unit1.~pas

二维化学信号图形特征的提取 与特征数据库的设计

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtDlgs, StdCtrls, Buttons, ExtCtrls, DB, DBTables, ADODB,
  Grids, DBGrids;

type
    TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    OpenPictureDialog1: TOpenPictureDialog;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Button1: TButton;
    Query1: TQuery;
    DataSource1: TDataSource;
    Button2: TButton;
    SavePictureDialog1: TSavePictureDialog;
    DBGrid1: TDBGrid;
    ADOQuery1: TADOQuery;
    DataSource2: TDataSource;
    ADOConnection1: TADOConnection;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public

    { Public declarations }
  end;

var
  Form1: TForm1;
  filename:shortstring;
implementation

{$R *.dfm}
procedure convert2gray(cnv:tcanvas);
var x,y:integer;
    color:longint;
    r,g,b,gr:byte;
begin

    with cnv do
        for x:=cliprect.Left to cliprect.Right do
            for y:=cliprect.Top to cliprect.Bottom do
            begin
                color:=colortorgb(pixels[x,y]);
                b:=(color and $ff0000) shr 16;
                g:=(color and $ff00) shr 8;
                r:=(color and $ff);
                gr:=hibyte(r*77+g*151+b*28);
                pixels[x,y]:=rgb(gr,gr,gr);
            end;
end;
function rgb(r,g,b:byte):tcolor;
begin
    result:=b shl 16 or g shl 8 or r;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if  OpenPictureDialog1.Execute() then
     filename:=OpenPictureDialog1.FileName;
     image1.Picture.Bitmap.LoadFromFile(filename);
     image1.Visible:=true;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var p:pbytearray;
    gray,x,y:integer;
    bmp:tbitmap;
begin
    bmp:=tbitmap.create;
    bmp.assign(image1.picture.bitmap);
    for y:=0 to bmp.height-1 do
    begin
        p:=bmp.scanline[y];
        for x:=0 to bmp.width-1 do
        begin
            gray:=round(p[x*3+2]*0.3+p[x*3+1]*0.59+p[x*3]*0.11);
            if gray>128 then
            begin
                p[x*3]:=255;
                p[x*3+1]:=255;
                p[x*3+2]:=255;
            end
            else
            begin
                 p[x*3]:=0;
                 p[x*3+1]:=0;
                 p[x*3+2]:=0;
            end
        end
    end;
    image1.picture.bitmap.assign(bmp);
    bmp.free;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
    screen.Cursor:=crhourglass;
    convert2gray(image1.Picture.Bitmap.Canvas);
    screen.Cursor:=crdefault;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var x,y,wx1,wy1,wx2,wy2,wx3,wy3,i,flag1,flag2,flag3,flag4,a:integer;
    cnv:tcanvas;
begin
    cnv:=image1.Picture.Bitmap.Canvas;
    a:=0;
    wx1:=0;
    wx3:=0;
    wy1:=0;
    wy2:=0;
   with cnv do
        for y:=cliprect.Top to cliprect.Bottom do      //左上角顶点
            begin
                for x:=cliprect.Left to cliprect.Right do
                begin
                    flag1:=0;
                    flag2:=0;
                    flag3:=0;
                    flag4:=0;
                    for i:=0 to 50 do
                    begin
                        if pixels[x,y-i]=clwhite then
                        flag1:=flag1+1;
                        if pixels[x+i,y]=clblack then
                        flag2:=flag2+1;
                        if pixels[x,y+i]=clblack then
                        flag3:=flag3+1;
                        if pixels[x-i,y]=clwhite then
                        flag4:=flag4+1;
                    end;
                        if flag1>=30 then
                           if flag2>=40 then
                              if flag3>=40 then
                                  if flag4>=40 then
                                    begin
                                        wx1:=x;
                                        wy1:=y;
                                        edit7.Text:=inttostr(wx1);
                                        edit8.Text:=inttostr(wy1);
                                        a:=1;
                                    end  ;
                          if a=1 then break;
                end;
                if a=1 then break;
            end;
    with cnv do
        for y:=cliprect.Bottom downto cliprect.Top do     //左下角顶点
            begin
                for x:=cliprect.Left to cliprect.Right do
                begin
                    flag1:=0;
                    flag2:=0;
                    flag3:=0;
                    flag4:=0;
                    a:=0;
                    for i:=0 to 50 do
                    begin
                        if pixels[x,y-i]=clblack then
                        flag1:=flag1+1;
                        if pixels[x-i,y]=clwhite then
                        flag2:=flag2+1;
                        if pixels[x,y+i]=clwhite then
                        flag3:=flag3+1;
                        if pixels[x+i,y]=clblack then
                        flag4:=flag4+1;
                    end;
                        if flag1>=40 then
                           if flag2>=40 then
                              if flag3>=40 then
                                  if flag4>=40 then
                                    begin
                                        wx2:=x;
                                        wy2:=y;
                                        edit1.Text:=inttostr(wx2);
                                        edit2.Text:=inttostr(wy2);
                                        a:=1;
                                    end  ;
                          if a=1 then break;
                end;
                if a=1 then break;
            end;
    with cnv do
        for y:=cliprect.Bottom downto cliprect.Top do   //右下角顶点
            begin
                for x:=cliprect.Right downto cliprect.Left do
                begin
                pixels[60,150]:=clred;
                    flag1:=0;
                    flag2:=0;
                    flag3:=0;
                    flag4:=0;
                    a:=0;
                    for i:=0 to 50 do
                    begin
                        if pixels[x,y+i]=clwhite then
                        flag1:=flag1+1;
                        if pixels[x-i,y]=clblack then
                        flag2:=flag2+1;
                        if pixels[x,y-i]=clblack then
                        flag3:=flag3+1;
                        if pixels[x+i,y]=clwhite then
                        flag4:=flag4+1;
                    end;
                        if flag1>=40 then
                           if flag2>=40 then
                              if flag3>=40 then
                                  if flag4>=40 then
                                    begin
                                        wx3:=x;
                                        wy3:=y;
                                        edit3.Text:=inttostr(wx3);
                                        edit4.Text:=inttostr(wy3);
                                        a:=1;
                                    end  ;
                          if a=1 then break;
                end;
                if a=1 then break;
            end;
        edit5.Text:=inttostr(wx3);
        edit6.Text:=inttostr(wy1);
        for x:=cnv.ClipRect.Left to wx1 do
            for y:=cnv.cliprect.top to cnv.cliprect.bottom do
                cnv.Pixels[x,y]:=clwhite;
        for x:=wx3 to cnv.ClipRect.Right do
            for y:=cnv.cliprect.top to cnv.cliprect.bottom do
                cnv.Pixels[x,y]:=clwhite;
        for x:=wx1 to wx3 do
            for y:=cnv.cliprect.top to wy1 do
                cnv.Pixels[x,y]:=clwhite;
        for x:=wx1 to wx3 do
            for y:=wy2 to cnv.ClipRect.Bottom do
                cnv.Pixels[x,y]:=clwhite;
end;

procedure TForm1.Button1Click(Sender: TObject);
var x,y,x1,x2,y1,y2,k,j,z,i,m,n:integer;
    v,w : extended;
    cnv:tcanvas;
    a:array[0..5000] of integer;
    b:array[0..5000] of integer;
    g:array[0..5000] of integer;
    h:array[0..5000] of integer;
    c:array[0..56] of integer;
    d:array[0..20] of integer;
    e:array[0..1000] of integer;
    f:array[0..1000] of integer;
begin
    cnv:=image1.Picture.Bitmap.Canvas;
    x1:=strtoint(edit7.Text);
    y1:=strtoint(edit8.Text);
    x2:=strtoint(edit3.Text);
    y2:=strtoint(edit4.Text);
    i:=0;
    m:=0;
    n:=0;
    with cnv do
    for k:=0 to 1000 do
        e[k]:=0;
     for k:=0 to 1000 do
        f[k]:=0;
    for k:=0 to 5000 do
    begin
        a[k]:=0;
        b[k]:=0;
        g[k]:=0;
        h[k]:=0;
    end;
    for k:=0 to 56 do
        c[k]:=0;
    for j:=0 to 20 do
        d[j]:=0;
    for k:=0 to 56 do
        c[k]:=x1+((x2-x1)div 56)*k;
    for j:=0 to 20 do
        d[j]:=y1+((y2-y1)div 20)*j;
    for k:=0 to 56 do
        for y:=y1 to y2 do
            cnv.pixels[c[k],y]:=clwhite;
    for j:=0 to 20 do
        for x:=x1 to x2 do
            cnv.Pixels[x,d[j]]:=clwhite;
    query1.Close;
    query1.SQL.Clear;
    query1.SQL.Add('delete FROM tezhengdianzuobiao');
    query1.ExecSQL;
    query1.Close;
    query1.SQL.Clear;
    query1.SQL.Add('insert into tezhengdianzuobiao(filename,hengzuobiao,zongzuobiao)');
    query1.SQL.Add('values(:filename,:hengzuobiao,:zongzuobiao)');
    for x:=x1+1 to x2 do
        for y:=y1 to y2 do
            if cnv.pixels[x,y]=clblack then
            begin
                a[i]:=x;
                b[i]:=y;
                i:=i+1;
            end;
    w:=(y2-y1)/100;
    for k:=0 to i do
    begin
        h[n]:=round((y2-b[k])*(1/w));
        n:=n+1;
    end;
    n:=0;
    z:=x1+(x2-x1)div 56*20;
    v:=(x2-z)/1800;
    for k:=0 to i do
    begin
        if a[k]<=z then
        begin
            g[n]:=round(2000+(z-a[k])*(1/v));
            n:=n+1;
        end;
        if a[k]>z then
        begin
            g[n]:=round(200+(x2-a[k])*(2/v));
            n:=n+1;
        end;
    end;
    for k:=0 to n-3 do
    begin
        if (h[k+1]>h[k]) and (h[k+1]>h[k+2]) then
        begin
            e[m]:=h[k+1];
            f[m]:=g[k+1];
            m:=m+1;
        end;
        if (h[k+1]<h[k]) and (h[k+1]<h[k+2]) then
        begin
            e[m]:=h[k+1];
            f[m]:=g[k+1];
            m:=m+1;
        end;
    end;
    try
    begin
        for k:=0 to m-1 do
        begin
            query1.Params[0].AsString:=filename;
            query1.Params[1].AsInteger:=f[k];
            query1.Params[2].AsInteger:=e[k];
            query1.ExecSQL;
        end;
    end;
    finally
        begin
            showmessage('程序已执行成功，谢谢你的使用');
            adoquery1.Close;
            adoquery1.SQL.Clear;
            adoquery1.SQL.Add('select * from tezhengdianzuobiao');
            adoquery1.Open;
        end;
     end;            
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
      if  savepicturedialog1.Execute then
      image1.Picture.SaveToFile(savepicturedialog1.FileName);
end;


end.