ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDialogs.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBDialogs.pas (file contents):
Revision 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 31 by tony, Tue Jul 14 15:31:25 2015 UTC

# Line 28 | Line 28
28  
29   unit IBDialogs;
30  
31 < {$Mode Delphi}
31 > {$mode objfpc}{$H+}
32  
33   interface
34  
# Line 38 | Line 38 | uses
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(const AServerName: string;
53 >                               var AUserName, APassword: string): Boolean;
54 >    function LoginDialogEx(const ADatabaseName: string;
55 >                               var AUserName, APassword: string;
56 >                               NameReadOnly: Boolean): Boolean;
57 >    procedure SetCursor;
58 >    procedure RestoreCursor;
59 >  end;
60  
61   implementation
62  
63 < function ServerLoginDialog(const AServerName: string;
64 <  var AUserName, APassword: string): Boolean;
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 >    Label1: 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(const AServerName: string;
85 >         var AUserName, APassword: string): Boolean;
86   begin
87    with TIBXLoginDlg.Create(nil) do
88    try
# Line 68 | Line 103 | begin
103    end;
104   end;
105  
106 + function TIBLCLInterface.LoginDialogEx(const 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