unit1.pas

《Delphi7编程100例》代码,书配资料

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, StdCtrls, ExtCtrls;

type    // For scanline simplification
  TRGBArray = ARRAY[0..32767] OF TRGBTriple;
  pRGBArray = ^TRGBArray;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure CopyMe(tobmp: TBitmap; frbmp : TGraphic); {复制TGraphic到4-bit TBitmap}
    procedure ConvolveM(ray : array of integer; z : word; aBmp : TBitmap);
  end;

function Set255(Clr : integer) : integer;  

var
  Form1: TForm1;
  z : integer;
  ray : array [0..8] of integer;

implementation

{$R *.dfm}


{复制TGraphic到4-bit TBitmap}
procedure TForm1.CopyMe(tobmp: TBitmap; frbmp : TGraphic);
begin
  tobmp.Width := frbmp.Width;
  tobmp.Height := frbmp.Height;
  tobmp.PixelFormat := pf24bit;
  tobmp.Canvas.Draw(0,0,frbmp);
end;

{Some edge detection filters:

laplace      hipass     find edges   sharpen    edge enhance  color emboss
                        (top down)                            (well, kinda)
-1 -1 -1    -1 -1 -1     1  1  1     -1 -1 -1     0 -1  0       1  0  1
-1  8 -1    -1  9 -1     1 -2  1     -1 16 -1    -1  5 -1       0  0  0
-1 -1 -1    -1 -1 -1    -1 -1 -1     -1 -1 -1     0 -1  0       1  0 -2

    1           1           1            8           1             1

 Soften        blur    Soften (less)

 2  2  2     3  3  3     0  1  0
 2  0  2     3  8  3     1  2  1
 2  2  2     3  3  3     0  1  0

   16          32           6
}

procedure TForm1.Button1Click(Sender: TObject);
var
  OrigBMP : TBitmap;              // 中间临时Bitmap
begin
{定义处理参数}
      ray[0] :=  2; ray[1] :=  2; ray[2] :=  2;
      ray[3] :=  2; ray[4] :=  0; ray[5] :=  2;
      ray[6] :=  2; ray[7] :=  2; ray[8] :=  2;
      z := 16;
{开始处理}
  OrigBMP := TBitmap.Create;   // 建立中间临时Bitmap
  CopyMe(OrigBMP,Image1.Picture.Graphic); // 复制TGraphic到4-bit TBitmap

  if z = 0 then z := 1;       // 防止零做除数

  ConvolveM(ray,z,OrigBMP); //处理指定效果

  Image1.Picture.Assign(OrigBMP);  // 把处理后的结果返回到Image1
  OrigBMP.Free;                    // 释放中间临时Bitmap
  Image1.Refresh;                  //刷新显示Image1
end;

procedure TForm1.ConvolveM(ray : array of integer; z : word; aBmp : TBitmap);
var
  O, T, C, B : pRGBArray;  // Scanlines
  x, y : integer;  // 坐标
  tBufr : TBitmap; // 临时bitmap
begin
  tBufr := TBitmap.Create;
  tBufr.Width:=aBmp.Width+2;  // 图象外增加一个2象素的框
  tBufr.Height:=aBmp.Height+2;
  tBufr.PixelFormat := pf24bit; // 设置图片属性
  O := tBufr.ScanLine[0];   // 复制顶角Pixels
  T := aBmp.ScanLine[0];
  O[0] := T[0];
  O[tBufr.Width - 1] := T[aBmp.Width - 1];
  // 从底到顶复制 - 保持无缝拼接
  tBufr.Canvas.CopyRect(RECT(1,0,tBufr.Width - 1,1),aBmp.Canvas,
          RECT(0,aBmp.Height - 1,aBmp.Width,aBmp.Height-2));
  O := tBufr.ScanLine[tBufr.Height - 1]; // 复制底角Pixels
  T := aBmp.ScanLine[aBmp.Height - 1];
  O[0] := T[0];
  O[tBufr.Width - 1] := T[aBmp.Width - 1];
  // 从顶向底处理
  tBufr.Canvas.CopyRect(RECT(1,tBufr.Height-1,tBufr.Width - 1,tBufr.Height),
         aBmp.Canvas,RECT(0,0,aBmp.Width,1));
  // 从左向右处理
  tBufr.Canvas.CopyRect(RECT(tBufr.Width-1,1,tBufr.Width,tBufr.Height-1),
         aBmp.Canvas,RECT(0,0,1,aBmp.Height));
  // 从右向左处理
  tBufr.Canvas.CopyRect(RECT(0,1,1,tBufr.Height-1),
         aBmp.Canvas,RECT(aBmp.Width - 1,0,aBmp.Width,aBmp.Height));
  // 处理主矩形
  tBufr.Canvas.CopyRect(RECT(1,1,tBufr.Width - 1,tBufr.Height - 1),
    aBmp.Canvas,RECT(0,0,aBmp.Width,aBmp.Height));
  for x := 0 to aBmp.Height - 1 do begin  // 步进处理scanlines
    O := aBmp.ScanLine[x];      // (Original)
    T := tBufr.ScanLine[x];     // x-1  (Top)
    C := tBufr.ScanLine[x+1];   // x    (Center)
    B := tBufr.ScanLine[x+2];   // x+1  (Bottom)
  // 处理主图
    for y := 1 to (tBufr.Width - 2) do begin  // 象素步进处理
      O[y-1].rgbtRed := Set255( // 处理RED部分
          ((T[y-1].rgbtRed*ray[0]) +
          (T[y].rgbtRed*ray[1]) + (T[y+1].rgbtRed*ray[2]) +
          (C[y-1].rgbtRed*ray[3]) +
          (C[y].rgbtRed*ray[4]) + (C[y+1].rgbtRed*ray[5])+
          (B[y-1].rgbtRed*ray[6]) +
          (B[y].rgbtRed*ray[7]) + (B[y+1].rgbtRed*ray[8])) div z
          );
      O[y-1].rgbtBlue := Set255( // 处理Blue部分
          ((T[y-1].rgbtBlue*ray[0]) +
          (T[y].rgbtBlue*ray[1]) + (T[y+1].rgbtBlue*ray[2]) +
          (C[y-1].rgbtBlue*ray[3]) +
          (C[y].rgbtBlue*ray[4]) + (C[y+1].rgbtBlue*ray[5])+
          (B[y-1].rgbtBlue*ray[6]) +
          (B[y].rgbtBlue*ray[7]) + (B[y+1].rgbtBlue*ray[8])) div z
          );
      O[y-1].rgbtGreen := Set255( // 处理Green部分
          ((T[y-1].rgbtGreen*ray[0]) +
          (T[y].rgbtGreen*ray[1]) + (T[y+1].rgbtGreen*ray[2]) +
          (C[y-1].rgbtGreen*ray[3]) +
          (C[y].rgbtGreen*ray[4]) + (C[y+1].rgbtGreen*ray[5])+
          (B[y-1].rgbtGreen*ray[6]) +
          (B[y].rgbtGreen*ray[7]) + (B[y+1].rgbtGreen*ray[8])) div z
          );
    end;
  end;
  tBufr.Free;
end;

{RGB值强制转换到0-255，使用ASM实现更高效率}
function Set255(Clr : integer) : integer;
asm
  MOV  EAX,Clr  // 保存值到EAX(32-bit)
  CMP  EAX,254  // 和254比较
  JG   @SETHI   // 大于254则为255
  CMP  EAX,1    // 和1比较
  JL   @SETLO   // 小于1则为0
  RET           // 不变
@SETHI:         // 附255值
  MOV  EAX,255  // EAX 注册255
  RET           // Exit (result value is the EAX register value)
@SETLO:         // 附0值
  MOV  EAX,0    // EAX 注册0
end;            // 结果返回到 EAX

end.