source: cprs/branches/GUI-config/BDK32/Samples/RPCBroker/SilentSignOn/fXWBAppHandle1.pas@ 881

Last change on this file since 881 was 476, checked in by Kevin Toppenberg, 16 years ago

New WorldVistA Config Utility

File size: 3.6 KB
RevLine 
[476]1unit fXWBAppHandle1;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, RpcSlogin, Trpcb, RpcConf1, frmVistAAbout, Menus, ActnList;
8
9type
10 TForm1 = class(TForm)
11 brkrRPCB: TRPCBroker;
12 btnConnect: TButton;
13 btnStartApp2: TButton;
14 edtOtherProgram: TEdit;
15 lblOtherProgram: TLabel;
16 lblOptional: TLabel;
17 lblWithFull: TLabel;
18 Memo1: TMemo;
19 btnExit: TButton;
20 mnuMainMenu: TMainMenu;
21 mnuFile: TMenuItem;
22 mnuFileExit: TMenuItem;
23 Help1: TMenuItem;
24 mnuAbout: TMenuItem;
25 mnuOptions: TMenuItem;
26 OnlyOldConnection1: TMenuItem;
27 ActionList1: TActionList;
28 actOldConnectionOnly: TAction;
29 actBackwardsCompatible: TAction;
30 actDebugMode: TAction;
31 BackwardsCompatible1: TMenuItem;
32 DebugMode1: TMenuItem;
33 procedure btnConnectClick(Sender: TObject);
34 procedure btnStartApp2Click(Sender: TObject);
35 procedure btnExitClick(Sender: TObject);
36 procedure mnuFileExitClick(Sender: TObject);
37 procedure mnuAboutClick(Sender: TObject);
38 procedure actOldConnectionOnlyExecute(Sender: TObject);
39 procedure actBackwardsCompatibleExecute(Sender: TObject);
40 procedure actDebugModeExecute(Sender: TObject);
41 private
42 { Private declarations }
43 public
44 { Public declarations }
45 end;
46
47var
48 Form1: TForm1;
49
50implementation
51
52{$R *.DFM}
53
54
55procedure TForm1.btnConnectClick(Sender: TObject);
56var
57 Server, Port: String;
58begin
59 if btnConnect.Caption = '&Connect' then
60 begin
61 GetServerInfo(Server, Port);
62 brkrRPCB.Server := Server;
63 brkrRPCB.ListenerPort := StrToInt(Port);
64 brkrRPCB.Connected := True;
65 if brkrRPCB.Connected then
66 begin
67 btnConnect.Caption := '&Disconnect';
68 mnuOptions.Enabled := False;
69 end;
70 end
71 else
72 begin
73 brkrRPCB.Connected := False;
74 btnConnect.Caption := '&Connect';
75 mnuOptions.Enabled := True;
76 end;
77end;
78
79procedure TForm1.btnStartApp2Click(Sender: TObject);
80var
81 CurDir: String;
82begin
83 if edtOtherProgram.Text <> '' then
84 begin
85 CurDir := edtOtherProgram.Text;
86 StartProgSLogin(CurDir,nil);
87 end
88 else
89 begin
90 { Use Test2.exe and expecting it to be in the startup directory for the current application}
91 CurDir := ExtractFilePath(ParamStr(0)) + 'XWBAppHandle2.exe';
92
93 { Now start application with silent login }
94 StartProgSLogin(CurDir, brkrRPCB);
95 end;
96end;
97
98procedure TForm1.btnExitClick(Sender: TObject);
99begin
100 halt;
101end;
102
103procedure TForm1.mnuFileExitClick(Sender: TObject);
104begin
105 Halt;
106end;
107
108procedure TForm1.mnuAboutClick(Sender: TObject);
109begin
110 ShowAboutBox;
111end;
112
113procedure TForm1.actOldConnectionOnlyExecute(Sender: TObject);
114begin
115 if actOldConnectionOnly.Checked then
116 begin
117 actOldConnectionOnly.Checked := False;
118 brkrRPCB.OldConnectionOnly := False;
119 end
120 else
121 begin
122 actOldConnectionOnly.Checked := True;
123 brkrRPCB.OldConnectionOnly := True;
124 end;
125end;
126
127procedure TForm1.actBackwardsCompatibleExecute(Sender: TObject);
128begin
129 if actBackwardsCompatible.Checked then
130 begin
131 actBackwardsCompatible.Checked := False;
132 brkrRPCB.IsBackwardCompatibleConnection := False;
133 end
134 else
135 begin
136 brkrRPCB.IsBackwardCompatibleConnection := True;
137 actBackwardsCompatible.Checked := True;
138 end;
139end;
140
141procedure TForm1.actDebugModeExecute(Sender: TObject);
142begin
143 if actDebugMode.Checked then
144 begin
145 actDebugMode.Checked := False;
146 brkrRPCB.DebugMode := False;
147 end
148 else
149 begin
150 brkrRPCB.DebugMode := True;
151 actDebugMode.Checked := True;
152 end;
153end;
154
155end.
Note: See TracBrowser for help on using the repository browser.