ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBDialogs.pas

Comparing ibx/trunk/runtime/IBDialogs.pas (file contents):
Revision 32 by tony, Tue Jul 14 15:31:25 2015 UTC vs.
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC

#	Line 1 | Line 1
1	<	{************************************************************************}
2	<	{                                                                        }
3	<	{       Borland Delphi Visual Component Library                          }
4	<	{       InterBase Express core components                                }
5	<	{                                                                        }
6	<	{       Copyright (c) 1998-2000 Inprise Corporation                      }
7	<	{                                                                        }
8	<	{    InterBase Express is based in part on the product                   }
9	<	{    Free IB Components, written by Gregory H. Deatz for                 }
10	<	{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
11	<	{    Free IB Components is used under license.                           }
12	<	{                                                                        }
13	<	{    The contents of this file are subject to the InterBase              }
14	<	{    Public License Version 1.0 (the "License"); you may not             }
15	<	{    use this file except in compliance with the License. You            }
16	<	{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17	<	{    Software distributed under the License is distributed on            }
18	<	{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
19	<	{    express or implied. See the License for the specific language       }
20	<	{    governing rights and limitations under the License.                 }
21	<	{    The Original Code was created by InterBase Software Corporation     }
22	<	{       and its successors.                                              }
23	<	{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
24	<	{       Corporation. All Rights Reserved.                                }
25	<	{    Contributor(s): Jeff Overcash                                       }
26	<	{                                                                        }
27	<	{************************************************************************}
28	<
29	<	unit IBDialogs;
30	<
31	<	{$mode objfpc}{$H+}
32	<
33	<	interface
34	<
35	<	uses
36	<	{$IFDEF WINDOWS }
37	<	Windows,
38	<	{$ELSE}
39	<	unix,
40	<	{$ENDIF}
41	<	SysUtils, Classes, Graphics, Controls,
42	<	Forms, StdCtrls, ExtCtrls, IB;
43	<
44	<	type
45	<
46	<	{ TIBLCLInterface }
47	<
48	<	TIBLCLInterface = class(TInterfacedObject,TIBGUIInterface)
49	<	private
50	<	FSetCursorDepth: integer;
51	<	public
52	<	function ServerLoginDialog(const AServerName: string;
53	<	var AUserName, APassword: string): Boolean;
54	<	function LoginDialogEx(const ADatabaseName: string;
55	<	var AUserName, APassword: string;
56	<	NameReadOnly: Boolean): Boolean;
57	<	procedure SetCursor;
58	<	procedure RestoreCursor;
59	<	end;
60	<
61	<	implementation
62	<
63	<	{$R IBDialogs.lfm}
64	<
65	<	type
66	<	{ TIBXLoginDlg }
67	<
68	<	TIBXLoginDlg = class(TForm)
69	<	Bevel1: TBevel;
70	<	Button1: TButton;
71	<	Button2: TButton;
72	<	DatabaseName: TLabel;
73	<	Label1: TLabel;
74	<	Label2: TLabel;
75	<	Label3: TLabel;
76	<	Password: TEdit;
77	<	UserName: TEdit;
78	<	private
79	<	{ private declarations }
80	<	public
81	<	{ public declarations }
82	<	end;
83	<
84	<	function TIBLCLInterface.ServerLoginDialog(const AServerName: string;
85	<	var AUserName, APassword: string): Boolean;
86	<	begin
87	<	with TIBXLoginDlg.Create(nil) do
88	<	try
89	<	Caption := 'Firebird Server Login';
90	<	Label3.Caption := 'Server Name: ';
91	<	DatabaseName.Caption := AServerName;
92	<	UserName.Text := AUserName;
93	<	Result := False;
94	<	if AUserName = '' then ActiveControl := UserName;
95	<	if ShowModal = mrOk then
96	<	begin
97	<	AUserName := UserName.Text;
98	<	APassword := Password.Text;
99	<	Result := True;
100	<	end;
101	<	finally
102	<	Free;
103	<	end;
104	<	end;
105	<
106	<	function TIBLCLInterface.LoginDialogEx(const ADatabaseName: string;
107	<	var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
108	<	begin
109	<	with TIBXLoginDlg.Create(Application) do
110	<	try
111	<	DatabaseName.Caption := ADatabaseName;
112	<	UserName.Text := AUserName;
113	<	Result := False;
114	<	if NameReadOnly then
115	<	UserName.Enabled := False
116	<	else
117	<	if AUserName = '' then ActiveControl := UserName;
118	<	if ShowModal = mrOk then
119	<	begin
120	<	AUserName := UserName.Text;
121	<	APassword := Password.Text;
122	<	Result := True;
123	<	end
124	<	finally
125	<	Free;
126	<	end;
127	<	end;
128	<
129	<	procedure TIBLCLInterface.SetCursor;
130	<	begin
131	<	if (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault) then
132	<	begin
133	<	if FSetCursorDepth = 0 then
134	<	Screen.Cursor := crHourGlass;
135	<	Inc(FSetCursorDepth);
136	<	end;
137	<	end;
138	<
139	<	procedure TIBLCLInterface.RestoreCursor;
140	<	begin
141	<	if FSetCursorDepth > 0 then
142	<	begin
143	<	Dec(FSetCursorDepth);
144	<	if FSetCursorDepth = 0 then
145	<	Screen.Cursor := crDefault
146	<	end;
147	<	end;
148	<
149	<	initialization
150	<	IBGUIInterface :=  TIBLCLInterface.Create;
151	<
152	<	end.
1	>	{************************************************************************}
2	>	{                                                                        }
3	>	{       Borland Delphi Visual Component Library                          }
4	>	{       InterBase Express core components                                }
5	>	{                                                                        }
6	>	{       Copyright (c) 1998-2000 Inprise Corporation                      }
7	>	{                                                                        }
8	>	{    InterBase Express is based in part on the product                   }
9	>	{    Free IB Components, written by Gregory H. Deatz for                 }
10	>	{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
11	>	{    Free IB Components is used under license.                           }
12	>	{                                                                        }
13	>	{    The contents of this file are subject to the InterBase              }
14	>	{    Public License Version 1.0 (the "License"); you may not             }
15	>	{    use this file except in compliance with the License. You            }
16	>	{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17	>	{    Software distributed under the License is distributed on            }
18	>	{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
19	>	{    express or implied. See the License for the specific language       }
20	>	{    governing rights and limitations under the License.                 }
21	>	{    The Original Code was created by InterBase Software Corporation     }
22	>	{       and its successors.                                              }
23	>	{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
24	>	{       Corporation. All Rights Reserved.                                }
25	>	{    Contributor(s): Jeff Overcash                                       }
26	>	{                                                                        }
27	>	{************************************************************************}
28	>
29	>	unit IBDialogs;
30	>
31	>	{$mode objfpc}{$H+}
32	>
33	>	interface
34	>
35	>	uses
36	>	{$IFDEF WINDOWS }
37	>	Windows,
38	>	{$ELSE}
39	>	unix,
40	>	{$ENDIF}
41	>	SysUtils, Classes, Graphics, Controls,
42	>	Forms, StdCtrls, ExtCtrls, IB;
43	>
44	>	type
45	>
46	>	{ TIBLCLInterface }
47	>
48	>	TIBLCLInterface = class(TInterfacedObject,TIBGUIInterface)
49	>	private
50	>	FSetCursorDepth: integer;
51	>	public
52	>	function ServerLoginDialog(const AServerName: string;
53	>	var AUserName, APassword: string): Boolean;
54	>	function LoginDialogEx(const ADatabaseName: string;
55	>	var AUserName, APassword: string;
56	>	NameReadOnly: Boolean): Boolean;
57	>	procedure SetCursor;
58	>	procedure RestoreCursor;
59	>	end;
60	>
61	>	implementation
62	>
63	>	{$R IBDialogs.lfm}
64	>
65	>	type
66	>	{ TIBXLoginDlg }
67	>
68	>	TIBXLoginDlg = class(TForm)
69	>	Bevel1: TBevel;
70	>	Button1: TButton;
71	>	Button2: TButton;
72	>	DatabaseName: TLabel;
73	>	Label1: TLabel;
74	>	Label2: TLabel;
75	>	Label3: TLabel;
76	>	Password: TEdit;
77	>	UserName: TEdit;
78	>	private
79	>	{ private declarations }
80	>	public
81	>	{ public declarations }
82	>	end;
83	>
84	>	function TIBLCLInterface.ServerLoginDialog(const AServerName: string;
85	>	var AUserName, APassword: string): Boolean;
86	>	begin
87	>	with TIBXLoginDlg.Create(nil) do
88	>	try
89	>	Caption := 'Firebird Server Login';
90	>	Label3.Caption := 'Server Name: ';
91	>	DatabaseName.Caption := AServerName;
92	>	UserName.Text := AUserName;
93	>	Result := False;
94	>	if AUserName = '' then ActiveControl := UserName;
95	>	if ShowModal = mrOk then
96	>	begin
97	>	AUserName := UserName.Text;
98	>	APassword := Password.Text;
99	>	Result := True;
100	>	end;
101	>	finally
102	>	Free;
103	>	end;
104	>	end;
105	>
106	>	function TIBLCLInterface.LoginDialogEx(const ADatabaseName: string;
107	>	var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
108	>	begin
109	>	with TIBXLoginDlg.Create(Application) do
110	>	try
111	>	DatabaseName.Caption := ADatabaseName;
112	>	UserName.Text := AUserName;
113	>	Result := False;
114	>	if NameReadOnly then
115	>	UserName.Enabled := False
116	>	else
117	>	if AUserName = '' then ActiveControl := UserName;
118	>	if ShowModal = mrOk then
119	>	begin
120	>	AUserName := UserName.Text;
121	>	APassword := Password.Text;
122	>	Result := True;
123	>	end
124	>	finally
125	>	Free;
126	>	end;
127	>	end;
128	>
129	>	procedure TIBLCLInterface.SetCursor;
130	>	begin
131	>	if (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault) then
132	>	begin
133	>	if FSetCursorDepth = 0 then
134	>	Screen.Cursor := crHourGlass;
135	>	Inc(FSetCursorDepth);
136	>	end;
137	>	end;
138	>
139	>	procedure TIBLCLInterface.RestoreCursor;
140	>	begin
141	>	if FSetCursorDepth > 0 then
142	>	begin
143	>	Dec(FSetCursorDepth);
144	>	if FSetCursorDepth = 0 then
145	>	Screen.Cursor := crDefault
146	>	end;
147	>	end;
148	>
149	>	initialization
150	>	IBGUIInterface :=  TIBLCLInterface.Create;
151	>
152	>	end.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines