Advanced Delphi Systems Code: ads

//Advanced Delphi Systems Code: ads_DlgDBAlias

unit ads_DlgDBAlias;
{Copyright(c)2016 Advanced Delphi Systems

 Richard Maley
 Advanced Delphi Systems
 12613 Maidens Bower Drive
 Potomac, MD 20854 USA
 phone 301-840-1554
 dickmaley@advdelphisys.com

 The code herein can be used or modified by anyone.  Please retain references
 to Richard Maley at Advanced Delphi Systems.  If you make improvements to the
 code please send your improvements to dickmaley@advdelphisys.com so that the
 entire Delphi community can benefit.  All comments are welcome.
}

(*
Description: ads_DlgDBAlias.pas.pas

This unit contains

*)

(*

UnitIndex Master Index Implementation Section Download Units

Description: ads_DlgDBAlias.pas
This unit contains the following routines.

DlgDBAlias_ads TDBAliasDlg_ads.btnCancelClick TDBAliasDlg_ads.btnOkClick TDBAliasDlg_ads.DatabaseAliasListDblClick TDBAliasDlg_ads.FormActivate TDBAliasDlg_ads.FormCreate TDBAliasDlg_ads.FormResize TDBAliasDlg_ads.GetDatabaseName TDBAliasDlg_ads.ReSizeAll TDBAliasDlg_ads.SetDatabaseName TDBAliasDlg_ads.SetMinFormHeight TDBAliasDlg_ads.SetMinFormWidth

*)
interface

{!~DlgDBAlias_ads

}
Function DlgDBAlias_ads(Var DBName: String): Boolean;

implementation



Uses
  ads_Exception,
  SysUtils,
  WinTypes,
  WinProcs,
  Dialogs,
  Classes,
  Graphics,
  Forms,
  Controls,
  Buttons,
  StdCtrls,
  ExtCtrls,
  DBTables,
  DB
  ;

Var
  UnitName : String;
  ProcName : String;

type
  TDBAliasDlg_ads = Class(TScrollingWinControl)
  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor  Destroy; Override;
  Public
    pnlButtons: TPanel;
    pnlBaseMessage: TPanel;
    pnlBaseList: TPanel;
    DatabaseAliasList: TListBox;
    pnlBtnSlider: TPanel;
    btnCancel: TBitBtn;
    btnOk: TBitBtn;
    procedure DatabaseAliasListDblClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
  private
    { Private declarations }
    FDatabaseName      : TFileName;
    FTitle             : String;    {stores the Dialog Title}
    FMsg               : String;    {stores the Dialog Message}
    FApplyChanges      : Boolean;
    FMinFormWidth      : Integer;   {Sets a Minimum FormWidth}
    FMinFormHeight     : Integer;   {Sets a Minimum FormHeight}
    procedure SetMinFormWidth(Value : Integer);
    procedure SetMinFormHeight(Value : Integer);
    procedure ReSizeAll;
    function  GetDatabaseName: TFileName;
    procedure SetDatabaseName(Value: TFileName);
  published
    property  DatabaseName : TFileName read GetDatabaseName write SetDatabaseName;
    property  Title         : String read FTitle write FTitle;
    property  Msg           : String read FMsg   write FMsg;
    property  ApplyChanges  : Boolean
      Read    FApplyChanges
      Write   FApplyChanges;
    property  MinFormWidth  : Integer    {Sets the form's Minimum Width}
      Read    FMinFormWidth
      Write   SetMinFormWidth;
    property  MinFormHeight : Integer    {Sets the form's Minimum Height}
      Read    FMinFormHeight
      Write   SetMinFormHeight;
  end;






//

Unit Description UnitIndex Master Index

procedure TDBAliasDlg_ads.DatabaseAliasListDblClick(Sender: TObject);
begin
  btnOKClick(Sender);
end;

//

Unit Description UnitIndex Master Index

procedure TDBAliasDlg_ads.ReSizeAll;
Begin
  If Width  < MinFormWidth  Then Width  := MinFormWidth;
  If Height < MinFormHeight Then Height := MinFormHeight;
End;

//

Unit Description UnitIndex Master Index

procedure TDBAliasDlg_ads.FormResize(Sender: TObject);
begin
  ReSizeAll;
end;

//

Unit Description UnitIndex Master Index

procedure TDBAliasDlg_ads.btnOkClick(Sender: TObject);
begin
  If (DatabaseAliasList.ItemIndex < 0) Then
  Begin
    ApplyChanges := False;
  End
  Else
  Begin
    DatabaseName := DatabaseAliasList.items[DatabaseAliasList.itemIndex];
    ApplyChanges := True;
  End;
end;

//

Unit Description UnitIndex Master Index

procedure TDBAliasDlg_ads.FormCreate(Sender: TObject);
Var
  inCounter : Integer;
begin
  For inCounter := 0 To ComponentCount - 1 Do
  Begin
    If Components[inCounter] is TPanel Then
    Begin
      TPanel(Components[inCounter]).BorderStyle := bsNone;
      TPanel(Components[inCounter]).BevelInner  := bvNone;
      TPanel(Components[inCounter]).BevelOuter  := bvNone;
    End;
  End;

  DatabaseAliasList.Items.Clear;
  Title              := 'Database Alias Dialog';   {stores the Dialog Title}
  Msg                := 'Select a Database Alias'; {stores the Dialog Message}
  ApplyChanges       := False;
  FMinFormWidth      := 200;                       {Sets a Minimum FormWidth}
  FMinFormHeight     := 300;                       {Sets a Minimum FormHeight}
  ReSizeAll;
end;

//

Unit Description UnitIndex Master Index

procedure TDBAliasDlg_ads.FormActivate(Sender: TObject);
Var I: Integer;
Begin
  Try
    Session.GetDatabaseNames(DatabaseAliasList.Items);
    For I :=0 To DatabaseAliasList.Items.Count -1 Do
    Begin
      If UpperCase(DatabaseAliasList.Items[I]) = UpperCase(DatabaseName) Then
      Begin
        DatabaseAliasList.ItemIndex := I;
        Break;
      End;
    End;
  Except
    Raise Exception.Create('Unable to list the Database Aliases');
  End;
  Caption                   := Title; {stores the Dialog Title}
  pnlBaseMessage.Caption    := Msg;   {stores the Dialog Message}
  Left := (Screen.Width -Width)  div 2;
  Top  := (Screen.Height-Height) div 2;
End;

//

Unit Description UnitIndex Master Index

function TDBAliasDlg_ads.GetDatabaseName: TFileName;
begin
  Result := FDatabaseName;
end;

//

Unit Description UnitIndex Master Index

procedure TDBAliasDlg_ads.SetDatabaseName(Value : TFileName);
begin
  FDatabaseName := Value;
end;

//

Unit Description UnitIndex Master Index

procedure TDBAliasDlg_ads.btnCancelClick(Sender: TObject);
begin
  ApplyChanges := False;
end;

//

Unit Description UnitIndex Master Index

procedure TDBAliasDlg_ads.SetMinFormWidth(Value : Integer);
Begin
  If FMinFormWidth <> Value Then FMinFormWidth := Value;
End;

//

Unit Description UnitIndex Master Index

procedure TDBAliasDlg_ads.SetMinFormHeight(Value : Integer);
Begin
  If FMinFormHeight <> Value Then FMinFormHeight := Value;
End;

Constructor TDBAliasDlg_ads.Create(AOwner: TComponent);
Begin
  ProcName  := 'TDBAliasDlg_ads.Create'; Try
  inherited;
  Self.Parent := TWincontrol(AOwner);

  pnlButtons := TPanel.Create(AOwner);
  With pnlButtons Do
  Begin
    Parent        := Self;
    Left          := 0;
    Top           := 219;
    Width         := 242;
    Height        := 54;
    Align         := alBottom;
    BevelOuter    := bvNone;
    BorderWidth   := 10;
    Caption       := '  ';
    ParentColor   := True;
    TabOrder      := 0;
  End;

  pnlBtnSlider := TPanel.Create(AOwner);
  With pnlBtnSlider Do
  Begin
    Parent        := pnlButtons;
    Left          := 73;
    Top           := 10;
    Width         := 159;
    Height        := 34;
    Align         := alRight;
    BevelOuter    := bvNone;
    Caption       := '  ';
    TabOrder      := 0;
  End;

  btnCancel := TBitBtn.Create(AOwner);
  With btnCancel Do
  Begin
    Parent        := pnlBtnSlider;
    Left          := 80;
    Top           := 1;
    Width         := 75;
    Height        := 25;
    Hint          := 'Close this dialog and make no changes.';
    TabOrder      := 0;
    OnClick       := btnCancelClick;
    Kind          := bkCancel;
  End;

  btnOk := TBitBtn.Create(AOwner);
  With btnOk Do
  Begin
    Parent        := pnlBtnSlider;
    Left          := 0;
    Top           := 1;
    Width         := 75;
    Height        := 25;
    Hint          := 'Accept this alias selection.';
    TabOrder      := 1;
    OnClick       := btnOkClick;
    Kind          := bkOK;
  End;

  pnlBaseMessage := TPanel.Create(AOwner);
  With pnlBaseMessage Do
  Begin
    Parent        := Self;
    Left          := 0;
    Top           := 0;
    Width         := 242;
    Height        := 53;
    Align         := alTop;
    BevelOuter    := bvNone;
    BorderWidth   := 10;
    Caption       := 'Select a Database Alias';
    ParentColor   := True;
    TabOrder      := 1;
  End;

  pnlBaseList := TPanel.Create(AOwner);
  With pnlBaseList Do
  Begin
    Parent        := Self;
    Left          := 0;
    Top           := 53;
    Width         := 242;
    Height        := 166;
    Align         := alClient;
    BevelOuter    := bvNone;
    BorderWidth   := 10;
    Caption       := '  ';
    ParentColor   := True;
    TabOrder      := 2;
  End;

  DatabaseAliasList := TListBox.Create(AOwner);
  With DatabaseAliasList Do
  Begin
    Parent        := pnlBaseList;
    Left          := 10;
    Top           := 10;
    Width         := 222;
    Height        := 134;
    Hint          := 'Click an alias to select it.';
    Align         := alClient;
    Font.Color    := clBlack;
    Font.Height   := -12;
    Font.Name     := 'MS Sans Serif';
    Font.Style    := [fsBold];
    IntegralHeight:= True;
    ItemHeight    := 13;
    ParentFont    := False;
    Sorted        := True;
    TabOrder      := 0;
    OnDblClick    := DatabaseAliasListDblClick;
    IsControl     := True;
  End;

  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

Destructor TDBAliasDlg_ads.Destroy;
Begin
  ProcName  := 'TDBAliasDlg_ads.Destroy'; Try
  DatabaseAliasList.Free;
  pnlBaseList      .Free;
  pnlBaseMessage   .Free;
  btnOk            .Free;
  btnCancel        .Free;
  pnlBtnSlider     .Free;
  pnlButtons       .Free;
  inherited Destroy;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

{!~DlgDBAlias_ads

}
//

Unit Description UnitIndex Master Index

Function DlgDBAlias_ads(Var DBName: String): Boolean;
Var
  Dialog    : TForm;
  Form      : TDBAliasDlg_ads;
Begin
  Result    := False;
  Dialog    := nil;
  ProcName  := 'DlgDBAlias_ads'; Try
  Try
    Dialog  := TForm.Create(nil);
    Form       := TDBAliasDlg_ads.Create(Dialog);
    Form.Parent:= Dialog;
    Form.Align := alClient;
    With Dialog Do
    Begin
      Left          := 429;
      Top           := 189;
      Width         := 250;
      Height        := 300;
      BorderIcons   := [];
      Caption       := 'Database Alias Dialog';
      Color         := clBtnFace;
      Font.Color    := clBlack;
      Font.Height   := -11;
      Font.Name     := 'MS Sans Serif';
      Font.Style    := [fsBold];
      OldCreateOrder:= True;
      Position      := poScreenCenter;
      ShowHint      := True;
      OnActivate    := Form.FormActivate;
      OnCreate      := Form.FormCreate;
      OnResize      := Form.FormResize;
      PixelsPerInch := 96;
    End;

    Form.FormCreate(Dialog);
    Form.DatabaseName := DBName;
    Dialog.ShowModal;
    If Dialog.ModalResult = mrOK Then
    Begin
      //Do Something here
      Result := True;
    DBName := Form.DatabaseName;
    End;
  Finally
    Dialog.Free;
  End;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

Initialization
  UnitName := 'ads_DlgDBAlias';
  ProcName := 'Unknown';
End.
//