[delphi] TWebbrowser 내 javascript 에서 delphi 함수 호출

2018-06-11

자바스크립트에서 델파이 함수 호출

code

  • index.html
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 <!DOCTYPE html>
<html>
<head>
	<meta charset="utf-8">
    <script language="javascript">
        function DelMessage() {
            window.status = 'delFunc_Message';
            window.status = '';
        }

        function DelForm() {
            window.status = 'delFunc_Form';
            window.status = '';
        }
        function DelMainMessage() {
            window.status = 'delFunc_MainMessage';
            window.status = '';
        }

        function DelMainForm() {
            window.status = 'delFunc_MainForm';
            window.status = '';
        }
    </script>
</head>

<body>
    <input type="button" value="나와라 델파이 TCallFunc 메시지" onclick='DelMessage()'>
    <input type="button" value="나와라 델파이 TCallFunc 폼" onclick='DelForm()'>
    <input type="button" value="나와라 델파이 메인 메시지" onclick='DelMainMessage()'>
    <input type="button" value="나와라 델파이 메인 폼" onclick='DelMainForm()'>
</body>
</html>
  • Main.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw, Vcl.StdCtrls,
  Vcl.ExtCtrls, Vcl.ComCtrls;

type
  TFMain = class(TForm)
    pnl: TPanel;
    btnMsg: TButton;
    btnForm: TButton;
    mmoLog: TMemo;
    Splitter1: TSplitter;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    wbs: TWebBrowser;
    procedure FormCreate(Sender: TObject);
    procedure wbsStatusTextChange(ASender: TObject; const Text: WideString);
    procedure btnFormClick(Sender: TObject);
    procedure btnMsgClick(Sender: TObject);
  private
    { Private declarations }
    procedure AddLog(s: String);
  public
    { Public declarations }
  published
    procedure delFunc_MainMessage;
    procedure delFunc_MainForm;
  end;

var
  FMain: TFMain;

implementation

uses
  UCommon, UCallFunc;

{$R *.dfm}

procedure TFMain.AddLog(s: String);
begin
  mmoLog.Lines.Add(s);
end;

procedure TFMain.btnFormClick(Sender: TObject);
var
  f: TForm;
begin
  f := TForm.Create(nil);
  f.Caption := '메인 폼';
  f.ShowModal;
  f.Free;
end;

procedure TFMain.btnMsgClick(Sender: TObject);
begin
  ShowMessage('메인 메시지');
end;

procedure TFMain.delFunc_MainForm;
begin
  btnForm.Click;
end;

procedure TFMain.delFunc_MainMessage;
begin
  btnMsg.Click;
end;

procedure TFMain.FormCreate(Sender: TObject);
begin
  wbs.Navigate2(ExtractFilePath(Application.ExeName) + 'index.html');
end;

procedure TFMain.wbsStatusTextChange(ASender: TObject; const Text: WideString);
const
  CST_DEL_FUNC = 'delFunc_';
var
  sFuncName: String;
begin
  sFuncName := Text;
  if Pos(CST_DEL_FUNC, sFuncName) = 0 then Exit;

  AddLog('Web Status: ' + String(Text));
  SetTimeOut( procedure
    begin
      // 사용할 함수가 있는 클래스를 넘겨줘야한다.
      CallMethod(g_CallFunc, sFuncName)
//      CallMethod(Self, sFuncName)
    end, 1);
end;

end.
  • UCallFunc.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
unit UCallFunc;

interface

uses
  Vcl.Dialogs, Vcl.Forms;

{$M+}
type
  TCallFunc = class
  private
  public
  published
    procedure delFunc_Message;
    procedure delFunc_Form;
  end;
{$M-}

var
  g_CallFunc: TCallFunc;

implementation

{ TCallFunc }

procedure TCallFunc.delFunc_Form;
var
  f: TForm;
begin
  f := TForm.Create(nil);
  f.Caption := 'TCallFunc 폼';
  f.ShowModal;
  f.Free;
end;

procedure TCallFunc.delFunc_Message;
begin
  ShowMessage('TCallFunc 메시지 테스트');
end;

initialization
  g_CallFunc := TCallFunc.Create;

finalization
  g_CallFunc.Free;

end.
  • UCommon.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
unit UCommon;

interface

uses
  System.SysUtils, System.Classes, System.Threading, System.Rtti;

procedure SetTimeOut(proc: TProc; nInterval: Integer = 100);

// 함수 이름으로 함수 호출
// 취향것 사용
procedure CallMethod(obj: TObject; AMethodName: string); overload;
function CallMethod(obj: TObject; AMethodName: string; AParameters: TArray<TValue>): TValue; overload;


implementation

procedure SetTimeOut(proc: TProc; nInterval: Integer = 100);
begin
  TThread.CreateAnonymousThread( procedure
    begin
    Sleep(nInterval);
  	// 내부 코드
    TThread.Synchronize( TThread.CurrentThread, procedure
      begin
    		// GUI 코드
        proc
      end);
    end).Start;
end;

procedure CallMethod(obj: TObject; AMethodName: string);
type
  TExecute = procedure of object;
var
  e: TExecute;
begin
  TMethod(e).Data := obj;
  TMethod(e).Code := obj.MethodAddress(AMethodName);
  if Assigned(e) then e;
end;

function CallMethod(obj: TObject; AMethodName: string; AParameters: TArray<TValue>): TValue;
{
// IF문을 사용하는 방식
begin
  if AMethodName = 'callDelphiMethodFromJS' then
    callDelphiMethodFromJS
  else if AMethodName = 'callDelphiMethodFromJSWithParam' then
    callDelphiMethodFromJSWithParam(AParameters[0].AsString, AParameters[1].AsString);
end;
}
// RTTI로 메소드이름으로 메소드 호출하는 방식(published, public 으로 메소드가 선언되야함)
var
  RttiCtx: TRttiContext;
  RttiTyp: TRttiType;
  RttiMtd: TRttiMethod;
begin
  RttiCtx := TRttiContext.Create;
  RttiTyp := RttiCtx.GetType(obj.ClassInfo);
  RttiMtd := nil;
  if Assigned(RttiTyp) then
  begin
    RttiMtd := RttiTyp.GetMethod(AMethodName);
    if Assigned(RttiMtd) then
      Result := RttiMtd.Invoke(obj, AParameters);
  end;
  RttiMtd.Free;
  RttiTyp.Free;
  RttiCtx.Free;
end;

end.

source

CallDelphiFunctionFromJavascript

Tags: delphi webbrowser
← [delphi] TTask 와 for문 [batch] Hyper-V 활성/비활성화 →