Bu unit program dabatase alias dialog işleminde kullanılır.
Kod: Tümünü seç
unit ads_DlgDBAlias;
{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@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 maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*
Description: ads_DlgDBAlias.pas.pas
This unit contains
*)
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;
procedure TDBAliasDlg_ads.DatabaseAliasListDblClick(Sender: TObject);
begin
btnOKClick(Sender);
end;
procedure TDBAliasDlg_ads.ReSizeAll;
Begin
If Width < MinFormWidth Then Width := MinFormWidth;
If Height < MinFormHeight Then Height := MinFormHeight;
End;
procedure TDBAliasDlg_ads.FormResize(Sender: TObject);
begin
ReSizeAll;
end;
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;
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;
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;
function TDBAliasDlg_ads.GetDatabaseName: TFileName;
begin
Result := FDatabaseName;
end;
procedure TDBAliasDlg_ads.SetDatabaseName(Value : TFileName);
begin
FDatabaseName := Value;
end;
procedure TDBAliasDlg_ads.btnCancelClick(Sender: TObject);
begin
ApplyChanges := False;
end;
procedure TDBAliasDlg_ads.SetMinFormWidth(Value : Integer);
Begin
If FMinFormWidth <> Value Then FMinFormWidth := Value;
End;
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
}
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.