unit1.pas

利用delphi OCX实现网页签名提取功能,

unit Unit1;

interface

uses
gifimage,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  ExtCtrls, StdCtrls,EncdDecd, AppEvnts,jpeg, Dialogs,INIFiles,Math,
  Buttons;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ApplicationEvents1: TApplicationEvents;
    PaintBox1: TPaintBox;
    Panel2: TPanel;
    Panel3: TPanel;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    BitBtn3: TBitBtn;
    Timer1: TTimer;
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    lx,ly,rx,ry,bjsize,jsq:integer;
    color1:tcolor;
    path:string;

  public
    { Public declarations }
    imgepath,imagedata:string;
    picwidth,picheight:integer;
  end;

var
  Form1: TForm1;
  x0,y0:integer;

implementation
uses Unit3;

{$R *.dfm}
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if (picwidth<rx-lx+10+bjsize) and ((x<lx) or (x>rx)) then
    begin
      jsq:=0;
      Timer1.Enabled:=true;
      Abort;
    end;
    if(picheight<ry-ly+10+bjsize) and ((y<ly) or (y>ry)) then
    begin
      jsq:=0;
      Timer1.Enabled:=true;
      Abort;
    end;
  if ssleft in shift then
  begin

    PaintBox1.canvas.pen.color:=color1;
    PaintBox1.canvas.Pen.Width:=bjsize;
    PaintBox1.canvas.Pen.Mode:=pmcopy;
    PaintBox1.canvas.moveto(x0,y0);
    PaintBox1.Canvas.LineTo(X, Y);
    if X<lx then
    begin
     lx:=x;
    end;
    if y<ly then
    begin
     ly:=y;
    end;

     if X>rx then
    begin
     rx:=x;
    end;
    if y>ry then
    begin
     ry:=y;
    end;

  end;
  x0:=x;
  y0:=y;
end;

function RGBToColor(R,G,B:Byte): TColor;
begin 
  Result:=B Shl 16 Or 
          G Shl 8  Or
          R; 
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  ps:pchar ;
  MyINI:TINIFile;
  R,G,B:Byte;
begin
   jsq:=0;
   if picwidth=0 then
   begin
      picwidth:=200;
   end;
   if picheight=0 then
   begin
      picheight:=200;
   end;
 PaintBox1.Canvas.Brush.style:=bsclear;
  getmem(ps,256);
  GetSystemDirectory(ps,128);
  path:=ps;
  CreateDir(ps+'\cchddata');
  myINI   :=     TINIFile.Create(path+'\cchddata\config.ini');
  try
    r:=Strtoint(myINI.ReadString('color','r','0'));
    g:=Strtoint(myINI.ReadString('color','g','0'));
    b:=Strtoint(myINI.ReadString('color','b','0'));
    bjsize:=Strtoint(myINI.ReadString('bjsize','value','2'));
  except
    r:=0;
    g:=0;
    b:=0;
    bjsize:=2;
    myINI.WriteString('color','r',inttostr(r));
    myINI.WriteString('color','g',inttostr(g));
    myINI.WriteString('color','b',inttostr(b));
    myINI.WriteString('bjsize','value',inttostr(bjsize));
  end ;
  myINI.Free;
  color1:=RGBToColor(r,g,b);
  imgepath:='';
  imagedata:='';
 // SetWindowPos(Form1.handle, HWND_TOPMOST, Form1.Left, Form1.Top, Form1.Width, Form1.Height, 0);
  lx:=100000;
  ly:=100000;
  rx:=0;
  ry:=0;

end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  if IsChild(Handle,Msg.Hwnd) and ((Msg.Message = WM_RBUTTONDOWN) or (Msg.Message=WM_RBUTTONUP)) then
  begin
   // close();
  // Handled:=True;
 end;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  MyINI:TINIFile;
  L : Longint;
  R,G,B:Byte;
begin
  if key=66 then
  begin
      color1:=clblack;
      L := ColorToRGB(color1);
      r:=GetRValue(L);
      g:=GetGValue(L);
      b:=GetBValue(L);
      myINI   :=     TINIFile.Create(path+'\cchddata\config.ini');
      try
         myINI.WriteString('color','r',inttostr(r));
         myINI.WriteString('color','g',inttostr(g));
         myINI.WriteString('color','b',inttostr(b));
      finally
          myINI.Free;
      end;

  end;
  if key=82 then
  begin
      color1:=clred;
      L := ColorToRGB(color1);
      r:=GetRValue(L);
      g:=GetGValue(L);
      b:=GetBValue(L);
      myINI   :=     TINIFile.Create(path+'\cchddata\config.ini');
      try
         myINI.WriteString('color','r',inttostr(r));
         myINI.WriteString('color','g',inttostr(g));
         myINI.WriteString('color','b',inttostr(b));
      finally
          myINI.Free;
      end;

  end;
 if (key>=49) and (key<=57) then
 begin
      myINI   :=     TINIFile.Create(path+'\cchddata\config.ini');
      try
         myINI.WriteString('bjsize','value',inttostr(key-48));
      finally
          myINI.Free;
      end;
      bjsize:=key-48;
 end;
 if (key=67)then
 begin
    lx:=100000;
    ly:=100000;
    rx:=0;
    ry:=0;
    imgepath:='';
    imagedata:='';
    PaintBox1.Repaint;
 end;

 if (key=83)then
 begin

    with TForm3.Create(nil) do
    begin
       color3:=color1;
       bjsize3:=bjsize;
       ShowModal;
       color1:=color3;
       bjsize:=bjsize3;
       Free;
    end;
      L := ColorToRGB(color1);
      r:=GetRValue(L);
      g:=GetGValue(L);
      b:=GetBValue(L);
      myINI   :=     TINIFile.Create(path+'\cchddata\config.ini');
      try
         myINI.WriteString('color','r',inttostr(r));
         myINI.WriteString('color','g',inttostr(g));
         myINI.WriteString('color','b',inttostr(b));
         myINI.WriteString('bjsize','value',inttostr(bjsize));
      finally
          myINI.Free;
      end;

 end;


end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  // jpeg:Tjpegimage;
   Bitp2: TBitmap;
   StringStream:TStringStream;
   momeryStream:TMemoryStream;
   myrect:trect;
   MyCanvas:   TCanvas;
   GIF			: TGIFImage;
begin
//Image1.Picture.SaveToFile('c:\123.bmp');
    if not( (rx=0) or (ry=0) or (lx=100000) or (ly=100000)) then
    begin
    Bitp2   :=   TBitmap.Create;
    StringStream:=TStringStream.Create('');
    momeryStream:=TMemoryStream.Create;
   // jpeg := Tjpegimage.Create;
    myrect:=paintbox1.ClientRect;
    MyCanvas   :=   TCanvas.Create;
    GIF := TGIFImage.Create;
    try
      MyCanvas.Handle   :=   paintbox1.canvas.handle;
      Bitp2.Transparent   :=   True;
      Bitp2.PixelFormat   :=   pf32bit;
      Bitp2.Width:=rx-lx+10+bjsize;
      Bitp2.Height:=ry-ly+10+bjsize;
      Bitp2.Canvas.CopyRect(Rect(0,0,rx-lx+10+bjsize,ry-ly+10+bjsize),MyCanvas,Rect(lx-5-Floor(bjsize/2), ly-5-Floor(bjsize/2), rx+5+Floor(bjsize/2), ry+5+Floor(bjsize/2)));
      GIF.Assign(Bitp2);
      GIF.SaveToFile(path+'\cchddata\temp.gif');
      GIF.SaveToStream(momeryStream);
     // jpeg.Assign(Bitp2);
     // jpeg.SaveToFile(path+'\cchddata\temp.jpg');
     // jpeg.SaveToStream(momeryStream);
      momeryStream.Position:=0;
      EncodeStream(momeryStream,StringStream);
      imagedata:=StringStream.DataString;
      imgepath:=path+'\cchddata\temp.gif';
      picwidth:=rx-lx+10+bjsize;
      picheight:=ry-ly+10+bjsize;
    finally
     // jpeg.Free;
      Bitp2.Free;
      momeryStream.Free;
      StringStream.Free;
      MyCanvas.Handle   :=   0;
      MyCanvas.Free;
      GIF.Free;
    end;
  end;
  close();
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
close();
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
    lx:=100000;
    ly:=100000;
    rx:=0;
    ry:=0;
    imgepath:='';
    imagedata:='';
    PaintBox1.Repaint;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  lx:=100000;
  ly:=100000;
  rx:=0;
  ry:=0;
  imgepath:='';
  imagedata:='';
  PaintBox1.Repaint;
  close();
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  jsq:= jsq+1;

  PaintBox1.canvas.Font.Size:=12;
   if(jsq=0) then
   begin
    PaintBox1.canvas.Font.Color:=clred;
  end
  else if(jsq=1) then

  begin
     PaintBox1.canvas.Font.Color:=clblue;
  end
  else if(jsq=2) then
  begin
    PaintBox1.canvas.Font.Color:=clred;
  end
  else
    PaintBox1.canvas.Font.Color:=clWhite;


  PaintBox1.canvas.Font.Style:=[fsBold];
  PaintBox1.canvas.TextOut(0,0,'Signature Size: Width:'+inttostr(picwidth) +' Height:'+inttostr(picheight));
  //PaintBox1.canvas.Rectangle(lx-5,ly-5,rx+5,ry+5);
  if(jsq=3) then
    Timer1.Enabled:=false;
end;

end.