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 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 67 by tony, Tue Oct 3 14:08:11 2017 UTC

#	Line 28 | Line 28
28
29		unit IBDialogs;
30
31	<	{$Mode Delphi}
31	>	{$mode objfpc}{$H+}
32
33		interface
34
35		uses
36	<	{$IFDEF LINUX }
37	<	unix,
38	<	{$ELSE}
36	>	{$IFDEF WINDOWS }
37		Windows,
38	+	{$ELSE}
39	+	unix,
40		{$ENDIF}
41	<	SysUtils, Messages, Classes, Graphics, Controls,
42	<	Forms, StdCtrls, ExtCtrls, dblogindlg;
41	>	SysUtils, Classes, Graphics, Controls,
42	>	Forms, StdCtrls, ExtCtrls, IB, IBTypes;
43
44	<	function ServerLoginDialog(const AServerName: string;
45	<	var AUserName, APassword: string): Boolean;
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	+	var ActiveForm: TCustomForm;
87		begin
88	<	with TLoginDlg.Create(nil) do
88	>	ActiveForm := Screen.ActiveCustomForm;
89	>	with TIBXLoginDlg.Create(nil) do
90		try
91		Caption := 'Firebird Server Login';
92	<	Label3.Caption := 'Server Name: ';
92	>	TargetCaption.Caption := 'Server Name: ';
93		DatabaseName.Caption := AServerName;
94		UserName.Text := AUserName;
95		Result := False;
#	Line 66 | Line 103 | begin
103		finally
104		Free;
105		end;
106	+	if ActiveForm <> nil then
107	+	begin
108	+	ActiveForm.SetFocus;
109	+	Application.ProcessMessages;
110	+	end;
111		end;
112
113	+	function TIBLCLInterface.LoginDialogEx(var ADatabaseName: string;
114	+	var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
115	+	var ActiveForm: TCustomForm;
116	+	begin
117	+	ActiveForm := Screen.ActiveCustomForm;
118	+	with TIBXLoginDlg.Create(Application) do
119	+	try
120	+	DatabaseName.Caption := ADatabaseName;
121	+	UserName.Text := AUserName;
122	+	Result := False;
123	+	if NameReadOnly then
124	+	UserName.Enabled := False
125	+	else
126	+	if AUserName = '' then ActiveControl := UserName;
127	+	if ShowModal = mrOk then
128	+	begin
129	+	AUserName := UserName.Text;
130	+	APassword := Password.Text;
131	+	Result := True;
132	+	end
133	+	finally
134	+	Free;
135	+	end;
136	+	if ActiveForm <> nil then
137	+	begin
138	+	ActiveForm.SetFocus;
139	+	Application.ProcessMessages;
140	+	end;
141	+	end;
142	+
143	+	procedure TIBLCLInterface.SetCursor;
144	+	begin
145	+	if (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault) then
146	+	begin
147	+	if FSetCursorDepth = 0 then
148	+	Screen.Cursor := crHourGlass;
149	+	Inc(FSetCursorDepth);
150	+	end;
151	+	end;
152	+
153	+	procedure TIBLCLInterface.RestoreCursor;
154	+	begin
155	+	if FSetCursorDepth > 0 then
156	+	begin
157	+	Dec(FSetCursorDepth);
158	+	if FSetCursorDepth = 0 then
159	+	Screen.Cursor := crDefault
160	+	end;
161	+	end;
162	+
163	+	initialization
164	+	IBGUIInterface :=  TIBLCLInterface.Create;
165	+
166		end.

Diff Legend

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