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; |
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. |