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 45 by tony, Tue Dec 6 10:33:46 2016 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		begin
87	<	with TLoginDlg.Create(nil) do
87	>	with TIBXLoginDlg.Create(nil) do
88		try
89		Caption := 'Firebird Server Login';
90	<	Label3.Caption := 'Server Name: ';
90	>	TargetCaption.Caption := 'Server Name: ';
91		DatabaseName.Caption := AServerName;
92		UserName.Text := AUserName;
93		Result := False;
#	Line 68 | 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