mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-10-31 22:10:55 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			120 lines
		
	
	
		
			3.0 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			120 lines
		
	
	
		
			3.0 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| unit dbconfiggui;
 | |
| 
 | |
| {$mode objfpc}{$H+}
 | |
| 
 | |
| interface
 | |
| 
 | |
| uses
 | |
|   Forms, Dialogs, StdCtrls, dbconfig;
 | |
| 
 | |
| type
 | |
|   TConnectionTestFunction = function(ChosenConfig: TDBConnectionConfig): boolean of object;
 | |
|   { TDBConfigForm }
 | |
| 
 | |
|   TDBConfigForm = class(TForm)
 | |
|     OKButton: TButton;
 | |
|     CancelButton: TButton;
 | |
|     TestButton: TButton;
 | |
|     ConnectorType: TComboBox;
 | |
|     Host: TEdit;
 | |
|     Database: TEdit;
 | |
|     Label1: TLabel;
 | |
|     Label2: TLabel;
 | |
|     Label3: TLabel;
 | |
|     Label4: TLabel;
 | |
|     Label5: TLabel;
 | |
|     Password: TEdit;
 | |
|     User: TEdit;
 | |
|     procedure ConnectorTypeEditingDone(Sender: TObject);
 | |
|     procedure DatabaseEditingDone(Sender: TObject);
 | |
|     procedure FormCreate(Sender: TObject);
 | |
|     procedure FormDestroy(Sender: TObject);
 | |
|     procedure FormShow(Sender: TObject);
 | |
|     procedure HostEditingDone(Sender: TObject);
 | |
|     procedure PasswordEditingDone(Sender: TObject);
 | |
|     procedure TestButtonClick(Sender: TObject);
 | |
|     procedure UserEditingDone(Sender: TObject);
 | |
|   private
 | |
|     FConnectionConfig: TDBConnectionConfig;
 | |
|     FConnectionTestFunction: TConnectionTestFunction;
 | |
|     FSetupComplete: boolean;
 | |
|   public
 | |
|     property Config: TDBConnectionConfig read FConnectionConfig;
 | |
|     property ConnectionTestCallback: TConnectionTestFunction write FConnectionTestFunction;
 | |
|   end;
 | |
| 
 | |
| var
 | |
|   DBConfigForm: TDBConfigForm;
 | |
| 
 | |
| implementation
 | |
| 
 | |
| {$R *.lfm}
 | |
| 
 | |
| { TDBConfigForm }
 | |
| 
 | |
| procedure TDBConfigForm.TestButtonClick(Sender: TObject);
 | |
| begin
 | |
|   // Call callback with settings, let it figure out if connection succeeded and
 | |
|   // get test result back
 | |
|   if assigned(FConnectionTestFunction) and assigned(FConnectionConfig) then
 | |
|     if FConnectionTestFunction(FConnectionConfig) then
 | |
|        showmessage('Connection test succeeded.')
 | |
|       else
 | |
|         showmessage('Connection test failed.')
 | |
|   else
 | |
|     showmessage('Error: connection test code has not been implemented.');
 | |
| end;
 | |
| 
 | |
| procedure TDBConfigForm.UserEditingDone(Sender: TObject);
 | |
| begin
 | |
|   FConnectionConfig.DBUser:=User.Text;
 | |
| end;
 | |
| 
 | |
| procedure TDBConfigForm.FormCreate(Sender: TObject);
 | |
| begin
 | |
|   FConnectionConfig:=TDBConnectionConfig.Create;
 | |
|   FSetupComplete:=false;
 | |
| end;
 | |
| 
 | |
| procedure TDBConfigForm.ConnectorTypeEditingDone(Sender: TObject);
 | |
| begin
 | |
|   FConnectionConfig.DBType:=ConnectorType.Text;
 | |
| end;
 | |
| 
 | |
| procedure TDBConfigForm.DatabaseEditingDone(Sender: TObject);
 | |
| begin
 | |
|   FConnectionConfig.DBPath:=Database.Text;
 | |
| end;
 | |
| 
 | |
| procedure TDBConfigForm.FormDestroy(Sender: TObject);
 | |
| begin
 | |
|   FConnectionConfig.Free;
 | |
| end;
 | |
| 
 | |
| procedure TDBConfigForm.FormShow(Sender: TObject);
 | |
| begin
 | |
|   if not FSetupComplete then
 | |
|   begin
 | |
|     // Only do this once in form's lifetime
 | |
|     FSetupComplete:=true;
 | |
|     ConnectorType.Text:=FConnectionConfig.DBType;
 | |
|     Host.Text:=FConnectionConfig.DBHost;
 | |
|     Database.Text:=FConnectionConfig.DBPath;
 | |
|     User.Text:=FConnectionConfig.DBUser;
 | |
|     Password.Text:=FConnectionConfig.DBPassword;
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| procedure TDBConfigForm.HostEditingDone(Sender: TObject);
 | |
| begin
 | |
|   FConnectionConfig.DBHost:=Host.Text;
 | |
| end;
 | |
| 
 | |
| procedure TDBConfigForm.PasswordEditingDone(Sender: TObject);
 | |
| begin
 | |
|   FConnectionConfig.DBPassword:=Password.Text;
 | |
| end;
 | |
| 
 | |
| end.
 | |
| 
 | 
