cchdszqmimpl1.~pas

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

unit cchdszqmImpl1;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls,Variants, cchdszqmProj1_TLB,StdVcl, Clipbrd, ExtCtrls;

type
  Tcchdszqm = class(TActiveForm, Icchdszqm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    imagepath,imagedata,picwidth,picheight,clipboardstr:String;
    FEvents: IcchdszqmEvents;
    procedure ActivateEvent(Sender: TObject);
    procedure ClickEvent(Sender: TObject);
    procedure CreateEvent(Sender: TObject);
    procedure DblClickEvent(Sender: TObject);
    procedure DeactivateEvent(Sender: TObject);
    procedure DestroyEvent(Sender: TObject);
    procedure KeyPressEvent(Sender: TObject; var Key: Char);
    procedure PaintEvent(Sender: TObject);
  protected
    { Protected declarations }
    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    function Get_Active: WordBool; safecall;
    function Get_AlignDisabled: WordBool; safecall;
    function Get_AutoScroll: WordBool; safecall;
    function Get_AutoSize: WordBool; safecall;
    function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
    function Get_Caption: WideString; safecall;
    function Get_Color: OLE_COLOR; safecall;
    function Get_DoubleBuffered: WordBool; safecall;
    function Get_DropTarget: WordBool; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: IFontDisp; safecall;
    function Get_HelpFile: WideString; safecall;
    function Get_KeyPreview: WordBool; safecall;
    function Get_PixelsPerInch: Integer; safecall;
    function Get_PrintScale: TxPrintScale; safecall;
    function Get_Scaled: WordBool; safecall;
    function Get_ScreenSnap: WordBool; safecall;
    function Get_SnapBuffer: Integer; safecall;
    function Get_Visible: WordBool; safecall;
    function Get_VisibleDockClientCount: Integer; safecall;
    procedure _Set_Font(var Value: IFontDisp); safecall;
    procedure Set_AutoScroll(Value: WordBool); safecall;
    procedure Set_AutoSize(Value: WordBool); safecall;
    procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    procedure Set_Color(Value: OLE_COLOR); safecall;
    procedure Set_DoubleBuffered(Value: WordBool); safecall;
    procedure Set_DropTarget(Value: WordBool); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(const Value: IFontDisp); safecall;
    procedure Set_HelpFile(const Value: WideString); safecall;
    procedure Set_KeyPreview(Value: WordBool); safecall;
    procedure Set_PixelsPerInch(Value: Integer); safecall;
    procedure Set_PrintScale(Value: TxPrintScale); safecall;
    procedure Set_Scaled(Value: WordBool); safecall;
    procedure Set_ScreenSnap(Value: WordBool); safecall;
    procedure Set_SnapBuffer(Value: Integer); safecall;
    procedure Set_Visible(Value: WordBool); safecall;
    function Get_imegedata: WideString; safecall;
    function Get_imgepath: WideString; safecall;
    procedure Set_imegedata(const Value: WideString); safecall;
    procedure Set_imgepath(const Value: WideString); safecall;
    procedure getszqm(const cs: WideString); safecall;
    function Get_version: WideString; safecall;
    procedure Set_version(const Value: WideString); safecall;
    function Get_picwidth: WideString; safecall;
    procedure Set_picwidth(const Value: WideString); safecall;
    function Get_picheight: WideString; safecall;
    procedure Set_picheight(const Value: WideString); safecall;
    procedure keydown(const Param1: WideString); safecall;
  public
    { Public declarations }
    procedure Initialize; override;
  end;

implementation

uses ComObj, ComServ, Unit1;

{$R *.DFM}

{ Tcchdszqm }

procedure Tcchdszqm.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
  { Define property pages here.  Property pages are defined by calling
    DefinePropertyPage with the class id of the page.  For example,
      DefinePropertyPage(Class_cchdszqmPage); }
end;

procedure Tcchdszqm.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IcchdszqmEvents;
  inherited EventSinkChanged(EventSink);
end;

procedure Tcchdszqm.Initialize;
begin
  inherited Initialize;
  OnActivate := ActivateEvent;
  OnClick := ClickEvent;
  OnCreate := CreateEvent;
  OnDblClick := DblClickEvent;
  OnDeactivate := DeactivateEvent;
  OnDestroy := DestroyEvent;
  OnKeyPress := KeyPressEvent;
  OnPaint := PaintEvent;
end;

function Tcchdszqm.Get_Active: WordBool;
begin
  Result := Active;
end;

function Tcchdszqm.Get_AlignDisabled: WordBool;
begin
  Result := AlignDisabled;
end;

function Tcchdszqm.Get_AutoScroll: WordBool;
begin
  Result := AutoScroll;
end;

function Tcchdszqm.Get_AutoSize: WordBool;
begin
  Result := AutoSize;
end;

function Tcchdszqm.Get_AxBorderStyle: TxActiveFormBorderStyle;
begin
  Result := Ord(AxBorderStyle);
end;

function Tcchdszqm.Get_Caption: WideString;
begin
  Result := WideString(Caption);
end;

function Tcchdszqm.Get_Color: OLE_COLOR;
begin
  Result := OLE_COLOR(Color);
end;

function Tcchdszqm.Get_DoubleBuffered: WordBool;
begin
  Result := DoubleBuffered;
end;

function Tcchdszqm.Get_DropTarget: WordBool;
begin
  Result := DropTarget;
end;

function Tcchdszqm.Get_Enabled: WordBool;
begin
  Result := Enabled;
end;

function Tcchdszqm.Get_Font: IFontDisp;
begin
  GetOleFont(Font, Result);
end;

function Tcchdszqm.Get_HelpFile: WideString;
begin
  Result := WideString(HelpFile);
end;

function Tcchdszqm.Get_KeyPreview: WordBool;
begin
  Result := KeyPreview;
end;

function Tcchdszqm.Get_PixelsPerInch: Integer;
begin
  Result := PixelsPerInch;
end;

function Tcchdszqm.Get_PrintScale: TxPrintScale;
begin
  Result := Ord(PrintScale);
end;

function Tcchdszqm.Get_Scaled: WordBool;
begin
  Result := Scaled;
end;

function Tcchdszqm.Get_ScreenSnap: WordBool;
begin
  Result := ScreenSnap;
end;

function Tcchdszqm.Get_SnapBuffer: Integer;
begin
  Result := SnapBuffer;
end;

function Tcchdszqm.Get_Visible: WordBool;
begin
  Result := Visible;
end;

function Tcchdszqm.Get_VisibleDockClientCount: Integer;
begin
  Result := VisibleDockClientCount;
end;

procedure Tcchdszqm._Set_Font(var Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;

procedure Tcchdszqm.ActivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnActivate;
end;

procedure Tcchdszqm.ClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnClick;
end;

procedure Tcchdszqm.CreateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnCreate;
end;

procedure Tcchdszqm.DblClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDblClick;
end;

procedure Tcchdszqm.DeactivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDeactivate;
end;

procedure Tcchdszqm.DestroyEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDestroy;
end;

procedure Tcchdszqm.KeyPressEvent(Sender: TObject; var Key: Char);
var
  TempKey: Smallint;
begin
  TempKey := Smallint(Key);
  if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  Key := Char(TempKey);
end;

procedure Tcchdszqm.PaintEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnPaint;
end;

procedure Tcchdszqm.Set_AutoScroll(Value: WordBool);
begin
  AutoScroll := Value;
end;

procedure Tcchdszqm.Set_AutoSize(Value: WordBool);
begin
  AutoSize := Value;
end;

procedure Tcchdszqm.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
begin
  AxBorderStyle := TActiveFormBorderStyle(Value);
end;

procedure Tcchdszqm.Set_Caption(const Value: WideString);
begin
  Caption := TCaption(Value);
end;

procedure Tcchdszqm.Set_Color(Value: OLE_COLOR);
begin
  Color := TColor(Value);
end;

procedure Tcchdszqm.Set_DoubleBuffered(Value: WordBool);
begin
  DoubleBuffered := Value;
end;

procedure Tcchdszqm.Set_DropTarget(Value: WordBool);
begin
  DropTarget := Value;
end;

procedure Tcchdszqm.Set_Enabled(Value: WordBool);
begin
  Enabled := Value;
end;

procedure Tcchdszqm.Set_Font(const Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;

procedure Tcchdszqm.Set_HelpFile(const Value: WideString);
begin
  HelpFile := String(Value);
end;

procedure Tcchdszqm.Set_KeyPreview(Value: WordBool);
begin
  KeyPreview := Value;
end;

procedure Tcchdszqm.Set_PixelsPerInch(Value: Integer);
begin
  PixelsPerInch := Value;
end;

procedure Tcchdszqm.Set_PrintScale(Value: TxPrintScale);
begin
  PrintScale := TPrintScale(Value);
end;

procedure Tcchdszqm.Set_Scaled(Value: WordBool);
begin
  Scaled := Value;
end;

procedure Tcchdszqm.Set_ScreenSnap(Value: WordBool);
begin
  ScreenSnap := Value;
end;

procedure Tcchdszqm.Set_SnapBuffer(Value: Integer);
begin
  SnapBuffer := Value;
end;

procedure Tcchdszqm.Set_Visible(Value: WordBool);
begin
  Visible := Value;
end;

function Tcchdszqm.Get_imegedata: WideString;
begin
  result:=imagedata;
end;

function Tcchdszqm.Get_imgepath: WideString;
//var
 // v: Variant;
begin
 // v:=CreateOleObject('WScript.Shell');
// v.sendKeys(imagepath);
// v:=Unassigned;
 //v:=NULL;
 result:=imagepath;

end;

procedure Tcchdszqm.Set_imegedata(const Value: WideString);

begin

end;

procedure Tcchdszqm.Set_imgepath(const Value: WideString);
begin

end;

procedure Tcchdszqm.getszqm(const cs: WideString);
var
 Form1:TForm1;
 //v: Variant;
  intpicwidth,intpicheight:integer;
begin
 try
   intpicwidth:=Strtoint(picwidth);
 except
   intpicwidth:=200;
 end;
 try
   intpicheight:=Strtoint(picheight);
 except
   intpicheight:=200;
 end;
 Form1:=tForm1.Create(nil);
 Form1.picwidth:= intpicwidth;
 Form1.picheight:= intpicheight;
 Form1.ShowModal;
 imagedata:=Form1.imagedata;
 imagepath:=Form1.imgepath;
 picwidth:=inttostr(Form1.picwidth);
 picheight:=inttostr(Form1.picheight);
 Form1.Free;
 //v:=CreateOleObject('WScript.Shell');
 //v.sendKeys(imagepath);
 //v:=Unassigned;
 //v:=NULL;
end;

function Tcchdszqm.Get_version: WideString;
begin
   result:='001';
end;

procedure Tcchdszqm.Set_version(const Value: WideString);
begin

end;

function Tcchdszqm.Get_picwidth: WideString;
begin
   result:=picwidth;
end;

procedure Tcchdszqm.Set_picwidth(const Value: WideString);
begin
   picwidth:=Value;
end;

function Tcchdszqm.Get_picheight: WideString;
begin
  result:=picheight;
end;

procedure Tcchdszqm.Set_picheight(const Value: WideString);
begin
    picheight:= Value;
end;

procedure Tcchdszqm.keydown(const Param1: WideString);
begin

      clipboardstr:=Clipboard.AsText;
      Clipboard.AsText:=Param1;
      keybd_event(VK_CONTROL,0,0,0);
      keybd_event(65,0,0,0);
      keybd_event(65,0,KEYEVENTF_KEYUP,0);
      keybd_event(VK_CONTROL,0,KEYEVENTF_KEYUP,0);


      keybd_event(VK_CONTROL,0,0,0);
      keybd_event(88,0,0,0);
      keybd_event(88,0,KEYEVENTF_KEYUP,0);
      keybd_event(VK_CONTROL,0,KEYEVENTF_KEYUP,0);


      keybd_event(VK_CONTROL,0,0,0);
      keybd_event(86,0,0,0);
      keybd_event(86,0,KEYEVENTF_KEYUP,0);
      keybd_event(VK_CONTROL,0,KEYEVENTF_KEYUP,0);
      Timer1.Enabled:=true;

end;

procedure Tcchdszqm.Timer1Timer(Sender: TObject);
begin
     Clipboard.AsText:=clipboardstr;
    Timer1.Enabled:=false;
end;

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    Tcchdszqm,
    Class_cchdszqm,
    1,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);
end.