Advertisement
Janilabo

Untitled

Sep 15th, 2013
74
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 5.66 KB | None | 0 0
  1. {$loadlib pumbaa.dll}
  2.  
  3. const
  4.   DIST = 7.5;
  5.  
  6. function GetBitmapColorTPA(bmp: Integer; color: Integer): TPointArray;
  7. var
  8.   w, h, x, y, r: Integer;
  9. begin
  10.   try
  11.     GetBitmapSize(bmp, w, h);
  12.   except
  13.   end;
  14.   if ((w > 0) and (h > 0)) then
  15.   begin
  16.     SetLength(Result, (w * h));
  17.     for y := 0 to (h - 1) do
  18.       for x := 0 to (w - 1) do
  19.         if (FastGetPixel(bmp, x, y) = color) then
  20.         begin
  21.           Result[r] := Point(x, y);
  22.           Inc(r);
  23.         end;
  24.   end;
  25.   SetLength(Result, r);
  26. end;
  27.  
  28. procedure Test;
  29. var
  30.   TPA: TPointArray;
  31.   bmp, t, w, h, i: Integer;
  32. begin
  33.   ClearDebug;
  34.   bmp := BitmapFromString(297, 166, 'meJztnVt3m8wOhlmxOWN8ilM3X7ObNKvtRf//7/OWmZQSYPAAc0J+n+Wb1vEgydK8jAzD5aKTYv+idTwAwG3Kx/fN4TXfofoAsMfm+LY5vAVBUOz/59oWnUDHgc+Uxx/BZ1xbpAceOo7ZQwsOw9hbUFl5Tjdfiv13ZqV3FXEWOs5j9nCOwzBuT796Cyrf/hf0Yd9CjXRFfKFO8Zg9nOM2jLLc601RgqTQvpGKDBSRTMSXWHpcVwGWcR5GcdBW1W9PP+Wl92TZQkVk8i2Qibi3qdtrFddVgDn8DCOVG71axy12L7TqlKlDVXpfkvxozUh1hqM3UHeBf1J+V6sAc3gbxnz3rXXcZiUOkBQna0aqI2wT80nrrQER/1t6fkm5LBPk9vs1dXiCt2HMyuf6oMXh9dIpxqWUXku+g7aCD4l4HXOvpPzjS1n+KsAtfoaRkk2lyqRG+lR93RnjoqzgNZ7MJ8xWAa7wNoxp8USvUZnZTtT8mOSP3ZGpCoxa3ktLvkcp+D+P/Cg9ZqsAV3gbRvWEHCDODrKRjRrfhKapmfLdxAcpZ7MKcIuHYSTN3RxeR6ak1Mhs+9wcfHN8E28ZMr6F0O6Z8v3Jo0rKe9X8YkXQOa0CHOJnGKlYdJVe0BE+MXK+/c+E5V10edHyqFfNL+YFndkqwBXehnGOSX1G/tMIMowktX5rjpE30ajdbY+KU1fNL1YEXYv9PqwC3OJnGDWem9XQmL0uG9U+vdrdpRt5o4LOaRXgEG/DSDWS5CcthjURv0JSrrb/vzD4E4l2L1q01Lwl6IHuNOa0CnCIt2G8nkrlR12G1aSbc7rpEVPZimkmevsqQ35J1FygN5P1Wu5qFeAcP8NYrRz1111l4XXY3nLIyvaKaSZCuE1odxeZmn+8q0/T2awC3OJtGEnytBumQrH/rjG8QrgNzSEtZGou0KXpnFYBDvE5jCSd2g1TQeMdiNaKTjCg5gItms5jFeAcb8OYZPYythdd4XXrRZeZms5jFeAcn8PoSvIEYurQEWGXXvQyU9N5rAKc43MYZb0CGfSRh1W4Wsf06r67DrN1lI8aNkp3c8PrWrgHmO7U8lcBPuBtGKNkO2pAcoR0qv54q/rWYfp32FJxwDjbayg9/yRPIDR9gqw7n0xmfiOe4HMY1Wukpll6gkoBk+aBwpHDzozwWOFuHXdAxAVNKR97LJpYJswtPFYBzvE2jGFchPFm7IBZ+TXJhy7epmFVxqFDk+bOjC2NMFa4a4SCD4h4UOn4BCmvEZo+ofQYrAJ8wNswXksvUiqTFsO/XKiU8/78R0tsqRwmVMQ/Rz6XXk1Xxy/jpbzJSKc4rAKc43MY11E2yrbGmEO3ySteKXe9+nHe5RNCtScIdw0p+E0Rr481auQ5ms5jFeAcb8M41qomA0m1e/p9c5ehm7YpIlR7mnA3Ubn8YFSBz9F0BqsAH/A5jCSgQXX6OtY8QXfAYvdSHt8nDJWVZ9mYw0xW7RbDIi4Ye9H7ZE1nsArwgUWEkWpQqOpAi68Jnb4Gn8uEcmzsLkNdsu11uwzZ9gtdZh6uyc15foKU1yi68+/rWPgqwBMWFEZRgOKDN2uQzqLrDw5vmT4BdYMD0XSaKtw3Dyp0fJqU15Cmq8v6nAN5sgrwgeWG8WEVUfVVffWPxF6FyfWfUdb8M1Hac9z87HIps+cmTeFW1O6Pg1ad/26ItOh4i1rWB5SdwSrAB3iHsThMPAHrJdaxs+jfAlTV7pqWiGvX8S7KvixsFeAbLMOoURTCGXo3gNDurnz3KvhFt4h3mSDri1sF+AmPMOqyYR3lXv1oq1fEu8yX9cWtAvxkoWGsb02Ks/0cM8RrpjF60b6yqyFNNyTrXTxcBSwRr8IYZ0dxGqwFXSGaiS53urjSdP9XAYvAwzBer9tP9yRYk6/d0mKGFpo3F88R8Sa1oFvWdC3GB/6tAiyzlDBSGSpeI1ddZlmYs2QUJN96FbyFfY8YrwJsstAwyu6hENfRWTNjFLWCzxHxJi5cYLgKsA+DMJL915ZC4/pSb+uui7qIN73zQc05rQIcgjB6wvC9kN6q+UJXAb6BMDrnQ8c/S3mwEDVf4irAQxBGMI1FrwL8AWEEAAAAAAAAAAAAAAAAYIhi/+LaBAD6YZyc5eP75vCa79g6CJYL4+TcHN82h7eA3ROyAAMYJ2d5/NG6ysi1RQB8wCA5e23OynO6+dLdm9G+eeCeYZyc29OvXptlO+fYtxDcLbyTU2Zzr2vB9YE1X+wbCe4T3skpbG6tUrenn3LvODySFSwCrslJHtGrJdbF7qXYvwxsv08TS3KvO+kBa/BOzta+cJfKX5lTTZLi9uMyAZgD7+TMyufa4OLwelHepHER3oFFwzg5SZpVHJGReu8gWC6MkzMtnprb5E6Azqh7Hy5DU5N9dwAneCfnHL9q4uwgG9m+R4ANXJOz2L2MfXK6DDqpzrbPzcE3xze33oFFwzs5yR5d3gWduUWMzON55cA+vJNTl1+C5hOc6USaZq36LVcOguXCODlnrl57oTF74wbtA6NgnJxkRpKf9HtXXTXX3ce49hqAm/BOTlp4JvnRgHfndNMzX/W2mADohXFyVr906HctqH5DCapppPtWVj7ftgzcPbyTk2YVE67dpNh/t+MgWC68kzPJHx15x23HDKAdxsmZZEbUXB3TDoLlwjs5Xc0qArHUNeogWC68k3P4MbJd6CMPq3C1junVfXcdZusoHzVslO7MeQcWDePkjJLtKNdoFqKpoP54y8F1mP4dVvXh7HG2R+mBXngnp7oZNU3vah9X6yRonBiHI4c15B1YNIyTUzwUe6x3Wfk1yYduNmw9fl0GHZqmNRN+AQbwTs6rd5GSJS2Gr7RRidj+/MecX4ABvJNzHWUTXAuu58BD2zop3tmR777hImogg3FyTvNLMKDFu6ffA7ux9WLIQbBceCfnOkyDqt06zcHugMXupTy+TxgqK8+GfAQLxbfkNJSf5KboAvX+FNIlSnctS0iaFbdiG8CEa2DpeJKc2fa692DvZkq6fBQHuulmlJRN12b6JTDhFOCB8+S0lqUPq4gcJH+vv/5Xor8Kk+s/o6z5Z2IpuhSnAA+cJGeznJ1THMYtV4eJl7ATPlgKvJNz/vlzTejTlAIYwDI5dXm0jnJcugn0wjg561vp42w/2S86bRYv194AVnBNzjg7iratFlx7A1hxD8kZZ4c43dOcMOG6Vp/9Agy4n+QkTxXv6aBQhHHh2l5wR9xPcsru+RX3fbi2Dtw195CcdL4dXuW+aHjHxDWwdJCcAAAAAAAAAAAAADwo9i+uTQDg7igf3zeH13yH6gPAHpvj2+bwFuDhPgBYpDz+aP2U79oiAPjQW1BZeU43X7oboNk3DwCWbE+/egtKtj2FfQuBz6D/NhlZQcku2CYptG8k8BP03+YgCqrVQtmefspLD0+TBFfQf5sMRYxerTPJYvdCpxADe1yT6iWe7bME7IP+2xxamy9dqmKUVVyTpBh6FhJgQ29Bof82n6x8ruNWHF4vyjuhofTuAfTfDEETl0qVyUhRfdyRFZQ0JdB/UyAtnuoN0KZBy73eJziQbtp3B5hAfNHov+llTtHVxNlBNrJ9j4BG0H8zAQVQ8eGYN6EVX7Z9bg6+Ob6h9BiA/psJqFh0lV7QET4xMh61vHTQfzOBrqL7CHX+WK/46NshSa3fcusmmAz6byaY2VqRhPpjcd36f2jfEkH/zQQU0iQ/zYlqL6Kl3N0stC5JsCC0pAT6by3oPJxmJC2xbZJuzummZ57sjT/wFvTfDFGdBuivu6A6wQgqjeu+Rat1134DVdB/MwRNRLqiOopi/92160AJvd87+m81FAe9sVUEt5MsAvTfDJFkRk411XEdADAE+m/mcCV5H6Gu+jCuYwCkoP9mDtljwmTQRx5W4Wod06v77jrM1lE+aljfHuwOatB/M0eUbEdG7JHmq/rjrepbh+nfYZWevBlUj4ZH6XkL+m/mUK+RmmbpCSoFTILGqi0cOaxdp4Eq6L8ZQjx5dmxYsvIrrbuHh1UZhw5NmmvNWTAW9N/McS29SKlMWgy3oVTKeX/+Y81NMA3038yxjrJpYYmzoXseFS97yHff7upHnMWB/pshRkW1HRP5ieLu6ffArcq92PQaKIL+mzkoGlVMJgpfd8Bi91Ie3ycMlZVn2ZjAFei/WYBqUISo9zyhC81FrZjQeaPifcoDZNvrvc+9N3MBy6D/ZhNRgML3mzVIU2L9Qdm+i5NxGAQgQP/NFQ+riKqPivG6NK7OSFdhcv1nlDX/TPRJJnxBvTTLGbgF/TefKQ7jeik3vjJsE+cNc75H9N8sMH9xVxNC73wC/Tc/mfZ1dFlHOdfWMRvQf/OH+jrzONtPjiSt6cTLtTdACfTf3ELLZzGnIYb3DPpvroizQ5zuKRQTfvRB0d0J6L+ZhspQ8YIHqtMwLlzbCyyB/ptNZBfEiosiXFsHbKCr3NB/mwBFLLyei/67CgJ1dyeg/waAZdB/A8Ah6L8B4Bz03wBwDvpvADgE/TcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAArvwfp05eIw==');
  35.   GetBitmapSize(bmp, w, h);
  36.   DisplayDebugImgWindow(w, h);
  37.   DrawBitmapDebugImg(bmp);
  38.   TPA := GetBitmapColorTPA(bmp, 0);
  39.   t := GetSystemTime;
  40.   pp_TPASortByNearbyPoints(TPA, DIST); // Adding 0.5 to adapt the behaviour from SplitTPA distance check..
  41.   WriteLn('TPASortByNearbyPoints() finished in ' + IntToStr(GetSystemTime - t) + ' ms.');
  42.   h := High(TPA);
  43.   for i := 0 to h do
  44.   begin
  45.     FastSetPixel(bmp, TPA[i].X, TPA[i].Y, 255);
  46.     DrawBitmapDebugImg(bmp);
  47.   end;
  48.   SetLength(TPA, 0);
  49.   FreeBitmap(bmp);
  50. end;
  51.  
  52. begin
  53.   Test;
  54. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement