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 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 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 Delphi}
32	<
33	<	interface
34	<
35	<	uses
36	<	{$IFDEF WINDOWS }
37	<	Windows,
38	<	{$ELSE}
39	<	unix,
40	<	{$ENDIF}
41	<	SysUtils, Messages, Classes, Graphics, Controls,
42	<	Forms, StdCtrls, ExtCtrls, dblogindlg;
43	<
44	<	function ServerLoginDialog(const AServerName: string;
45	<	var AUserName, APassword: string): Boolean;
46	<
47	<	implementation
48	<
49	<	function ServerLoginDialog(const AServerName: string;
50	<	var AUserName, APassword: string): Boolean;
51	<	begin
52	<	with TIBXLoginDlg.Create(nil) do
53	<	try
54	<	Caption := 'Firebird Server Login';
55	<	Label3.Caption := 'Server Name: ';
56	<	DatabaseName.Caption := AServerName;
57	<	UserName.Text := AUserName;
58	<	Result := False;
59	<	if AUserName = '' then ActiveControl := UserName;
60	<	if ShowModal = mrOk then
61	<	begin
62	<	AUserName := UserName.Text;
63	<	APassword := Password.Text;
64	<	Result := True;
65	<	end;
66	<	finally
67	<	Free;
68	<	end;
69	<	end;
70	<
71	<	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, IBTypes;
43	>
44	>	type
45	>
46	>	{ TIBLCLInterface }
47	>
48	>	TIBLCLInterface = class(TInterfacedObject,TIBGUIInterface)
49	>	private
50	>	FSetCursorDepth: integer;
51	>	public
52	>	function ServerLoginDialog(var AServerName: string;
53	>	var AUserName, APassword: string): Boolean;  virtual;
54	>	function LoginDialogEx(var ADatabaseName: string;
55	>	var AUserName, APassword: string;
56	>	NameReadOnly: Boolean): Boolean; virtual;
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	>	TargetCaption: 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(var AServerName: string;
85	>	var AUserName, APassword: string): Boolean;
86	>	begin
87	>	with TIBXLoginDlg.Create(nil) do
88	>	try
89	>	Caption := 'Firebird Server Login';
90	>	TargetCaption.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(var 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