From 85bb6c6e1d6ce10fbbc1c21c1cac63473ed31717 Mon Sep 17 00:00:00 2001 From: Raymond Date: Sat, 17 Oct 2009 22:25:40 +0000 Subject: [PATCH] Added FindDeformedBitmapToleranceIn.. git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@136 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- Tests/PS/Several bitmap operations.mufa | 158 ++ Units/MMLCore/finder.pas | 2097 ++++++++++++----------- 2 files changed, 1259 insertions(+), 996 deletions(-) create mode 100644 Tests/PS/Several bitmap operations.mufa diff --git a/Tests/PS/Several bitmap operations.mufa b/Tests/PS/Several bitmap operations.mufa new file mode 100644 index 0000000..97f2b68 --- /dev/null +++ b/Tests/PS/Several bitmap operations.mufa @@ -0,0 +1,158 @@ +program new; +const + SaveDir = 'C:\'; +var + Bmpz : integer; + Bmp2 : integer; + w,h : integer; +begin + Bmpz := BitmapFromString(166, 73, 'beNq9Xf2PVeURtv+Jv' + + 'zeKSYvZaNlc2/S4N22tmtoYE0NsLdYQQoiClpgNQaSUUpRSpFhC/a' + + 'yIX0QCVaOtxn/MYWd39rnPM/Pecz/OJm82994958z7vjPvfM+c1ZW' + + 'f/+RHOtZWd9vwD/T7eLT7Fz+9z/7G17g+LrYfbdC99ks3mvil2/jF' + + 'nxDP8YfbX/8Q/8WB/wro9KM/wQbOKmau42f33W0Dv6aXLTgcCu6Dz' + + '6cbreDqYi3+tRttbm8nk9/YwxVcFG07ogORopitNieQjo/y22/jdH' + + 'XF1+W/2GSqDcSlxTPxK2IWf8Tf/bE+W7rXL/NpBDbjXzGlWMsD994' + + 'V0/av9//4h36N345LCFKfSjb+1bYlZuJoInTE8mPgj3qmcA8JOym+' + + 'cN8aBKm3IyycA36mVeMpUyaAvCJWFxfghPHk4i/+nDjODiKwr8tJ9' + + '6RappMBnan2EdYdwPXG79Vp8pl3gKBuch+QVXZbn4OQKozjw5Gpxv' + + 'Lj7LR5VEp46XEYC1U7cnFRSNXdJBuvzjiNlAD0PBIx0PRo2ElvnIV' + + 'YqX2wK20YkTxw7z1KKr5efxohTlGGHM9/jzl3k1JVT73OdvuYrK7E' + + 'mcJjiA8h5l8h/Y47fmCD7rVV2MLxmUFIKrDiAJIUoyuJ//sHh07iA' + + 'DnG2mgXbmyAQ25PqCGCj4MWk4wHOnRfrKNbBRnugBODajWpyDOx6J' + + 'cFxG5LsvtjHXqba5HqNZWZ00FG3NlwiKdOrR879kKAjusd41MB4ZT' + + 'wCJNAJ+lmHwh6XB+U01OhQloidpTO3KEo9IrPK08IZQznidgkVkAs' + + 'vRPoJAdRhCknVElHaNVrgrYN4jvvXPzyy+sXLpw+ePCZOOmhHaWaD' + + 'G0mcuyYACIa9Rn/VwVdNZlNGhjtIgVMgdq9D3d7/GuwZeWcSOcE3f' + + 'l2KgiC49FRIu0F7QvcBNyTCnolvGg/U2VeMY57hRA//+/H3377+Xf' + + 'ffXn16uX19cP2+z133tlHB8DT5PMhso+FE1fvAx0nEIBQptB+kgqR' + + '2hf+wD7Qg7E7n9c9JLUccYpfSbchXDfWTuoiYbzi2+lAiLduffjVV' + + '5/Z+PrrG///381vvrl1/vypI0cOOKn31PqQqvGr/+Kma0y1P/SKtF' + + 'SDVbQaN0AaS+m8J3RHcSA9JHhqgqH8IuwTrvuvvc3SKzmOS3aIN25' + + 'cNaA2jMy++OITG8ZbbALvvXfppZeec2JDo6yN9MAv2dG+XWt77o4l' + + '94eOoGMP8bA7OBSyZDlun7UNrW8m6JW2bBhfXbmLbEy1xJEe4mjPC' + + 'h3lAunGwTYrBIXINoifffafTz99+/r1d+2DDZvAzZsf4Bxee/WVo0' + + 'cPuTwNPKZKqdJe5WSYA/oYLFbaPdTYyX2UOvfmgI4ycbylaSvoCtG' + + 'I8bmhI64R47jViPRwfgZEA2fj2rUrNj766N+ffPyW/+JzsAn4HOxK' + + 'IzanNxLHhE3yppJvFsXWfNBRSJHninQGPBQdCL5FoJPrQP0D8TWsM' + + 'BJqC6499VeoDwcXHhANhA37YMO4x/vvv2HDtAWfQMzBJuBzOHv2Zb' + + 'cXnLfn7q8NXk2uP7xsKdDJzEdHRzdpCZJqscS1q+O0Kyy+IIDl7nx' + + 'YNx2gm7huQHS6+tcbr16+fO7Klb/beGXXbhs4B5tAzMFneODwkePH' + + '/2TDFQn1/boGizo5mttLhK6OtdQ1gadvudDVxVTpS0Rpi0NPfZUUf' + + 'kJc+9NMAzRbz8bFi2cuXTrrQG3YBN588x8xB5tAzMGneubM8RMnjj' + + 'qxdVtUTa5vFWRDQEcfMvJS1ZqGgI4SLXWhK09bInSV0Rh+cgKLh9i' + + 'NxiJsmD5w7tyfbfgcAjQOm8Pbb71uI8jv2UOHTp58yYa7H9EJluqi' + + 'vuQhoFO4p+K0A0FXp184xPAIDAS98rc7xh2oDyMSu8XMARunTx+jO' + + 'QQ4Jz8byHxiDnv37bN7bYTHm8LWqNcNCj3s4hTjOwBdRQmy1qF3Hu' + + '0RhG7/dRqzsb5+2BQAlwg+BxtKYEiBNgefhs3Br7fZGr0dXl8P/kZ' + + 'RLeKog0IPdI8zt97Q0FMHMmpNQ0OnUGwosXaBa4N2r1l2NkzV9znY' + + 'SLmKE6FRoBOhT9V+2f/c8w7RgaLqqBGTQPpw0MO9iV591G0GhZ4eM' + + 'Tz7Q0Mn5QGJzdUGG4cOPfv88/uPHDnw4osHbcQcfBoI2lmQz82gm7' + + 'ponxCiA628THHwh4OuerIGZAeFHhDJVAxKGA56GoQlu8wNPeMYBw7' + + '84eDBZ2zEHHwaPocgQvtg1GVkdvCFF43O0t1Gnx5yVEqjWjr0Kl8L' + + 'GU4Y5kuHHgycdiDNxxgCuqoQGkG2W9yyMwVg3769z/7xKRv79//e5' + + 'uDT8DkEEZqssRmmEOPJqCbpVzTTlgg9dR1TbGLbEbfhDlru2impEv' + + 'eZYuVB7cuCjjZ4h9HJjQQYNR/sXnfimaTYu/fx3z31xNNPP2lz8Gn' + + 'YHGwYUNMQTG0w9fLoiRPpelU51yNGF7ijb0HolE6gpzvNiY2DtiD0' + + 'cebKU1YTkfrlQsdMNs18IKU9uI09wcTD9evvmhbx+OOPPPHEb5588' + + 'rc2fA5GXSY7TDm8Haw5efKVV19TLqrqGaGbfFCktM8NHcP65N9Io5' + + 'ORTbcU6EjGGmkNvdH4iY34TI7lRdautJ3mMqW/2KNu3LhqWoSxjkc' + + 'f/aWNxx77tQkRM/HMCjCV0iZm5gESWJpVRYnllM6kccnY9lmh0wKR' + + 'e7cx7nyP/H6zQg8nj1r6uNjKXojb/bjNCl19p2H9UYSUQqXE2I2Eb' + + 't78wCSF8RPTEIzPGOHdzrU4derU+fMqNOkJGqTT0LPvCbm/5oBOt6' + + 'fqGQ7PqKfUGqS3WdeeUhpJzMCIJ0VgGgYZibNCxwRmzLdHesPT3Y3' + + 'y42CPvXXrQ9MizMS7fPnctWtXjv3ldAqRTlA7kYZQkIp1l2h9oKf+' + + '0tSxpnRVJaL0XztVu9A+B1ePCpRANGluIWEjkNR/5wODaTIPBoUpT' + + 'o3UGKs++89LpkWYvXD8r2dOX7igKoqWC6FnqZH3opusGJ8KPTXt0z' + + 'QDPEQVaMqPbUNHnoZZTMRh0LUb2lrci7FyrKroAx1v75q55WmeiZY' + + 'PhEx5+W9nz7x+MT1Zmp+GG6tFTMptiGBClQqSa0BXNSke8nC355Hx' + + 'A9XpJlyTQ2brXKy0oWMOW0U8eITTah3aQPJ4p9ArS7MT0Um+DlKck' + + 'C9R5Ut/Hk6qoLpZCAQhOjbK8EXhS1JH48mE1niUPeHhtdU+GCdNng' + + '6s4lp1YBLcPqWGVYgVeXg61I6reBqKg6hfIH2JHqhphEo2iEdcL6p' + + 'eeCOlYaep11WBoWoUOBz6r9buj+sp+1cTpRqCW8tbSOugu9CZQzdq' + + '9qljHOkQVaOHuhH63PrkkNO5rlCGWLv9qNWVdm1gNxnTSRWwqlI1K' + + 'q282MqzNBu1qFpnpL+0NS63ZO1z0EBsYJUH3lbVdA406KTEKm4jcW' + + '20uaWjXepONNTjoaZAkobsqzyooPPIvyVDTG1D4iHtKtFxpto1hqM' + + 'bzUycQ2od49ywiLKBcdITHN1YVY1ZgvHfNvHgw1NrWmM9qTmApwYL' + + 'WyiP0Y4eMoo0ESjVMVTPp0ic0uTm07bql1OMt4vO+pfDp7o3kXHVD' + + 'aCqQ0n9dQ2FXOuVGuhO3QI53je4JZWfO7r9A1Wya8uFVMdrgE6rBq' + + 'I4tJLIOmftMDB3uwNlMunGqozQPdGVpkzYU3zxOIeShviNY94Q7lM' + + 'NdtQP0RAj9QmtUdTE1LOtx7mVi7W6knLaiVOwFRmZOrRItiofSOtq' + + 'kyK+1U1fZapBYeFzGpuumHn8yzGo/MGGYTxkejcZEdMz1ZPP096Se' + + 'kxSspJBMWfc5MYR3jQ0HhxRHLkS1rMOtc6matpUBalOvAYGlQ9oYm' + + '3IvoYGFdjvpFTcy4V6FnrQZcT8FeOoFronraF7pPUI0R0l9Hb1tKe' + + 'hTNRSGiyLOnVUZYxVMxPtylI1WplaOYX71okKRLen8i69nm40Mpjp' + + 'CCjG00YEVKRDJwLVM53zVA+/lu5WTYd6HvCUTpTOUWmsdIxGgLub5' + + 'GzjQvHGE03KEpFTpYegOUZtARr0pn1j4smuAFSIJiJUryntiSJdu1' + + 'XgcGrRKmMvPDc7VyvNMRJEa0T5i9XxarWRzw0/NwRBVQZL6lk36cf' + + 'WoAmFzmPa1amJM9XgLUo/xk4rvR1X1HDRR3yqUrQqNSy2VC82evPl' + + 'uPbVqGKgxzYal5E3jEhOufpUjHegf3Yjflr0gdHyzCotQbNQsDdUm' + + '4kRb4k+MKm20MiTJ7OlYdapCa/QdaXsZlzdluboT1aFJwwx9Rt4oz' + + 'Cs7PBSiLQ/W7rnVVw17bcThqdW8UcvFFTkqFdDugT1SaKWgh4VNdL' + + 'TXihpjpOmU2p8x2HhrMw6I9Tg8xU6hVdiK1wJ3+o3ck/KdV2jS/MD' + + 'cVZBNgSd1OzKWK5ccIjTShtvdCNpkFyFi4pRV2GRNvSGF6tyOaItH' + + 'Dc+tDYibzkWJCr0EKM0W7Tr0T9J14R1lnKkuL7RAwePUlAIAaq6Em' + + 'lmi3ZYqrqRbJ7u0a7UzQJF09tGdFpHTy5TLGlvQE+tsKl9tCq3Hkb' + + 'E+nRioVCgE4w/BHlXJWsq1bFnFxoNEum5a3QiDWRhUnffPjBbaXtu' + + 'iqLTG/NhUmHhe6Ue8p7QSY9Now8N46JSXHtCD19QPCeQbvwKsZ/6u' + + 'NSon2nnNa6hXru00SJtTqTX9u9GMs76laW9lVI/z6YqO5mMNFMXGt' + + 'KiQ13pad7S9GZdOybKBsZxYAkYCtNKhM269j7xODrXaWV3/24k5Fq' + + 'MNstkTWv6dOio2jOhP3SyONIOimgXd/UBn68LDfIQ5O2EdMqWIeXB' + + 'xnwdeHRv04586KsJ4lykGwlG4dXQrhLmqbB6kU4sbZeUhryrrjtz9' + + '8BRzWSbw4MJoLNacOfbqgsVyChtL9iJBZuIVm4QZTtLgZ6mHERqAd' + + 'YXo58Hd3vBTixVP4qGKr6stVNCGmGcxOgSu5F0PXzmWhSzxC405NX' + + 'R7isVD18cugaMXGZNuEwhQW650DVomyaWD9GNZDt8LIYhGWsDQU/D' + + 'lBjhJTpfLvR2ly2sNByiC00aQQsaGK4bSdWAhbwKA3ViodBP6O3Yh' + + 'XXQLjSaP4wN9ofrA9NO8hy6G0kjpBvoHgg6RTAxjukm/86vHcXZzq' + + 'xdc/Z2oA8MURpVTw8KHeNumsOzA2tHc4wy7Xdy51VpGboPTDBS8rA' + + 'NDT38OZpNFCQ36No1IuM/uum9YzuPPgcDPVw3EordY5tcrHQbFDrl' + + 'wpEjaAegN/Jmh4PuvIX81T6H8PAsvRuJpuph50AKvC4XejtHCDmMH' + + 'cAdgJ6i25n8ENAb9XeI8WV1IyF/KeUeaHGrq6xL7MQSaa601eFZ1Y' + + 'O23D4wtOGVzbL0ne+Z7BeqxVK6kWhRDKGbCiswGriULjSNw4Up7lo' + + '5viB0xDJ+Jsc+7bkT4RLX3o1miBMt2I2ky7I605qItBB1QeiNMiKK' + + 'yqVVUYtAx0hoO72qiowv3oWm6rmU1sLQwhfvA6MZsFVlBCV0zd0Lh' + + 'bIKVYVo1J7E8Z+vC02Fa1xa9YKYyHdyTWa+HjhVonvF7jRiNV8nlr' + + 'RYhmIZ8T7T9P0vc3RiqXKoFG5Dc0N6mxV6zx4FE+9mgoowN5QC4zN' + + 'BD7iaAtEI2aTJCTP1QtHsxKpUaqIbxlbxo6ag9O+FUlUjpmmQyNJV' + + 'l4vY9ExdaG43KNgY6bkeQ1JEo04ZWUR/6A0JUq0O31yjpN7uRlLle' + + 'NP7NOnh6TvsNP11KvR2Sc7UKjNtKzHr2isjSys+MAhLMfGwi2+nr2' + + '/pk1Ohk/tOMz/7hGW12r3RiSUqpjVhjN615P/VupUgRX29whhex1l' + + 'B71n/m7YG1d4jlftxahcafCYx9mpXKfulwlobOuXL+WfNuW0jXfM0' + + 'MPtd22/qi+bbZeZpvZKmK5BKk0qQIBgV2VXWgdKb/kvvTbmobqkTv' + + '/6L3ihtw9SzFOOb7tYt5Q2Dp7rzrubFc+yzj3imf527htpMSNWOcL' + + 'ejGx51C0lFuRbU42O1pCs6sYQzp9FGoErtbltqVfEIdqEhaev8AbO' + + 'R22+lRJUS0U32hStvSAPbmuGDo+rwOnIDxRW625Xm2lWyLSMmurRJ' + + 'U4LIc4voSVrUGRjfPBRb1VjY7gwba2hrDnrlaFqzlpYcTrTNaa4un' + + 'rOdgbznbsxWavQ/ieNJF2DxC0pn/7xJYw+OpoqhqTWnU7Pi1UEUOl' + + 'gIHX+Nr7duoP7h1DRsgsNPqrLaZU5zk+IlZZqSN5YCh9QUjWhpN6l' + + 'm9FFyQuWIWhU84FUOdspksM4okml9bq4J+EmnE61lUI0J69vEdNUq' + + 'Q4lZpZG+tLhS++s2ClLUXE21Aqzg7ia7J6X1renO0Bmvuv8lGs5W3' + + 'xXcE6wyaNQKRduHgE6sW/fWSSLdbfWcTFXPsNJ5LO9wTAveUxcxvf' + + 'WV6psUv423Syd8dbLrO/HqwPu2RiQSilKMegawti01UJtJ3w4iIe2' + + 'ry1KUA7kh/QmPgetGv8Ew37Q1Qa9uRUUfsEZibUP/SZ1saRd9dbv1' + + 'gZVSTtuVpMt0PkzqE5VETZWA9ORAYtxORWo4HJuqd6EyhpGdBsanM' + + 'pM+fH7qXVRxSZ6WbsS9QJMebtBVLH1PqzZk07pdJOxutBsNn0huof' + + '6H6avb2+2V0KYgqUdS1VFABNOoOkm3FI98BHDT0ADJgrLZi5G3j3a' + + 'Po+8BCV1cWQ=='); + SaveBitmap(bmpz,SaveDir + 'original.bmp'); + GetBitmapSize(bmpz,w,h); + SetBitmapName(bmpz,'Invetory Bitmap'); + Writeln('Bitmap size: ('+inttostr(w) + ',' + inttostr(h) + ')'); + Bmp2 := CopyBitmap(bmpz); + SetBitmapSize(Bmp2,w div 2, h div 2); + SaveBitmap(bmp2,SaveDir + 'cut.bmp'); + StretchBitmapResize(Bmpz,w*2,h*2); + SaveBitmap(bmpz,savedir + 'stretched.bmp'); + FreeBitmap(bmp2); + Bmp2 := CopyBitmap(bmpz); + StretchBitmapResize(bmp2,w div 2, h div 2); + SaveBitmap(bmp2,savedir + 'stretchedSmall.bmp'); + SaveBitmap(ContrastBitmap(bmpz,50),savedir + 'Contrast.bmp'); + SaveBitmap(BrightnessBitmap(bmpz,150),savedir + 'Brightness.bmp'); + SaveBitmap(GreyScaleBitmap(bmpz),savedir + 'GreyScale.bmp'); + InvertBitmap(bmpz); + SaveBitmap(bmpz,savedir + 'inverted.bmp'); + Invertbitmap(bmpz);//Invert back + SaveBitmap(DesaturateBitmap(Bmpz),savedir + 'desaturate.bmp'); + SaveBitmap(RotateBitmap(Bmpz,0.30*pi),savedir + 'rotated.bmp'); +end. diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 741e290..7c2fd30 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -1,996 +1,1101 @@ -{ - This file is part of the Mufasa Macro Library (MML) - Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer - - MML is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - MML is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with MML. If not, see . - - See the file COPYING, included in this distribution, - for details about the copyright. - - Finder class for the Mufasa Macro Library -} - -unit finder; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils,bitmaps, MufasaTypes; // Types - -{ TMFinder Class } - -{ - Should be 100% independant, as all platform dependant code is in the - Window and Input classes. - - Let's try not to use any OS-specific defines here? ;) -} - -type - TMFinder = class(TObject) - constructor Create(aClient: TObject); - destructor Destroy; override; - private - Procedure UpdateCachedValues(NewWidth,NewHeight : integer); - procedure DefaultOperations(var xs,ys,xe,ye : integer); - //Loads the Spiral into ClientTPA (Will not cause problems) - procedure LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer); - public - function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer; - procedure SetToleranceSpeed(nCTS: Integer); - function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean; - // Possibly turn x, y into a TPoint var. - function FindColor(var x, y: Integer; Color, xs, ys, xe, ye: Integer): Boolean; - function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean; - function FindColorTolerance(var x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean; - function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean; - function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean; - function FindColors(var TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean; - //Bitmap functions - function FindBitmap(bitmap: TMufasaBitmap; var x, y: Integer): Boolean; - function FindBitmapIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean; - function FindBitmapToleranceIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean; - function FindBitmapSpiral(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean; - function FindBitmapSpiralTolerance(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean; - function FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean; - protected - Client: TObject; - CachedWidth, CachedHeight : integer; - ClientTPA : TPointArray; - hueMod, satMod: Extended; - CTS: Integer; - end; - -implementation -uses - Client, // For the Client Casts. - colour_conv // For RGBToColor, etc. - ; -type - TPRGB32Array = array of PRGB32; - -procedure TMFinder.LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer); -var - i,y,x,c,Ring : integer; - CurrBox : TBox; -begin; - i := 0; - Ring := 1; - c := 0; - CurrBox.x1 := Startx-1; - CurrBox.y1 := Starty-1; - CurrBox.x2 := Startx+1; - CurrBox.y2 := Starty+1; - if (startx >= x1) and (startx <= x2) and (starty >= y1) and (starty <= y2) then - begin; - ClientTPA[c] := Point(Startx, StartY); - inc(c); - end; - Repeat - if (CurrBox.x2 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y1 >= y1) and (Currbox.y1 <= y2) then - for i := CurrBox.x1 + 1 to CurrBox.x2 do - if (I >= x1) and ( I <= x2) then - begin; - ClientTPA[c] := Point(i,CurrBox.y1); - inc(c); - end; - if (CurrBox.x2 >= x1) and (CurrBox.x2 <= x2) and (Currbox.y2 >= y1) and (Currbox.y1 <= y2) then - for i := CurrBox.y1 + 1 to CurrBox.y2 do - if (I >= y1) and ( I <= y2) then - begin; - ClientTPA[c] := Point(Currbox.x2, I); - inc(c); - end; - if (CurrBox.x2 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y2 >= y1) and (Currbox.y2 <= y2) then - for i := CurrBox.x2 - 1 downto CurrBox.x1 do - if (I >= x1) and ( I <= x2) then - begin; - ClientTPA[c] := Point(i,CurrBox.y2); - inc(c); - end; - if (CurrBox.x1 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y2 >= y1) and (Currbox.y1 <= y2) then - for i := CurrBox.y2 - 1 downto CurrBox.y1 do - if (I >= y1) and ( I <= y2) then - begin; - ClientTPA[c] := Point(Currbox.x1, I); - inc(c); - end; - inc(ring); - CurrBox.x1 := Startx-ring; - CurrBox.y1 := Starty-Ring; - CurrBox.x2 := Startx+Ring; - CurrBox.y2 := Starty+Ring; - until (Currbox.x1 < x1) and (Currbox.x2 > x2) and (currbox.y1 < y1) and (currbox.y2 > y2); -end; - -function CalculateRowPtrs(ReturnData : TRetData; RowCount : integer) : TPRGB32Array;overload; -var - I : integer; -begin; - setlength(result,RowCount); - for i := 0 to RowCount - 1do - begin; - result[i] := ReturnData.Ptr; - inc(ReturnData.Ptr,ReturnData.IncPtrWith); - end; -end; - -function CalculateRowPtrs(Bitmap : TMufasaBitmap) : TPRGB32Array;overload; -var - I : integer; -begin; - setlength(result,Bitmap.Height); - for i := 0 to Bitmap.Height - 1 do - result[i] := Bitmap.FData + Bitmap.Width; -end; - -constructor TMFinder.Create(aClient: TObject); - -begin - inherited Create; - - Self.Client := aClient; - Self.CTS := 1; - Self.hueMod := 0.2; - Self.satMod := 0.2; - -end; - -destructor TMFinder.Destroy; -begin - - inherited; -end; - -procedure TMFinder.SetToleranceSpeed(nCTS: Integer); -begin - if (nCTS < 0) or (nCTS > 2) then - raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]); - Self.CTS := nCTS; -end; - -function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean; -var - R1,G1,B1,R2,G2,B2 : Byte; - H1,S1,L1,H2,S2,L2 : extended; -begin - Result := False; - ColorToRGB(Color1,R1,G1,B1); - ColorToRGB(Color2,R2,G2,B2); - if Color1 = Color2 then - Result := true - else - case CTS of - 0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance)); - 1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance); - 2: begin - RGBToHSL(R1,g1,b1,H1,S1,L1); - RGBToHSL(R2,g2,b2,H2,S2,L2); - Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance)); - end; - end; -end; - - -function ColorSame(var CTS,Tolerance : Integer; var R1,G1,B1,R2,G2,B2 : byte; var H1,S1,L1,huemod,satmod : extended) : boolean; inline; -var - H2,S2,L2 : extended; -begin - Result := False; - case CTS of - 0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance)); - 1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance); - 2: begin - RGBToHSL(R1,g1,b1,H1,S1,L1); - RGBToHSL(R2,g2,b2,H2,S2,L2); - Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance)); - end; - end; -end; - -procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer); -begin - CachedWidth := NewWidth; - CachedHeight := NewHeight; - SetLength(ClientTPA,NewWidth * NewHeight); -end; - -procedure TMFinder.DefaultOperations(var xs, ys, xe, ye: integer); -var - w,h : integer; -begin -{ if xs > xe then - Swap(xs,xe); - if ys > ye then - Swap(ys,ye);} - if xs < 0 then - // xs := 0; - raise Exception.createFMT('Any Find Function, you did not pass a ' + - 'correct xs: %d.', [xs]); - if ys < 0 then -// ys := 0; - raise Exception.createFMT('Any Find Function, you did not pass a ' + - 'correct ys: %d.', [ys]); - - TClient(Self.Client).MWindow.GetDimensions(w,h); - if (w <> CachedWidth) or (h <> CachedHeight) then - UpdateCachedValues(w,h); - if xe >= w then -// xe := w-1; - raise Exception.createFMT('Any Find Function, you did not pass a ' + - 'correct xe: %d.', [xe]); - if ye >= h then -// ye := h-1; - raise Exception.createFMT('Any Find Function, you did not pass a ' + - 'correct ye: %d.', [ye]); -end; - -function TMFinder.CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer; -var - PtrData: TRetData; - Ptr: PRGB32; - PtrInc: Integer; - clR, clG, clB : byte; - dX, dY, xx, yy: Integer; - h,s,l,hmod,smod : extended; - Ccts : integer; -begin - Result := 0; - DefaultOperations(xs, ys, xe, ye); - dX := xe - xs; - dY := ye - ys; - ColorToRGB(Color, clR, clG, clB); - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - Ptr := PtrData.Ptr; - PtrInc := PtrData.IncPtrWith; - CCts := Self.CTS; - result := 0; - if cts = 2 then - begin; - RGBToHSL(clR,clG,clB,h,s,l); - hmod := Self.hueMod; - smod := Self.satMod; - end; - for yy := ys to ye do - begin; - for xx := xs to xe do - begin; - if ColorSame(CCts,Tolerance,clR,clG,clB,Ptr^.r,Ptr^.g,Ptr^.b,H,S,L,hmod,smod) then - inc(result); - Inc(Ptr); - end; - Inc(Ptr, PtrInc) - end; - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindColor(var x, y: Integer; Color, xs, ys, xe, ye: Integer): Boolean; -var - PtrData: TRetData; - Ptr: PRGB32; - PtrInc: Integer; - dX, dY, clR, clG, clB, xx, yy: Integer; - -begin - Result := false; - // checks for valid xs,ys,xe,ye? (may involve GetDimensions) - DefaultOperations(xs,ys,xe,ye); - - // calculate delta x and y - dX := xe - xs; - dY := ye - ys; - - //next, convert the color to r,g,b - ColorToRGB(Color, clR, clG, clB); - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - - // Do we want to "cache" these vars? - // We will, for now. Easier to type. - Ptr := PtrData.Ptr; - PtrInc := PtrData.IncPtrWith; - - for yy := ys to ye do - begin; - for xx := xs to xe do - begin; - // Colour comparison here. Possibly with tolerance? ;) - if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then - begin - Result := True; - x := xx; - y := yy; - - TClient(Client).MWindow.FreeReturnData; - Exit; - end; - Inc(Ptr); - end; - Inc(Ptr, PtrInc) - end; - - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindColorSpiral(var x, y: Integer; color, xs, ys, xe, - ye: Integer): Boolean; -var - PtrData: TRetData; - RowData : TPRGB32Array; - dX, dY, clR, clG, clB, i,HiSpiral: Integer; - -begin - Result := false; - // checks for valid xs,ys,xe,ye? (may involve GetDimensions) - DefaultOperations(xs,ys,xe,ye); - - // calculate delta x and y - dX := xe - xs; - dY := ye - ys; - - //next, convert the color to r,g,b - ColorToRGB(Color, clR, clG, clB); - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - //Load rowdata - RowData:= CalculateRowPtrs(ptrdata,dy+1); - //Load the spiral path - LoadSpiralPath(x-xs,y-ys,0,0,dx,dy); - - - HiSpiral := (dy+1) * (dx + 1) -1; - for i := 0 to HiSpiral do - if (RowData[ClientTPA[i].y][ClientTPA[i].x].R = clR) and (RowData[ClientTPA[i].y][ClientTPA[i].x].G = clG) - and (RowData[ClientTPA[i].y][ClientTPA[i].x].B = clB) then - begin - Result := True; - x := ClientTPA[i].x + xs; - y := ClientTPA[i].y + ys; - TClient(Client).MWindow.FreeReturnData; - Exit; - end; - - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindColorTolerance(var x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean; -var - PtrData: TRetData; - Ptr: PRGB32; - PtrInc: Integer; - dX, dY, clR, clG, clB, xx, yy: Integer; - H1, S1, L1, H2, S2, L2: Extended; - - label Hit; - label Miss; - -begin - Result := false; - // checks for valid xs,ys,xe,ye? (may involve GetDimensions) - DefaultOperations(xs,ys,xe,ye); - - // calculate delta x and y - dX := xe - xs; - dY := ye - ys; - //next, convert the color to r,g,b - ColorToRGB(Color, clR, clG, clB); - ColorToHSL(Color, H1, S1, L1); - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - - // Do we want to "cache" these vars? - // We will, for now. Easier to type. - Ptr := PtrData.Ptr; - PtrInc := PtrData.IncPtrWith; - - case CTS of - 0: - for yy := ys to ye do - begin - for xx := xs to xe do - begin - if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then - goto Hit; - inc(Ptr); - end; - Inc(Ptr, PtrInc); - end; - - 1: - begin - Tol := Sqr(Tol); - - for yy := ys to ye do - begin - for xx := xs to xe do - begin - if (sqr(clB - Ptr^.B) + sqr(clG - Ptr^.G) + sqr(clR-Ptr^.R)) <= Tol then - goto Hit; - inc(ptr); - end; - Inc(Ptr, PtrInc); - end; - - end; - 2: - // Can be optimized a lot... RGBToHSL isn't really inline, - // and hueMod * tol is also calculated every time. - begin - for yy := ys to ye do - for xx := xs to xe do - begin - RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2); - if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then - goto Hit; - inc(Ptr); - end; - Inc(Ptr, PtrInc); - end; - end; - Result := False; - TClient(Client).MWindow.FreeReturnData; - Exit; - - Hit: - Result := True; - x := xx; - y := yy; - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindColorsTolerance(var Points: TPointArray; Color, xs, ys, - xe, ye, Tol: Integer): Boolean; -var - PtrData: TRetData; - Ptr: PRGB32; - PtrInc,C: Integer; - dX, dY, clR, clG, clB, xx, yy: Integer; - H1, S1, L1, H2, S2, L2: Extended; -begin - Result := false; - DefaultOperations(xs,ys,xe,ye); - - dX := xe - xs; - dY := ye - ys; - //next, convert the color to r,g,b - ColorToRGB(Color, clR, clG, clB); - ColorToHSL(Color, H1, S1, L1); - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - - // Do we want to "cache" these vars? - // We will, for now. Easier to type. - Ptr := PtrData.Ptr; - PtrInc := PtrData.IncPtrWith; - c := 0; - case CTS of - 0: - for yy := ys to ye do - begin - for xx := xs to xe do - begin - if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then - begin; - ClientTPA[c].x := xx; - ClientTPA[c].y := yy; - inc(c); - end; - inc(Ptr); - end; - Inc(Ptr, PtrInc); - end; - - 1: - for yy := ys to ye do - begin - for xx := xs to xe do - begin - if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then - begin; - ClientTPA[c].x := xx; - ClientTPA[c].y := yy; - inc(c); - end; - inc(ptr); - end; - Inc(Ptr, PtrInc); - end; - 2: - begin - for yy := ys to ye do - for xx := xs to xe do - begin - RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2); - if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then - begin; - ClientTPA[c].x := xx; - ClientTPA[c].y := yy; - inc(c); - end; - inc(Ptr); - end; - Inc(Ptr, PtrInc); - end; - end; - SetLength(Points, C); - Move(ClientTPA[0], Points[0], C * SizeOf(TPoint)); - Result := C > 0; - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindColorsSpiralTolerance(x, y: Integer; - var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer - ): boolean; -var - PtrData: TRetData; - c : integer; - RowData : TPRGB32Array; - dX, dY, clR, clG, clB, i,SpiralHi: Integer; - H1, S1, L1, H2, S2, L2: Extended; -begin - Result := false; - DefaultOperations(xs,ys,xe,ye); - - dX := xe - xs; - dY := ye - ys; - //next, convert the color to r,g,b - ColorToRGB(Color, clR, clG, clB); - ColorToHSL(Color, H1, S1, L1); - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - - c := 0; - - //Load rowdata - RowData:= CalculateRowPtrs(ptrdata,dy+1); - //Load the spiral path - LoadSpiralPath(x-xs,y-ys,0,0,dx,dy); - SpiralHi := (dx + 1) * (dy + 1) - 1; - case CTS of - 0: - for i := 0 to SpiralHi do - if ((abs(clB-RowData[ClientTPA[i].y][ClientTPA[i].x].B) <= Tolerance) and - (abs(clG-RowData[ClientTPA[i].y][ClientTPA[i].x].G) <= Tolerance) and - (Abs(clR-RowData[ClientTPA[i].y][ClientTPA[i].x].R) <= Tolerance)) then - begin; - ClientTPA[c].x := ClientTPA[i].x + xs; - ClientTPA[c].y := ClientTPA[i].y + ys; - inc(c); - end; - - - 1: - for i := 0 to SpiralHi do - if (Sqrt(sqr(clR - RowData[ClientTPA[i].y][ClientTPA[i].x].R) + - sqr(clG - RowData[ClientTPA[i].y][ClientTPA[i].x].G) + - sqr(clB - RowData[ClientTPA[i].y][ClientTPA[i].x].B)) <= Tolerance) then - begin; - ClientTPA[c].x := ClientTPA[i].x + xs; - ClientTPA[c].y := ClientTPA[i].y + ys; - inc(c); - end; - - 2: - for i := 0 to SpiralHi do - begin; - RGBToHSL(RowData[ClientTPA[i].y][ClientTPA[i].x].R, - RowData[ClientTPA[i].y][ClientTPA[i].x].G, - RowData[ClientTPA[i].y][ClientTPA[i].x].B,H2,S2,L2); - if ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S1 - S2) <= (satMod * Tolerance)) and (abs(L1 - L2) <= Tolerance)) then - begin; - ClientTPA[c].x := ClientTPA[i].x + xs; - ClientTPA[c].y := ClientTPA[i].y + ys; - inc(c); - end; - end; - end; - SetLength(Points, C); - Move(ClientTPA[0], Points[0], C * SizeOf(TPoint)); - Result := C > 0; - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindColors(var TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean; -var - PtrData: TRetData; - Ptr: PRGB32; - PtrInc: Integer; - dX, dY, clR, clG, clB, xx, yy, i: Integer; - -begin - Result := false; - DefaultOperations(xs,ys,xe,ye); - - dX := xe - xs; - dY := ye - ys; - - I := 0; - - ColorToRGB(Color, clR, clG, clB); - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - - Ptr := PtrData.Ptr; - PtrInc := PtrData.IncPtrWith; - - for yy := ys to ye do - begin; - for xx := xs to xe do - begin; - if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then - begin - Self.ClientTPA[I].x := xx; - Self.ClientTPA[i].y := yy; - Inc(I); - end; - Inc(Ptr); - end; - Inc(Ptr, PtrInc); - end; - - SetLength(TPA, I); - - Move(ClientTPA[0], TPA[0], i * SizeOf(TPoint)); - - Result := I > 0; - - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindBitmap(bitmap: TMufasaBitmap; var x, y: Integer): Boolean; -var - w,h : integer; -begin - TClient(Client).MWindow.GetDimensions(w,h); - result := Self.FindBitmapIn(bitmap,x,y,0,0,w-1,h-1); -end; - -function TMFinder.FindBitmapIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, - ys, xe, ye: Integer): Boolean; -var - MainRowdata : TPRGB32Array; - BmpRowData : TPRGB32Array; - PtrData : TRetData; - BmpW,BmpH : integer; - xBmp,yBmp : integer; - tmpY : integer; - dX, dY, xx, yy: Integer; -label NotFoundBmp; - //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. - -begin - Result := false; - // checks for valid xs,ys,xe,ye? (may involve GetDimensions) - DefaultOperations(xs,ys,xe,ye); - - // calculate delta x and y - dX := xe - xs; - dY := ye - ys; - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - //Caculate the row ptrs - MainRowdata:= CalculateRowPtrs(PtrData,dy+1); - BmpRowData:= CalculateRowPtrs(bitmap); - //Get the 'fixed' bmp size - BmpW := bitmap.Width - 1; - BmpH := bitmap.Height - 1; - //Heck our bitmap cannot be outside the search area - dX := dX - bmpW; - dY := dY - bmpH; - for yy := 0 to dY do - for xx := 0 to dX do - begin; - for yBmp:= 0 to BmpH do - begin; - tmpY := yBmp + yy; - for xBmp := 0 to BmpW do - if (BmpRowData[yBmp][xBmp].R <> MainRowdata[tmpY][xBmp + xx].R) or - (BmpRowData[yBmp][xBmp].G <> MainRowdata[tmpY][xBmp + xx].G) or - (BmpRowData[yBmp][xBmp].B <> MainRowdata[tmpY][xBmp + xx].B) then - goto NotFoundBmp; - - end; - //We did find the Bmp, otherwise we would be at the part below - TClient(Client).MWindow.FreeReturnData; - x := xx + xs; - y := yy + ys; - result := true; - exit; - NotFoundBmp: - end; - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindBitmapToleranceIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, - ys, xe, ye: Integer; tolerance: Integer): Boolean; -var - MainRowdata : TPRGB32Array; - BmpRowData : TPRGB32Array; - PtrData : TRetData; - BmpW,BmpH : integer; - xBmp,yBmp : integer; - tmpY : integer; - dX, dY, xx, yy: Integer; - CCTS : integer; - H,S,L,HMod,SMod : extended; -label NotFoundBmp; - //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. - -begin - Result := false; - // checks for valid xs,ys,xe,ye? (may involve GetDimensions) - DefaultOperations(xs,ys,xe,ye); - - // calculate delta x and y - dX := xe - xs; - dY := ye - ys; - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - //Caculate the row ptrs - MainRowdata:= CalculateRowPtrs(PtrData,dy+1); - BmpRowData:= CalculateRowPtrs(bitmap); - //Get the 'fixed' bmp size - BmpW := bitmap.Width - 1; - BmpH := bitmap.Height - 1; - //Heck our bitmap cannot be outside the search area - dX := dX - bmpW; - dY := dY - bmpH; - //We wont want HSL comparison with BMPs, right? Not for now atleast. - CCTS := Self.CTS; - if CCTS > 1 then - CCTS := 1; - for yy := 0 to dY do - for xx := 0 to dX do - begin; - for yBmp:= 0 to BmpH do - begin; - tmpY := yBmp + yy; - for xBmp := 0 to BmpW do - if not ColorSame(CCTS,tolerance, - BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B, - MainRowdata[tmpY][xBmp + xx].R,MainRowdata[tmpY][xBmp + xx].G,MainRowdata[tmpY][xBmp + xx].B, - H,S,L,HMod,SMod) then - goto NotFoundBmp; - - end; - //We did find the Bmp, otherwise we would be at the part below - TClient(Client).MWindow.FreeReturnData; - x := xx + xs; - y := yy + ys; - result := true; - exit; - NotFoundBmp: - end; - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindBitmapSpiral(bitmap: TMufasaBitmap; var x, y: Integer; - xs, ys, xe, ye: Integer): Boolean; -var - MainRowdata : TPRGB32Array; - BmpRowData : TPRGB32Array; - PtrData : TRetData; - BmpW,BmpH : integer; - xBmp,yBmp : integer; - tmpY : integer; - dX, dY, i,HiSpiral: Integer; -label NotFoundBmp; - //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. - -begin - Result := false; - // checks for valid xs,ys,xe,ye? (may involve GetDimensions) - DefaultOperations(xs,ys,xe,ye); - - // calculate delta x and y - dX := xe - xs; - dY := ye - ys; - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - //Caculate the row ptrs - MainRowdata:= CalculateRowPtrs(PtrData,dy+1); - BmpRowData:= CalculateRowPtrs(bitmap); - //Get the 'fixed' bmp size - BmpW := bitmap.Width - 1; - BmpH := bitmap.Height - 1; - //Heck, our bitmap cannot be outside the search area - dX := dX - bmpW; - dY := dY - bmpH; - //Load the spiral into memory - LoadSpiralPath(x-xs,y-ys,0,0,dX,dY); - HiSpiral := (dx+1) * (dy+1) - 1; - for i := 0 to HiSpiral do - begin; - for yBmp:= 0 to BmpH do - begin; - tmpY := yBmp + ClientTPA[i].y; - for xBmp := 0 to BmpW do - if (BmpRowData[yBmp][xBmp].R <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].R) or - (BmpRowData[yBmp][xBmp].G <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].G) or - (BmpRowData[yBmp][xBmp].B <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].B) then - goto NotFoundBmp; - - end; - //We did find the Bmp, otherwise we would be at the part below - TClient(Client).MWindow.FreeReturnData; - x := ClientTPA[i].x + xs; - y := ClientTPA[i].y + ys; - result := true; - exit; - NotFoundBmp: - end; - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindBitmapSpiralTolerance(bitmap: TMufasaBitmap; var x, - y: Integer; xs, ys, xe, ye, tolerance: integer): Boolean; -var - MainRowdata : TPRGB32Array; - BmpRowData : TPRGB32Array; - PtrData : TRetData; - BmpW,BmpH : integer; - xBmp,yBmp : integer; - tmpY : integer; - dX, dY, i,HiSpiral: Integer; - CCTS : integer; - H,S,L,HMod,SMod : extended; -label NotFoundBmp; - //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. - -begin - Result := false; - // checks for valid xs,ys,xe,ye? (may involve GetDimensions) - DefaultOperations(xs,ys,xe,ye); - - // calculate delta x and y - dX := xe - xs; - dY := ye - ys; - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - //Caculate the row ptrs - MainRowdata:= CalculateRowPtrs(PtrData,dy+1); - BmpRowData:= CalculateRowPtrs(bitmap); - //Get the 'fixed' bmp size - BmpW := bitmap.Width - 1; - BmpH := bitmap.Height - 1; - //Heck, our bitmap cannot be outside the search area - dX := dX - bmpW; - dY := dY - bmpH; - //Load the spiral into memory - LoadSpiralPath(x-xs,y-ys,0,0,dX,dY); - HiSpiral := (dx+1) * (dy+1) - 1; - //NO HSL. - CCTS := Self.CTS; - if CCTS > 1 then - CCTS := 1; - for i := 0 to HiSpiral do - begin; - for yBmp:= 0 to BmpH do - begin; - tmpY := yBmp + ClientTPA[i].y; - for xBmp := 0 to BmpW do - if not ColorSame(CCTS,tolerance, - BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B, - MainRowdata[tmpY][xBmp + ClientTPA[i].x].R,MainRowdata[tmpY][xBmp + ClientTPA[i].x].G, - MainRowdata[tmpY][xBmp + ClientTPA[i].x].B, - H,S,L,HMod,SMod) then - goto NotFoundBmp; - - end; - //We did find the Bmp, otherwise we would be at the part below - x := ClientTPA[i].x + xs; - y := ClientTPA[i].y + ys; - result := true; - exit; - NotFoundBmp: - end; - TClient(Client).MWindow.FreeReturnData; -end; - -function TMFinder.FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x, - y: Integer; var Points: TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean; -var - MainRowdata : TPRGB32Array; - BmpRowData : TPRGB32Array; - PtrData : TRetData; - BmpW,BmpH : integer; - xBmp,yBmp : integer; - tmpY : integer; - dX, dY, i,HiSpiral: Integer; - FoundC : integer; - CCTS : integer; - H,S,L,HMod,SMod : extended; -label NotFoundBmp; - //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. - -begin - Result := false; - // checks for valid xs,ys,xe,ye? (may involve GetDimensions) - DefaultOperations(xs,ys,xe,ye); - - // calculate delta x and y - dX := xe - xs; - dY := ye - ys; - - PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); - //Caculate the row ptrs - MainRowdata:= CalculateRowPtrs(PtrData,dy+1); - BmpRowData:= CalculateRowPtrs(bitmap); - //Get the 'fixed' bmp size - BmpW := bitmap.Width - 1; - BmpH := bitmap.Height - 1; - //Heck, our bitmap cannot be outside the search area - dX := dX - bmpW; - dY := dY - bmpH; - //Load the spiral into memory - LoadSpiralPath(x-xs,y-ys,0,0,dX,dY); - HiSpiral := (dx+1) * (dy+1) - 1; - //NO HSL. - CCTS := Self.CTS; - if CCTS > 1 then - CCTS := 1; - FoundC := 0; - for i := 0 to HiSpiral do - begin; - for yBmp:= 0 to BmpH do - begin; - tmpY := yBmp + ClientTPA[i].y; - for xBmp := 0 to BmpW do - if not ColorSame(CCTS,tolerance, - BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B, - MainRowdata[tmpY][xBmp + ClientTPA[i].x].R,MainRowdata[tmpY][xBmp + ClientTPA[i].x].G, - MainRowdata[tmpY][xBmp + ClientTPA[i].x].B, - H,S,L,HMod,SMod) then - goto NotFoundBmp; - - end; - //We did find the Bmp, otherwise we would be at the part below - ClientTPA[FoundC].x := ClientTPA[i].x + xs; - ClientTPA[FoundC].y := ClientTPA[i].y + ys; - inc(FoundC); - NotFoundBmp: - end; - if FoundC > 0 then - begin; - result := true; - SetLength(Points,FoundC); - Move(ClientTPA[0], Points[0], FoundC * SizeOf(TPoint)); - end; - TClient(Client).MWindow.FreeReturnData; -end; - -end. - +{ + This file is part of the Mufasa Macro Library (MML) + Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer + + MML is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + MML is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with MML. If not, see . + + See the file COPYING, included in this distribution, + for details about the copyright. + + Finder class for the Mufasa Macro Library +} + +unit finder; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils,bitmaps, MufasaTypes; // Types + +{ TMFinder Class } + +{ + Should be 100% independant, as all platform dependant code is in the + Window and Input classes. + + Let's try not to use any OS-specific defines here? ;) +} + +type + TMFinder = class(TObject) + constructor Create(aClient: TObject); + destructor Destroy; override; + private + Procedure UpdateCachedValues(NewWidth,NewHeight : integer); + procedure DefaultOperations(var xs,ys,xe,ye : integer); + //Loads the Spiral into ClientTPA (Will not cause problems) + procedure LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer); + public + function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer; + procedure SetToleranceSpeed(nCTS: Integer); + function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean; + // Possibly turn x, y into a TPoint var. + function FindColor(var x, y: Integer; Color, xs, ys, xe, ye: Integer): Boolean; + function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean; + function FindColorTolerance(var x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean; + function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean; + function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean; + function FindColors(var TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean; + //Bitmap functions + function FindBitmap(bitmap: TMufasaBitmap; var x, y: Integer): Boolean; + function FindBitmapIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean; + function FindBitmapToleranceIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean; + function FindBitmapSpiral(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean; + function FindBitmapSpiralTolerance(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean; + function FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean; + function FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean; + protected + Client: TObject; + CachedWidth, CachedHeight : integer; + ClientTPA : TPointArray; + hueMod, satMod: Extended; + CTS: Integer; + end; + +implementation +uses + Client, // For the Client Casts. + colour_conv // For RGBToColor, etc. + ; +type + TPRGB32Array = array of PRGB32; + +procedure TMFinder.LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer); +var + i,y,x,c,Ring : integer; + CurrBox : TBox; +begin; + i := 0; + Ring := 1; + c := 0; + CurrBox.x1 := Startx-1; + CurrBox.y1 := Starty-1; + CurrBox.x2 := Startx+1; + CurrBox.y2 := Starty+1; + if (startx >= x1) and (startx <= x2) and (starty >= y1) and (starty <= y2) then + begin; + ClientTPA[c] := Point(Startx, StartY); + inc(c); + end; + Repeat + if (CurrBox.x2 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y1 >= y1) and (Currbox.y1 <= y2) then + for i := CurrBox.x1 + 1 to CurrBox.x2 do + if (I >= x1) and ( I <= x2) then + begin; + ClientTPA[c] := Point(i,CurrBox.y1); + inc(c); + end; + if (CurrBox.x2 >= x1) and (CurrBox.x2 <= x2) and (Currbox.y2 >= y1) and (Currbox.y1 <= y2) then + for i := CurrBox.y1 + 1 to CurrBox.y2 do + if (I >= y1) and ( I <= y2) then + begin; + ClientTPA[c] := Point(Currbox.x2, I); + inc(c); + end; + if (CurrBox.x2 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y2 >= y1) and (Currbox.y2 <= y2) then + for i := CurrBox.x2 - 1 downto CurrBox.x1 do + if (I >= x1) and ( I <= x2) then + begin; + ClientTPA[c] := Point(i,CurrBox.y2); + inc(c); + end; + if (CurrBox.x1 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y2 >= y1) and (Currbox.y1 <= y2) then + for i := CurrBox.y2 - 1 downto CurrBox.y1 do + if (I >= y1) and ( I <= y2) then + begin; + ClientTPA[c] := Point(Currbox.x1, I); + inc(c); + end; + inc(ring); + CurrBox.x1 := Startx-ring; + CurrBox.y1 := Starty-Ring; + CurrBox.x2 := Startx+Ring; + CurrBox.y2 := Starty+Ring; + until (Currbox.x1 < x1) and (Currbox.x2 > x2) and (currbox.y1 < y1) and (currbox.y2 > y2); +end; + +function CalculateRowPtrs(ReturnData : TRetData; RowCount : integer) : TPRGB32Array;overload; +var + I : integer; +begin; + setlength(result,RowCount); + for i := 0 to RowCount - 1do + begin; + result[i] := ReturnData.Ptr; + inc(ReturnData.Ptr,ReturnData.IncPtrWith); + end; +end; + +function CalculateRowPtrs(Bitmap : TMufasaBitmap) : TPRGB32Array;overload; +var + I : integer; +begin; + setlength(result,Bitmap.Height); + for i := 0 to Bitmap.Height - 1 do + result[i] := Bitmap.FData + Bitmap.Width; +end; + +constructor TMFinder.Create(aClient: TObject); + +begin + inherited Create; + + Self.Client := aClient; + Self.CTS := 1; + Self.hueMod := 0.2; + Self.satMod := 0.2; + +end; + +destructor TMFinder.Destroy; +begin + + inherited; +end; + +procedure TMFinder.SetToleranceSpeed(nCTS: Integer); +begin + if (nCTS < 0) or (nCTS > 2) then + raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]); + Self.CTS := nCTS; +end; + +function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean; +var + R1,G1,B1,R2,G2,B2 : Byte; + H1,S1,L1,H2,S2,L2 : extended; +begin + Result := False; + ColorToRGB(Color1,R1,G1,B1); + ColorToRGB(Color2,R2,G2,B2); + if Color1 = Color2 then + Result := true + else + case CTS of + 0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance)); + 1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance); + 2: begin + RGBToHSL(R1,g1,b1,H1,S1,L1); + RGBToHSL(R2,g2,b2,H2,S2,L2); + Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance)); + end; + end; +end; + + +function ColorSame(var CTS,Tolerance : Integer; var R1,G1,B1,R2,G2,B2 : byte; var H1,S1,L1,huemod,satmod : extended) : boolean; inline; +var + H2,S2,L2 : extended; +begin + Result := False; + case CTS of + 0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance)); + 1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance); + 2: begin + RGBToHSL(R1,g1,b1,H1,S1,L1); + RGBToHSL(R2,g2,b2,H2,S2,L2); + Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance)); + end; + end; +end; + +procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer); +begin + CachedWidth := NewWidth; + CachedHeight := NewHeight; + SetLength(ClientTPA,NewWidth * NewHeight); +end; + +procedure TMFinder.DefaultOperations(var xs, ys, xe, ye: integer); +var + w,h : integer; +begin +{ if xs > xe then + Swap(xs,xe); + if ys > ye then + Swap(ys,ye);} + if xs < 0 then + // xs := 0; + raise Exception.createFMT('Any Find Function, you did not pass a ' + + 'correct xs: %d.', [xs]); + if ys < 0 then +// ys := 0; + raise Exception.createFMT('Any Find Function, you did not pass a ' + + 'correct ys: %d.', [ys]); + + TClient(Self.Client).MWindow.GetDimensions(w,h); + if (w <> CachedWidth) or (h <> CachedHeight) then + UpdateCachedValues(w,h); + if xe >= w then +// xe := w-1; + raise Exception.createFMT('Any Find Function, you did not pass a ' + + 'correct xe: %d.', [xe]); + if ye >= h then +// ye := h-1; + raise Exception.createFMT('Any Find Function, you did not pass a ' + + 'correct ye: %d.', [ye]); +end; + +function TMFinder.CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer; +var + PtrData: TRetData; + Ptr: PRGB32; + PtrInc: Integer; + clR, clG, clB : byte; + dX, dY, xx, yy: Integer; + h,s,l,hmod,smod : extended; + Ccts : integer; +begin + Result := 0; + DefaultOperations(xs, ys, xe, ye); + dX := xe - xs; + dY := ye - ys; + ColorToRGB(Color, clR, clG, clB); + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + Ptr := PtrData.Ptr; + PtrInc := PtrData.IncPtrWith; + CCts := Self.CTS; + result := 0; + if cts = 2 then + begin; + RGBToHSL(clR,clG,clB,h,s,l); + hmod := Self.hueMod; + smod := Self.satMod; + end; + for yy := ys to ye do + begin; + for xx := xs to xe do + begin; + if ColorSame(CCts,Tolerance,clR,clG,clB,Ptr^.r,Ptr^.g,Ptr^.b,H,S,L,hmod,smod) then + inc(result); + Inc(Ptr); + end; + Inc(Ptr, PtrInc) + end; + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindColor(var x, y: Integer; Color, xs, ys, xe, ye: Integer): Boolean; +var + PtrData: TRetData; + Ptr: PRGB32; + PtrInc: Integer; + dX, dY, clR, clG, clB, xx, yy: Integer; + +begin + Result := false; + // checks for valid xs,ys,xe,ye? (may involve GetDimensions) + DefaultOperations(xs,ys,xe,ye); + + // calculate delta x and y + dX := xe - xs; + dY := ye - ys; + + //next, convert the color to r,g,b + ColorToRGB(Color, clR, clG, clB); + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + + // Do we want to "cache" these vars? + // We will, for now. Easier to type. + Ptr := PtrData.Ptr; + PtrInc := PtrData.IncPtrWith; + + for yy := ys to ye do + begin; + for xx := xs to xe do + begin; + // Colour comparison here. Possibly with tolerance? ;) + if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then + begin + Result := True; + x := xx; + y := yy; + + TClient(Client).MWindow.FreeReturnData; + Exit; + end; + Inc(Ptr); + end; + Inc(Ptr, PtrInc) + end; + + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindColorSpiral(var x, y: Integer; color, xs, ys, xe, + ye: Integer): Boolean; +var + PtrData: TRetData; + RowData : TPRGB32Array; + dX, dY, clR, clG, clB, i,HiSpiral: Integer; + +begin + Result := false; + // checks for valid xs,ys,xe,ye? (may involve GetDimensions) + DefaultOperations(xs,ys,xe,ye); + + // calculate delta x and y + dX := xe - xs; + dY := ye - ys; + + //next, convert the color to r,g,b + ColorToRGB(Color, clR, clG, clB); + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + //Load rowdata + RowData:= CalculateRowPtrs(ptrdata,dy+1); + //Load the spiral path + LoadSpiralPath(x-xs,y-ys,0,0,dx,dy); + + + HiSpiral := (dy+1) * (dx + 1) -1; + for i := 0 to HiSpiral do + if (RowData[ClientTPA[i].y][ClientTPA[i].x].R = clR) and (RowData[ClientTPA[i].y][ClientTPA[i].x].G = clG) + and (RowData[ClientTPA[i].y][ClientTPA[i].x].B = clB) then + begin + Result := True; + x := ClientTPA[i].x + xs; + y := ClientTPA[i].y + ys; + TClient(Client).MWindow.FreeReturnData; + Exit; + end; + + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindColorTolerance(var x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean; +var + PtrData: TRetData; + Ptr: PRGB32; + PtrInc: Integer; + dX, dY, clR, clG, clB, xx, yy: Integer; + H1, S1, L1, H2, S2, L2: Extended; + + label Hit; + label Miss; + +begin + Result := false; + // checks for valid xs,ys,xe,ye? (may involve GetDimensions) + DefaultOperations(xs,ys,xe,ye); + + // calculate delta x and y + dX := xe - xs; + dY := ye - ys; + //next, convert the color to r,g,b + ColorToRGB(Color, clR, clG, clB); + ColorToHSL(Color, H1, S1, L1); + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + + // Do we want to "cache" these vars? + // We will, for now. Easier to type. + Ptr := PtrData.Ptr; + PtrInc := PtrData.IncPtrWith; + + case CTS of + 0: + for yy := ys to ye do + begin + for xx := xs to xe do + begin + if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then + goto Hit; + inc(Ptr); + end; + Inc(Ptr, PtrInc); + end; + + 1: + begin + Tol := Sqr(Tol); + + for yy := ys to ye do + begin + for xx := xs to xe do + begin + if (sqr(clB - Ptr^.B) + sqr(clG - Ptr^.G) + sqr(clR-Ptr^.R)) <= Tol then + goto Hit; + inc(ptr); + end; + Inc(Ptr, PtrInc); + end; + + end; + 2: + // Can be optimized a lot... RGBToHSL isn't really inline, + // and hueMod * tol is also calculated every time. + begin + for yy := ys to ye do + for xx := xs to xe do + begin + RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2); + if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then + goto Hit; + inc(Ptr); + end; + Inc(Ptr, PtrInc); + end; + end; + Result := False; + TClient(Client).MWindow.FreeReturnData; + Exit; + + Hit: + Result := True; + x := xx; + y := yy; + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindColorsTolerance(var Points: TPointArray; Color, xs, ys, + xe, ye, Tol: Integer): Boolean; +var + PtrData: TRetData; + Ptr: PRGB32; + PtrInc,C: Integer; + dX, dY, clR, clG, clB, xx, yy: Integer; + H1, S1, L1, H2, S2, L2: Extended; +begin + Result := false; + DefaultOperations(xs,ys,xe,ye); + + dX := xe - xs; + dY := ye - ys; + //next, convert the color to r,g,b + ColorToRGB(Color, clR, clG, clB); + ColorToHSL(Color, H1, S1, L1); + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + + // Do we want to "cache" these vars? + // We will, for now. Easier to type. + Ptr := PtrData.Ptr; + PtrInc := PtrData.IncPtrWith; + c := 0; + case CTS of + 0: + for yy := ys to ye do + begin + for xx := xs to xe do + begin + if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then + begin; + ClientTPA[c].x := xx; + ClientTPA[c].y := yy; + inc(c); + end; + inc(Ptr); + end; + Inc(Ptr, PtrInc); + end; + + 1: + for yy := ys to ye do + begin + for xx := xs to xe do + begin + if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then + begin; + ClientTPA[c].x := xx; + ClientTPA[c].y := yy; + inc(c); + end; + inc(ptr); + end; + Inc(Ptr, PtrInc); + end; + 2: + begin + for yy := ys to ye do + for xx := xs to xe do + begin + RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2); + if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then + begin; + ClientTPA[c].x := xx; + ClientTPA[c].y := yy; + inc(c); + end; + inc(Ptr); + end; + Inc(Ptr, PtrInc); + end; + end; + SetLength(Points, C); + Move(ClientTPA[0], Points[0], C * SizeOf(TPoint)); + Result := C > 0; + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindColorsSpiralTolerance(x, y: Integer; + var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer + ): boolean; +var + PtrData: TRetData; + c : integer; + RowData : TPRGB32Array; + dX, dY, clR, clG, clB, i,SpiralHi: Integer; + H1, S1, L1, H2, S2, L2: Extended; +begin + Result := false; + DefaultOperations(xs,ys,xe,ye); + + dX := xe - xs; + dY := ye - ys; + //next, convert the color to r,g,b + ColorToRGB(Color, clR, clG, clB); + ColorToHSL(Color, H1, S1, L1); + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + + c := 0; + + //Load rowdata + RowData:= CalculateRowPtrs(ptrdata,dy+1); + //Load the spiral path + LoadSpiralPath(x-xs,y-ys,0,0,dx,dy); + SpiralHi := (dx + 1) * (dy + 1) - 1; + case CTS of + 0: + for i := 0 to SpiralHi do + if ((abs(clB-RowData[ClientTPA[i].y][ClientTPA[i].x].B) <= Tolerance) and + (abs(clG-RowData[ClientTPA[i].y][ClientTPA[i].x].G) <= Tolerance) and + (Abs(clR-RowData[ClientTPA[i].y][ClientTPA[i].x].R) <= Tolerance)) then + begin; + ClientTPA[c].x := ClientTPA[i].x + xs; + ClientTPA[c].y := ClientTPA[i].y + ys; + inc(c); + end; + + + 1: + for i := 0 to SpiralHi do + if (Sqrt(sqr(clR - RowData[ClientTPA[i].y][ClientTPA[i].x].R) + + sqr(clG - RowData[ClientTPA[i].y][ClientTPA[i].x].G) + + sqr(clB - RowData[ClientTPA[i].y][ClientTPA[i].x].B)) <= Tolerance) then + begin; + ClientTPA[c].x := ClientTPA[i].x + xs; + ClientTPA[c].y := ClientTPA[i].y + ys; + inc(c); + end; + + 2: + for i := 0 to SpiralHi do + begin; + RGBToHSL(RowData[ClientTPA[i].y][ClientTPA[i].x].R, + RowData[ClientTPA[i].y][ClientTPA[i].x].G, + RowData[ClientTPA[i].y][ClientTPA[i].x].B,H2,S2,L2); + if ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S1 - S2) <= (satMod * Tolerance)) and (abs(L1 - L2) <= Tolerance)) then + begin; + ClientTPA[c].x := ClientTPA[i].x + xs; + ClientTPA[c].y := ClientTPA[i].y + ys; + inc(c); + end; + end; + end; + SetLength(Points, C); + Move(ClientTPA[0], Points[0], C * SizeOf(TPoint)); + Result := C > 0; + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindColors(var TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean; +var + PtrData: TRetData; + Ptr: PRGB32; + PtrInc: Integer; + dX, dY, clR, clG, clB, xx, yy, i: Integer; + +begin + Result := false; + DefaultOperations(xs,ys,xe,ye); + + dX := xe - xs; + dY := ye - ys; + + I := 0; + + ColorToRGB(Color, clR, clG, clB); + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + + Ptr := PtrData.Ptr; + PtrInc := PtrData.IncPtrWith; + + for yy := ys to ye do + begin; + for xx := xs to xe do + begin; + if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then + begin + Self.ClientTPA[I].x := xx; + Self.ClientTPA[i].y := yy; + Inc(I); + end; + Inc(Ptr); + end; + Inc(Ptr, PtrInc); + end; + + SetLength(TPA, I); + + Move(ClientTPA[0], TPA[0], i * SizeOf(TPoint)); + + Result := I > 0; + + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindBitmap(bitmap: TMufasaBitmap; var x, y: Integer): Boolean; +var + w,h : integer; +begin + TClient(Client).MWindow.GetDimensions(w,h); + result := Self.FindBitmapIn(bitmap,x,y,0,0,w-1,h-1); +end; + +function TMFinder.FindBitmapIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, + ys, xe, ye: Integer): Boolean; +var + MainRowdata : TPRGB32Array; + BmpRowData : TPRGB32Array; + PtrData : TRetData; + BmpW,BmpH : integer; + xBmp,yBmp : integer; + tmpY : integer; + dX, dY, xx, yy: Integer; +label NotFoundBmp; + //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. + +begin + Result := false; + // checks for valid xs,ys,xe,ye? (may involve GetDimensions) + DefaultOperations(xs,ys,xe,ye); + + // calculate delta x and y + dX := xe - xs; + dY := ye - ys; + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + //Caculate the row ptrs + MainRowdata:= CalculateRowPtrs(PtrData,dy+1); + BmpRowData:= CalculateRowPtrs(bitmap); + //Get the 'fixed' bmp size + BmpW := bitmap.Width - 1; + BmpH := bitmap.Height - 1; + //Heck our bitmap cannot be outside the search area + dX := dX - bmpW; + dY := dY - bmpH; + for yy := 0 to dY do + for xx := 0 to dX do + begin; + for yBmp:= 0 to BmpH do + begin; + tmpY := yBmp + yy; + for xBmp := 0 to BmpW do + if (BmpRowData[yBmp][xBmp].R <> MainRowdata[tmpY][xBmp + xx].R) or + (BmpRowData[yBmp][xBmp].G <> MainRowdata[tmpY][xBmp + xx].G) or + (BmpRowData[yBmp][xBmp].B <> MainRowdata[tmpY][xBmp + xx].B) then + goto NotFoundBmp; + + end; + //We did find the Bmp, otherwise we would be at the part below + TClient(Client).MWindow.FreeReturnData; + x := xx + xs; + y := yy + ys; + result := true; + exit; + NotFoundBmp: + end; + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindBitmapToleranceIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, + ys, xe, ye: Integer; tolerance: Integer): Boolean; +var + MainRowdata : TPRGB32Array; + BmpRowData : TPRGB32Array; + PtrData : TRetData; + BmpW,BmpH : integer; + xBmp,yBmp : integer; + tmpY : integer; + dX, dY, xx, yy: Integer; + CCTS : integer; + H,S,L,HMod,SMod : extended; +label NotFoundBmp; + //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. + +begin + Result := false; + // checks for valid xs,ys,xe,ye? (may involve GetDimensions) + DefaultOperations(xs,ys,xe,ye); + + // calculate delta x and y + dX := xe - xs; + dY := ye - ys; + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + //Caculate the row ptrs + MainRowdata:= CalculateRowPtrs(PtrData,dy+1); + BmpRowData:= CalculateRowPtrs(bitmap); + //Get the 'fixed' bmp size + BmpW := bitmap.Width - 1; + BmpH := bitmap.Height - 1; + //Heck our bitmap cannot be outside the search area + dX := dX - bmpW; + dY := dY - bmpH; + //We wont want HSL comparison with BMPs, right? Not for now atleast. + CCTS := Self.CTS; + if CCTS > 1 then + CCTS := 1; + for yy := 0 to dY do + for xx := 0 to dX do + begin; + for yBmp:= 0 to BmpH do + begin; + tmpY := yBmp + yy; + for xBmp := 0 to BmpW do + if not ColorSame(CCTS,tolerance, + BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B, + MainRowdata[tmpY][xBmp + xx].R,MainRowdata[tmpY][xBmp + xx].G,MainRowdata[tmpY][xBmp + xx].B, + H,S,L,HMod,SMod) then + goto NotFoundBmp; + + end; + //We did find the Bmp, otherwise we would be at the part below + TClient(Client).MWindow.FreeReturnData; + x := xx + xs; + y := yy + ys; + result := true; + exit; + NotFoundBmp: + end; + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindBitmapSpiral(bitmap: TMufasaBitmap; var x, y: Integer; + xs, ys, xe, ye: Integer): Boolean; +var + MainRowdata : TPRGB32Array; + BmpRowData : TPRGB32Array; + PtrData : TRetData; + BmpW,BmpH : integer; + xBmp,yBmp : integer; + tmpY : integer; + dX, dY, i,HiSpiral: Integer; +label NotFoundBmp; + //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. + +begin + Result := false; + // checks for valid xs,ys,xe,ye? (may involve GetDimensions) + DefaultOperations(xs,ys,xe,ye); + + // calculate delta x and y + dX := xe - xs; + dY := ye - ys; + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + //Caculate the row ptrs + MainRowdata:= CalculateRowPtrs(PtrData,dy+1); + BmpRowData:= CalculateRowPtrs(bitmap); + //Get the 'fixed' bmp size + BmpW := bitmap.Width - 1; + BmpH := bitmap.Height - 1; + //Heck, our bitmap cannot be outside the search area + dX := dX - bmpW; + dY := dY - bmpH; + //Load the spiral into memory + LoadSpiralPath(x-xs,y-ys,0,0,dX,dY); + HiSpiral := (dx+1) * (dy+1) - 1; + for i := 0 to HiSpiral do + begin; + for yBmp:= 0 to BmpH do + begin; + tmpY := yBmp + ClientTPA[i].y; + for xBmp := 0 to BmpW do + if (BmpRowData[yBmp][xBmp].R <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].R) or + (BmpRowData[yBmp][xBmp].G <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].G) or + (BmpRowData[yBmp][xBmp].B <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].B) then + goto NotFoundBmp; + + end; + //We did find the Bmp, otherwise we would be at the part below + TClient(Client).MWindow.FreeReturnData; + x := ClientTPA[i].x + xs; + y := ClientTPA[i].y + ys; + result := true; + exit; + NotFoundBmp: + end; + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindBitmapSpiralTolerance(bitmap: TMufasaBitmap; var x, + y: Integer; xs, ys, xe, ye, tolerance: integer): Boolean; +var + MainRowdata : TPRGB32Array; + BmpRowData : TPRGB32Array; + PtrData : TRetData; + BmpW,BmpH : integer; + xBmp,yBmp : integer; + tmpY : integer; + dX, dY, i,HiSpiral: Integer; + CCTS : integer; + H,S,L,HMod,SMod : extended; +label NotFoundBmp; + //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. + +begin + Result := false; + // checks for valid xs,ys,xe,ye? (may involve GetDimensions) + DefaultOperations(xs,ys,xe,ye); + + // calculate delta x and y + dX := xe - xs; + dY := ye - ys; + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + //Caculate the row ptrs + MainRowdata:= CalculateRowPtrs(PtrData,dy+1); + BmpRowData:= CalculateRowPtrs(bitmap); + //Get the 'fixed' bmp size + BmpW := bitmap.Width - 1; + BmpH := bitmap.Height - 1; + //Heck, our bitmap cannot be outside the search area + dX := dX - bmpW; + dY := dY - bmpH; + //Load the spiral into memory + LoadSpiralPath(x-xs,y-ys,0,0,dX,dY); + HiSpiral := (dx+1) * (dy+1) - 1; + //NO HSL. + CCTS := Self.CTS; + if CCTS > 1 then + CCTS := 1; + for i := 0 to HiSpiral do + begin; + for yBmp:= 0 to BmpH do + begin; + tmpY := yBmp + ClientTPA[i].y; + for xBmp := 0 to BmpW do + if not ColorSame(CCTS,tolerance, + BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B, + MainRowdata[tmpY][xBmp + ClientTPA[i].x].R,MainRowdata[tmpY][xBmp + ClientTPA[i].x].G, + MainRowdata[tmpY][xBmp + ClientTPA[i].x].B, + H,S,L,HMod,SMod) then + goto NotFoundBmp; + + end; + //We did find the Bmp, otherwise we would be at the part below + x := ClientTPA[i].x + xs; + y := ClientTPA[i].y + ys; + result := true; + exit; + NotFoundBmp: + end; + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x, + y: Integer; var Points: TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean; +var + MainRowdata : TPRGB32Array; + BmpRowData : TPRGB32Array; + PtrData : TRetData; + BmpW,BmpH : integer; + xBmp,yBmp : integer; + tmpY : integer; + dX, dY, i,HiSpiral: Integer; + FoundC : integer; + CCTS : integer; + H,S,L,HMod,SMod : extended; +label NotFoundBmp; + //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. + +begin + Result := false; + // checks for valid xs,ys,xe,ye? (may involve GetDimensions) + DefaultOperations(xs,ys,xe,ye); + + // calculate delta x and y + dX := xe - xs; + dY := ye - ys; + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + //Caculate the row ptrs + MainRowdata:= CalculateRowPtrs(PtrData,dy+1); + BmpRowData:= CalculateRowPtrs(bitmap); + //Get the 'fixed' bmp size + BmpW := bitmap.Width - 1; + BmpH := bitmap.Height - 1; + //Heck, our bitmap cannot be outside the search area + dX := dX - bmpW; + dY := dY - bmpH; + //Load the spiral into memory + LoadSpiralPath(x-xs,y-ys,0,0,dX,dY); + HiSpiral := (dx+1) * (dy+1) - 1; + //NO HSL. + CCTS := Self.CTS; + if CCTS > 1 then + CCTS := 1; + FoundC := 0; + for i := 0 to HiSpiral do + begin; + for yBmp:= 0 to BmpH do + begin; + tmpY := yBmp + ClientTPA[i].y; + for xBmp := 0 to BmpW do + if not ColorSame(CCTS,tolerance, + BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B, + MainRowdata[tmpY][xBmp + ClientTPA[i].x].R,MainRowdata[tmpY][xBmp + ClientTPA[i].x].G, + MainRowdata[tmpY][xBmp + ClientTPA[i].x].B, + H,S,L,HMod,SMod) then + goto NotFoundBmp; + + end; + //We did find the Bmp, otherwise we would be at the part below + ClientTPA[FoundC].x := ClientTPA[i].x + xs; + ClientTPA[FoundC].y := ClientTPA[i].y + ys; + inc(FoundC); + NotFoundBmp: + end; + if FoundC > 0 then + begin; + result := true; + SetLength(Points,FoundC); + Move(ClientTPA[0], Points[0], FoundC * SizeOf(TPoint)); + end; + TClient(Client).MWindow.FreeReturnData; +end; + +function TMFinder.FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; var x, + y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; + AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean; +var + MainRowdata : TPRGB32Array; + BmpRowData : TPRGB32Array; + PtrData : TRetData; + BmpW,BmpH : integer; + xBmp,yBmp : integer; + tmpY,tmpX : integer; + dX, dY, xx, yy: Integer; + SearchdX,SearchdY : integer; + CCTS : integer; + GoodCount : integer;//Save the amount of pixels who have found a correspondening pixel + BestCount : integer;//The best amount of pixels till now.. + BestPT : TPoint; //The point where it found the most pixels. + RangeX,RangeY : Integer; + H,S,L,HMod,SMod : extended; +label FoundBMPPoint; + //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. + +begin + Result := false; + // checks for valid xs,ys,xe,ye? (may involve GetDimensions) + DefaultOperations(xs,ys,xe,ye); + + // calculate delta x and y + dX := xe - xs; + dY := ye - ys; + SearchDx := dX; + SearchDy := dY; + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + //Caculate the row ptrs + MainRowdata:= CalculateRowPtrs(PtrData,dy+1); + BmpRowData:= CalculateRowPtrs(bitmap); + //Get the 'fixed' bmp size + BmpW := bitmap.Width - 1; + BmpH := bitmap.Height - 1; + //Heck our bitmap cannot be outside the search area + dX := dX - bmpW; + dY := dY - bmpH; + //We wont want HSL comparison with BMPs, right? Not for now atleast. + CCTS := Self.CTS; + if CCTS > 1 then + CCTS := 1; + //Reset the accuracy :-) + Accuracy := 0; + BestCount := -1; + BestPT := Point(-1,-1); + + for yy := 0 to dY do + for xx := 0 to dX do + begin; + GoodCount := 0; + for yBmp:= 0 to BmpH do + begin; + //Calculate points of the BMP left against Goodcount (if it cannot possibly get more points skip this x,y? + if bestCount > (goodcount + (Bmph - yBmp) * (bmpW)) then + Break; + for xBmp := 0 to BmpW do + begin; + + for RangeY := (yy-Range) to (yy + Range) do + begin; + tmpY := yBmp + RangeY; + if (tmpY < 0) or (tmpY > SearchdY ) then + continue; + for RangeX := (xx-Range) to (xx + Range) do + begin; + tmpX := xBmp + RangeX; + if (tmpX < 0) or (tmpX > SearchdX) then + Continue; + if ColorSame(CCTS,tolerance, + BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B, + MainRowdata[tmpY][tmpX].R,MainRowdata[tmpY][tmpX].G,MainRowdata[tmpY][tmpX].B, + H,S,L,HMod,SMod) then + goto FoundBMPPoint; + end; + end; + //We did not find a good point so were continueing! + Continue; + FoundBMPPoint: + //We found a pooint woot! + inc(GoodCount); + end; + end; + if GoodCount > BestCount then //This x,y has the best Acc so far! + begin; + BestCount := GoodCount; + BestPT := Point(xx+xs,yy+ys); + end; + end; + TClient(Client).MWindow.FreeReturnData; + if BestCount = 0 then + Exit; + accuracy := BestCount / ((BmpW + 1) * (BmpH+1)); + if (accuracy = 1) or AllowPartialAccuracy then + begin + x := BestPT.x; + y := BestPT.y; + Exit(true); + end; +end; + +end. +