Janilabo

Untitled

Oct 25th, 2013
66
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 6.18 KB | None | 0 0
  1. const
  2.   DISPLAY_DELAY = 1000;
  3.  
  4. var
  5.   bmp := BitmapFromString(496, 76, 'meJzt3d1v1FUex/FlZsq0nU6faKczDA+lpbVLIiC4CgRZN0oMF7puYAmLTdclWcy62G2pRbOJigrRaIyJyV5gC0gL6IWafbxa2D6I17ZwLZ3yByz8B7ubdLNpcj6fZs4yQsD3N5/LyZnzO7/zff160TO/Yq6xqLKm0CyzrthSkbjxCy31MnKS/0lXe14m9nvd+G6c7/rzseO4dXPXGxv3vbH3MfZ6c811Mm78Dd3tMiffPi5Tqf0Z+/nY9XHr4Pa/S+z+cYntu9i+rlS/x86nUv0bO37s/om9v3iO53iO53j+//UvnuN5OcFzPMdzPMfzpb8Xz/H8dvYnnuP57YyP53iO53iO53hezv29deumzL8qVPOlOZnY58jTe56QuTY7I+Pm89nFcZme9WtkKnW/fn/sqIxbHzd/51XsPDdvWC/z9ZUpGTefK9OTMg/2dMhUql9eHR6UuTr7jUxjtlbGfe+tmzdlbrMd/lfz8yWZWK+eemKXzNXZGRk3n7FPzsi4fRL7XHD3ffhov8yN+ZKMm//7756QiV1Pd73TkxMybj7TUxMysesZ+xzEczzHczzHczwvp/Acz/E8LDzHczzHczzHczwPC8/xHM/xHM8XCs/xvJzCczzH87DwHM/xHM/xHM/xPCw8x3M8x3M8Xyg8v7c8d878sLMok1i2TGarqX+aetJUKpWUcevs9v+Jt16Xacu1yvzd1OnREZnudQUZt54DR16QcT4839crU5VKyrj1zGbSMu58inN4/NxZmep0lcwpU5cvXZJZW1ghE9t358fOyrx1/DWZdFVKJvY5+J33RTIh4/q6NDcn4577udYWGdcXZ06PyhRaG2Tcuh0+1Cfj/p7s6z0o49Ynti/cOR3XFxfGz8mkl6dkbF9cviQTu554jud4jud4jud4jud4jud4jud4jud4jud4jud4jud4jud4jud4jud4jud4jud4jud4jud4jud4jud4jud3y3O3n915EHd+59VjgzLLTLU01skc2PesjPu/fedec31GpmtdUcaNvzLfJuPWuVSakzk68JKM86EpWyPjvre5oVbG3Ud3vT0PdMk0ZGtltm3dKOPGL+RzOmYfun1709SO7Y/KuP3gxnfr3N2xSuba1VmZocF+GXff8y0NMrF9kUwmZOrramQ29nTKuPGLhTYd89y5cWNeJrYvWprqZNz3OmfcuZ7YvqirTcvs3LZFxo2fz7XK4Dme4zme4zme43lYeI7neB4WnuM5nuM5nuM5noeF5wuF53iO52HhOZ7jeVh4jud4Hhae4zme4zme4zmeh4XnC4XneI7nYeH5/e25i1uHv/3lTzJuPqMjIzLdnWtk3Pe690q4cwfuHIG7XvdeDHddbvwdjzwk48Zx50rc5931Dg2+JOM8PNR3QMZ97w9Mrcw1yrj7GLue7pzRnt2Py7j1SSSWyeSaszJu/i5//fMfZdz1jox8LLO+fZWMu48buttl3HPNrbMbv1J9se3hTTJunEr1hXtfjLve3gN7Zdz3ur5Y3dYk4743dj1jz9/hOZ4vLjzHczwPC8/xfHHh+dLried4jufl9wWe4zme4zme4zmeh4XneI7nYeE5nuN5WHiO53geFp7jOZ7jOZ4vFJ7jOZ6Hhed4judh4fmd8dy9t8K55+ZTLORl3O/hf/nF5zJtK7Iyro+Gh34nE70fzHsl3Oc7TO3f+1MZN45734E7N+Hur7ve9tUrZfb97GmZ2H3r3ovh9k/svnXnaP7w0Ycy42NnZdx6xp6nc5+345hzUrYvvvxCxvWv64tXXh6QqZSTd6sv3DnE2L7oWFuU2b/3GZnYvoj9eyC2L9w5QTz/777FczzH87Av8BzP8RzP8RzP8RzP8RzP8RzP8XzJvsBzPMdzPMdzPMfzO79v8RzP8RzP8RzP8RzP8RzP8RzPY/ctnuP5newLPF/ac9d3rk/dvnXz/MXPn5Vx869OV8nEPl9yK3RcXx829a0pdx+7162ScdfbZMqd03HX68bfbaq7c7WMG8f1qbsvP96+VSZ2HZznV2dnZPqPvCiTzVTLxO4rl9hx+g7uk3Hrk6lJy7jvdX2azaRl3HmrivWFOT9Yqb6I/fvB9UVP11qZ2L5wfyfHvufFrYN7Hwee4zme4zme4zme4zme4zme47mbP57jOZ6Hhed4jud4jud4jufl9wWe4zme4zme4zmeh4XneI7nYeE5nuM5nuM5nuN5+X1xr3u+/UebZa7Nzsj89oVDMu539b+anpQZP3dWxu0Hd7/c78+7z/e/+GsZd26ir/egTCqZkHF95K7XnStx3n7w3kmZUmlOxq2ne4/D1OQ/ZE6Zcv118fw5manJCRk3z9j3IORaW2Qa6qpl3P3auW2LjOuL3xz+lcyDPR0y01MTMrF94Z4Xv3xuv4y73sOH+mRcXzzf1yuTSiVlXD/G9sXGnk6Zk28flynNzcnE9oVzzPVF24p6Gd8Xuu/cPN35MjzHczzHczxfui/wHM/xHM/xHM/xPCw8x3M8DwvP8RzP8RzP8RzPy+8LPMdzPMdzPMdzPA8Lz/Ecz8PCczzHczzHczzH8/L74l7xPPb38K9f/1bG9denF8Zk3O/811Yvl3H70Pnm5jNfmpMZHhqQcecsCq2NMm6e7nl35vSojJv/7Mw3Mj/ZtVOmKpWUcQ48vOkBmcuXL8m4eU5PTsi4++7Oywwf7Zf5ampSxu1/954U54zri2NDAzLXTbn1OT/2iUw+n5Opq03LuHm+c+JNmdi+GBrsl0mYasrWyLj95p53p0dHZNz83fmyXY/tkHHPHTfPzRvWy8T2xZXpSZn2NUWZ9PKUjJsnnuM5nuM5nuM5nuO5myee4zmeh4XneL648BzP8TwsPMdzPMdzPF+6L/AczxcXnuM5noeF53iO53iO53iO52HhOZ7jOZ7j+dJ9gef3h+dun7tzGW59XH85t1e1Ncm4+Ts/m+szMm4+yURCpjFbK+PWp6s9L+PW2Z0LqElXybj5O7dbGjMy7vf2Y+fp3j/i5umuq7UpI+POX7z5xmsy6aqUjLtfbv/E9oXbJ7F9kalZLlNobZCJ3W/ufRZuPu7cnLtet69i+9ftN/dcc/N3+8H1hbu/Lm6e7nvtPI3bri9i/w7BczzHczzHczzHczx388RzPMdzMU88x/NFhed4judh4Tme4zme4/lC4Tme4zmeu3niOZ7juZgnnuP5osJzPMfzsL5vnv8bqgp8lQ==');
  6.  
  7. type
  8.   TThreshMethod = (TM_Mean, TM_MinMax);
  9.  
  10. function ImThresholdAdaptive(bmp: Integer; Alpha, Beta: Integer; Method: TThreshMethod; C: Integer): T2DIntegerArray;
  11. var
  12.   W, H, x, y, i, cl, Color, IMin, IMax: Integer;
  13.   Threshold, Counter: Integer;
  14.   Temp: T2DIntegerArray;
  15.   Tab: array[0..256] of Integer;
  16. begin
  17.   if (Alpha > Beta) then
  18.   begin
  19.     X := Beta;
  20.     Beta := Alpha;
  21.     Alpha := X;
  22.   end;
  23.   GetBitmapSize(bmp, W, H);
  24.   SetLength(Result, H, W);
  25.   SetLength(Temp, (H + 2), (W + 2));
  26.   Dec(W);
  27.   Dec(H);
  28.   Threshold := 0;
  29.   case Method of
  30.     TM_Mean:
  31.     begin
  32.       for y := 0 to H do
  33.       begin
  34.         Counter := 0;
  35.         for x := 0 to W do
  36.         begin
  37.           cl := FastGetPixel(bmp, x, y);
  38.           Color := Trunc((0.2126 * (cl and $FF)) +
  39.                          (0.7152 * ((cl shr 8) and $FF)) +
  40.                          (0.0722 * ((cl shr 16) and $FF)));
  41.           Temp[(y + 1)][(x + 1)] := Color;
  42.           Counter := (Counter + Color);
  43.         end;
  44.         Threshold := (Threshold + (Counter div W));
  45.       end;
  46.       if (C < 0) then
  47.         Threshold := ((Threshold div H) - Abs(C))
  48.       else
  49.         Threshold := ((Threshold div H) + C);
  50.     end;
  51.     TM_MinMax:
  52.     begin
  53.       cl := FastGetPixel(bmp, 0, 0);
  54.       IMin := Trunc((0.2126 * (cl and $FF)) +
  55.                     (0.7152 * ((cl shr 8) and $FF)) +
  56.                     (0.0722 * ((cl shr 16) and $FF)));
  57.       IMax := IMin;
  58.       for y := 0 to H do
  59.         for x := 0 to W do
  60.         begin
  61.           cl := FastGetPixel(bmp, x, y);
  62.           Color := Trunc((0.2126 * (cl and $FF)) +
  63.                          (0.7152 * ((cl shr 8) and $FF)) +
  64.                          (0.0722 * ((cl shr 16) and $FF)));
  65.           Temp[(y + 1)][(x + 1)] := Color;
  66.           if (Color < IMin) then
  67.             IMin := Color
  68.           else
  69.             if (Color > IMax) then
  70.               IMax := Color;
  71.         end;
  72.       if (C < 0) then
  73.         Threshold := (((IMax + IMin) div 2) - Abs(C))
  74.       else
  75.         Threshold := (((IMax + IMin) div 2) + C);
  76.     end;
  77.   end;
  78.   Threshold := Max(0, Min(Threshold, 255));
  79.   for i := 0 to (Threshold - 1) do
  80.     Tab[i] := Alpha;
  81.   for i := Threshold to 255 do
  82.     Tab[i] := Beta;
  83.   for y := 1 to H do
  84.     for x := 1 to W do
  85.       Result[(y - 1)][(x - 1)] := Tab[Temp[y][x]];
  86. end;
  87.  
  88. procedure DrawMatrixBitmap(bitmap: Integer; matrix: T2DIntegerArray);
  89. var
  90.   x, y, w, h: Integer;
  91. begin
  92.   h := High(matrix);
  93.   for y := 0 to (h - 1) do
  94.   begin
  95.     w := High(matrix[y]);
  96.     for x := 0 to (w - 1) do
  97.       FastSetPixel(bitmap, x, y, matrix[y][x]);
  98.   end;
  99. end;
  100.  
  101. var
  102.   matrix, res: T2DIntegerArray;
  103.   w, h: integer;
  104.  
  105. begin
  106.   getBitmapSize(bmp, w, h);
  107.   displayDebugImgWindow(w, h);
  108.   drawBitmapDebugImg(bmp);
  109.   Wait(DISPLAY_DELAY);
  110.   res := ImThresholdAdaptive(bmp, 0, 255, TM_Mean, 50);
  111.   drawMatrixBitmap(bmp, res);
  112.  
  113.   displayDebugImgWindow(496, 76);
  114.   drawBitmapDebugImg(bmp);
  115.  
  116.   freeBitmap(bmp);
  117. end.
Advertisement
Add Comment
Please, Sign In to add comment