unit2.pas

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

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    ColorDialog1: TColorDialog;
    Timer1: TTimer;
    Button7: TButton;
    Memo1: TMemo;
    Edit2: TEdit;
    Button4: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    Panel1: TPanel;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button7Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Image1Click(Sender: TObject);
  private
    { Private declarations }
    jsq,sjs:longint;
      lx,ly,rx,ry,bjsize:integer;
       selectColor,selectColor1,selectColor2,selectColor3,selectColor4,selectColor5,selectColor6,selectColor7,selectColor8 : TColor;
       procedure ConvertImageToBitmap;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  Down: Boolean;
  prePt: TPoint;
implementation

uses Unit1;

{$R *.dfm}
procedure TForm2.ConvertImageToBitmap;
var
  Bmp : TBitmap;
begin
  { 将当前格式转换为BMP格式 }
  if Image1.Picture.Graphic is TBitmap then Exit;

  Bmp := nil;
  try
    Bmp := TBitmap.Create;
    Bmp.PixelFormat := pf24bit;
    Bmp.Width := Image1.Picture.Graphic.Width;
    Bmp.Height := Image1.Picture.Graphic.Height;

    { 增加透明背景色 }
    Bmp.Canvas.Brush.Color := clFuchsia;
    Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));

    Bmp.Canvas.Draw(0, 0, Image1.Picture.Graphic);
    Image1.Picture.Graphic := Bmp;
  finally
    Bmp.Free;
  end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
 ddd:TForm1;
begin
ddd:=TForm1.Create(nil);
  ddd.ShowModal;
  edit1.Text:= ddd.imgepath;
  Memo1.Text:=ddd.imagedata;
  Image1.Picture.LoadFromFile(edit1.Text);
  ddd.Free;
end;
function RGBToColor(R,G,B:Byte): TColor;
begin 
  Result:=B Shl 16 Or 
          G Shl 8  Or
          R; 
end; 


procedure TForm2.Button2Click(Sender: TObject);
var

  L : Longint;
  R,G,B:Byte;
begin
if ColorDialog1.Execute then
begin
   L := ColorToRGB(ColorDialog1.Color);
   Form2.Color:=ColorDialog1.Color;

  r:=GetRValue(L);
  g:=GetGValue(L);
  b:=GetBValue(L);
  Edit2.Text:=inttostr(r) +'.'+inttostr(g)+'.' +inttostr(b)  ;
end;



end;
procedure TForm2.FormKeyPress(Sender: TObject; var Key: Char);
var

  L : Longint;
  R,G,B:Byte;
begin
if key='c' then
if ColorDialog1.Execute then
begin
   L := ColorToRGB(ColorDialog1.Color);


  r:=GetRValue(L);
  g:=GetGValue(L);
  b:=GetBValue(L);
  Edit2.Text:=inttostr(r) +'.'+inttostr(g)+'.' +inttostr(b)  ;
end;

end;

procedure TForm2.Timer1Timer(Sender: TObject);
var

currentTime:LongInt;

begin
currentTime:=GetTickCount;
edit1.Text:= inttostr(currentTime);

end;

procedure TForm2.FormCreate(Sender: TObject);
var
   myrect:trect;
begin
Label1.Font.Size:=500;
 self.DoubleBuffered := true;
jsq:=GetTickCount;
sjs:=0;
 //Image1.Canvas.Brush.style:=bsclear;
 //Image1.Canvas.Brush.Color:=clWhite;

  //SetBkMode(image1.Canvas.Handle,   TRANSPARENT);
  //image1.Picture.Graphic:=nil;
   ConvertImageToBitmap;
end;

procedure TForm2.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  js:longint;
begin
js:=GetTickCount;
if (js-jsq)<300 then
begin
  sjs:=sjs+1;
  if (sjs=3) then
  begin
   ShowMessage('Found ');
  end;
end
else
begin
sjs:=0;
end;
jsq:=js;
end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
selectColor := Image1.Canvas.Pixels[x, y];
selectColor1 := Image1.Canvas.Pixels[x, y-1];
selectColor2 := Image1.Canvas.Pixels[x, y+1];
selectColor3 := Image1.Canvas.Pixels[x-1, y];
selectColor4 := Image1.Canvas.Pixels[x-1, y-1];
selectColor5 := Image1.Canvas.Pixels[x-1, y+1];
selectColor6 := Image1.Canvas.Pixels[x+1, y];
selectColor7 := Image1.Canvas.Pixels[x+1, y+1];
selectColor8 := Image1.Canvas.Pixels[x+1, y-1];
  if Down then
  begin
    Image1.canvas.pen.color:=clblack;
    Image1.canvas.Pen.Width:=2;
    Image1.Canvas.LineTo(X, Y);
    prePt := Point(X, Y);

  end;
  lx:=x;
  ly:=y;
end;

procedure TForm2.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//Down := False;
end;

procedure TForm2.Button7Click(Sender: TObject);
var
  Bitmap		: TBitmap;
  GIF			: TGIFImage;
begin
  try
    Bitmap := TBitmap.Create;
    Bitmap.Transparent:=true;

    try
      Bitmap.LoadFromFile(ExtractFIlePath(Application.ExeName)+'test.bmp');




      GIF := TGIFImage.Create;
      try

        GIF.Assign(Bitmap);

        GIF.SaveToFile('test.gif');

      finally
        GIF.Free;
      end;
    finally
      Bitmap.Free;
    end;
  finally
  end;
end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 // Down := True;
  //Image1.Canvas.MoveTo(X, Y);
 
end;

procedure TForm2.Button4Click(Sender: TObject);
var
   myrect:trect;
begin
 myrect:=image1.ClientRect;
 Image1.Canvas.Refresh;
 Image1.Canvas.Rectangle(0,0,Image1.Width-1,Image1.Height-1);
// Image1.Canvas.
end;

procedure TForm2.Button3Click(Sender: TObject);
var
  i,j : Integer;
  Bmp : TBitmap;
  SaveColor : TColor;
begin
  { 添加透明背景色 }
  if image1.Picture.Graphic = nil then Exit;

  Screen.Cursor := crHourGlass;
  try
    ConvertImageToBitmap;
    SaveColor := clred;

    Bmp := image1.Picture.Bitmap;
     SaveColor := clred;

    for  i:=lx-10  to lx+10 do
    begin
      for  j:=ly-10  to ly+10 do
      begin
          if ((Bmp.Canvas.Pixels[i, j] = selectColor) or (Bmp.Canvas.Pixels[i, j] = selectColor1) or (Bmp.Canvas.Pixels[i, j] = selectColor2) or (Bmp.Canvas.Pixels[i, j] = selectColor3) or (Bmp.Canvas.Pixels[i, j] = selectColor4) or (Bmp.Canvas.Pixels[i, j] = selectColor5) or (Bmp.Canvas.Pixels[i, j] = selectColor6) or (Bmp.Canvas.Pixels[i, j] = selectColor7) or (Bmp.Canvas.Pixels[i, j] = selectColor1)) and (Bmp.Canvas.Pixels[i, j] <> SaveColor) then
              Bmp.Canvas.Pixels[i, j] := SaveColor;
      end;

    end;

  finally
    Screen.Cursor := crDefault;
  end;
  end;
procedure TForm2.Image1Click(Sender: TObject);
begin
 
Button3Click(nil);
end;

end.