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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC

#	Line 28 | Line 28
28
29		unit IBDialogs;
30
31	<	interface
31	>	{$mode objfpc}{$H+}
32
33	<	uses SysUtils, Windows, Messages, Classes, Graphics, Controls,
34	<	Forms, StdCtrls, ExtCtrls, DBLogDlg;
33	>	interface
34
35	<	function ServerLoginDialog(const AServerName: string;
36	<	var AUserName, APassword: string): Boolean;
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	<	function ServerLoginDialog(const AServerName: string;
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 TLoginDialog.Create(nil) do
87	>	with TIBXLoginDlg.Create(nil) do
88		try
89	<	Caption := 'InterBase Server Login';
90	<	Label3.Caption := 'Server Name: ';
89	>	Caption := 'Firebird Server Login';
90	>	TargetCaption.Caption := 'Server Name: ';
91		DatabaseName.Caption := AServerName;
92		UserName.Text := AUserName;
93		Result := False;
#	Line 60 | Line 103 | begin
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