28 |
|
|
29 |
|
unit IBDialogs; |
30 |
|
|
31 |
< |
{$Mode Delphi} |
31 |
> |
{$mode objfpc}{$H+} |
32 |
|
|
33 |
|
interface |
34 |
|
|
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; |
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 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; |
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. |