├── LICENSE ├── README.md └── src ├── imagenodes.pas ├── imageshop.lpi ├── imageshop.lpr ├── imageshop.lps ├── imageshop.res ├── main.lfm ├── main.pas ├── pixels.pas └── styles.pas /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Codebot.ImageShop 2 | A visual node based image manipulation program. 3 | 4 | ## What is Image Shop? 5 | Image Shop is a cross platform teaching application that allows students to write programming functions and see the results. 6 | 7 | After a student writes a function, they can run the Image Shop program, drop their image function on a canvas, and visually connect it to other functions or images. Several functions can be combined to create new and interesteing image effects. 8 | 9 | This program is part of a greater computer programming studies course taught to children using resources and tools from the [getlazarus website](https://www.getlazarus.org/learn/). 10 | 11 | https://user-images.githubusercontent.com/1647932/117630628-64fd8f80-b149-11eb-8fe4-a273e9706c47.mp4 12 | 13 | ## See Also 14 | 15 | [**Codebot.SoundShop**](https://github.com/sysrpl/Codebot.SoundShop/) a similar program where students can write programming functions generating muscial effects and tone. 16 | -------------------------------------------------------------------------------- /src/imagenodes.pas: -------------------------------------------------------------------------------- 1 | unit ImageNodes; 2 | 3 | {$mode delphi} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Graphics, LCLType, LCLIntf, Pixels, ExtDlgs, Styles; 9 | 10 | { TBaseNode } 11 | 12 | type 13 | TBaseNode = class 14 | protected 15 | procedure Changed; virtual; abstract; 16 | procedure Update; virtual; abstract; 17 | function GetConnected: Boolean; virtual; abstract; 18 | function GetImage: TGraphic; virtual; abstract; 19 | public 20 | procedure Align; virtual; abstract; 21 | procedure Draw(Canvas: TCanvas); virtual; abstract; 22 | function MouseOver(X, Y: Integer): Boolean; virtual; abstract; 23 | procedure MouseDown(X, Y: Integer); virtual; abstract; 24 | procedure MouseDrag(X, Y: Integer); virtual; abstract; 25 | procedure MouseUp(X, Y: Integer); virtual; abstract; 26 | function Regenerate: Boolean; virtual; abstract; 27 | property Connected: Boolean read GetConnected; 28 | property Image: TGraphic read GetImage; 29 | end; 30 | 31 | TChildNode = class; 32 | TDisplayNode = class; 33 | 34 | { TNodeEnumerator } 35 | 36 | TNodeEnumerator = class 37 | private 38 | FList: TList; 39 | FPosition: Integer; 40 | public 41 | constructor Create(List: TList); 42 | function GetCurrent: TChildNode; 43 | function MoveNext: Boolean; 44 | property Current: TChildNode read GetCurrent; 45 | end; 46 | 47 | { TNodeList } 48 | 49 | TNodeList = class(TBaseNode) 50 | private 51 | FInsert: TPoint; 52 | FList: TList; 53 | FHotNode: TChildNode; 54 | FCaptureNode: TChildNode; 55 | FWidth: Integer; 56 | FHeight: Integer; 57 | FDisplay: TDisplayNode; 58 | FContainsNode: TChildNode; 59 | FContains: Boolean; 60 | FOnChange: TNotifyEvent; 61 | FOnUpdate: TNotifyEvent; 62 | function GetCount: Integer; 63 | function GetNode(Index: Integer): TChildNode; 64 | public 65 | function GetEnumerator: TNodeEnumerator; 66 | protected 67 | procedure Add(Node: TChildNode); 68 | procedure Changed; override; 69 | procedure Update; override; 70 | function GetConnected: Boolean; override; 71 | function GetImage: TGraphic; override; 72 | public 73 | constructor Create; 74 | destructor Destroy; override; 75 | procedure Remove(Node: TChildNode); 76 | procedure Clear; 77 | procedure Align; override; 78 | procedure Draw(Canvas: TCanvas); override; 79 | procedure Resize(Width, Height: Integer); 80 | function MouseOver(X, Y: Integer): Boolean; override; 81 | procedure MouseDown(X, Y: Integer); override; 82 | procedure MouseDrag(X, Y: Integer); override; 83 | procedure MouseUp(X, Y: Integer); override; 84 | function Contains(Node: TChildNode): Boolean; 85 | function Regenerate: Boolean; override; 86 | property Display: TDisplayNode read FDisplay; 87 | property Count: Integer read GetCount; 88 | property Node[Index: Integer]: TChildNode read GetNode; default; 89 | property Width: Integer read FWidth; 90 | property Height: Integer read FHeight; 91 | property OnChange: TNotifyEvent read FOnChange write FOnChange; 92 | property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate; 93 | end; 94 | 95 | { TPinKind } 96 | 97 | TPinKind = (pkInput, pkOutput); 98 | 99 | { TNodePin } 100 | 101 | TNodePin = class 102 | private 103 | FNode: TChildNode; 104 | FConnect: TNodePin; 105 | FKind: TPinKind; 106 | FLocation: TPoint; 107 | procedure SetConnect(Value: TNodePin); 108 | public 109 | constructor Create(Node: TChildNode; Kind: TPinKind); 110 | destructor Destroy; override; 111 | function CanConnect(Pin: TNodePin): Boolean; 112 | property Node: TChildNode read FNode; 113 | property Connect: TNodePin read FConnect write SetConnect; 114 | property Kind: TPinKind read FKind; 115 | end; 116 | 117 | { TChildNode } 118 | 119 | TChildNode = class(TBaseNode) 120 | private 121 | FOwner: TNodeList; 122 | FDragPin: TNodePin; 123 | FDragPoint: TPoint; 124 | FReleased: Boolean; 125 | FRect: TRect; 126 | FCaptionHeight: Integer; 127 | FTitle: string; 128 | FCloseDown: Boolean; 129 | function CloseRect: TRect; 130 | procedure SetTitle(const Value: string); 131 | protected 132 | procedure Changed; override; 133 | procedure Update; override; 134 | function GetConnected: Boolean; override; 135 | function GetImage: TGraphic; override; 136 | function GetInfo: string; virtual; 137 | procedure Release; virtual; 138 | function GetInputPin(Index: Integer): TNodePin; virtual; 139 | function GetInputCount: Integer; virtual; 140 | function GetOutputPin(Index: Integer): TNodePin; virtual; 141 | function GetOutputCount: Integer; virtual; 142 | property Owner: TNodeList read FOwner; 143 | property InputPin[Index: Integer]: TNodePin read GetInputPin; 144 | property InputCount: Integer read GetInputCount; 145 | property OutputPin[Index: Integer]: TNodePin read GetOutputPin; 146 | property OutputCount: Integer read GetOutputCount; 147 | public 148 | constructor Create(Owner: TNodeList); virtual; 149 | destructor Destroy; override; 150 | procedure Align; override; 151 | procedure Draw(Canvas: TCanvas); override; 152 | function PinFromPoint(X, Y: Integer; Kind: TPinKind): TNodePin; 153 | function MouseOver(X, Y: Integer): Boolean; override; 154 | procedure MouseDown(X, Y: Integer); override; 155 | procedure MouseDrag(X, Y: Integer); override; 156 | procedure MouseUp(X, Y: Integer); override; 157 | procedure MoveTo(X, Y: Integer); 158 | function Regenerate: Boolean; override; 159 | property Info: string read GetInfo; 160 | property Title: string read FTitle write SetTitle; 161 | end; 162 | 163 | { TDisplayNode } 164 | 165 | TDisplayNode = class(TChildNode) 166 | private 167 | FInput: TNodePin; 168 | protected 169 | function GetInfo: string; override; 170 | function GetInputPin(Index: Integer): TNodePin; override; 171 | function GetInputCount: Integer; override; 172 | public 173 | constructor Create(Owner: TNodeList); override; 174 | procedure Align; override; 175 | property Input: TNodePin read FInput; 176 | end; 177 | 178 | { TControlNode } 179 | 180 | TControlNode = class(TChildNode) 181 | private 182 | FControl: TRect; 183 | FPressed: Boolean; 184 | public 185 | procedure Draw(Canvas: TCanvas); override; 186 | procedure MouseDown(X, Y: Integer); override; 187 | procedure MouseDrag(X, Y: Integer); override; 188 | procedure MouseUp(X, Y: Integer); override; 189 | end; 190 | 191 | { TImageNode } 192 | 193 | TImageNode = class(TControlNode) 194 | private 195 | FOutput: TNodePin; 196 | FImage: TPortableNetworkGraphic; 197 | FSurface: TPortableNetworkGraphic; 198 | FFileName: string; 199 | protected 200 | function GetImage: TGraphic; override; 201 | function GetInfo: string; override; 202 | function GetOutputPin(Index: Integer): TNodePin; override; 203 | function GetOutputCount: Integer; override; 204 | public 205 | constructor Create(Owner: TNodeList); override; 206 | destructor Destroy; override; 207 | procedure Clear; 208 | procedure LoadImage(const FileName: string); 209 | function Regenerate: Boolean; override; 210 | procedure Draw(Canvas: TCanvas); override; 211 | procedure MouseUp(X, Y: Integer); override; 212 | property Output: TNodePin read FOutput; 213 | end; 214 | 215 | { TSliderNode } 216 | 217 | TSliderNode = class(TControlNode) 218 | private 219 | FPosition: Single; 220 | procedure SetPosition(Value: Single); 221 | public 222 | constructor Create(Owner: TNodeList); override; 223 | procedure Draw(Canvas: TCanvas); override; 224 | procedure MouseDrag(X, Y: Integer); override; 225 | property Position: Single read FPosition write SetPosition; 226 | end; 227 | 228 | { TOperationNode } 229 | 230 | TOperationNode = class(TSliderNode) 231 | private 232 | FOperation: TPixelOperation; 233 | FInput: TNodePin; 234 | FOutput: TNodePin; 235 | protected 236 | function GetImage: TGraphic; override; 237 | function GetInfo: string; override; 238 | function GetInputPin(Index: Integer): TNodePin; override; 239 | function GetInputCount: Integer; override; 240 | function GetOutputPin(Index: Integer): TNodePin; override; 241 | function GetOutputCount: Integer; override; 242 | public 243 | constructor Create(Owner: TNodeList); override; 244 | function Regenerate: Boolean; override; 245 | property Operation: TPixelOperation read FOperation write FOperation; 246 | property Input: TNodePin read FInput; 247 | property Output: TNodePin read FOutput; 248 | end; 249 | 250 | { TBlendNode } 251 | 252 | TBlendNode = class(TSliderNode) 253 | private 254 | FBlend: TPixelBlend; 255 | FImage: TPortableNetworkGraphic; 256 | FInputA: TNodePin; 257 | FInputB: TNodePin; 258 | FOutput: TNodePin; 259 | protected 260 | function GetImage: TGraphic; override; 261 | function GetInfo: string; override; 262 | function GetInputPin(Index: Integer): TNodePin; override; 263 | function GetInputCount: Integer; override; 264 | function GetOutputPin(Index: Integer): TNodePin; override; 265 | function GetOutputCount: Integer; override; 266 | public 267 | constructor Create(Owner: TNodeList); override; 268 | destructor Destroy; override; 269 | function Regenerate: Boolean; override; 270 | property Blend: TPixelBlend read FBlend write FBlend; 271 | property InputA: TNodePin read FInputA; 272 | property InputB: TNodePin read FInputB; 273 | property Output: TNodePin read FOutput; 274 | end; 275 | 276 | type 277 | TDirection = (dirLeft = DT_LEFT, dirCenter = DT_CENTER, dirRight = DT_RIGHT, dirWrap); 278 | 279 | procedure DrawString(Canvas: TCanvas; S: string; Rect: TRect; Direction: TDirection); 280 | function PointInRect(const Rect: TRect; X, Y: Integer): Boolean; 281 | 282 | implementation 283 | 284 | var 285 | SimpleWires: Boolean; 286 | 287 | function RectHeight(const Rect: TRect): Integer; 288 | begin 289 | Result := Rect.Bottom - Rect.Top; 290 | end; 291 | 292 | procedure DrawString(Canvas: TCanvas; S: string; Rect: TRect; Direction: TDirection); 293 | var 294 | F: Cardinal; 295 | R: TRect; 296 | begin 297 | if S = '' then 298 | Exit; 299 | F := DT_WORDBREAK; 300 | if Direction = dirWrap then 301 | DrawText(Canvas.Handle, PChar(S), -1, Rect, DT_LEFT or F); 302 | F := F or Ord(Direction); 303 | R := Rect; 304 | DrawText(Canvas.Handle, PChar(S), -1, R, F or DT_CALCRECT); 305 | Rect.Top := Rect.Top + RectHeight(Rect) div 2 - RectHeight(R) div 2; 306 | DrawText(Canvas.Handle, PChar(S), -1, Rect, F or DT_NOCLIP); 307 | end; 308 | 309 | const 310 | GridSize = 10; 311 | NodeWidth = 160; 312 | NodeHeight = 60; 313 | 314 | function PointInRect(const Rect: TRect; X, Y: Integer): Boolean; 315 | begin 316 | Result := (X > Rect.Left) and (X < Rect.Right) and 317 | (Y > Rect.Top) and (Y < Rect.Bottom); 318 | end; 319 | 320 | function RectIsEmpty(const Rect: TRect): Boolean; 321 | begin 322 | Result := (Rect.Left >= Rect.Right) or (Rect.Top >= Rect.Bottom); 323 | end; 324 | 325 | function InflateRect(X, Y: Integer; const Rect: TRect): TRect; 326 | begin 327 | Result := Rect; 328 | Dec(Result.Left, X); 329 | Dec(Result.Top, Y); 330 | Inc(Result.Right, X); 331 | Inc(Result.Bottom, Y); 332 | end; 333 | 334 | { TNodePin } 335 | 336 | constructor TNodePin.Create(Node: TChildNode; Kind: TPinKind); 337 | begin 338 | inherited Create; 339 | FNode := Node; 340 | FKind := Kind; 341 | end; 342 | 343 | destructor TNodePin.Destroy; 344 | begin 345 | Connect := nil; 346 | inherited Destroy; 347 | end; 348 | 349 | procedure TNodePin.SetConnect(Value: TNodePin); 350 | begin 351 | if Value = nil then 352 | begin 353 | if FConnect <> nil then 354 | FConnect.FConnect := nil; 355 | FConnect := nil; 356 | FNode.Changed; 357 | end 358 | else if CanConnect(Value) then 359 | begin 360 | if FConnect <> nil then 361 | begin 362 | if FConnect.FConnect <> nil then 363 | FConnect.FConnect.FConnect := nil; 364 | FConnect.FConnect := nil; 365 | end; 366 | if Value.FConnect <> nil then 367 | Value.FConnect.FConnect := nil; 368 | FConnect := Value; 369 | FConnect.FConnect := Self; 370 | FNode.Changed; 371 | end; 372 | if FNode.FOwner <> nil then 373 | FNode.FOwner.Update; 374 | end; 375 | 376 | function TNodePin.CanConnect(Pin: TNodePin): Boolean; 377 | var 378 | Linked: Boolean; 379 | 380 | procedure CheckLinks(Node: TChildNode); 381 | var 382 | P: TNodePin; 383 | I: Integer; 384 | begin 385 | for I := 0 to Node.GetOutputCount - 1 do 386 | begin 387 | P := Node.GetOutputPin(I); 388 | if P.Connect <> nil then 389 | if P.Connect.FNode = FNode then 390 | begin 391 | Linked := True; 392 | Exit; 393 | end 394 | else 395 | CheckLinks(P.Connect.FNode); 396 | end; 397 | end; 398 | 399 | begin 400 | if FKind = pkInput then 401 | Exit(False); 402 | Result := (Pin.FNode <> FNode) and (Pin.FKind = pkInput); 403 | if Result then 404 | begin 405 | Linked := False; 406 | CheckLinks(Pin.FNode); 407 | Result := not Linked; 408 | end; 409 | end; 410 | 411 | { TNodeEnumerator } 412 | 413 | constructor TNodeEnumerator.Create(List: TList); 414 | begin 415 | inherited Create; 416 | FList := List; 417 | FPosition := -1; 418 | end; 419 | 420 | function TNodeEnumerator.GetCurrent: TChildNode; 421 | begin 422 | Result := TChildNode(FList[FPosition]); 423 | end; 424 | 425 | function TNodeEnumerator.MoveNext: Boolean; 426 | begin 427 | Inc(FPosition); 428 | Result := FPosition < FList.Count; 429 | end; 430 | 431 | { TNodeList } 432 | 433 | function TNodeList.GetEnumerator: TNodeEnumerator; 434 | begin 435 | Result := TNodeEnumerator.Create(FList); 436 | end; 437 | 438 | constructor TNodeList.Create; 439 | begin 440 | inherited Create; 441 | FList := TList.Create; 442 | FDisplay := TDisplayNode.Create(Self); 443 | end; 444 | 445 | destructor TNodeList.Destroy; 446 | begin 447 | FDisplay := nil; 448 | while Count > 1 do 449 | Remove(Node[0]); 450 | FList.Free; 451 | inherited Destroy; 452 | end; 453 | 454 | function TNodeList.GetCount: Integer; 455 | begin 456 | Result := FList.Count; 457 | end; 458 | 459 | function TNodeList.GetNode(Index: Integer): TChildNode; 460 | begin 461 | Result := TChildNode(FList[Index]); 462 | end; 463 | 464 | procedure TNodeList.Changed; 465 | begin 466 | if Assigned(FOnChange) then 467 | FOnChange(Self); 468 | end; 469 | 470 | procedure TNodeList.Update; 471 | begin 472 | if Assigned(FOnUpdate) then 473 | FOnUpdate(Self); 474 | end; 475 | 476 | procedure TNodeList.Add(Node: TChildNode); 477 | begin 478 | FList.Add(Node); 479 | Inc(FInsert.X, GridSize * 2); 480 | if FInsert.X > 500 then 481 | FInsert.X := GridSize * 2; 482 | Inc(FInsert.Y, GridSize * 2); 483 | if FInsert.Y > 200 then 484 | FInsert.Y := GridSize * 2; 485 | Node.FRect.TopLeft := FInsert; 486 | Node.FRect.Right := Node.FRect.Left + NodeWidth; 487 | Node.FRect.Bottom := Node.FRect.Top + NodeHeight; 488 | Node.Align; 489 | Changed; 490 | end; 491 | 492 | procedure TNodeList.Remove(Node: TChildNode); 493 | var 494 | WasConnected: Boolean; 495 | begin 496 | if Node.Owner = Self then 497 | begin 498 | WasConnected := Contains(Node); 499 | FList.Remove(Node); 500 | Node.Release; 501 | Changed; 502 | if WasConnected then 503 | Update; 504 | end; 505 | end; 506 | 507 | procedure TNodeList.Clear; 508 | begin 509 | FDisplay := nil; 510 | while Count > 0 do 511 | Remove(Node[0]); 512 | FDisplay := TDisplayNode.Create(Self); 513 | FInsert.X := GridSize; 514 | FInsert.Y := GridSize; 515 | Changed; 516 | Update; 517 | end; 518 | 519 | procedure TNodeList.Align; 520 | var 521 | N: TChildNode; 522 | begin 523 | for N in Self do N.Align; 524 | end; 525 | 526 | procedure TNodeList.Draw(Canvas: TCanvas); 527 | var 528 | N: TChildNode; 529 | X, Y: Integer; 530 | R: TRect; 531 | S: string; 532 | begin 533 | Canvas.Brush.Color := clStyleWindow; 534 | Canvas.FillRect(0, 0, FWidth, FHeight); 535 | Canvas.Pen.Color := clBlack; 536 | Canvas.Pen.Style := psDot; 537 | for X := 0 to FWidth div GridSize div 2 + 1 do 538 | begin 539 | Y := X * GridSize * 2; 540 | Canvas.MoveTo(Y, 0); 541 | Canvas.LineTo(Y, FHeight + 1); 542 | end; 543 | for Y := 0 to FHeight div GridSize div 2 + 1 do 544 | begin 545 | X := Y * GridSize * 2; 546 | Canvas.MoveTo(0, X); 547 | Canvas.LineTo(FWidth + 1, X); 548 | end; 549 | Canvas.Pen.Style := psSolid; 550 | for N in Self do 551 | N.Draw(Canvas); 552 | if FHotNode <> nil then 553 | begin 554 | S := FHotNode.Info; 555 | if S = '' then 556 | Exit; 557 | R.Right := FWidth + 1; 558 | R.Bottom := FHeight + 1; 559 | R.Top := R.Bottom - Canvas.TextHeight('Wg') - 8; 560 | R.Left := R.Right - Canvas.TextWidth(S) - 16; 561 | Canvas.Pen.Color := clStyleText; 562 | Canvas.Brush.Color := clStyleWindow; 563 | Canvas.Rectangle(R); 564 | Canvas.Font.Color := clStyleText; 565 | Inc(R.Left, 8); 566 | DrawString(Canvas, S, R, dirLeft); 567 | end; 568 | end; 569 | 570 | procedure TNodeList.Resize(Width, Height: Integer); 571 | begin 572 | FWidth := Width; 573 | FHeight := Height; 574 | Align; 575 | Changed; 576 | end; 577 | 578 | function TNodeList.MouseOver(X, Y: Integer): Boolean; 579 | var 580 | N: TChildNode; 581 | I: Integer; 582 | begin 583 | Result := False; 584 | if FCaptureNode <> nil then 585 | begin 586 | MouseDrag(X, Y); 587 | Exit; 588 | end; 589 | for I := Count - 1 downto 0 do 590 | begin 591 | N := Node[I]; 592 | if N.MouseOver(X, Y) then 593 | begin 594 | if FHotNode <> N then 595 | Changed; 596 | FHotNode := N; 597 | Exit; 598 | end; 599 | end; 600 | if FHotNode <> nil then 601 | Changed; 602 | FHotNode := nil; 603 | end; 604 | 605 | procedure TNodeList.MouseDown(X, Y: Integer); 606 | var 607 | N: TChildNode; 608 | I: Integer; 609 | begin 610 | if (FHotNode <> nil) or (FCaptureNode <> nil) then 611 | Changed; 612 | FCaptureNode := nil; 613 | for I := Count - 1 downto 0 do 614 | begin 615 | N := Node[I]; 616 | if N.MouseOver(X, Y) then 617 | begin 618 | FHotNode := N; 619 | FCaptureNode := N; 620 | N.MouseDown(X, Y); 621 | N.MouseDrag(X, Y); 622 | Exit; 623 | end; 624 | end; 625 | end; 626 | 627 | procedure TNodeList.MouseDrag(X, Y: Integer); 628 | begin 629 | if FCaptureNode = nil then 630 | Exit; 631 | FCaptureNode.MouseDrag(X, Y); 632 | end; 633 | 634 | procedure TNodeList.MouseUp(X, Y: Integer); 635 | begin 636 | if FCaptureNode = nil then 637 | Exit; 638 | FCaptureNode.MouseUp(X, Y); 639 | FCaptureNode := nil; 640 | Changed; 641 | end; 642 | 643 | function TNodeList.Contains(Node: TChildNode): Boolean; 644 | begin 645 | FContainsNode := Node; 646 | FContains := False; 647 | GetImage; 648 | Result := FContains; 649 | end; 650 | 651 | function TNodeList.Regenerate: Boolean; 652 | begin 653 | Result := FDisplay.Regenerate; 654 | end; 655 | 656 | function TNodeList.GetConnected: Boolean; 657 | begin 658 | Result := FDisplay.GetConnected; 659 | end; 660 | 661 | function TNodeList.GetImage; 662 | begin 663 | if FDisplay <> nil then 664 | Result := FDisplay.GetImage 665 | else 666 | Result := nil; 667 | end; 668 | 669 | { TChildNode } 670 | 671 | constructor TChildNode.Create(Owner: TNodeList); 672 | begin 673 | inherited Create; 674 | FOwner := Owner; 675 | FOwner.Add(Self); 676 | end; 677 | 678 | destructor TChildNode.Destroy; 679 | var 680 | I: Integer; 681 | begin 682 | FReleased := True; 683 | for I := 0 to OutputCount - 1 do 684 | OutputPin[I].Free; 685 | for I := 0 to InputCount - 1 do 686 | InputPin[I].Free; 687 | inherited Destroy; 688 | end; 689 | 690 | function TChildNode.CloseRect: TRect; 691 | begin 692 | if Self is TDisplayNode then 693 | begin 694 | Result.Left := 0; 695 | Result.Top := 0; 696 | Result.Right := 0; 697 | Result.Bottom := 0; 698 | end 699 | else 700 | begin 701 | Result := FRect; 702 | Result.Bottom := FRect.Top + FCaptionHeight; 703 | Result.Left := Result.Right - FCaptionHeight; 704 | Result := InflateRect(-3, -3, Result); 705 | end; 706 | end; 707 | 708 | procedure TChildNode.Release; 709 | var 710 | PriorOwner: TNodeList; 711 | MustFree: Boolean; 712 | begin 713 | PriorOwner := FOwner; 714 | if PriorOwner = nil then 715 | Exit; 716 | FOwner := nil; 717 | MustFree := not FReleased; 718 | FReleased := True; 719 | PriorOwner.Remove(Self); 720 | if MustFree then 721 | Free; 722 | end; 723 | 724 | function TChildNode.GetInputPin(Index: Integer): TNodePin; 725 | begin 726 | Result := nil; 727 | end; 728 | 729 | function TChildNode.GetInputCount: Integer; 730 | begin 731 | Result := 0; 732 | end; 733 | 734 | function TChildNode.GetOutputPin(Index: Integer): TNodePin; 735 | begin 736 | Result := nil; 737 | end; 738 | 739 | function TChildNode.GetOutputCount: Integer; 740 | begin 741 | Result := 0; 742 | end; 743 | 744 | procedure TChildNode.SetTitle(const Value: string); 745 | begin 746 | if Value <> FTitle then 747 | begin 748 | FTitle := Value; 749 | Changed; 750 | end; 751 | end; 752 | 753 | procedure TChildNode.Changed; 754 | begin 755 | if FOwner <> nil then 756 | FOwner.Changed; 757 | end; 758 | 759 | procedure TChildNode.Update; 760 | begin 761 | if FOwner <> nil then 762 | if FOwner.Contains(Self) then 763 | FOwner.Update; 764 | end; 765 | 766 | function TChildNode.GetConnected; 767 | begin 768 | Result := GetImage <> nil; 769 | end; 770 | 771 | function TChildNode.GetImage: TGraphic; 772 | begin 773 | if FOwner.FContainsNode = Self then 774 | FOwner.FContains := True; 775 | Result := nil; 776 | if (InputCount > 0) and (InputPin[0].Connect <> nil) then 777 | Result := InputPin[0].Connect.Node.GetImage; 778 | end; 779 | 780 | function TChildNode.GetInfo: string; 781 | begin 782 | Result := ''; 783 | end; 784 | 785 | function TChildNode.Regenerate: Boolean; 786 | begin 787 | Result := False; 788 | if (InputCount > 0) and (InputPin[0].Connect <> nil) then 789 | Result := InputPin[0].Connect.Node.Regenerate; 790 | end; 791 | 792 | procedure TChildNode.Align; 793 | var 794 | R: TRect; 795 | P: TPoint; 796 | I: Integer; 797 | begin 798 | R.Left := FRect.Left div GridSize * GridSize; 799 | if R.Left < 0 then 800 | R.Left := 0; 801 | R.Top := FRect.Top div GridSize * GridSize; 802 | if R.Top < 0 then 803 | R.Top := 0; 804 | R.Right := R.Left + NodeWidth; 805 | R.Bottom := R.Top + NodeHeight; 806 | for I := 0 to InputCount - 1 do 807 | begin 808 | P.X := R.Left - GridSize; 809 | P.Y := R.Top + NodeHeight div (InputCount + 1) * (I + 1); 810 | InputPin[I].FLocation := P; 811 | end; 812 | for I := 0 to OutputCount - 1 do 813 | begin 814 | P.X := R.Right + GridSize; 815 | P.Y := R.Top + NodeHeight div (OutputCount + 1) * (I + 1); 816 | OutputPin[I].FLocation := P; 817 | end; 818 | if FRect <> R then 819 | begin 820 | FRect := R; 821 | Changed; 822 | end; 823 | end; 824 | 825 | procedure TChildNode.Draw(Canvas: TCanvas); 826 | 827 | procedure DrawClose; 828 | const 829 | Offset = 4; 830 | var 831 | R: TRect; 832 | C: TColor; 833 | begin 834 | R := CloseRect; 835 | if RectIsEmpty(R) then 836 | Exit; 837 | C := Canvas.Pen.Color; 838 | if FCloseDown then 839 | Canvas.Pen.Color := clStyleHighlight; 840 | Canvas.Pen.Width := 3; 841 | Canvas.MoveTo(R.Left + Offset, R.Top + Offset); 842 | Canvas.LineTo(R.Right - Offset - 1, R.Bottom - Offset - 1); 843 | Canvas.MoveTo(R.Left + Offset, R.Bottom - Offset - 1); 844 | Canvas.LineTo(R.Right - Offset - 1, R.Top + Offset); 845 | Canvas.Pen.Width := 1; 846 | Canvas.Pen.Color := C; 847 | end; 848 | 849 | procedure DrawWire(A, B: TPoint); 850 | var 851 | X: Integer; 852 | begin 853 | Canvas.MoveTo(FRect.Right, A.Y); 854 | Canvas.LineTo(A.X, A.Y); 855 | if B.X < A.X + GridSize then 856 | begin 857 | if B.Y > A.Y then 858 | begin 859 | Canvas.LineTo(A.X, FRect.Bottom + GridSize * 2); 860 | Canvas.LineTo(B.X - GridSize div 2, FRect.Bottom + GridSize * 2); 861 | Canvas.LineTo(B.X - GridSize div 2, B.Y); 862 | end 863 | else 864 | begin 865 | Canvas.LineTo(A.X, FRect.Top - GridSize * 2); 866 | Canvas.LineTo(B.X - GridSize div 2, FRect.Top - GridSize * 2); 867 | Canvas.LineTo(B.X - GridSize div 2, B.Y); 868 | end; 869 | end 870 | else if (B.X - A.X > Abs(B.Y - A.Y)) then 871 | begin 872 | X := ((B.X - A.X) - Abs(B.Y - A.Y)) div 2; 873 | Canvas.LineTo(A.X + X, A.Y); 874 | Canvas.LineTo(B.X - X, B.Y); 875 | Canvas.LineTo(B.X, B.Y); 876 | end 877 | else 878 | begin 879 | X := (B.X - A.X - GridSize) div 2; 880 | Canvas.LineTo(A.X + X, A.Y); 881 | Canvas.LineTo(A.X + X, B.Y); 882 | Canvas.LineTo(B.X - GridSize, B.Y); 883 | end; 884 | B.X := B.X - GridSize; 885 | Canvas.Brush.Color := Canvas.Pen.Color; 886 | Canvas.Brush.Color := Canvas.Pen.Color; 887 | Canvas.Rectangle(B.X + 1, B.Y - GridSize div 2 + 1, 888 | B.X + GridSize - 1, B.Y + GridSize div 2 - 1); 889 | end; 890 | 891 | var 892 | R: TRect; 893 | P: TPoint; 894 | I: Integer; 895 | begin 896 | R := FRect; 897 | if Self = FOwner.FHotNode then 898 | begin 899 | Canvas.Pen.Color := clStyleText; 900 | Canvas.Font.Color := clStyleText; 901 | end 902 | else 903 | begin 904 | Canvas.Pen.Color := clStyleDull; 905 | Canvas.Font.Color := clStyleDull; 906 | end; 907 | Canvas.Brush.Color := clStyleWindow; 908 | Canvas.Rectangle(R); 909 | FCaptionHeight := Canvas.TextHeight('Wg') + 8; 910 | R.Bottom := R.Top + FCaptionHeight; 911 | Canvas.Rectangle(R); 912 | Canvas.TextOut(R.Left + 8, R.Top + 4, FTitle); 913 | DrawClose; 914 | if InputCount > 0 then 915 | begin 916 | for I := 0 to InputCount - 1 do 917 | begin 918 | P := InputPin[I].FLocation; 919 | Canvas.MoveTo(FRect.Left, P.Y); 920 | Canvas.LineTo(P.X, P.Y); 921 | Canvas.LineTo(P.X, P.Y - GridSize div 2); 922 | Canvas.LineTo(P.X - GridSize, P.Y - GridSize div 2); 923 | Canvas.MoveTo(P.X, P.Y); 924 | Canvas.LineTo(P.X, P.Y + GridSize div 2); 925 | Canvas.LineTo(P.X - GridSize, P.Y + GridSize div 2); 926 | end; 927 | end; 928 | if OutputCount > 0 then 929 | begin 930 | for I := 0 to OutputCount - 1 do 931 | begin 932 | if OutputPin[I] = FDragPin then 933 | begin 934 | if SimpleWires then 935 | begin 936 | P := OutputPin[I].FLocation; 937 | Canvas.MoveTo(FRect.Right, P.Y); 938 | Canvas.LineTo(P.X, P.Y); 939 | P := FDragPoint; 940 | Canvas.LineTo(P.X - GridSize, P.Y); 941 | P.X := P.X - GridSize; 942 | Canvas.Brush.Color := Canvas.Pen.Color; 943 | Canvas.Rectangle(P.X, P.Y * (I + 1) - GridSize div 2 + 2, 944 | P.X + GridSize - 2, P.Y * (I + 1) + GridSize div 2 - 1); 945 | end 946 | else 947 | DrawWire(OutputPin[I].FLocation, FDragPoint); 948 | end 949 | else if OutputPin[I].Connect <> nil then 950 | begin 951 | if SimpleWires then 952 | begin 953 | P := OutputPin[I].FLocation; 954 | Canvas.MoveTo(FRect.Right, P.Y); 955 | Canvas.LineTo(P.X, P.Y); 956 | P := OutputPin[I].Connect.FLocation; 957 | P.X := P.X - GridSize; 958 | Canvas.LineTo(P.X, P.Y); 959 | Canvas.Brush.Color := Canvas.Pen.Color; 960 | Canvas.Rectangle(P.X, P.Y * (I + 1) - GridSize div 2 + 2, 961 | P.X + GridSize - 2, P.Y * (I + 1) + GridSize div 2 - 1); 962 | end 963 | else 964 | DrawWire(OutputPin[I].FLocation, OutputPin[I].Connect.FLocation); 965 | end 966 | else 967 | begin 968 | P := OutputPin[I].FLocation; 969 | Canvas.MoveTo(FRect.Right, P.Y); 970 | Canvas.LineTo(P.X, P.Y); 971 | Canvas.Brush.Color := Canvas.Pen.Color; 972 | Canvas.Rectangle(P.X, P.Y * (I + 1) - GridSize div 2 + 1, 973 | P.X + GridSize - 2, P.Y * (I + 1) + GridSize div 2 - 1); 974 | end; 975 | end; 976 | end; 977 | end; 978 | 979 | function Distance(X1, Y1, X2, Y2: Integer): Double; 980 | begin 981 | Result := Sqrt((X1 - X2) * (X1 - X2) + (Y1 - Y2) * (Y1 - Y2)); 982 | end; 983 | 984 | function TChildNode.PinFromPoint(X, Y: Integer; Kind: TPinKind): TNodePin; 985 | var 986 | C: TNodePin; 987 | P: TPoint; 988 | I: Integer; 989 | begin 990 | Result := nil; 991 | if Kind = pkInput then 992 | for I := 0 to InputCount - 1 do 993 | begin 994 | P := InputPin[I].FLocation; 995 | if Distance(X, Y, P.X, P.Y) < GridSize then 996 | Exit(InputPin[I]) 997 | end 998 | else 999 | for I := 0 to OutputCount - 1 do 1000 | begin 1001 | C := OutputPin[I].Connect; 1002 | if C = nil then 1003 | begin 1004 | P := OutputPin[I].FLocation; 1005 | if Distance(X, Y, P.X, P.Y) < GridSize then 1006 | Exit(OutputPin[I]); 1007 | end 1008 | else 1009 | begin 1010 | P := C.FLocation; 1011 | if Distance(X, Y, P.X, P.Y) < GridSize then 1012 | Exit(OutputPin[I]); 1013 | end; 1014 | end; 1015 | end; 1016 | 1017 | function TChildNode.MouseOver(X, Y: Integer): Boolean; 1018 | begin 1019 | Result := PointInRect(FRect, X, Y) or (PinFromPoint(X, Y, pkOutput) <> nil); 1020 | end; 1021 | 1022 | procedure TChildNode.MouseDown(X, Y: Integer); 1023 | begin 1024 | FOwner.FList.Remove(Self); 1025 | FOwner.FList.Add(Self); 1026 | FCloseDown := PointInRect(CloseRect, X, Y); 1027 | if FCloseDown then 1028 | begin 1029 | Changed; 1030 | Exit; 1031 | end; 1032 | FDragPoint.X := X; 1033 | FDragPoint.Y := Y; 1034 | FDragPin := PinFromPoint(X, Y, pkOutput); 1035 | end; 1036 | 1037 | procedure TChildNode.MouseDrag(X, Y: Integer); 1038 | begin 1039 | if FCloseDown then 1040 | Exit; 1041 | if FDragPin <> nil then 1042 | begin 1043 | FDragPoint.X := X; 1044 | FDragPoint.Y := Y; 1045 | Changed; 1046 | end 1047 | else 1048 | MoveTo(X, Y); 1049 | end; 1050 | 1051 | procedure TChildNode.MouseUp(X, Y: Integer); 1052 | var 1053 | N: TChildNode; 1054 | P: TNodePin; 1055 | I: Integer; 1056 | begin 1057 | if FCloseDown then 1058 | begin 1059 | FCloseDown := False; 1060 | Changed; 1061 | if PointInRect(CloseRect, X, Y) then 1062 | FOwner.Remove(Self); 1063 | Exit; 1064 | end; 1065 | if FDragPin <> nil then 1066 | begin 1067 | FDragPin.Connect := nil; 1068 | for N in FOwner do 1069 | begin 1070 | if N = Self then 1071 | Continue; 1072 | for I := 0 to N.InputCount - 1 do 1073 | begin 1074 | P := N.PinFromPoint(X, Y, pkInput); 1075 | if (P <> nil) and FDragPin.CanConnect(P) then 1076 | begin 1077 | FDragPin.Connect := P; 1078 | FDragPin := nil; 1079 | Exit; 1080 | end; 1081 | end; 1082 | end; 1083 | end; 1084 | FDragPin := nil; 1085 | end; 1086 | 1087 | procedure TChildNode.MoveTo(X, Y: Integer); 1088 | var 1089 | X1, Y1: Integer; 1090 | begin 1091 | X1 := X - NodeWidth div 2; 1092 | Y1 := Y - NodeHeight div 2; 1093 | X1 := X1 div GridSize * GridSize; 1094 | Y1 := Y1 div GridSize * GridSize; 1095 | if (X1 <> FRect.Left) or (Y1 <> FRect.Top) then 1096 | begin 1097 | FRect.Left := X1; 1098 | FRect.Top := Y - FCaptionHeight div 3; 1099 | Align; 1100 | end; 1101 | end; 1102 | 1103 | { TDisplayNode } 1104 | 1105 | constructor TDisplayNode.Create(Owner: TNodeList); 1106 | begin 1107 | FInput := TNodePin.Create(Self, pkInput); 1108 | inherited Create(Owner); 1109 | Title := 'Final output'; 1110 | end; 1111 | 1112 | function TDisplayNode.GetInfo: string; 1113 | var 1114 | G: TGraphic; 1115 | begin 1116 | G := GetImage; 1117 | if G <> nil then 1118 | Result := Format('Final output %d X %d', [G.Width, G.Height]) 1119 | else 1120 | Result := 'Final output no image'; 1121 | end; 1122 | 1123 | function TDisplayNode.GetInputPin(Index: Integer): TNodePin; 1124 | begin 1125 | case Index of 1126 | 0: Result := FInput; 1127 | else 1128 | Result := nil; 1129 | end; 1130 | end; 1131 | 1132 | function TDisplayNode.GetInputCount: Integer; 1133 | begin 1134 | Result := 1; 1135 | end; 1136 | 1137 | procedure TDisplayNode.Align; 1138 | begin 1139 | FRect.Top := (Owner.Height - NodeHeight) div 2; 1140 | FRect.Left := Owner.Width - NodeWidth - GridSize * 2; 1141 | FRect.Right := FRect.Left + NodeWidth; 1142 | FRect.Bottom := FRect.Top + NodeHeight; 1143 | inherited Align; 1144 | end; 1145 | 1146 | { TControlNode } 1147 | 1148 | procedure TControlNode.Draw(Canvas: TCanvas); 1149 | begin 1150 | inherited Draw(Canvas); 1151 | FControl := FRect; 1152 | FControl.Top := FControl.Top + FCaptionHeight; 1153 | FControl := InflateRect(-12, -8, FControl); 1154 | FControl.Top := FControl.Top - 1; 1155 | Canvas.Brush.Color := clStyleWindow; 1156 | end; 1157 | 1158 | procedure TControlNode.MouseDown(X, Y: Integer); 1159 | begin 1160 | inherited MouseDown(X, Y); 1161 | FPressed := PointInRect(FControl, X, Y); 1162 | if FPressed then 1163 | Changed; 1164 | end; 1165 | 1166 | procedure TControlNode.MouseDrag(X, Y: Integer); 1167 | begin 1168 | if not FPressed then 1169 | inherited MouseDrag(X, Y); 1170 | end; 1171 | 1172 | procedure TControlNode.MouseUp(X, Y: Integer); 1173 | begin 1174 | inherited MouseUp(X, Y); 1175 | if FPressed then 1176 | Changed; 1177 | FPressed := False; 1178 | end; 1179 | 1180 | { TImageNode } 1181 | 1182 | constructor TImageNode.Create(Owner: TNodeList); 1183 | begin 1184 | FOutput := TNodePin.Create(Self, pkOutput); 1185 | FImage := TPortableNetworkGraphic.Create; 1186 | FSurface := TPortableNetworkGraphic.Create; 1187 | inherited Create(Owner); 1188 | Title := 'No image'; 1189 | end; 1190 | 1191 | destructor TImageNode.Destroy; 1192 | begin 1193 | FImage.Free; 1194 | FSurface.Free; 1195 | inherited Destroy; 1196 | end; 1197 | 1198 | procedure TImageNode.Clear; 1199 | begin 1200 | FImage.Width := 0; 1201 | FImage.Height := 0; 1202 | FSurface.Width := 0; 1203 | FSurface.Height := 0; 1204 | end; 1205 | 1206 | procedure TImageNode.LoadImage(const FileName: string); 1207 | var 1208 | P: TPicture; 1209 | A, B: PPixel; 1210 | {$ifdef linux} 1211 | C: Byte; 1212 | {$endif} 1213 | I: Integer; 1214 | begin 1215 | P := TPicture.Create; 1216 | try 1217 | P.LoadFromFile(FileName); 1218 | FImage.Width := P.Width; 1219 | FImage.Height := P.Height; 1220 | FImage.PixelFormat := pf32bit; 1221 | if (P.Graphic is TPortableNetworkGraphic) and 1222 | (TPortableNetworkGraphic(P.Graphic).PixelFormat = pf32bit) then 1223 | begin 1224 | A := TPortableNetworkGraphic(P.Graphic).ScanLine[0]; 1225 | B := FImage.ScanLine[0]; 1226 | for I := 1 to FImage.Width * FImage.Height do 1227 | begin 1228 | B^ := A^; 1229 | {$ifdef linux} 1230 | C := B.R; 1231 | B.R := B.B; 1232 | B.B := C; 1233 | {$endif} 1234 | Inc(A); 1235 | Inc(B); 1236 | end; 1237 | end 1238 | else 1239 | begin 1240 | FImage.Canvas.Draw(0, 0, P.Graphic); 1241 | A := FImage.ScanLine[0]; 1242 | for I := 1 to FImage.Width * FImage.Height do 1243 | begin 1244 | A.A := $FF; 1245 | Inc(A); 1246 | end; 1247 | end; 1248 | Regenerate; 1249 | FFileName:= FileName; 1250 | finally 1251 | P.Free; 1252 | end; 1253 | Changed; 1254 | Update; 1255 | end; 1256 | 1257 | function TImageNode.GetImage: TGraphic; 1258 | begin 1259 | if FOwner.FContainsNode = Self then 1260 | FOwner.FContains := True; 1261 | if FSurface.Empty then 1262 | Result := nil 1263 | else 1264 | Result := FSurface; 1265 | end; 1266 | 1267 | function TImageNode.GetInfo: string; 1268 | begin 1269 | if FSurface.Empty then 1270 | Result := 'No image has been loaded' 1271 | else 1272 | Result := Format('Image %d X %d from %s', [FSurface.Width, FSurface.Height, FFileName]); 1273 | end; 1274 | 1275 | function TImageNode.Regenerate: Boolean; 1276 | var 1277 | A, B: PPixel; 1278 | begin 1279 | Result := not FImage.Empty; 1280 | if Result then 1281 | begin 1282 | FSurface.Width := 0; 1283 | FSurface.Height := 0; 1284 | FSurface.Width := FImage.Width; 1285 | FSurface.Height := FImage.Height; 1286 | FSurface.PixelFormat := pf32bit; 1287 | A := FImage.ScanLine[0]; 1288 | B := FSurface.ScanLine[0]; 1289 | Move(A^, B^, FImage.Width * FImage.Height * SizeOf(TPixel)); 1290 | end; 1291 | end; 1292 | 1293 | procedure TImageNode.Draw(Canvas: TCanvas); 1294 | var 1295 | C: TColor; 1296 | begin 1297 | inherited Draw(Canvas); 1298 | if Self = FOwner.FHotNode then 1299 | C := clStyleText 1300 | else 1301 | C := clStyleDull; 1302 | if FPressed then 1303 | begin 1304 | Canvas.Pen.Color := clStyleHighlight; 1305 | Canvas.Font.Color := clStyleHighlight; 1306 | end 1307 | else 1308 | begin 1309 | Canvas.Pen.Color := C; 1310 | Canvas.Font.Color := C; 1311 | end; 1312 | Canvas.Rectangle(FControl); 1313 | FControl.Bottom := FControl.Bottom - 1; 1314 | DrawString(Canvas, 'Open Image', FControl, dirCenter); 1315 | Canvas.Pen.Color := C; 1316 | Canvas.Font.Color := C; 1317 | end; 1318 | 1319 | procedure TImageNode.MouseUp(X, Y: Integer); 1320 | const 1321 | Limit = 17; 1322 | var 1323 | WasPressed: Boolean; 1324 | D: TOpenPictureDialog; 1325 | S: string; 1326 | begin 1327 | WasPressed := FPressed; 1328 | inherited MouseUp(X, Y); 1329 | if WasPressed and PointInRect(FControl, X, Y) then 1330 | begin 1331 | D := TOpenPictureDialog.Create(nil); 1332 | try 1333 | if D.Execute then 1334 | begin 1335 | S := D.FileName; 1336 | LoadImage(S); 1337 | S := ExtractFileName(S); 1338 | if Length(S) > Limit then 1339 | SetLength(S, Limit); 1340 | Title := S; 1341 | end; 1342 | finally 1343 | D.Free; 1344 | end; 1345 | end; 1346 | end; 1347 | 1348 | function TImageNode.GetOutputPin(Index: Integer): TNodePin; 1349 | begin 1350 | case Index of 1351 | 0: Result := FOutput; 1352 | else 1353 | Result := nil; 1354 | end; 1355 | end; 1356 | 1357 | function TImageNode.GetOutputCount: Integer; 1358 | begin 1359 | Result := 1; 1360 | end; 1361 | 1362 | { TSliderNode } 1363 | 1364 | constructor TSliderNode.Create(Owner: TNodeList); 1365 | begin 1366 | FPosition := 1; 1367 | inherited Create(Owner); 1368 | end; 1369 | 1370 | procedure TSliderNode.SetPosition(Value: Single); 1371 | begin 1372 | if Value < 0 then 1373 | Value := 0; 1374 | if Value > 1 then 1375 | Value := 1; 1376 | if FPosition <> Value then 1377 | begin 1378 | FPosition := Value; 1379 | Changed; 1380 | Update; 1381 | end; 1382 | end; 1383 | 1384 | procedure TSliderNode.Draw(Canvas: TCanvas); 1385 | const 1386 | Thumb = 4; 1387 | var 1388 | C: TColor; 1389 | R: TRect; 1390 | X, Y: Integer; 1391 | begin 1392 | inherited Draw(Canvas); 1393 | if Self = FOwner.FHotNode then 1394 | C := clStyleText 1395 | else 1396 | C := clStyleDull; 1397 | if FPressed then 1398 | begin 1399 | Canvas.Pen.Color := clStyleHighlight; 1400 | Canvas.Font.Color := clStyleHighlight; 1401 | end 1402 | else 1403 | begin 1404 | Canvas.Pen.Color := C; 1405 | Canvas.Font.Color := C; 1406 | end; 1407 | R := FControl; 1408 | R.Left := R.Left + Thumb; 1409 | R.Right := R.Right - Thumb; 1410 | X := R.Left + Round(FPosition * (R.Right - R.Left)); 1411 | Y := (R.Top + R.Bottom) div 2; 1412 | Canvas.MoveTo(R.Left, Y); 1413 | Canvas.LineTo(R.Right, Y); 1414 | Canvas.Rectangle(X - Thumb, R.Top, X + Thumb, R.Bottom); 1415 | end; 1416 | 1417 | procedure TSliderNode.MouseDrag(X, Y: Integer); 1418 | begin 1419 | inherited MouseDrag(X, Y); 1420 | if FPressed then 1421 | Position := (X - FControl.Left) / (FControl.Right - FControl.Left); 1422 | end; 1423 | 1424 | { TOperationNode } 1425 | 1426 | constructor TOperationNode.Create(Owner: TNodeList); 1427 | begin 1428 | FInput := TNodePin.Create(Self, pkInput); 1429 | FOutput := TNodePin.Create(Self, pkOutput); 1430 | inherited Create(Owner); 1431 | end; 1432 | 1433 | function TOperationNode.GetImage: TGraphic; 1434 | begin 1435 | if FOwner.FContainsNode = Self then 1436 | FOwner.FContains := True; 1437 | if Assigned(FOperation) then 1438 | Result := inherited GetImage 1439 | else 1440 | Result := nil; 1441 | end; 1442 | 1443 | function TOperationNode.GetInfo: string; 1444 | var 1445 | G: TGraphic; 1446 | begin 1447 | if Input.Connect = nil then 1448 | Result := Format(Title + ' operation no input at level %.3f', [Position]) 1449 | else 1450 | begin 1451 | G := GetImage; 1452 | if G = nil then 1453 | Result := Format(Title + ' operation connected no source image at level %.3f', [Position]) 1454 | else 1455 | Result := Format(Title + ' operation connected %d X %d at level %.3f', [ 1456 | G.Width, G.Height, Position]); 1457 | end; 1458 | end; 1459 | 1460 | function TOperationNode.Regenerate: Boolean; 1461 | var 1462 | Graphic: TGraphic; 1463 | Bitmap: TPortableNetworkGraphic; 1464 | Pixel: PPixel; 1465 | X, Y: Integer; 1466 | begin 1467 | Result := inherited Regenerate; 1468 | if Result and Assigned(FOperation) then 1469 | begin 1470 | Graphic := GetImage; 1471 | if Graphic <> nil then 1472 | begin 1473 | Bitmap := Graphic as TPortableNetworkGraphic; 1474 | Pixel := PPixel(Bitmap.ScanLine[0]); 1475 | ImageWidth := Bitmap.Width; 1476 | ImageHeight := Bitmap.Height; 1477 | for Y := 0 to ImageHeight - 1 do 1478 | for X := 0 to ImageWidth - 1 do 1479 | begin 1480 | FOperation(Pixel^, X, Y, FPosition); 1481 | Inc(Pixel); 1482 | end; 1483 | Result := True; 1484 | end; 1485 | end; 1486 | end; 1487 | 1488 | function TOperationNode.GetInputPin(Index: Integer): TNodePin; 1489 | begin 1490 | case Index of 1491 | 0: Result := FInput; 1492 | else 1493 | Result := nil; 1494 | end; 1495 | end; 1496 | 1497 | function TOperationNode.GetInputCount: Integer; 1498 | begin 1499 | Result := 1; 1500 | end; 1501 | 1502 | function TOperationNode.GetOutputPin(Index: Integer): TNodePin; 1503 | begin 1504 | case Index of 1505 | 0: Result := FOutput; 1506 | else 1507 | Result := nil; 1508 | end; 1509 | end; 1510 | 1511 | function TOperationNode.GetOutputCount: Integer; 1512 | begin 1513 | Result := 1; 1514 | end; 1515 | 1516 | { TBlendNode } 1517 | 1518 | constructor TBlendNode.Create(Owner: TNodeList); 1519 | begin 1520 | FInputA := TNodePin.Create(Self, pkInput); 1521 | FInputB := TNodePin.Create(Self, pkInput); 1522 | FOutput := TNodePin.Create(Self, pkOutput); 1523 | FImage := TPortableNetworkGraphic.Create; 1524 | inherited Create(Owner); 1525 | end; 1526 | 1527 | destructor TBlendNode.Destroy; 1528 | begin 1529 | FImage.Free; 1530 | FImage := nil; 1531 | inherited Destroy; 1532 | end; 1533 | 1534 | function TBlendNode.GetImage: TGraphic; 1535 | var 1536 | A, B: TGraphic; 1537 | W, H: Integer; 1538 | begin 1539 | Result := nil; 1540 | if FOwner.FContainsNode = Self then 1541 | FOwner.FContains := True; 1542 | if Assigned(FBlend) and (FInputA.Connect <> nil) and 1543 | (FInputB.Connect <> nil) then 1544 | begin 1545 | A := FInputA.Connect.Node.Image; 1546 | B := FInputB.Connect.Node.Image; 1547 | if (A = nil) or (B = nil) then 1548 | Exit; 1549 | if A.Empty or B.Empty then 1550 | Exit; 1551 | W := A.Width; 1552 | if B.Width < W then 1553 | W := B.Width; 1554 | H := A.Height; 1555 | if B.Height < H then 1556 | H := B.Height; 1557 | if (FImage.Width <> W) or (FImage.Height <> H) then 1558 | begin 1559 | FImage.Width := W; 1560 | FImage.Height := H; 1561 | FImage.PixelFormat := pf32bit; 1562 | end; 1563 | Result := FImage; 1564 | end 1565 | end; 1566 | 1567 | function TBlendNode.GetInfo: string; 1568 | var 1569 | G: TGraphic; 1570 | begin 1571 | if InputA.Connect = nil then 1572 | Result := Format(Title + ' blend no A input at level %.3f', [Position]) 1573 | else if InputB.Connect = nil then 1574 | Result := Format(Title + ' blend no B input at level %.3f', [Position]) 1575 | else 1576 | begin 1577 | G := GetImage; 1578 | if G = nil then 1579 | Result := Format(Title + ' blend connected no source A or B image at level %.3f', [Position]) 1580 | else 1581 | Result := Format(Title + ' blend connected %d X %d at level %.3f', [ 1582 | G.Width, G.Height, Position]); 1583 | end; 1584 | end; 1585 | 1586 | function TBlendNode.Regenerate: Boolean; 1587 | var 1588 | Graphic: TGraphic; 1589 | BitmapA, BitmapB: TPortableNetworkGraphic; 1590 | PixelA, PixelB, Pixel: PPixel; 1591 | X, Y: Integer; 1592 | begin 1593 | Result := False; 1594 | Graphic := GetImage; 1595 | if Graphic = nil then 1596 | Exit; 1597 | Result := InputA.Connect.Node.Regenerate and InputB.Connect.Node.Regenerate; 1598 | if Result then 1599 | begin 1600 | Graphic.Width := 0; 1601 | Graphic.Height := 0; 1602 | Graphic := GetImage; 1603 | if Graphic = nil then 1604 | Exit; 1605 | ImageWidth := FImage.Width; 1606 | ImageHeight := FImage.Height; 1607 | BitmapA := InputA.Connect.Node.Image as TPortableNetworkGraphic; 1608 | BitmapB := InputB.Connect.Node.Image as TPortableNetworkGraphic; 1609 | for Y := 0 to ImageHeight - 1 do 1610 | begin 1611 | PixelA := BitmapA.ScanLine[Y]; 1612 | PixelB := BitmapB.ScanLine[Y]; 1613 | Pixel := FImage.ScanLine[Y]; 1614 | for X := 0 to ImageWidth - 1 do 1615 | begin 1616 | FBlend(PixelA^, PixelB^, Pixel^, X, Y, Position); 1617 | Inc(PixelA); 1618 | Inc(PixelB); 1619 | Inc(Pixel); 1620 | end; 1621 | end; 1622 | Result := True; 1623 | end; 1624 | end; 1625 | 1626 | function TBlendNode.GetInputPin(Index: Integer): TNodePin; 1627 | begin 1628 | case Index of 1629 | 0: Result := FInputA; 1630 | 1: Result := FInputB; 1631 | else 1632 | Result := nil; 1633 | end; 1634 | end; 1635 | 1636 | function TBlendNode.GetInputCount: Integer; 1637 | begin 1638 | Result := 2; 1639 | end; 1640 | 1641 | function TBlendNode.GetOutputPin(Index: Integer): TNodePin; 1642 | begin 1643 | case Index of 1644 | 0: Result := FOutput; 1645 | else 1646 | Result := nil; 1647 | end; 1648 | end; 1649 | 1650 | function TBlendNode.GetOutputCount: Integer; 1651 | begin 1652 | Result := 1; 1653 | end; 1654 | 1655 | initialization 1656 | SimpleWires := ParamStr(1) = '-simple'; 1657 | end. 1658 | 1659 | -------------------------------------------------------------------------------- /src/imageshop.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | <Scaled Value="True"/> 10 | <ResourceType Value="res"/> 11 | <UseXPManifest Value="True"/> 12 | <XPManifest> 13 | <DpiAware Value="True"/> 14 | </XPManifest> 15 | <Icon Value="0"/> 16 | </General> 17 | <BuildModes Count="1"> 18 | <Item1 Name="Default" Default="True"/> 19 | </BuildModes> 20 | <PublishOptions> 21 | <Version Value="2"/> 22 | <UseFileFilters Value="True"/> 23 | </PublishOptions> 24 | <RunParams> 25 | <FormatVersion Value="2"/> 26 | <Modes Count="0"/> 27 | </RunParams> 28 | <RequiredPackages Count="1"> 29 | <Item1> 30 | <PackageName Value="LCL"/> 31 | </Item1> 32 | </RequiredPackages> 33 | <Units Count="5"> 34 | <Unit0> 35 | <Filename Value="imageshop.lpr"/> 36 | <IsPartOfProject Value="True"/> 37 | <UnitName Value="ImageShop"/> 38 | </Unit0> 39 | <Unit1> 40 | <Filename Value="main.pas"/> 41 | <IsPartOfProject Value="True"/> 42 | <ComponentName Value="ImageForm"/> 43 | <HasResources Value="True"/> 44 | <ResourceBaseClass Value="Form"/> 45 | <UnitName Value="Main"/> 46 | </Unit1> 47 | <Unit2> 48 | <Filename Value="styles.pas"/> 49 | <IsPartOfProject Value="True"/> 50 | <UnitName Value="Styles"/> 51 | </Unit2> 52 | <Unit3> 53 | <Filename Value="imagenodes.pas"/> 54 | <IsPartOfProject Value="True"/> 55 | <UnitName Value="ImageNodes"/> 56 | </Unit3> 57 | <Unit4> 58 | <Filename Value="pixels.pas"/> 59 | <IsPartOfProject Value="True"/> 60 | <UnitName Value="Pixels"/> 61 | </Unit4> 62 | </Units> 63 | </ProjectOptions> 64 | <CompilerOptions> 65 | <Version Value="11"/> 66 | <Target> 67 | <Filename Value="imageshop"/> 68 | </Target> 69 | <SearchPaths> 70 | <IncludeFiles Value="$(ProjOutDir)"/> 71 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 72 | </SearchPaths> 73 | <Linking> 74 | <Options> 75 | <Win32> 76 | <GraphicApplication Value="True"/> 77 | </Win32> 78 | </Options> 79 | </Linking> 80 | <Other> 81 | <CompilerMessages> 82 | <IgnoredMessages idx5044="True" idx5024="True"/> 83 | </CompilerMessages> 84 | </Other> 85 | </CompilerOptions> 86 | <Debugging> 87 | <Exceptions Count="3"> 88 | <Item1> 89 | <Name Value="EAbort"/> 90 | </Item1> 91 | <Item2> 92 | <Name Value="ECodetoolError"/> 93 | </Item2> 94 | <Item3> 95 | <Name Value="EFOpenError"/> 96 | </Item3> 97 | </Exceptions> 98 | </Debugging> 99 | </CONFIG> 100 | -------------------------------------------------------------------------------- /src/imageshop.lpr: -------------------------------------------------------------------------------- 1 | program ImageShop; 2 | 3 | {$mode delphi} 4 | 5 | uses 6 | {$ifdef unix} 7 | {$ifdef usecthreads} 8 | cthreads, 9 | {$endif} 10 | {$endif} 11 | Interfaces, Forms, Main; 12 | 13 | {$R *.res} 14 | 15 | begin 16 | RequireDerivedFormResource := True; 17 | Application.Scaled := True; 18 | Application.Initialize; 19 | Application.CreateForm(TImageForm, ImageForm); 20 | Application.Run; 21 | end. 22 | 23 | -------------------------------------------------------------------------------- /src/imageshop.lps: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <Version Value="11"/> 5 | <BuildModes Active="Default"/> 6 | <Units Count="7"> 7 | <Unit0> 8 | <Filename Value="imageshop.lpr"/> 9 | <IsPartOfProject Value="True"/> 10 | <UnitName Value="ImageShop"/> 11 | <EditorIndex Value="1"/> 12 | <CursorPos X="12" Y="8"/> 13 | <UsageCount Value="207"/> 14 | <Loaded Value="True"/> 15 | </Unit0> 16 | <Unit1> 17 | <Filename Value="main.pas"/> 18 | <IsPartOfProject Value="True"/> 19 | <ComponentName Value="ImageForm"/> 20 | <HasResources Value="True"/> 21 | <ResourceBaseClass Value="Form"/> 22 | <UnitName Value="Main"/> 23 | <IsVisibleTab Value="True"/> 24 | <EditorIndex Value="2"/> 25 | <TopLine Value="183"/> 26 | <CursorPos Y="183"/> 27 | <UsageCount Value="207"/> 28 | <Loaded Value="True"/> 29 | <LoadedDesigner Value="True"/> 30 | </Unit1> 31 | <Unit2> 32 | <Filename Value="styles.pas"/> 33 | <IsPartOfProject Value="True"/> 34 | <UnitName Value="Styles"/> 35 | <EditorIndex Value="-1"/> 36 | <CursorPos X="14" Y="10"/> 37 | <UsageCount Value="207"/> 38 | </Unit2> 39 | <Unit3> 40 | <Filename Value="imagenodes.pas"/> 41 | <IsPartOfProject Value="True"/> 42 | <UnitName Value="ImageNodes"/> 43 | <EditorIndex Value="3"/> 44 | <TopLine Value="1160"/> 45 | <CursorPos X="32" Y="1193"/> 46 | <UsageCount Value="207"/> 47 | <Bookmarks Count="1"> 48 | <Item0 Y="526" ID="1"/> 49 | </Bookmarks> 50 | <Loaded Value="True"/> 51 | </Unit3> 52 | <Unit4> 53 | <Filename Value="pixels.pas"/> 54 | <IsPartOfProject Value="True"/> 55 | <UnitName Value="Pixels"/> 56 | <TopLine Value="333"/> 57 | <CursorPos X="33" Y="44"/> 58 | <UsageCount Value="207"/> 59 | <Loaded Value="True"/> 60 | </Unit4> 61 | <Unit5> 62 | <Filename Value="unit1.pas"/> 63 | <ComponentName Value="Form1"/> 64 | <ResourceBaseClass Value="Form"/> 65 | <UnitName Value="Unit1"/> 66 | <EditorIndex Value="-1"/> 67 | <UsageCount Value="3"/> 68 | </Unit5> 69 | <Unit6> 70 | <Filename Value="../../Development/Pascal/lazarus/lcl/graphics.pp"/> 71 | <UnitName Value="Graphics"/> 72 | <EditorIndex Value="-1"/> 73 | <TopLine Value="1456"/> 74 | <CursorPos X="3" Y="1474"/> 75 | <UsageCount Value="77"/> 76 | </Unit6> 77 | </Units> 78 | <JumpHistory Count="30" HistoryIndex="29"> 79 | <Position1> 80 | <Filename Value="pixels.pas"/> 81 | <Caret Line="370" Column="5" TopLine="345"/> 82 | </Position1> 83 | <Position2> 84 | <Filename Value="pixels.pas"/> 85 | <Caret Line="405" TopLine="372"/> 86 | </Position2> 87 | <Position3> 88 | <Filename Value="pixels.pas"/> 89 | <Caret Line="395" Column="6" TopLine="377"/> 90 | </Position3> 91 | <Position4> 92 | <Filename Value="pixels.pas"/> 93 | <Caret Line="301" TopLine="275"/> 94 | </Position4> 95 | <Position5> 96 | <Filename Value="main.pas"/> 97 | <Caret Line="119" Column="24" TopLine="95"/> 98 | </Position5> 99 | <Position6> 100 | <Filename Value="imagenodes.pas"/> 101 | <Caret Line="208" Column="15" TopLine="190"/> 102 | </Position6> 103 | <Position7> 104 | <Filename Value="imagenodes.pas"/> 105 | <Caret Line="1223" TopLine="1204"/> 106 | </Position7> 107 | <Position8> 108 | <Filename Value="imagenodes.pas"/> 109 | <Caret Line="1236" TopLine="1207"/> 110 | </Position8> 111 | <Position9> 112 | <Filename Value="imagenodes.pas"/> 113 | <Caret Line="1247" Column="11" TopLine="1230"/> 114 | </Position9> 115 | <Position10> 116 | <Filename Value="imagenodes.pas"/> 117 | <Caret Line="1245" Column="21" TopLine="1220"/> 118 | </Position10> 119 | <Position11> 120 | <Filename Value="imagenodes.pas"/> 121 | </Position11> 122 | <Position12> 123 | <Filename Value="imagenodes.pas"/> 124 | <Caret Line="23" Column="24"/> 125 | </Position12> 126 | <Position13> 127 | <Filename Value="imagenodes.pas"/> 128 | <Caret Line="81" Column="24" TopLine="52"/> 129 | </Position13> 130 | <Position14> 131 | <Filename Value="main.pas"/> 132 | <Caret Line="104" Column="17" TopLine="95"/> 133 | </Position14> 134 | <Position15> 135 | <Filename Value="main.pas"/> 136 | <Caret Line="43" Column="17" TopLine="25"/> 137 | </Position15> 138 | <Position16> 139 | <Filename Value="main.pas"/> 140 | </Position16> 141 | <Position17> 142 | <Filename Value="main.pas"/> 143 | <Caret Line="43" Column="17" TopLine="14"/> 144 | </Position17> 145 | <Position18> 146 | <Filename Value="main.pas"/> 147 | <Caret Line="199" Column="15" TopLine="170"/> 148 | </Position18> 149 | <Position19> 150 | <Filename Value="main.pas"/> 151 | <Caret Line="224" Column="15" TopLine="195"/> 152 | </Position19> 153 | <Position20> 154 | <Filename Value="main.pas"/> 155 | </Position20> 156 | <Position21> 157 | <Filename Value="main.pas"/> 158 | <Caret Line="43" Column="17" TopLine="14"/> 159 | </Position21> 160 | <Position22> 161 | <Filename Value="main.pas"/> 162 | <Caret Line="199" Column="15" TopLine="170"/> 163 | </Position22> 164 | <Position23> 165 | <Filename Value="main.pas"/> 166 | <Caret Line="225" Column="25" TopLine="165"/> 167 | </Position23> 168 | <Position24> 169 | <Filename Value="main.pas"/> 170 | <Caret Line="32" Column="26" TopLine="13"/> 171 | </Position24> 172 | <Position25> 173 | <Filename Value="main.pas"/> 174 | <Caret Line="242" Column="3" TopLine="239"/> 175 | </Position25> 176 | <Position26> 177 | <Filename Value="imagenodes.pas"/> 178 | <Caret Line="81" Column="15" TopLine="63"/> 179 | </Position26> 180 | <Position27> 181 | <Filename Value="main.pas"/> 182 | <Caret Line="242" Column="3" TopLine="239"/> 183 | </Position27> 184 | <Position28> 185 | <Filename Value="main.pas"/> 186 | <Caret Line="265" Column="25" TopLine="246"/> 187 | </Position28> 188 | <Position29> 189 | <Filename Value="main.pas"/> 190 | <Caret Line="99" Column="3" TopLine="94"/> 191 | </Position29> 192 | <Position30> 193 | <Filename Value="pixels.pas"/> 194 | <Caret Line="389" Column="31" TopLine="359"/> 195 | </Position30> 196 | </JumpHistory> 197 | <RunParams> 198 | <FormatVersion Value="2"/> 199 | <Modes Count="0" ActiveMode=""/> 200 | </RunParams> 201 | </ProjectSession> 202 | </CONFIG> 203 | -------------------------------------------------------------------------------- /src/imageshop.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sysrpl/Codebot.ImageShop/4ee582243ca4a141d0fb9ddc34f83459907641d9/src/imageshop.res -------------------------------------------------------------------------------- /src/main.lfm: -------------------------------------------------------------------------------- 1 | object ImageForm: TImageForm 2 | Left = 376 3 | Height = 561 4 | Top = 250 5 | Width = 923 6 | Caption = 'Image Node Manipulator' 7 | ClientHeight = 561 8 | ClientWidth = 923 9 | Color = 5391680 10 | Font.Color = clWhite 11 | OnCreate = FormCreate 12 | OnDestroy = FormDestroy 13 | OnShow = FormShow 14 | Position = poScreenCenter 15 | LCLVersion = '2.0.2.0' 16 | object RightPanel: TPanel 17 | Left = 200 18 | Height = 561 19 | Top = 0 20 | Width = 723 21 | Align = alClient 22 | BevelOuter = bvNone 23 | ClientHeight = 561 24 | ClientWidth = 723 25 | TabOrder = 0 26 | object NodePanel: TPanel 27 | Left = 0 28 | Height = 300 29 | Top = 261 30 | Width = 723 31 | Align = alBottom 32 | BevelOuter = bvNone 33 | Color = 5391680 34 | ParentColor = False 35 | TabOrder = 0 36 | OnMouseDown = NodePanelMouseDown 37 | OnMouseMove = NodePanelMouseMove 38 | OnMouseUp = NodePanelMouseUp 39 | OnPaint = NodePanelPaint 40 | OnResize = NodePanelResize 41 | end 42 | object ImagePanel: TPanel 43 | Left = 0 44 | Height = 256 45 | Top = 0 46 | Width = 723 47 | Align = alClient 48 | BevelOuter = bvNone 49 | Color = 5391680 50 | ParentColor = False 51 | TabOrder = 1 52 | OnPaint = ImagePanelPaint 53 | OnResize = NodePanelResize 54 | end 55 | object Splitter: TSplitter 56 | Cursor = crVSplit 57 | Left = 0 58 | Height = 5 59 | Top = 256 60 | Width = 723 61 | Align = alBottom 62 | ResizeAnchor = akBottom 63 | end 64 | end 65 | object LeftPanel: TPanel 66 | Left = 0 67 | Height = 561 68 | Top = 0 69 | Width = 200 70 | Align = alLeft 71 | BevelOuter = bvNone 72 | ClientHeight = 561 73 | ClientWidth = 200 74 | TabOrder = 1 75 | object NodeBox: TListBox 76 | Left = 0 77 | Height = 561 78 | Top = 0 79 | Width = 200 80 | Align = alClient 81 | BorderStyle = bsNone 82 | Color = 5391680 83 | Font.Color = clWhite 84 | ItemHeight = 25 85 | OnDrawItem = NodeBoxDrawItem 86 | OnMouseDown = NodeBoxMouseDown 87 | OnMouseUp = NodeBoxMouseUp 88 | Options = [] 89 | ParentFont = False 90 | ScrollWidth = 200 91 | Style = lbOwnerDrawFixed 92 | TabOrder = 0 93 | TopIndex = -1 94 | end 95 | end 96 | object UpdateTimer: TTimer 97 | Enabled = False 98 | Interval = 50 99 | OnTimer = UpdateTimerTimer 100 | left = 80 101 | top = 40 102 | end 103 | end 104 | -------------------------------------------------------------------------------- /src/main.pas: -------------------------------------------------------------------------------- 1 | unit Main; 2 | 3 | {$mode delphi} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 | ExtCtrls, ImageNodes, Pixels, Types, LCLType, Styles; 10 | 11 | { TImageForm } 12 | 13 | type 14 | TImageForm = class(TForm) 15 | ImagePanel: TPanel; 16 | NodeBox: TListBox; 17 | NodePanel: TPanel; 18 | LeftPanel: TPanel; 19 | RightPanel: TPanel; 20 | Splitter: TSplitter; 21 | UpdateTimer: TTimer; 22 | procedure FormCreate(Sender: TObject); 23 | procedure FormDestroy(Sender: TObject); 24 | procedure FormShow(Sender: TObject); 25 | procedure ImagePanelPaint(Sender: TObject); 26 | procedure NodeBoxDrawItem(Control: TWinControl; Index: Integer; 27 | ARect: TRect; State: TOwnerDrawState); 28 | procedure NodeBoxMouseDown(Sender: TObject; Button: TMouseButton; 29 | Shift: TShiftState; X, Y: Integer); 30 | procedure NodeBoxMouseUp(Sender: TObject; Button: TMouseButton; 31 | Shift: TShiftState; X, Y: Integer); 32 | procedure NodePanelMouseDown(Sender: TObject; Button: TMouseButton; 33 | Shift: TShiftState; X, Y: Integer); 34 | procedure NodePanelMouseMove(Sender: TObject; Shift: TShiftState; X, 35 | Y: Integer); 36 | procedure NodePanelMouseUp(Sender: TObject; Button: TMouseButton; 37 | Shift: TShiftState; X, Y: Integer); 38 | procedure NodePanelPaint(Sender: TObject); 39 | procedure NodePanelResize(Sender: TObject); 40 | procedure UpdateTimerTimer(Sender: TObject); 41 | private 42 | FNodes: TNodeList; 43 | FNodeBoxDown: Boolean; 44 | procedure NodesChange(Sender: TObject); 45 | procedure NodesUpdate(Sender: TObject); 46 | end; 47 | 48 | var 49 | ImageForm: TImageForm; 50 | 51 | implementation 52 | 53 | {$R *.lfm} 54 | 55 | type 56 | TPixelOperationItem = record 57 | Name: string; 58 | Proc: TPixelOperation; 59 | end; 60 | TPixelOperations = array of TPixelOperationItem; 61 | 62 | TPixelBlendItem = record 63 | Name: string; 64 | Proc: TPixelBlend; 65 | end; 66 | TPixelBlends = array of TPixelBlendItem; 67 | 68 | var 69 | Operations: TPixelOperations; 70 | Blends: TPixelBlends; 71 | 72 | procedure AddOperation(const Name: string; Proc: TPixelOperation); 73 | var 74 | I: Integer; 75 | begin 76 | I := Length(Operations); 77 | SetLength(Operations, I + 1); 78 | Operations[I].Name := Name; 79 | Operations[I].Proc := Proc; 80 | end; 81 | 82 | procedure AddBlends(const Name: string; Proc: TPixelBlend); 83 | var 84 | I: Integer; 85 | begin 86 | I := Length(Blends); 87 | SetLength(Blends, I + 1); 88 | Blends[I].Name := Name; 89 | Blends[I].Proc := Proc; 90 | end; 91 | 92 | { TImageForm } 93 | 94 | procedure TImageForm.FormCreate(Sender: TObject); 95 | var 96 | I: Integer; 97 | begin 98 | FNodes := TNodeList.Create; 99 | FNodes.OnChange := NodesChange; 100 | FNodes.OnUpdate := NodesUpdate; 101 | NodeBox.Items.AddObject('Sources', nil); 102 | NodeBox.Items.AddObject('Image', TObject(1)); 103 | NodeBox.Items.AddObject('Reset', TObject(1)); 104 | NodeBox.Items.AddObject('Operator Nodes', nil); 105 | InitializeOperations(AddOperation); 106 | for I := Low(Operations) to High(Operations) do 107 | NodeBox.Items.AddObject(Operations[I].Name, TObject(2)); 108 | NodeBox.Items.AddObject('Blend Nodes', nil); 109 | InitializeBlends(AddBlends); 110 | for I := Low(Blends) to High(Blends) do 111 | NodeBox.Items.AddObject(Blends[I].Name, TObject(3)); 112 | NodeBox.ItemIndex := -1; 113 | end; 114 | 115 | procedure TImageForm.FormDestroy(Sender: TObject); 116 | begin 117 | FNodes.OnUpdate := nil; 118 | FNodes.OnChange := nil; 119 | FNodes.Free; 120 | end; 121 | 122 | procedure TImageForm.FormShow(Sender: TObject); 123 | begin 124 | NodeBox.ItemIndex := 3; 125 | NodeBox.Invalidate; 126 | NodeBox.ItemIndex := -1; 127 | end; 128 | 129 | procedure TImageForm.ImagePanelPaint(Sender: TObject); 130 | var 131 | B: TBitmap; 132 | G: TGraphic; 133 | X, Y: Integer; 134 | begin 135 | B := TBitmap.Create; 136 | try 137 | B.Width := 20; 138 | B.Height := 20; 139 | B.Canvas.Brush.Color := clWhite; 140 | B.Canvas.FillRect(0, 0, 20, 20); 141 | B.Canvas.Brush.Color := clSilver; 142 | B.Canvas.FillRect(0, 0, 10, 10); 143 | B.Canvas.FillRect(10, 10, 20, 20); 144 | ImagePanel.Canvas.Brush.Bitmap := B; 145 | ImagePanel.Canvas.FillRect(ImagePanel.ClientRect); 146 | finally 147 | B.Free; 148 | end; 149 | G := FNodes.Display.Image; 150 | if G <> nil then 151 | begin 152 | X := (ImagePanel.Width - G.Width) div 2; 153 | Y := (ImagePanel.Height - G.Height) div 2; 154 | ImagePanel.Canvas.Draw(X, Y, G); 155 | end; 156 | end; 157 | 158 | procedure TImageForm.NodeBoxDrawItem(Control: TWinControl; Index: Integer; 159 | ARect: TRect; State: TOwnerDrawState); 160 | var 161 | S: string; 162 | begin 163 | S := NodeBox.Items[Index]; 164 | if NodeBox.Items.Objects[Index] = nil then 165 | begin 166 | NodeBox.Canvas.Pen.Color := clStyleDull; 167 | NodeBox.Canvas.Brush.Color := clStyleLight; 168 | NodeBox.Canvas.Font.Color := clBlack; 169 | NodeBox.Canvas.Rectangle(ARect); 170 | ARect.Left := ARect.Left + 3; 171 | DrawString(NodeBox.Canvas, S, ARect, ImageNodes.dirLeft); 172 | end 173 | else 174 | begin 175 | if Index = NodeBox.ItemIndex then 176 | NodeBox.Canvas.Brush.Color := clStyleHighlight 177 | else 178 | NodeBox.Canvas.Brush.Color := clStyleWindow; 179 | NodeBox.Canvas.FillRect(ARect); 180 | NodeBox.Canvas.Font.Color := clStyleText; 181 | ARect.Left := ARect.Left + 8; 182 | DrawString(NodeBox.Canvas, S, ARect, ImageNodes.dirLeft); 183 | end; 184 | end; 185 | 186 | procedure TImageForm.NodeBoxMouseDown(Sender: TObject; Button: TMouseButton; 187 | Shift: TShiftState; X, Y: Integer); 188 | begin 189 | if Button <> mbLeft then 190 | Exit; 191 | FNodeBoxDown := True; 192 | NodeBox.Invalidate; 193 | end; 194 | 195 | procedure TImageForm.NodeBoxMouseUp(Sender: TObject; Button: TMouseButton; 196 | Shift: TShiftState; X, Y: Integer); 197 | var 198 | S: string; 199 | I: Integer; 200 | begin 201 | if Button <> mbLeft then 202 | Exit; 203 | I := NodeBox.ItemIndex; 204 | if I < 0 then 205 | Exit; 206 | S := NodeBox.Items[I]; 207 | I := IntPtr(NodeBox.Items.Objects[I]); 208 | if (I = 1) and (S = 'Reset') then 209 | begin 210 | if NodeBox.GetIndexAtXY(X, Y) = NodeBox.ItemIndex then 211 | FNodes.Clear; 212 | NodeBox.ItemIndex := -1; 213 | NodeBox.Visible := False; 214 | NodeBox.Visible := True; 215 | end; 216 | FNodeBoxDown := False; 217 | NodeBox.Invalidate; 218 | end; 219 | 220 | procedure TImageForm.NodesChange(Sender: TObject); 221 | begin 222 | NodePanel.Invalidate; 223 | end; 224 | 225 | procedure TImageForm.NodesUpdate(Sender: TObject); 226 | begin 227 | UpdateTimer.Enabled := False; 228 | UpdateTimer.Enabled := True; 229 | end; 230 | 231 | procedure TImageForm.NodePanelMouseDown(Sender: TObject; Button: TMouseButton; 232 | Shift: TShiftState; X, Y: Integer); 233 | begin 234 | if Button = mbLeft then 235 | begin 236 | FNodes.MouseOver(X, Y); 237 | FNodes.MouseDown(X, Y); 238 | end; 239 | end; 240 | 241 | procedure TImageForm.NodePanelMouseMove(Sender: TObject; Shift: TShiftState; X, 242 | Y: Integer); 243 | begin 244 | FNodes.MouseOver(X, Y); 245 | end; 246 | 247 | procedure TImageForm.NodePanelMouseUp(Sender: TObject; Button: TMouseButton; 248 | Shift: TShiftState; X, Y: Integer); 249 | var 250 | O: TOperationNode; 251 | B: TBlendNode; 252 | S: string; 253 | I: Integer; 254 | begin 255 | if Button <> mbLeft then 256 | Exit; 257 | I := NodeBox.ItemIndex; 258 | if I < 0 then 259 | begin 260 | FNodes.MouseUp(X, Y); 261 | FNodes.MouseOver(X, Y); 262 | Exit; 263 | end; 264 | S := NodeBox.Items[I]; 265 | I := IntPtr(NodeBox.Items.Objects[I]); 266 | case I of 267 | 1: 268 | if S = 'Image' then 269 | TImageNode.Create(FNodes).MoveTo(X, Y) 270 | else if S = 'Reset' then 271 | FNodes.Clear; 272 | 2: 273 | for I := Low(Operations) to High(Operations) do 274 | if S = Operations[I].Name then 275 | begin 276 | O := TOperationNode.Create(FNodes); 277 | O.Title := Operations[I].Name; 278 | O.Operation := Operations[I].Proc; 279 | O.MoveTo(X, Y); 280 | end; 281 | 3: 282 | for I := Low(Blends) to High(Blends) do 283 | if S = Blends[I].Name then 284 | begin 285 | B := TBlendNode.Create(FNodes); 286 | B.Title := Blends[I].Name; 287 | B.Blend := Blends[I].Proc; 288 | B.MoveTo(X, Y); 289 | end; 290 | end; 291 | I := NodeBox.TopIndex; 292 | NodeBox.ItemIndex := -1; 293 | NodeBox.Visible := False; 294 | NodeBox.Visible := True; 295 | NodeBox.Invalidate; 296 | NodeBox.TopIndex := I; 297 | end; 298 | 299 | procedure TImageForm.NodePanelPaint(Sender: TObject); 300 | begin 301 | FNodes.Draw(NodePanel.Canvas); 302 | end; 303 | 304 | procedure TImageForm.NodePanelResize(Sender: TObject); 305 | begin 306 | FNodes.Resize(NodePanel.Width, NodePanel.Height); 307 | end; 308 | 309 | procedure TImageForm.UpdateTimerTimer(Sender: TObject); 310 | begin 311 | UpdateTimer.Enabled := False; 312 | FNodes.Regenerate; 313 | ImagePanel.Invalidate; 314 | end; 315 | 316 | end. 317 | 318 | -------------------------------------------------------------------------------- /src/pixels.pas: -------------------------------------------------------------------------------- 1 | unit Pixels; 2 | 3 | {$mode delphi} 4 | 5 | interface 6 | 7 | { The TPixel type } 8 | 9 | type 10 | {$ifdef linux} 11 | TPixel = record R, G, B, A: Byte; end; 12 | {$else} 13 | TPixel = record B, G, R, A: Byte; end; 14 | {$endif} 15 | PPixel = ^TPixel; 16 | 17 | { Operation and blend registration functions } 18 | 19 | TPixelOperation = procedure(var Pixel: TPixel; X, Y: Integer; Level: Single); 20 | TPixelBlend = procedure(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 21 | 22 | TAddOperation = procedure(const Name: string; Proc: TPixelOperation); 23 | TAddBlend = procedure(const Name: string; Proc: TPixelBlend); 24 | 25 | { Initialization callbacks } 26 | 27 | procedure InitializeOperations(Add: TAddOperation); 28 | procedure InitializeBlends(Add: TAddBlend); 29 | 30 | { Globally set width and height of the image being processed by operations or blends } 31 | 32 | var 33 | ImageWidth, ImageHeight: Integer; 34 | 35 | implementation 36 | 37 | { Helper functions } 38 | 39 | const 40 | {$ifdef linux} 41 | White: TPixel = (R: $FF; G: $FF; B: $FF; A: $FF); 42 | Black: TPixel = (R: 0; G: 0; B: 0; A: $FF); 43 | {$else} 44 | White: TPixel = (B: $FF; G: $FF; R: $FF; A: $FF); 45 | Black: TPixel = (B: 0; G: 0; R: 0; A: $FF); 46 | {$endif} 47 | 48 | function RoundByte(Value: Single): Byte; inline; 49 | begin 50 | if Value > $FF then 51 | Result := $FF 52 | else if Value < 0 then 53 | Result := 0 54 | else 55 | Result := Round(Value); 56 | end; 57 | 58 | function Mix(A, B: TPixel; Percent: Single): TPixel; inline; 59 | var 60 | Invert: Single; 61 | begin 62 | if Percent < 0.001 then 63 | Result := A 64 | else if Percent > 0.999 then 65 | Result := B 66 | else 67 | begin 68 | Invert := 1 - Percent; 69 | Result.B := RoundByte(B.B * Percent + A.B * Invert); 70 | Result.G := RoundByte(B.G * Percent + A.G * Invert); 71 | Result.R := RoundByte(B.R * Percent + A.R * Invert); 72 | Result.A := RoundByte(B.A * Percent + A.A * Invert); 73 | end; 74 | end; 75 | 76 | function Hue(Value: Single): TPixel; 77 | const 78 | Step = 1 / 6; 79 | var 80 | R, G, B: Single; 81 | begin 82 | R := 0; 83 | G := 0; 84 | B := 0; 85 | if Value < 0 then 86 | R := 1 87 | else if Value < 1 * Step then 88 | begin 89 | R := 1; 90 | G := Value / Step; 91 | end 92 | else if Value < 2 * Step then 93 | begin 94 | R := 1 - (Value - 1 * Step) / Step; 95 | G := 1; 96 | end 97 | else if Value < 3 * Step then 98 | begin 99 | G := 1; 100 | B := (Value - 2 * Step) / Step; 101 | end 102 | else if Value < 4 * Step then 103 | begin 104 | G := 1 - (Value - 3 * Step) / Step; 105 | B := 1; 106 | end 107 | else if Value < 5 * Step then 108 | begin 109 | B := 1; 110 | R := (Value - 4 * Step) / Step; 111 | end 112 | else if Value < 6 * Step then 113 | begin 114 | B := 1 - (Value - 5 * Step) / Step; 115 | R := 1; 116 | end 117 | else 118 | R := 1; 119 | Result.R := RoundByte(R * $FF); 120 | Result.G := RoundByte(G * $FF); 121 | Result.B := RoundByte(B * $FF); 122 | Result.A := $FF; 123 | end; 124 | 125 | { Operation procedures } 126 | 127 | procedure InvertOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 128 | var 129 | P: TPixel; 130 | begin 131 | P.B := not Pixel.B; 132 | P.G := not Pixel.G; 133 | P.R := not Pixel.R; 134 | P.A := Pixel.A; 135 | Pixel := Mix(Pixel, P, Level); 136 | end; 137 | 138 | procedure SaturationOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 139 | var 140 | P: TPixel; 141 | D: Byte; 142 | begin 143 | D := RoundByte(Pixel.B * 0.863 + Pixel.G * 0.275 + Pixel.R * 0.510); 144 | P.B := D; 145 | P.G := D; 146 | P.R := D; 147 | P.A := Pixel.A; 148 | Pixel := Mix(P, Pixel, Level); 149 | end; 150 | 151 | procedure HueOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 152 | var 153 | P: TPixel; 154 | A: Byte; 155 | begin 156 | P := Hue(Level); 157 | A := Pixel.A; 158 | Pixel := Mix(P, White, (Pixel.B * 0.863 + Pixel.G * 0.275 + Pixel.R * 0.510) / $FF); 159 | Pixel.A := A; 160 | end; 161 | 162 | procedure BlackOrWhiteOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 163 | var 164 | A: Byte; 165 | begin 166 | A := Pixel.A; 167 | if Pixel.R + Pixel.G + Pixel.B > Level * 3 * $FF then 168 | Pixel := White 169 | else 170 | Pixel := Black; 171 | Pixel.A := A; 172 | end; 173 | 174 | procedure BrightenOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 175 | begin 176 | Pixel.B := RoundByte(Pixel.B + Level * $FF); 177 | Pixel.G := RoundByte(Pixel.G + Level * $FF); 178 | Pixel.R := RoundByte(Pixel.R + Level * $FF); 179 | end; 180 | 181 | procedure ContrastOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 182 | var 183 | B, G, R: Single; 184 | begin 185 | B := (Pixel.B / $FF - 0.5) * 4 * Level; 186 | G := (Pixel.G / $FF - 0.5) * 4 * Level; 187 | R := (Pixel.R / $FF - 0.5) * 4 * Level; 188 | Pixel.B := RoundByte(Pixel.B + B * $FF); 189 | Pixel.G := RoundByte(Pixel.G + G * $FF); 190 | Pixel.R := RoundByte(Pixel.R + R * $FF); 191 | end; 192 | 193 | procedure DarkenOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 194 | begin 195 | Pixel.B := RoundByte(Pixel.B - Level * $FF); 196 | Pixel.G := RoundByte(Pixel.G - Level * $FF); 197 | Pixel.R := RoundByte(Pixel.R - Level * $FF); 198 | end; 199 | 200 | procedure RedOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 201 | begin 202 | Pixel.R := RoundByte(Pixel.R + (Level - 0.5) * $FF * 2); 203 | end; 204 | 205 | procedure GreenOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 206 | begin 207 | Pixel.G := RoundByte(Pixel.G + (Level - 0.5) * $FF * 2); 208 | end; 209 | 210 | procedure BlueOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 211 | begin 212 | Pixel.B := RoundByte(Pixel.B + (Level - 0.5) * $FF * 2); 213 | end; 214 | 215 | procedure AlphaOperation(var Pixel: TPixel; X, Y: Integer; Level: Single); 216 | begin 217 | Pixel.A := RoundByte(Pixel.A * Level); 218 | end; 219 | 220 | { Blend procedures } 221 | 222 | procedure OpacityBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 223 | begin 224 | Pixel := Mix(B, A, Level); 225 | end; 226 | 227 | var 228 | FastR1: Integer = 13; 229 | FastR2: Integer = 31; 230 | 231 | function FastRandom(Range: Integer): Integer; 232 | begin 233 | FastR1 := 18030 * (FastR1 and $FFFF) + (FastR1 shr 16); 234 | FastR2 := 30903 * (FastR2 and $FFFF) + (FastR2 shr 16); 235 | if Range < 2 then 236 | Result := 0 237 | else 238 | Result := (FastR1 shr 16 + (FastR2 and $FFFF)) mod Range; 239 | end; 240 | 241 | procedure FastRandomSeed(Seed: Integer); 242 | begin 243 | FastR1 := Seed; 244 | FastR2 := 31; 245 | FastR2 := FastRandom(High(Word)); 246 | end; 247 | 248 | procedure DisolveBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 249 | begin 250 | if Level < 0.001 then 251 | Pixel := B 252 | else if Level > 0.999 then 253 | Pixel := A 254 | else 255 | begin 256 | if (X = 0) and (Y = 0) then 257 | FastRandomSeed(ImageWidth * ImageHeight); 258 | if FastRandom(10000) < Level * 10000 then 259 | Pixel := A 260 | else 261 | Pixel := B; 262 | end; 263 | end; 264 | 265 | procedure BlockBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 266 | const 267 | BlockSize = 50; 268 | var 269 | Fade: Single; 270 | begin 271 | if Level < 0.001 then 272 | Pixel := B 273 | else if Level > 0.999 then 274 | Pixel := A 275 | else 276 | begin 277 | Inc(X, BlockSize); 278 | Inc(Y, BlockSize); 279 | FastRandomSeed((X div BlockSize) + (Y div BlockSize) * (X div BlockSize) * 73 + 280 | ImageWidth * 31 + ImageHeight * 57 * ImageWidth * 31); 281 | Fade := Level + 0.2 - FastRandom(10000) / 10000; 282 | if Level < 0.5 then 283 | Fade := Fade * (Level / 0.5); 284 | if Fade < 0.001 then 285 | Pixel := B 286 | else if Fade < 0.2 then 287 | Pixel := Mix(B, A, Fade / 0.2) 288 | else 289 | Pixel := A; 290 | end; 291 | end; 292 | 293 | procedure MultiplyBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 294 | var 295 | P: TPixel; 296 | begin 297 | P.B := RoundByte(A.B * B.B / $FF); 298 | P.G := RoundByte(A.G * B.G / $FF); 299 | P.R := RoundByte(A.R * B.R / $FF); 300 | P.A := RoundByte(A.A * B.A / $FF); 301 | Pixel := Mix(B, P, Level); 302 | end; 303 | 304 | procedure AdditionBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 305 | var 306 | P: TPixel; 307 | begin 308 | P.B := RoundByte(A.B + B.B); 309 | P.G := RoundByte(A.G + B.G); 310 | P.R := RoundByte(A.R + B.R); 311 | P.A := RoundByte(A.A + B.A); 312 | Pixel := Mix(B, P, Level); 313 | end; 314 | 315 | procedure SubtractionBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 316 | var 317 | P: TPixel; 318 | begin 319 | P.B := RoundByte(B.B - A.B); 320 | P.G := RoundByte(B.G - A.G); 321 | P.R := RoundByte(B.R - A.R); 322 | P.A := RoundByte(B.A - A.A); 323 | Pixel := Mix(B, P, Level); 324 | end; 325 | 326 | procedure WipeBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 327 | begin 328 | if X < ImageWidth * Level then 329 | Pixel := A 330 | else 331 | Pixel := B; 332 | end; 333 | 334 | procedure CircleBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 335 | var 336 | D, W, H: Single; 337 | begin 338 | D := ImageWidth; 339 | if ImageHeight > D then 340 | D := ImageHeight; 341 | D := D * 1.42 * Level / 2; 342 | W := X - ImageWidth / 2; 343 | H := Y - ImageHeight / 2; 344 | if Sqrt(W * W + H * H) < D then 345 | Pixel := A 346 | else 347 | Pixel := B; 348 | end; 349 | 350 | procedure ScreenBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 351 | var 352 | P: TPixel; 353 | begin 354 | P.R := RoundByte($FF - ($FF - A.R) * ($FF - B.R) / $FF); 355 | P.G := RoundByte($FF - ($FF - A.G) * ($FF - B.G) / $FF); 356 | P.B := RoundByte($FF - ($FF - A.B) * ($FF - B.B) / $FF); 357 | P.A := RoundByte(A.A * B.A / $FF); 358 | Pixel := Mix(B, P, Level); 359 | end; 360 | 361 | procedure OverlayBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 362 | var 363 | P: TPixel; 364 | begin 365 | P.R := RoundByte(B.R / $FF * (B.R + (2 * A.R) / $FF * ($FF - B.R))); 366 | P.G := RoundByte(B.G / $FF * (B.G + (2 * A.G) / $FF * ($FF - B.G))); 367 | P.B := RoundByte(B.B / $FF * (B.B + (2 * A.B) / $FF * ($FF - B.B))); 368 | P.A := RoundByte(A.A * B.A / $FF); 369 | Pixel := Mix(B, P, Level); 370 | end; 371 | 372 | procedure BurnBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 373 | var 374 | P: TPixel; 375 | begin 376 | P.R := RoundByte($FF - $100 * ($FF - B.R) / (A.R + 1)); 377 | P.G := RoundByte($FF - $100 * ($FF - B.G) / (A.G + 1)); 378 | P.B := RoundByte($FF - $100 * ($FF - B.B) / (A.B + 1)); 379 | P.A := RoundByte(A.A * B.A / $FF); 380 | Pixel := Mix(B, P, Level); 381 | end; 382 | 383 | procedure DodgeBlend(const A, B: TPixel; var Pixel: TPixel; X, Y: Integer; Level: Single); 384 | var 385 | P: TPixel; 386 | begin 387 | P.R := RoundByte($100 * B.R / ($FF - A.R + 1)); 388 | P.G := RoundByte($100 * B.G / ($FF - A.G + 1)); 389 | P.B := RoundByte($100 * B.B / ($FF - A.B + 1)); 390 | P.A := RoundByte(A.A * B.A / $FF); 391 | Pixel := Mix(B, P, Level); 392 | end; 393 | 394 | { Initialization callbacks } 395 | 396 | procedure InitializeOperations(Add: TAddOperation); 397 | begin 398 | Add('Red Channel', RedOperation); 399 | Add('Green Channel', GreenOperation); 400 | Add('Blue Channel', BlueOperation); 401 | Add('Saturation', SaturationOperation); 402 | Add('Alpha Channel', AlphaOperation); 403 | Add('Black or White', BlackOrWhiteOperation); 404 | Add('Brighten', BrightenOperation); 405 | Add('Contrast', ContrastOperation); 406 | Add('Darken', DarkenOperation); 407 | Add('Invert', InvertOperation); 408 | Add('Hue', HueOperation); 409 | end; 410 | 411 | procedure InitializeBlends(Add: TAddBlend); 412 | begin 413 | Add('Opacity', OpacityBlend); 414 | Add('Disolve', DisolveBlend); 415 | Add('Multiply', MultiplyBlend); 416 | Add('Addition', AdditionBlend); 417 | Add('Subtraction', SubtractionBlend); 418 | Add('Wipe', WipeBlend); 419 | Add('Circle', CircleBlend); 420 | Add('Blocks', BlockBlend); 421 | Add('Screen', ScreenBlend); 422 | Add('Overlay', OverlayBlend); 423 | Add('Burn', BurnBlend); 424 | Add('Dodge', DodgeBlend); 425 | end; 426 | 427 | end. 428 | 429 | -------------------------------------------------------------------------------- /src/styles.pas: -------------------------------------------------------------------------------- 1 | unit Styles; 2 | 3 | {$mode delphi} 4 | 5 | interface 6 | 7 | const 8 | clStyleHighlight = 14849106; 9 | clStyleButton = 5260094; 10 | clStyleText = $FFFFFF; 11 | clStyleWindow = 5391680; 12 | clStyleFrame = $F0F0F0; 13 | clStyleDull = $A0A0A0; 14 | clStyleLight = $D0D0D0; 15 | 16 | implementation 17 | 18 | end. 19 | 20 | --------------------------------------------------------------------------------