source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/fWebTab.pas@ 699

Last change on this file since 699 was 541, checked in by Kevin Toppenberg, 15 years ago

TMG Ver 1.1 Added HTML Support, better demographics editing

File size: 3.0 KB
RevLine 
[541]1unit fWebTab;
2//kt Added entire unit and form.
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
8 Dialogs, OleCtrls, SHDocVw, StdCtrls,fPage;
9
10type
11 TfrmWebTab = class(TfrmPage)
12 WebBrowser: TWebBrowser;
13 private
14 { Private declarations }
15 public
16 { Public declarations }
17 Procedure RequestPrint; override;
18 Procedure NagivateTo(URL: Widestring);
19 end;
20
21function AskServerForURLs(URLList : TStringList) : string;
22
23var
24 frmWebTabs: TList;
25
26 TMG_URL_RPC_Available : boolean;
27 TMG_URL_RPC_Checked : boolean;
28
29implementation
30
31{$R *.dfm}
32uses ORNet,ORFn,Trpcb,uConst;
33
34
35Procedure TfrmWebTab.RequestPrint;
36begin
37 inherited;
38 MessageDlg('Finish code: request printing from web browser...',mtInformation,[mbOK],0);
39end;
40
41
42Procedure TfrmWebTab.NagivateTo(URL: WideString);
43begin
44 WebBrowser.Navigate(URL);
45end;
46
47//=================================================================
48//===== Globally available functions, not part of object ==========
49//=================================================================
50
51function AskServerForURLs(URLList : TStringList) : string;
52//Get URL list from server.
53//URLList is filled with RPCBroker.Results. Should have this format:
54// URLList(0)='1^Success' pr '0^Failure'
55// URLList(1)="URL#1" a URL to display in tab 1
56// URLList(2)="URL#2" a URL to display in tab 2
57// URLList(3)="URL#3" a URL to display in tab 3
58// Note: if URL='<!HIDE!>' then server is requesting tab to be hidden
59//Results of Fn: Returns '1^Success' if success, or '0^ErrorMessage'
60var
61 RPCResult : AnsiString;
62 i : integer;
63begin
64 if TMG_URL_RPC_Checked = false then begin
65 RPCBrokerV.remoteprocedure := 'XWB IS RPC AVAILABLE';
66 RPCBrokerV.Param[0].Value := 'TMG CPRS GET URL LIST';
67 RPCBrokerV.Param[0].ptype := literal;
68 RPCBrokerV.Param[1].Value := 'R';
69 RPCBrokerV.Param[1].ptype := literal;
70 RPCResult := RPCBrokerV.StrCall; {returns 1 if available, 0 if not available}
71 TMG_URL_RPC_Checked := true;
72 TMG_URL_RPC_Available := (RPCResult='1');
73 end;
74
75 if TMG_URL_RPC_Available= true then begin
76 if (URLList <> nil) then begin
77 RPCBrokerV.remoteprocedure := 'TMG CPRS GET URL LIST';
78 RPCBrokerV.Call;
79 URLList.Assign(RPCBrokerV.Results);
80 if RPCBrokerV.Results.Count>0 then Result := RPCBrokerV.Results.Strings[0]
81 else Result := '-1^Error: No URL''s returned from server.';
82 end else begin
83 Result := '0^Invalid TStringList URLList passed';
84 end;
85 end else begin
86 Result := '-1^"TMG CPRS GET URL LIST" RPC Not available on server';
87 end;
88end;
89
90
91initialization
92 TMG_URL_RPC_Available := false; //default to not avail.
93 TMG_URL_RPC_Checked := false; //default to not checked.
94 frmWebTabs := TList.Create;
95 frmWebTabs.Count := CT_LAST_WEBTAB-CT_WEBTAB1+1; //fill up list with nil pointers
96finalization
97 frmWebTabs.Free;
98end.
99
Note: See TracBrowser for help on using the repository browser.