trunk/design/IBDSDialogs.pas

{************************************************************************}
{                                                                        }
{       Borland Delphi Visual Component Library                          }
{       InterBase Express core components                                }
{                                                                        }
{       Copyright (c) 1998-2000 Inprise Corporation                      }
{                                                                        }
{    InterBase Express is based in part on the product                   }
{    Free IB Components, written by Gregory H. Deatz for                 }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
{    Free IB Components is used under license.                           }
{                                                                        }
{    The contents of this file are subject to the InterBase              }
{    Public License Version 1.0 (the "License"); you may not             }
{    use this file except in compliance with the License. You            }
{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
{    Software distributed under the License is distributed on            }
{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
{    express or implied. See the License for the specific language       }
{    governing rights and limitations under the License.                 }
{    The Original Code was created by InterBase Software Corporation     }
{       and its successors.                                              }
{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
{       Corporation. All Rights Reserved.                                }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{************************************************************************}

unit IBDSDialogs;

{$mode objfpc}{$H+}

interface

uses
{$IFDEF WINDOWS }
  Windows,
{$ELSE}
  unix,
{$ENDIF}
  SysUtils, Classes, Graphics, Controls, Dialogs,
  Forms, StdCtrls, ExtCtrls, Buttons, IB, IBDialogs;

type
  { TIBDSLCLInterface }

  TIBDSLCLInterface = class(TIBLCLInterface)
  private
    function GetProjectName: string;
    procedure GetDatabaseName(DefaultDBName, DefaultUserName: string; var DBName: string;
      var UserName: string);
    procedure GetServerName(DefaultServerName, DefaultUserName: string;
              var ServerName, UserName: string);
    procedure SaveDatabaseParams(DatabaseName, UserName: string);
    procedure SaveServerParams(ServerName, UserName: string);
 public
    function ServerLoginDialog(var AServerName: string;
                               var AUserName, APassword: string): Boolean;  override;
    function LoginDialogEx(var ADatabaseName: string;
                               var AUserName, APassword: string;
                               NameReadOnly: Boolean): Boolean; override;
  end;

implementation

{$R *.lfm}

uses BaseIDEIntf, LazIDEIntf;

const
  ConfigFile = 'ibx.xml';

type
  { TIBXDSLoginDlg }

  TIBXDSLoginDlg = class(TForm)
    Bevel1: TBevel;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    ProjectName: TLabel;
    SpeedButton1: TSpeedButton;
    TargetCaption: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Password: TEdit;
    UserName: TEdit;
    DatabaseName: TEdit;
    procedure SpeedButton1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;


{ TIBXDSLoginDlg }

procedure TIBXDSLoginDlg.SpeedButton1Click(Sender: TObject);
begin
  OpenDialog1.InitialDir := ExtractFileDir(DatabaseName.Text);
  if OpenDialog1.Execute then
    DatabaseName.Text := OpenDialog1.FileName;
end;


function TIBDSLCLInterface.GetProjectName: string;
begin
  Result := ChangeFileExt(ExtractFileName(LazarusIDE.ActiveProject.MainFile.FileName),'');
end;

procedure TIBDSLCLInterface.GetDatabaseName(DefaultDBName,
  DefaultUserName: string; var DBName: string; var UserName: string);
begin
  With GetIDEConfigStorage(ConfigFile,True) do
  try
    DBName := GetValue(GetProjectName + '/Database',DefaultDBName);
    UserName := GetValue(GetProjectName + '/UserName',DefaultUserName);
  finally
    Free
  end;
end;

procedure TIBDSLCLInterface.GetServerName(DefaultServerName,
  DefaultUserName: string; var ServerName, UserName: string);
begin
  With GetIDEConfigStorage(ConfigFile,True) do
  try
    ServerName := GetValue(GetProjectName + '/Server',DefaultServerName);
    UserName := GetValue(GetProjectName + '/UserName',DefaultUserName);
  finally
    Free
  end;
end;

procedure TIBDSLCLInterface.SaveDatabaseParams(DatabaseName, UserName: string);
begin
  With GetIDEConfigStorage(ConfigFile,True) do
  try
    SetValue(GetProjectName + '/Database',DatabaseName);
    SetValue(GetProjectName + '/UserName',UserName);
    WriteToDisk;
  finally
    Free
  end;
end;

procedure TIBDSLCLInterface.SaveServerParams(ServerName, UserName: string);
begin
  With GetIDEConfigStorage(ConfigFile,True) do
  try
    SetValue(GetProjectName + '/Server',ServerName);
    SetValue(GetProjectName + '/UserName',UserName);
    WriteToDisk;
  finally
    Free
  end;
end;

function TIBDSLCLInterface.ServerLoginDialog(var AServerName: string;
  var AUserName, APassword: string): Boolean;
var ActiveForm: TCustomForm;
begin
  ActiveForm := Screen.ActiveCustomForm;
  with TIBXDSLoginDlg.Create(nil) do
  try
    Caption := 'Firebird Server Login';
    TargetCaption.Caption := 'Server Name: ';
    GetServerName(AServerName,AUserName,AServerName,AUserName);
    ProjectName.Caption := GetProjectName;
    DatabaseName.Text := AServerName;
    UserName.Text := AUserName;
    Result := False;
    if AUserName = '' then ActiveControl := UserName;
    if ShowModal = mrOk then
    begin
      AServerName :=  DatabaseName.Text;
      AUserName := UserName.Text;
      APassword := Password.Text;
      SaveServerParams(DatabaseName.Text,UserName.Text);
      Result := True;
    end;
  finally
    Free;
  end;
  if ActiveForm <> nil then
  begin
    ActiveForm.SetFocus;
    Application.ProcessMessages;
  end;
end;

function TIBDSLCLInterface.LoginDialogEx(var ADatabaseName: string;
  var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
var ActiveForm: TCustomForm;
begin
 try
  ActiveForm := Screen.ActiveCustomForm;
  with TIBXDSLoginDlg.Create(Application) do
  try
    ProjectName.Caption := GetProjectName;
    GetDatabaseName(ADatabaseName, AUserName, ADatabaseName,AUserName);
    DatabaseName.Text := ADatabaseName;
    UserName.Text := AUserName;
    Result := False;
    if NameReadOnly then
      UserName.Enabled := False
    else
      if AUserName = '' then ActiveControl := UserName;
    if ShowModal = mrOk then
    begin
      ADatabaseName :=  DatabaseName.Text;
      AUserName := UserName.Text;
      APassword := Password.Text;
      SaveDatabaseParams(DatabaseName.Text,UserName.Text);
      Result := True;
    end
  finally
    Free;
  end;
  if ActiveForm <> nil then
  begin
    ActiveForm.SetFocus;
    Application.ProcessMessages;
  end;
 except On E:Exception do
   MessageDlg('Unable to Load Login Dialog ' + E.Message,mtError,[mbOK],0);
 end;
end;

end.
Revision:	67
Committed:	Tue Oct 3 14:08:11 2017 UTC (7 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	7396 byte(s)
Log Message:	Property Editor positioning tidy up
#	Content
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 IBDSDialogs;
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, Dialogs,
42	Forms, StdCtrls, ExtCtrls, Buttons, IB, IBDialogs;
43
44	type
45	{ TIBDSLCLInterface }
46
47	TIBDSLCLInterface = class(TIBLCLInterface)
48	private
49	function GetProjectName: string;
50	procedure GetDatabaseName(DefaultDBName, DefaultUserName: string; var DBName: string;
51	var UserName: string);
52	procedure GetServerName(DefaultServerName, DefaultUserName: string;
53	var ServerName, UserName: string);
54	procedure SaveDatabaseParams(DatabaseName, UserName: string);
55	procedure SaveServerParams(ServerName, UserName: string);
56	public
57	function ServerLoginDialog(var AServerName: string;
58	var AUserName, APassword: string): Boolean; override;
59	function LoginDialogEx(var ADatabaseName: string;
60	var AUserName, APassword: string;
61	NameReadOnly: Boolean): Boolean; override;
62	end;
63
64	implementation
65
66	{$R *.lfm}
67
68	uses BaseIDEIntf, LazIDEIntf;
69
70	const
71	ConfigFile = 'ibx.xml';
72
73	type
74	{ TIBXDSLoginDlg }
75
76	TIBXDSLoginDlg = class(TForm)
77	Bevel1: TBevel;
78	Button1: TButton;
79	Button2: TButton;
80	Label1: TLabel;
81	OpenDialog1: TOpenDialog;
82	ProjectName: TLabel;
83	SpeedButton1: TSpeedButton;
84	TargetCaption: TLabel;
85	Label2: TLabel;
86	Label3: TLabel;
87	Password: TEdit;
88	UserName: TEdit;
89	DatabaseName: TEdit;
90	procedure SpeedButton1Click(Sender: TObject);
91	private
92	{ private declarations }
93	public
94	{ public declarations }
95	end;
96
97
98	{ TIBXDSLoginDlg }
99
100	procedure TIBXDSLoginDlg.SpeedButton1Click(Sender: TObject);
101	begin
102	OpenDialog1.InitialDir := ExtractFileDir(DatabaseName.Text);
103	if OpenDialog1.Execute then
104	DatabaseName.Text := OpenDialog1.FileName;
105	end;
106
107
108	function TIBDSLCLInterface.GetProjectName: string;
109	begin
110	Result := ChangeFileExt(ExtractFileName(LazarusIDE.ActiveProject.MainFile.FileName),'');
111	end;
112
113	procedure TIBDSLCLInterface.GetDatabaseName(DefaultDBName,
114	DefaultUserName: string; var DBName: string; var UserName: string);
115	begin
116	With GetIDEConfigStorage(ConfigFile,True) do
117	try
118	DBName := GetValue(GetProjectName + '/Database',DefaultDBName);
119	UserName := GetValue(GetProjectName + '/UserName',DefaultUserName);
120	finally
121	Free
122	end;
123	end;
124
125	procedure TIBDSLCLInterface.GetServerName(DefaultServerName,
126	DefaultUserName: string; var ServerName, UserName: string);
127	begin
128	With GetIDEConfigStorage(ConfigFile,True) do
129	try
130	ServerName := GetValue(GetProjectName + '/Server',DefaultServerName);
131	UserName := GetValue(GetProjectName + '/UserName',DefaultUserName);
132	finally
133	Free
134	end;
135	end;
136
137	procedure TIBDSLCLInterface.SaveDatabaseParams(DatabaseName, UserName: string);
138	begin
139	With GetIDEConfigStorage(ConfigFile,True) do
140	try
141	SetValue(GetProjectName + '/Database',DatabaseName);
142	SetValue(GetProjectName + '/UserName',UserName);
143	WriteToDisk;
144	finally
145	Free
146	end;
147	end;
148
149	procedure TIBDSLCLInterface.SaveServerParams(ServerName, UserName: string);
150	begin
151	With GetIDEConfigStorage(ConfigFile,True) do
152	try
153	SetValue(GetProjectName + '/Server',ServerName);
154	SetValue(GetProjectName + '/UserName',UserName);
155	WriteToDisk;
156	finally
157	Free
158	end;
159	end;
160
161	function TIBDSLCLInterface.ServerLoginDialog(var AServerName: string;
162	var AUserName, APassword: string): Boolean;
163	var ActiveForm: TCustomForm;
164	begin
165	ActiveForm := Screen.ActiveCustomForm;
166	with TIBXDSLoginDlg.Create(nil) do
167	try
168	Caption := 'Firebird Server Login';
169	TargetCaption.Caption := 'Server Name: ';
170	GetServerName(AServerName,AUserName,AServerName,AUserName);
171	ProjectName.Caption := GetProjectName;
172	DatabaseName.Text := AServerName;
173	UserName.Text := AUserName;
174	Result := False;
175	if AUserName = '' then ActiveControl := UserName;
176	if ShowModal = mrOk then
177	begin
178	AServerName := DatabaseName.Text;
179	AUserName := UserName.Text;
180	APassword := Password.Text;
181	SaveServerParams(DatabaseName.Text,UserName.Text);
182	Result := True;
183	end;
184	finally
185	Free;
186	end;
187	if ActiveForm <> nil then
188	begin
189	ActiveForm.SetFocus;
190	Application.ProcessMessages;
191	end;
192	end;
193
194	function TIBDSLCLInterface.LoginDialogEx(var ADatabaseName: string;
195	var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
196	var ActiveForm: TCustomForm;
197	begin
198	try
199	ActiveForm := Screen.ActiveCustomForm;
200	with TIBXDSLoginDlg.Create(Application) do
201	try
202	ProjectName.Caption := GetProjectName;
203	GetDatabaseName(ADatabaseName, AUserName, ADatabaseName,AUserName);
204	DatabaseName.Text := ADatabaseName;
205	UserName.Text := AUserName;
206	Result := False;
207	if NameReadOnly then
208	UserName.Enabled := False
209	else
210	if AUserName = '' then ActiveControl := UserName;
211	if ShowModal = mrOk then
212	begin
213	ADatabaseName := DatabaseName.Text;
214	AUserName := UserName.Text;
215	APassword := Password.Text;
216	SaveDatabaseParams(DatabaseName.Text,UserName.Text);
217	Result := True;
218	end
219	finally
220	Free;
221	end;
222	if ActiveForm <> nil then
223	begin
224	ActiveForm.SetFocus;
225	Application.ProcessMessages;
226	end;
227	except On E:Exception do
228	MessageDlg('Unable to Load Login Dialog ' + E.Message,mtError,[mbOK],0);
229	end;
230	end;
231
232	end.