lisp2arx
Visual Programming for AutoLisp Mathématiques en programmation Lisp.. doc2cpp,doc2lsp, sld2lsp, bmp2dcl, free__GifCcapture for all-CAD'platforms..
Lista Forumurilor Pe Tematici
lisp2arx | Reguli | Inregistrare | Login

POZE LISP2ARX

Nu sunteti logat.
Nou pe simpatie:
Profil Anne98
Femeie
25 ani
Buzau
cauta Barbat
25 - 50 ani
lisp2arx / Delphi, webdesign / Delphi32- How the sharpen tBitmap is too slower  
Autor
Mesaj Pagini: 1
zauchan
Moderator

Inregistrat: acum 13 ani
Postari: 180
Type swf_definebitmap=graphics.TBitmap;
This is slow-solution

Code:

Function glColor3b_sharpen(var Bitmap:swf_definebitmap):integer;
const
  M3 : array[0..24] of integer = (1,1,1,1,1,   // to detect if matrix is 3x3
                                  1,0,0,0,1,   // or 5x5
                                  1,0,0,0,1,
                                  1,0,0,0,1,
                                  1,1,1,1,1);
var
  x, y : integer;
  R, G, B : integer;
  RR, GG , BB : integer;
  i : integer;                    // index  of matrix coefficients
  ix, iy, dx, dy, d : integer;    // positions of sliding matrix
begin
  if ac_dv = 0 then ac_dv := 1;   // le diviseur ne doit pas ªtre 0
  // rcduction de la matrice   la taille 3x3 pour optimisation
  dx := 0;
  For i := 0 to 24 do if (ac_PF[i] AND M3[i]) <> 0 then inc(dx);
  if dx = 0 then d := 1 else d := 2 ;  // offset from center

  For y := 0 to Bitmap.Height-1 do
  begin
    for x := 0 to Bitmap.Width-1 do
    begin
      RR := 0; GG := 0; BB := 0;
      for dy := -d to d do
      for dx := -d to d do
      begin
        // current pixel location
        iy := y+dy;
        ix := x+dx;
        // get and add separate color values  9, or 25 pixels
        if (iy >= 1) and (iy <= Bitmap.Height-1) and  // check limits
           (ix >= 1) and (ix <= Bitmap.Width-1) 
           then  begin
                         R := (Bitmap.Canvas.Pixels[iy,ix] and $0000FF);
                         G := (Bitmap.Canvas.Pixels[iy,ix] and $00FF00) shr 8;
                         B := (Bitmap.Canvas.Pixels[iy,ix] and $FF0000) shr 16;
                   end
        else // outside : original pixel
              begin   R := (Bitmap.Canvas.Pixels[y,x] and $0000FF);
                      G := (Bitmap.Canvas.Pixels[y,x] and $00FF00) shr 8;
                      B := (Bitmap.Canvas.Pixels[y,x] and $FF0000) shr 16;
               end;
        i := 12+dy*5+dx;        // matrix factor position
        RR := RR + R * ac_PF[i];   // multiply color values bu matrix factor
        GG := GG + G * ac_PF[i];
        BB := BB + B * ac_PF[i];
      end;
      RR := RR div ac_Dv;    // divide results to preserve luminance
      GG := GG div ac_Dv;
      BB := BB div ac_Dv;
      if RR > 255 then RR := 255 else if RR < 0 then RR := 0; // check color bounds
      if GG > 255 then GG := 255 else if GG < 0 then GG := 0;
      if BB > 255 then BB := 255 else if BB < 0 then BB := 0;
      Bitmap.Canvas.Pixels[y,x] := RR+(GG shl 8)+ (BB shl 16);
    end;
  end;
  result:=RTNORM;
end;



Modificat de zauchan (acum 3 ani)


_______________________________________
psw: cea de la wjndowsXP gigabyte..

pus acum 3 ani
   
Pagini: 1  

Mergi la