unit ads_DlgDBFieldName;
{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.
}
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_DlgDBFieldName.pas This unit contains the following routines.
DlgDB_Tbl_Fld_Detail_ads DlgDBFieldName_ads DlgDBTableName_ads TFieldNameDlg_ads.AliasesClick TFieldNameDlg_ads.AliasTablesClick TFieldNameDlg_ads.AliasTablesClicker TFieldNameDlg_ads.ButtonCancelClick TFieldNameDlg_ads.ButtonOKClick TFieldNameDlg_ads.ButtonReSizer TFieldNameDlg_ads.DirectoryListBoxClick TFieldNameDlg_ads.DriveComboBoxChange TFieldNameDlg_ads.FieldsListBoxClick TFieldNameDlg_ads.FieldsListBoxClicker TFieldNameDlg_ads.FileListBoxChange TFieldNameDlg_ads.FileListBoxChanger TFieldNameDlg_ads.FileListBoxClick TFieldNameDlg_ads.FileListBoxDblClick TFieldNameDlg_ads.FileListBoxEnter TFieldNameDlg_ads.FormActivate TFieldNameDlg_ads.FormCreate TFieldNameDlg_ads.FormDestroy TFieldNameDlg_ads.FormResize TFieldNameDlg_ads.GetCenterFormLeft TFieldNameDlg_ads.GetCenterFormTop TFieldNameDlg_ads.GetDatabaseName TFieldNameDlg_ads.GetIsAlias TFieldNameDlg_ads.GetTableName TFieldNameDlg_ads.Loaded TFieldNameDlg_ads.OptionsClick TFieldNameDlg_ads.ReSizeAll TFieldNameDlg_ads.rg_OptionsClick TFieldNameDlg_ads.SetBevel TFieldNameDlg_ads.SetBevelCheck TFieldNameDlg_ads.SetBeveled TFieldNameDlg_ads.SetColorOfListBoxes TFieldNameDlg_ads.SetColorOfTableName TFieldNameDlg_ads.SetDatabaseName TFieldNameDlg_ads.SetDataFieldMode TFieldNameDlg_ads.SetIsAlias TFieldNameDlg_ads.SetMinFormHeight TFieldNameDlg_ads.SetMinFormWidth TFieldNameDlg_ads.SetReSizeNow TFieldNameDlg_ads.SetTableName TFieldNameDlg_ads.SetTitle
*)
interface
Function DlgDBTableName_ads(
Var DatabaseName : String; {Database Name}
Var TableName : String {Table Name}
): Boolean;
Function DlgDBFieldName_ads(
Var DatabaseName : String; {Database Name}
Var TableName : String; {Table Name}
Var DataField : String {Field Name}
): Boolean;
Function DlgDB_Tbl_Fld_Detail_ads(
Var DatabaseName : String; {Database Name}
Var TableName : String; {Table Name}
Var DataField : String; {Field Name}
Var Title : String; {stores the Dialog Title}
Var DataFieldMode : Boolean {True if this is a Datafield Dialog}
): Boolean;
implementation
Uses
{$WARNINGS OFF}FileCtrl,{$WARNINGS ON}
ads_Exception,
ads_GraphicStrings,
Buttons,
Classes,
Controls,
DBCtrls,
DBTables,
Dialogs,
ExtCtrls,
Forms,
Graphics,
StdCtrls,
SysUtils
;
Var
UnitName : String;
ProcName : String;
type
TFieldNameDlg_ads = Class(TScrollingWinControl)
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Public
PanelButtons: TPanel;
PanelBaseSelected: TPanel;
GroupBox5: TGroupBox;
PanelLabel: TPanel;
SelectedTable: TLabel;
PanelSpacer: TPanel;
rg_Options: TRadioGroup;
Pages: TPanel;
Page_Path: TPanel;
PanelBaseFilesPlus: TPanel;
PanelBaseDrive: TPanel;
GroupBox3: TGroupBox;
DriveComboBox: TDriveComboBox;
PanelBaseFiles: TPanel;
GroupBox2: TGroupBox;
FileListBox: TFileListBox;
PanelFileType: TPanel;
GroupBox4: TGroupBox;
FilterComboBox: TFilterComboBox;
PanelBaseDir: TPanel;
GroupBox1: TGroupBox;
DirectoryListBox: TDirectoryListBox;
Page_Aliases: TPanel;
PanelTables: TPanel;
GroupBoxTables: TGroupBox;
AliasTables: TListBox;
PanelAliases: TPanel;
GroupBoxAliases: TGroupBox;
Aliases: TListBox;
PanelButtonSlider: TPanel;
ButtonOK: TBitBtn;
ButtonCancel: TBitBtn;
FieldsBase1: TPanel;
FieldsBase2: TPanel;
GroupBoxFields: TGroupBox;
FieldsListBox: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure DirectoryListBoxClick(Sender: TObject);
procedure FileListBoxChange(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure AliasesClick(Sender: TObject);
procedure AliasTablesClick(Sender: TObject);
procedure ButtonCancelClick(Sender: TObject);
procedure rg_OptionsClick(Sender: TObject);
procedure ButtonOKClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FieldsListBoxClick(Sender: TObject);
procedure FileListBoxClick(Sender: TObject);
procedure FileListBoxDblClick(Sender: TObject);
procedure FileListBoxEnter(Sender: TObject);
procedure DriveComboBoxChange(Sender: TObject);
private
{ Private declarations }
fDatabaseName : TFileName;
fTableName : TFileName;
FDataField : String;
fIsAlias : Boolean;
InStartup : Boolean;
FColorOfListBoxes : TColor;
FColorOfTableName : TColor;
FTitle : String; {stores the Dialog Title}
FBeveled : Boolean; {Selected panels have beveling if true}
FButtonsReSize : Boolean; {Buttons resize if true}
FButtonsAlignment : TAlignment; {taLeftJustify, taCenter, taRightJustify}
FButtonWidth : Integer; {Sets Button Widths}
FButtonSpacer : Integer; {Sets Button Spacer Width}
FApplyChanges : Boolean; {True if changes should be made. = mrOk}
FModal : Boolean; {True if Form is being shown modal}
FIsComponent : Boolean; {True if Form is part of a component,
False if Form is a standalone form,
Default is False}
FReSizeNow : Boolean; {Causes the form to resize when the
property is set}
FMinFormWidth : Integer; {Sets a Minimum FormWidth}
FMinFormHeight : Integer; {Sets a Minimum FormHeight}
FDialogComponentName : String;
FDataFieldMode : Boolean; {True if this is a Datafield Dialog,
False if TableName Dialog}
procedure SetReSizeNow(Value : Boolean);
procedure SetMinFormWidth(Value : Integer);
procedure SetMinFormHeight(Value : Integer);
procedure SetBeveled(Value : Boolean);
function GetDatabaseName: TFileName;
procedure SetDatabaseName(Value: TFileName);
function GetTableName: TFileName;
procedure SetTableName(Value: TFileName);
function GetIsAlias: Boolean;
procedure SetIsAlias(Value: Boolean);
Procedure SetColorOfTableName(Value : TColor);
Procedure SetColorOfListBoxes(Value : TColor);
Function SetBevelCheck(PanelName : String): Boolean;
procedure SetDataFieldMode(Value : Boolean);
procedure SetTitle(Value: String);
procedure FieldsListBoxClicker;
procedure AliasTablesClicker;
Function GetCenterFormLeft(FormWidth : Integer): Integer;
Function GetCenterFormTop(FormHeight : Integer): Integer;
procedure ButtonReSizer(
ButtonBase : TPanel;
ButtonSlider : TPanel;
ButtonWidth : Integer;
ButtonSpacer : Integer;
ButtonsReSize : Boolean;
ButtonsAlignment: TAlignment;
Beveled : Boolean);
public
procedure Loaded; OverRide;
procedure FileListBoxChanger;
procedure ReSizeAll;
procedure SetBevel;
property IsComponent : Boolean
Read FIsComponent
Write FIsComponent;
property ReSizeNow : Boolean
Read FReSizeNow
Write SetReSizeNow;
{ Public declarations }
property IsAlias : Boolean
read GetIsAlias
write SetIsAlias;
procedure OptionsClick(i : Integer);
published
{ Published declarations }
property DatabaseName : TFileName
read GetDatabaseName
write SetDatabaseName;
property TableName : TFileName
read GetTableName
write SetTableName;
property DataField : String
read FDataField
write FDataField;
property ColorOfListBoxes : TColor
Read FColorOfListBoxes
Write SetColorOfListBoxes;
property ColorOfTableName : TColor
Read FColorOfTableName
Write SetColorOfTableName;
property Title : String {stores the Dialog Title}
read FTitle
write SetTitle;
property Beveled : Boolean {Selected panels have beveling if true}
Read FBeveled
Write SetBeveled;
property ButtonsReSize : Boolean {Buttons resize if true}
Read FButtonsReSize
Write FButtonsReSize;
property ButtonsAlignment : TAlignment {taLeftJustify, taCenter, taRightJustify}
Read FButtonsAlignment
Write FButtonsAlignment;
property ButtonWidth : Integer {Sets Button Widths}
Read FButtonWidth
Write FButtonWidth;
property ButtonSpacer : Integer {Sets Button Spacer Width}
Read FButtonSpacer
Write FButtonSpacer;
property ApplyChanges: Boolean {True if changes should be made. = mrOk}
Read FApplyChanges
Write FApplyChanges;
property Modal : Boolean {True if Form is being shown modal}
Read FModal
Write FModal;
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;
property DialogComponentName : String {Used in messages to display the }
Read FDialogComponentName {dialog component name}
Write FDialogComponentName;
property DataFieldMode : Boolean {True if this is a Datafield Dialog,}
Read FDataFieldMode {False if TableName Dialog}
Write SetDataFieldMode;
end;
//Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.ReSizeAll;
Var W: Integer;
Begin
ProcName := 'TFieldNameDlg_ads.ReSizeAll'; Try
If Width < MinFormWidth Then Width := MinFormWidth;
If Height < MinFormHeight Then Height := MinFormHeight;
ButtonReSizer(
PanelButtons, {ButtonBase}
PanelButtonSlider, {ButtonSlider}
ButtonWidth, {ButtonWidth}
ButtonSpacer, {ButtonSpacer}
ButtonsReSize, {ButtonsReSize}
ButtonsAlignment, {ButtonsAlignment}
Beveled); {Beveled}
If DataFieldMode Then
Begin
FieldsBase1.Width := Pages.Width div 3;
End
Else
Begin
FieldsBase1.Width := 0;
End;
W := (PanelAliases.Width + PanelTables.Width) div 2;
PanelAliases.Width := W;
PanelBaseFilesPlus.Width := W;
Left := GetCenterFormLeft(Width);
Top := GetCenterFormTop(Height);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.FormCreate(Sender: TObject);
begin
ProcName := 'TFieldNameDlg_ads.FormCreate'; Try
ShowHint := True;
DataFieldMode := True;
FDatabaseName := '';
FTableName := '';
FDataField := '';
DriveComboBox.Align := alClient;
FilterComboBox.Align := alClient;
Aliases.Items.Clear;
AliasTables.Items.Clear;
InStartup := True;
ColorOfListBoxes := clWindow;
ColorOfTableName := clBtnFace;
Title := 'Select a Table';{stores the Dialog Title}
Beveled := False; {Selected panels have beveling if true}
ButtonsReSize := False; {Buttons resize if true}
ButtonsAlignment := taRightJustify; {taLeftJustify, taCenter, taRightJustify}
ButtonWidth := 75; {Sets Button Widths}
ButtonSpacer := 10; {Sets Button Spacer Width}
ApplyChanges := False; {True if changes should be made. = mrOk}
Modal := True; {True if Form is being shown modal}
IsComponent := False; {True if Form is part of a component,
False if Form is a standalone form,
Default is False}
FMinFormWidth := 345; {Sets a Minimum FormWidth}
FMinFormHeight := 361; {Sets a Minimum FormHeight}
FDialogComponentName := 'TTableDialog_ads';
{Set bevel prior to resizing}
SetBevel;
{ReSize at the end of the create}
ReSizeAll;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Indexprocedure TFieldNameDlg_ads.FormResize(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.FormResize'; Try ReSizeAll; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.DirectoryListBoxClick(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.DirectoryListBoxClick'; Try DirectoryListBox.Invalidate; SelectedTable.Invalidate; SelectedTable.Caption := DirectoryListBox.Directory; SelectedTable.Invalidate; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.FormActivate(Sender: TObject);
Var I,J : Integer;
begin
ProcName := 'TFieldNameDlg_ads.FormActivate'; Try
Caption := Title;
SetBevel;
Left := GetCenterFormLeft(Width);
Top := GetCenterFormTop(Height);
ButtonOK.Enabled := False;
SelectedTable.Caption := '';
IsAlias := True;
Try
Session.GetDatabaseNames(Aliases.Items);
Except
Raise Exception.Create('Unable to list the Database Aliases');
End;
If DatabaseName = '' Then
Begin
If TableName = '' Then
Begin
IsAlias := True;
rg_Options.ItemIndex := 0;
OptionsClick(rg_Options.ItemIndex);
End
Else
Begin
IsAlias := False;
rg_Options.ItemIndex := 1;
OptionsClick(rg_Options.ItemIndex);
Try
J := 0;
For I := 0 To FileListBox.Items.Count-1 Do
Begin
If UpperCase(FileListBox.Items[I]) = UpperCase(TableName) Then
Begin
Try
FileListBox.FileName := DirectoryListBox.Directory+'\'+TableName;
J := 1;
Except
End;
End;
End;
If J = 1 Then
Begin
If DataFieldMode Then
Begin
DatabaseName := DirectoryListBox.Directory+'\';
End
Else
Begin
SelectedTable.Caption := TableName;
DatabaseName := DirectoryListBox.Directory+'\';
ButtonOK.Enabled := True;
End;
End
Else
Begin
SelectedTable.Caption := '';
DatabaseName := '';
ButtonOK.Enabled := False;
IsAlias := True;
rg_Options.ItemIndex := 0;
OptionsClick(rg_Options.ItemIndex);
End;
Except
End;
End;
End
Else
Begin
If TableName = '' Then
Begin
If (Pos(':',DatabaseName) > 0) or (Pos('\',DatabaseName) > 0) Then
Begin
IsAlias := False;
rg_Options.ItemIndex := 1;
OptionsClick(rg_Options.ItemIndex);
Try
DirectoryListBox.Directory := DatabaseName;
Except
End;
End
Else
Begin
IsAlias := True;
rg_Options.ItemIndex := 0;
OptionsClick(rg_Options.ItemIndex);
For I := 0 To Aliases.Items.Count -1 Do
Begin
If UpperCase(Aliases.Items[I]) = UpperCase(DatabaseName) Then
Begin
Aliases.ItemIndex := I;
AliasTables.items.Clear;
If Aliases.itemIndex >= 0 then
Begin
Try
Session.GetTableNames
(Aliases.items[Aliases.itemIndex],
'',true,true,AliasTables.items);
Except
End;
End;
Break;
End;
End;
End;
End
Else
Begin
If (Pos(':',DatabaseName) > 0) or (Pos('\',DatabaseName) > 0) Then
Begin
IsAlias := False;
rg_Options.ItemIndex := 1;
OptionsClick(rg_Options.ItemIndex);
Try
DirectoryListBox.Directory := DatabaseName;
If Copy(DatabaseName,Length(DatabaseName),1)='\' Then
Begin
FileListBox.FileName := DatabaseName+TableName;
End
Else
Begin
FileListBox.FileName := DatabaseName+'\'+TableName;
End;
If Not (FileListBox.FileName = '') Then
Begin
If DataFieldMode Then
Begin
InStartUp := False;
FileListBoxChanger;
InStartUp := True;
If Not (FieldsListBox.Items.IndexOf(DataField) = -1) Then
Begin
FieldsListBox.ItemIndex :=
FieldsListBox.Items.IndexOf(DataField);
FieldsListBoxClick(Sender);
End;
End
Else
Begin
SelectedTable.Caption := TableName;
ButtonOK.Enabled := True;
End;
End;
Except
End;
End
Else
Begin
IsAlias := True;
rg_Options.ItemIndex := 0;
OptionsClick(rg_Options.ItemIndex);
For I := 0 To Aliases.Items.Count -1 Do
Begin
If UpperCase(Aliases.Items[I]) = UpperCase(DatabaseName) Then
Begin
Aliases.ItemIndex := I;
AliasTables.items.Clear;
If Aliases.itemIndex >= 0 then
Begin
Try
Session.GetTableNames
(Aliases.items[Aliases.itemIndex],
'',true,true,AliasTables.items);
For J := 0 To AliasTables.Items.Count -1 Do
Begin
If UpperCase(AliasTables.Items[J]) = UpperCase(TableName) Then
Begin
AliasTables.ItemIndex := J;
If DataFieldMode Then
Begin
AliasTablesClick(Sender);
If Not (FieldsListBox.Items.IndexOf(DataField) = -1) Then
Begin
FieldsListBox.ItemIndex :=
FieldsListBox.Items.IndexOf(DataField);
FieldsListBoxClick(Sender);
End;
End
Else
Begin
SelectedTable.Caption := TableName;
ButtonOK.Enabled := True;
End;
End;
End;
Except
End;
End;
Break;
End;
End;
End;
End;
End;
InStartup := False;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Indexfunction TFieldNameDlg_ads.GetDatabaseName: TFileName; begin ProcName := 'TFieldNameDlg_ads.GetDatabaseName'; Try Result := FDatabaseName; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.SetDatabaseName(Value : TFileName); begin ProcName := 'TFieldNameDlg_ads.SetDatabaseName'; Try FDatabaseName := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
function TFieldNameDlg_ads.GetTableName: TFileName; begin ProcName := 'TFieldNameDlg_ads.GetTableName'; Try Result := FTableName; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.SetTableName(Value : TFileName); begin ProcName := 'TFieldNameDlg_ads.SetTableName'; Try FTableName := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
function TFieldNameDlg_ads.GetIsAlias: Boolean; begin Result := False; ProcName := 'TFieldNameDlg_ads.GetIsAlias'; Try Result := FIsAlias; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.SetIsAlias(Value : Boolean); begin ProcName := 'TFieldNameDlg_ads.SetIsAlias'; Try FIsAlias := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.ButtonCancelClick(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.ButtonCancelClick'; Try ApplyChanges := False; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.rg_OptionsClick(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.rg_OptionsClick'; Try OptionsClick(rg_Options.ItemIndex); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.OptionsClick(i : Integer);
Begin
ProcName := 'TFieldNameDlg_ads.OptionsClick'; Try
If i = 0 Then
Begin
If Assigned(Page_Aliases) Then Page_Aliases.BringToFront;
If Assigned(Page_Path) Then Page_Path.SendToBack;
If Not InStartUp Then
Begin
If Assigned(DirectoryListBox) Then DatabaseName := DirectoryListBox.Directory+'\';
If Assigned(FileListBox) Then FileListBox.ItemIndex := -1;
TableName := '';
If Assigned(FieldsListBox) Then FieldsListBox.Items.Clear;
DataField := '';
SelectedTable.Caption := '';
End;
End
Else
Begin
Page_Aliases.SendToBack;
Page_Path.BringToFront;
If Not InStartUp Then
Begin
Aliases.ItemIndex := -1;
DatabaseName := '';
AliasTables.Items.Clear;
TableName := '';
FieldsListBox.Items.Clear;
DataField := '';
SelectedTable.Caption := '';
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Indexprocedure TFieldNameDlg_ads.ButtonOKClick(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.ButtonOKClick'; Try ApplyChanges := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.SetBevel;
Var
i : Integer;
Begin
ProcName := 'TFieldNameDlg_ads.SetBevel'; Try
If Not Beveled Then
Begin
For I := 0 to ComponentCount -1 Do
Begin
If Components[I] is TPanel Then
Begin
If SetBevelCheck(TPanel(Components[I]).Name) Then
Begin
TPanel(Components[I]).BevelOuter := bvNone;
TPanel(Components[I]).BevelInner := bvNone;
End;
End;
End;
End
Else
Begin
For I := 0 to ComponentCount -1 Do
Begin
If Components[I] is TPanel Then
Begin
If SetBevelCheck(TPanel(Components[I]).Name) Then
Begin
TPanel(Components[I]).BevelOuter := bvRaised;
TPanel(Components[I]).BevelInner := bvLowered;
End;
End;
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function TFieldNameDlg_ads.SetBevelCheck(PanelName : String): Boolean;
Begin
Result := True;
ProcName := 'TFieldNameDlg_ads.SetBevelCheck'; Try
{Test for or identify those panels that you do not want to change beveling.
If PanelName is a panel you don't want to change set result to false. }
{example:
If PanelName = 'MasterPanel' Then
Begin
Result := False;
Exit;
End;
}
If PanelName = 'PanelButtonSlider' Then
Begin
Result := False;
Exit;
End;
If PanelName = 'PanelLabel' Then
Begin
Result := False;
Exit;
End;
If PanelName = 'PanelSpacer' Then
Begin
Result := False;
Exit;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master IndexProcedure TFieldNameDlg_ads.SetColorOfTableName(Value : TColor); Begin ProcName := 'TFieldNameDlg_ads.SetColorOfTableName'; Try FColorOfTableName := Value; SelectedTable.Color := Value; PanelSpacer.Color := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index
Procedure TFieldNameDlg_ads.SetColorOfListBoxes(Value : TColor);
Var
I : Integer;
Begin
ProcName := 'TFieldNameDlg_ads.SetColorOfListBoxes'; Try
FColorOfListBoxes := Value;
For I := 0 To ComponentCount -1 Do
Begin
If (Components[I] is TListBox) Then
Begin
TListBox(Components[I]).Color := Value;
End;
DriveComboBox.Color := Value;
FileListBox.Color := Value;
DirectoryListBox.Color := Value;
FilterComboBox.Color := Value;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Indexprocedure TFieldNameDlg_ads.SetBeveled(Value : Boolean); Begin ProcName := 'TFieldNameDlg_ads.SetBeveled'; Try FBeveled := Value; SetBevel; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.SetReSizeNow(Value : Boolean); Begin ProcName := 'TFieldNameDlg_ads.SetReSizeNow'; Try ReSizeAll; FReSizeNow := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.SetMinFormWidth(Value : Integer); Begin ProcName := 'TFieldNameDlg_ads.SetMinFormWidth'; Try If FMinFormWidth <> Value Then FMinFormWidth := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.SetMinFormHeight(Value : Integer); Begin ProcName := 'TFieldNameDlg_ads.SetMinFormHeight'; Try If FMinFormHeight <> Value Then FMinFormHeight := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.FormDestroy(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.FormDestroy'; Try Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.AliasesClick(Sender: TObject);
begin
ProcName := 'TFieldNameDlg_ads.AliasesClick'; Try
AliasTables.items.Clear;
If Aliases.itemIndex >= 0 Then
Begin
Session.GetTableNames
(Aliases.items[Aliases.itemIndex],
'',true,true,AliasTables.items);
FieldsListBox.Items.Clear;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Indexprocedure TFieldNameDlg_ads.AliasTablesClick(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.AliasTablesClick'; Try AliasTablesClicker; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.AliasTablesClicker;
Var
Table : TTable;
begin
ProcName := 'TFieldNameDlg_ads.AliasTablesClicker'; Try
If DataFieldMode Then
Begin
Table := TTable.Create(nil);
Try
FieldsListBox.Items.Clear;
If AliasTables.ItemIndex >= 0 Then
Begin
Table.DatabaseName := Aliases.Items[Aliases.itemIndex];
Table.TableName := AliasTables.Items[AliasTables.ItemIndex];
Table.Active := True;
Table.GetFieldNames(FieldsListBox.Items);
End;
DatabaseName := Aliases.items[Aliases.itemIndex];
TableName := AliasTables.items[AliasTables.itemIndex];
Finally
Table.Free;
End;
End
Else
Begin
SelectedTable.Caption := AliasTables.Items[AliasTables.ItemIndex];
DatabaseName := Aliases.items[Aliases.itemIndex];
TableName := AliasTables.items[AliasTables.itemIndex];
ButtonOK.Enabled := True;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Indexprocedure TFieldNameDlg_ads.FieldsListBoxClick(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.FieldsListBoxClick'; Try FieldsListBoxClicker; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.FileListBoxChange(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.FileListBoxChange'; Try FileListBoxChanger; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.SetDataFieldMode(Value : Boolean);
Begin
ProcName := 'TFieldNameDlg_ads.SetDataFieldMode'; Try
If FDataFieldMode <> Value Then
Begin
FDataFieldMode := Value;
FieldsBase1.Visible := FDataFieldMode;
If FDataFieldMode Then
Begin
GroupBox5.Caption := 'Field Name';
Title := 'Field Selection Dialog';
ButtonCancel.Hint := 'Close this window without selecting a Field.';
ButtonOk.Hint := 'Accept the current Field Name';
End
Else
Begin
GroupBox5.Caption := 'Table Name';
Title := 'Table Selection Dialog';
ButtonCancel.Hint := 'Close this window without selecting a Table.';
ButtonOk.Hint := 'Accept the current Table Name';
End;
ReSizeAll;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.SetTitle(Value: String);
Begin
ProcName := 'TFieldNameDlg_ads.SetTitle'; Try
If FTitle <> Value Then
Begin
FTitle := Value;
Caption := Title;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Indexprocedure TFieldNameDlg_ads.FileListBoxClick(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.FileListBoxClick'; Try FileListBoxEnter(Sender); FileListBoxChanger; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.FileListBoxDblClick(Sender: TObject); begin ProcName := 'TFieldNameDlg_ads.FileListBoxDblClick'; Try FileListBoxEnter(Sender); FileListBoxChanger; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.FileListBoxChanger;
Var
FullPath : String;
PathString : String;
TableString: String;
TableExtn : String;
Table : TTable;
begin
ProcName := 'TFieldNameDlg_ads.FileListBoxChanger'; Try
If InStartup Then Exit;
If DataFieldMode Then
Begin
Table := TTable.Create(nil);
Try
FullPath := FileListBox.FileName;
PathString := ExtractFilePath(FullPath);
TableString := ExtractFileName(FullPath);
TableExtn := UpperCase(ExtractFileExt(TableString));
If TableExtn = '.TXT' Then
Begin
If Not FileExists(Copy(TableString,1,Length(TableString)-3)+'sch') Then
Begin
If FileListBox.Tag = 0 Then
Begin
ShowMessage('This is not a valid text table.');
FileListBox.Tag := 1;
End;
Exit;
End;
End;
If Not (TableString = '') Then
Begin
SelectedTable.Caption := '';
ButtonOK.Enabled := False;
DatabaseName := PathString;
TableName := TableString;
FieldsListBox.Items.Clear;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
Table.GetFieldNames(FieldsListBox.Items);
End
Else
Begin
SelectedTable.Caption := '';
ButtonOK.Enabled := False;
DatabaseName := '';
TableName := '';
End;
Finally
Table.Free;
End;
End
Else
Begin
FullPath := FileListBox.FileName;
PathString := ExtractFilePath(FullPath);
TableString := ExtractFileName(FullPath);
TableExtn := UpperCase(ExtractFileExt(TableString));
If TableExtn = '.TXT' Then
Begin
If Not FileExists(Copy(TableString,1,Length(TableString)-3)+'sch') Then
Begin
If FileListBox.Tag = 0 Then
Begin
ShowMessage('This is not a valid text table.');
FileListBox.Tag := 1;
End;
Exit;
End;
End;
If Not (TableString = '') Then
Begin
SelectedTable.Caption := TableString;
ButtonOK.Enabled := True;
FDatabaseName := PathString;
FTableName := TableString;
End
Else
Begin
SelectedTable.Caption := '';
ButtonOK.Enabled := False;
FDatabaseName := '';
FTableName := '';
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.Loaded;
Var I,J : Integer;
begin
ProcName := 'TFieldNameDlg_ads.Loaded'; Try
If IsComponent Then
Begin
{}
End
Else
Begin
Caption := Title; {stores the Dialog Title}
SetBevel;
Left := GetCenterFormLeft(Width);
Top := GetCenterFormTop(Height);
End;
ButtonOK.Enabled := False;
SelectedTable.Caption := '';
IsAlias := True;
Try
Session.GetDatabaseNames(Aliases.Items);
Except
Raise Exception.Create('Unable to list the Database Aliases');
End;
If DatabaseName = '' Then
Begin
If TableName = '' Then
Begin
{No Default was set}
IsAlias := True;
rg_Options.ItemIndex := 0;
OptionsClick(rg_Options.ItemIndex);
End
Else
Begin
{Implies Table in current directory}
IsAlias := False;
rg_Options.ItemIndex := 1;
OptionsClick(rg_Options.ItemIndex);
Try
{Before setting FileListBox.FileName I am going to check to
see if the file exists and potentially avoid an error}
J := 0;
For I := 0 To FileListBox.Items.Count-1 Do
Begin
If UpperCase(FileListBox.Items[I]) = UpperCase(TableName) Then
Begin
Try
FileListBox.FileName := DirectoryListBox.Directory+'\'+TableName;
J := 1;
Except
End;
End;
End;
If J = 1 Then
Begin
If DataFieldMode Then
Begin
DatabaseName := DirectoryListBox.Directory+'\';
End
Else
Begin
SelectedTable.Caption := TableName;
DatabaseName := DirectoryListBox.Directory+'\';
ButtonOK.Enabled := True;
End;
End
Else
Begin
SelectedTable.Caption := '';
DatabaseName := '';
ButtonOK.Enabled := False;
IsAlias := True;
rg_Options.ItemIndex := 0;
OptionsClick(rg_Options.ItemIndex);
End;
Except
End;
End;
End
Else
Begin
If TableName = '' Then
Begin
{DatabaseName was set but no TableName was provided}
{??? Don't know if the DatabaseName is an alias or a path}
If (Pos(':',DatabaseName) > 0) or (Pos('\',DatabaseName) > 0) Then
Begin
{This is a path DatabaseName}
IsAlias := False;
rg_Options.ItemIndex := 1;
OptionsClick(rg_Options.ItemIndex);
Try
DirectoryListBox.Directory := DatabaseName;
Except
End;
End
Else
Begin
{This is an alias DatabaseName}
IsAlias := True;
rg_Options.ItemIndex := 0;
OptionsClick(rg_Options.ItemIndex);
For I := 0 To Aliases.Items.Count -1 Do
Begin
If UpperCase(Aliases.Items[I]) = UpperCase(DatabaseName) Then
Begin
Aliases.ItemIndex := I;
AliasTables.items.Clear;
If Aliases.itemIndex >= 0 then
Begin
Try
Session.GetTableNames
(Aliases.items[Aliases.itemIndex],
'',true,true,AliasTables.items);
Except
End;
End;
Break;
End;
End;
End;
End
Else
Begin
{DatabaseName and TableName were provided}
{??? Don't know if the DatabaseName is an alias or a path}
If (Pos(':',DatabaseName) > 0) or (Pos('\',DatabaseName) > 0) Then
Begin
{This is a path DatabaseName}
IsAlias := False;
rg_Options.ItemIndex := 1;
OptionsClick(rg_Options.ItemIndex);
Try
DirectoryListBox.Directory := DatabaseName;
If Copy(DatabaseName,Length(DatabaseName),1)='\' Then
Begin
FileListBox.FileName := DatabaseName+TableName;
End
Else
Begin
FileListBox.FileName := DatabaseName+'\'+TableName;
End;
If Not (FileListBox.FileName = '') Then
Begin
If DataFieldMode Then
Begin
InStartUp := False;
FileListBoxChanger;
InStartUp := True;
If Not (FieldsListBox.Items.IndexOf(DataField) = -1) Then
Begin
FieldsListBox.ItemIndex :=
FieldsListBox.Items.IndexOf(DataField);
FieldsListBoxClicker;
End;
End
Else
Begin
SelectedTable.Caption := TableName;
ButtonOK.Enabled := True;
End;
End;
Except
End;
End
Else
Begin
{This is an alias DatabaseName}
IsAlias := True;
rg_Options.ItemIndex := 0;
OptionsClick(rg_Options.ItemIndex);
For I := 0 To Aliases.Items.Count -1 Do
Begin
If UpperCase(Aliases.Items[I]) = UpperCase(DatabaseName) Then
Begin
Aliases.ItemIndex := I;
AliasTables.items.Clear;
If Aliases.itemIndex >= 0 then
Begin
Try
Session.GetTableNames
(Aliases.items[Aliases.itemIndex],
'',true,true,AliasTables.items);
For J := 0 To AliasTables.Items.Count -1 Do
Begin
If UpperCase(AliasTables.Items[J]) = UpperCase(TableName) Then
Begin
AliasTables.ItemIndex := J;
If DataFieldMode Then
Begin
AliasTablesClicker;
If Not (FieldsListBox.Items.IndexOf(DataField) = -1) Then
Begin
FieldsListBox.ItemIndex :=
FieldsListBox.Items.IndexOf(DataField);
FieldsListBoxClicker;
End;
End
Else
Begin
SelectedTable.Caption := TableName;
ButtonOK.Enabled := True;
End;
End;
End;
Except
End;
End;
Break;
End;
End;
End;
End;
End;
Refresh;
InStartup := False;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.ButtonReSizer(
ButtonBase : TPanel;
ButtonSlider : TPanel;
ButtonWidth : Integer;
ButtonSpacer : Integer;
ButtonsReSize : Boolean;
ButtonsAlignment: TAlignment;
Beveled : Boolean);
Var
MinFormWidth : Integer;
NButtons : Integer;
i : Integer;
NSpacers : Integer;
SpacerWidth : Integer;
SpacersWidth : Integer;
W : Integer;
LeftPos : Integer;
Begin
ProcName := 'TFieldNameDlg_ads.ButtonReSizer'; Try
NButtons := ButtonSlider.ControlCount;
If ButtonSpacer > 0 Then
Begin
SpacerWidth := ButtonSpacer;
NSpacers := NButtons +1;
SpacersWidth := ButtonSpacer * NSpacers;
End
Else
Begin
SpacerWidth := 0;
SpacersWidth:= 0;
End;
MinFormWidth :=
SpacersWidth +
(NButtons * ButtonWidth) +
(ButtonBase.BorderWidth * 2) +
(ButtonBase.BevelWidth * 4) +
25;
Try
If ButtonBase.Parent is TForm Then
Begin
If ButtonBase.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
{Not going to set a minimum form width}
End;
Except
End;
End;
Except
End;
End;
Except
End;
End;
Except
End;
If Beveled Then
Begin
ButtonBase.Height :=
(ButtonBase.BorderWidth * 2) +
(ButtonBase.BevelWidth * 4) +
2 {for borderStyle} +
25 {for standard button height} +
3;
End
else
Begin
ButtonBase.Height :=
(ButtonBase.BorderWidth * 2) +
25 {for standard button height} +
4;
End;
If ButtonsReSize Then
Begin
Buttonslider.Align := alClient;
W := (Buttonslider.Width - SpacersWidth) div NButtons;
LeftPos := SpacerWidth;
For i := 0 To NButtons - 1 Do
Begin
ButtonSlider.Controls[i].Align := alNone;
ButtonSlider.Controls[i].Top := 0;
ButtonSlider.Controls[i].Height := 25;
ButtonSlider.Controls[i].Width := W;
ButtonSlider.Controls[i].Left := LeftPos;
LeftPos := LeftPos + W + SpacerWidth;
End;
End
Else
Begin
ButtonSlider.Align := alNone;
If Beveled Then
Begin
ButtonSlider.Top :=
ButtonBase.BorderWidth +
(ButtonBase.BevelWidth * 2)+
1 + {For BorderStyle}
0; {For Margin}
End
Else
Begin
ButtonSlider.Top :=
ButtonBase.BorderWidth +
1; {For Margin}
End;
ButtonSlider.Height := 25;
ButtonSlider.Width :=
SpacersWidth +
(NButtons * ButtonWidth);
If (Not Beveled) Then
Begin
{Align totally left with not leftmost spacer}
If ButtonsAlignment = taLeftJustify Then
Begin
LeftPos := 0;
End
Else
Begin
If ButtonsAlignment = taRightJustify Then
Begin
{Align totally Right with not rightmost spacer}
LeftPos := 2 * SpacerWidth;
End
Else
Begin
LeftPos := SpacerWidth;
End;
End;
End
Else
Begin
LeftPos := SpacerWidth;
End;
For i := 0 To NButtons - 1 Do
Begin
ButtonSlider.Controls[i].Align := alNone;
ButtonSlider.Controls[i].Top := 0;
ButtonSlider.Controls[i].Height := 25;
ButtonSlider.Controls[i].Width := ButtonWidth;
ButtonSlider.Controls[i].Left := LeftPos;
LeftPos := LeftPos + ButtonWidth+ SpacerWidth;
End;
If ButtonsAlignment = taLeftJustify Then ButtonSlider.Align := alLeft;
If ButtonsAlignment = taRightJustify Then ButtonSlider.Align := alRight;
If ButtonsAlignment = taCenter Then
Begin
ButtonSlider.Align := alNone;
ButtonSlider.Left :=
(ButtonBase.Width -
ButtonSlider.Width) div 2;
End;
End;
ButtonBase.Refresh;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Indexprocedure TFieldNameDlg_ads.FieldsListBoxClicker; begin ProcName := 'TFieldNameDlg_ads.FieldsListBoxClicker'; Try DataField := FieldsListBox.items[FieldsListBox.itemIndex]; SelectedTable.Caption := DataField; ButtonOK.Enabled := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
Function TFieldNameDlg_ads.GetCenterFormLeft(FormWidth : Integer): Integer;
Begin
Result := 614;
ProcName := 'TFieldNameDlg_ads.GetCenterFormLeft'; Try
If Screen.Width < FormWidth Then
Begin
Result := Screen.Width-26;
End
Else
Begin
Result := (Screen.Width - FormWidth) div 2;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function TFieldNameDlg_ads.GetCenterFormTop(FormHeight : Integer): Integer;
Begin
Result := 454;
ProcName := 'TFieldNameDlg_ads.GetCenterFormTop'; Try
If Screen.Height < FormHeight Then
Begin
Result := Screen.Height-26;
End
Else
Begin
Result := (Screen.Height - FormHeight) div 2;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Indexprocedure TFieldNameDlg_ads.FileListBoxEnter(Sender: TObject); begin FileListBox.Tag := 0; end; //Unit Description UnitIndex Master Index
procedure TFieldNameDlg_ads.DriveComboBoxChange(Sender: TObject);
begin
DirectoryListBox.Drive := DriveComboBox.Drive;
end;
Constructor TFieldNameDlg_ads.Create(AOwner: TComponent);
Begin
ProcName := 'TFieldNameDlg_ads.Create'; Try
inherited;
Self.Parent := TWincontrol(AOwner);
PanelButtons := TPanel.Create(AOwner);
With PanelButtons Do
Begin
Parent := Self;
Left := 0;
Top := 305;
Width := 571;
Height := 41;
Align := alBottom;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
PanelButtonSlider := TPanel.Create(AOwner);
With PanelButtonSlider Do
Begin
Parent := PanelButtons;
Left := 4;
Top := 4;
Width := 563;
Height := 33;
Align := alClient;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
ButtonOK := TBitBtn.Create(AOwner);
With ButtonOK Do
Begin
Parent := PanelButtonSlider;
Left := 387;
Top := 0;
Width := 75;
Height := 27;
Hint := 'Accept the current Table Name';
TabOrder := 0;
OnClick := ButtonOKClick;
Kind := bkOK;
End;
ButtonCancel := TBitBtn.Create(AOwner);
With ButtonCancel Do
Begin
Parent := PanelButtonSlider;
Left := 471;
Top := -1;
Width := 75;
Height := 27;
Hint := 'Close this window without selecting a table.';
TabOrder := 1;
OnClick := ButtonCancelClick;
Kind := bkCancel;
End;
PanelBaseSelected := TPanel.Create(AOwner);
With PanelBaseSelected Do
Begin
Parent := Self;
Left := 0;
Top := 0;
Width := 571;
Height := 57;
Align := alTop;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
GroupBox5 := TGroupBox.Create(AOwner);
With GroupBox5 Do
Begin
Parent := PanelBaseSelected;
Left := 4;
Top := 4;
Width := 438;
Height := 49;
Align := alClient;
Caption := 'Field Name';
TabOrder := 0;
End;
PanelLabel := TPanel.Create(AOwner);
With PanelLabel Do
Begin
Parent := GroupBox5;
Left := 18;
Top := 18;
Width := 418;
Height := 29;
Align := alClient;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
SelectedTable := TLabel.Create(AOwner);
With SelectedTable Do
Begin
Parent := PanelLabel;
Left := 0;
Top := 0;
Width := 418;
Height := 29;
Align := alClient;
AutoSize := False;
Color := clBtnFace;
ParentColor := False;
End;
PanelSpacer := TPanel.Create(AOwner);
With PanelSpacer Do
Begin
Parent := GroupBox5;
Left := 2;
Top := 18;
Width := 16;
Height := 29;
Align := alLeft;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 1;
End;
rg_Options := TRadioGroup.Create(AOwner);
With rg_Options Do
Begin
Parent := PanelBaseSelected;
Left := 442;
Top := 4;
Width := 125;
Height := 49;
Align := alRight;
Caption := 'Select Table by';
Columns := 2;
TabOrder := 1;
OnClick := rg_OptionsClick;
Items.Clear;
With Items Do
Begin
Try Add('Alias'); Except End;
Try Add('Path'); Except End;
End;
ItemIndex := 0;
End;
Pages := TPanel.Create(AOwner);
With Pages Do
Begin
Parent := Self;
Left := 0;
Top := 57;
Width := 571;
Height := 248;
Align := alClient;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 2;
End;
Page_Path := TPanel.Create(AOwner);
With Page_Path Do
Begin
Parent := Pages;
Left := 0;
Top := 0;
Width := 381;
Height := 248;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
PanelBaseFilesPlus := TPanel.Create(AOwner);
With PanelBaseFilesPlus Do
Begin
Parent := Page_Path;
Left := 4;
Top := 4;
Width := 182;
Height := 240;
Align := alLeft;
BevelOuter := bvNone;
Caption := 'PanelBaseFilesPlus';
ParentColor := True;
TabOrder := 0;
End;
PanelBaseDrive := TPanel.Create(AOwner);
With PanelBaseDrive Do
Begin
Parent := PanelBaseFilesPlus;
Left := 0;
Top := 0;
Width := 182;
Height := 58;
Align := alTop;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
GroupBox3 := TGroupBox.Create(AOwner);
With GroupBox3 Do
Begin
Parent := PanelBaseDrive;
Left := 4;
Top := 4;
Width := 174;
Height := 50;
Align := alClient;
Caption := 'Drives';
TabOrder := 0;
End;
DriveComboBox := TDriveComboBox.Create(AOwner);
With DriveComboBox Do
Begin
Parent := GroupBox3;
Left := 6;
Top := 19;
Width := 206;
Height := 22;
Hint := 'Click on a drive to select it.';
DirList := DirectoryListBox;
TabOrder := 0;
OnChange := DriveComboBoxChange;
End;
PanelBaseFiles := TPanel.Create(AOwner);
With PanelBaseFiles Do
Begin
Parent := PanelBaseFilesPlus;
Left := 0;
Top := 58;
Width := 182;
Height := 124;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
GroupBox2 := TGroupBox.Create(AOwner);
With GroupBox2 Do
Begin
Parent := PanelBaseFiles;
Left := 4;
Top := 4;
Width := 174;
Height := 116;
Align := alClient;
Caption := 'Files';
TabOrder := 0;
End;
FileListBox := TFileListBox.Create(AOwner);
With FileListBox Do
Begin
Parent := GroupBox2;
Left := 2;
Top := 18;
Width := 170;
Height := 96;
Hint := 'Click on a table name to select it.';
Align := alClient;
ItemHeight := 16;
Mask := '*.db;*.dbf;*.txt;';
TabOrder := 0;
OnChange := FileListBoxChange;
OnClick := FileListBoxClick;
OnDblClick := FileListBoxDblClick;
OnEnter := FileListBoxEnter;
OnExit := FileListBoxEnter;
End;
PanelFileType := TPanel.Create(AOwner);
With PanelFileType Do
Begin
Parent := PanelBaseFilesPlus;
Left := 0;
Top := 182;
Width := 182;
Height := 58;
Align := alBottom;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 2;
End;
GroupBox4 := TGroupBox.Create(AOwner);
With GroupBox4 Do
Begin
Parent := PanelFileType;
Left := 4;
Top := 4;
Width := 174;
Height := 50;
Align := alClient;
Caption := 'File Type';
TabOrder := 0;
End;
FilterComboBox := TFilterComboBox.Create(AOwner);
With FilterComboBox Do
Begin
Parent := GroupBox4;
Left := 0;
Top := 19;
Width := 212;
Height := 24;
Hint := 'Choose the tables to display.';
FileList := FileListBox;
Filter :=
'All Tables|*.db;*.dbf;*.txt;*.xml;*.cds|'+
'ClientDataSet Tables|*.cds;*.xml|'+
'DBase Tables|*.dbf|'+
'Paradox Tables|*.db|'+
'Text Tables|*.txt|'+
'XML Tables|*.xml';
TabOrder := 0;
End;
PanelBaseDir := TPanel.Create(AOwner);
With PanelBaseDir Do
Begin
Parent := Page_Path;
Left := 186;
Top := 4;
Width := 191;
Height := 240;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
GroupBox1 := TGroupBox.Create(AOwner);
With GroupBox1 Do
Begin
Parent := PanelBaseDir;
Left := 4;
Top := 4;
Width := 183;
Height := 232;
Align := alClient;
Caption := 'Directories';
TabOrder := 0;
End;
DirectoryListBox := TDirectoryListBox.Create(AOwner);
With DirectoryListBox Do
Begin
Parent := GroupBox1;
Left := 2;
Top := 18;
Width := 179;
Height := 212;
Hint := 'Doubleclick on a directory to open it.';
Align := alClient;
FileList := FileListBox;
ItemHeight := 16;
TabOrder := 0;
End;
Page_Aliases := TPanel.Create(AOwner);
With Page_Aliases Do
Begin
Parent := Pages;
Left := 0;
Top := 0;
Width := 381;
Height := 248;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
PanelTables := TPanel.Create(AOwner);
With PanelTables Do
Begin
Parent := Page_Aliases;
Left := 188;
Top := 4;
Width := 189;
Height := 240;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
GroupBoxTables := TGroupBox.Create(AOwner);
With GroupBoxTables Do
Begin
Parent := PanelTables;
Left := 4;
Top := 4;
Width := 181;
Height := 232;
Align := alClient;
Caption := 'Tables';
TabOrder := 0;
End;
AliasTables := TListBox.Create(AOwner);
With AliasTables Do
Begin
Parent := GroupBoxTables;
Left := 2;
Top := 18;
Width := 177;
Height := 212;
Hint := 'Click on a table to select it.';
Align := alClient;
ItemHeight := 16;
Sorted := True;
TabOrder := 0;
OnClick := AliasTablesClick;
End;
PanelAliases := TPanel.Create(AOwner);
With PanelAliases Do
Begin
Parent := Page_Aliases;
Left := 4;
Top := 4;
Width := 184;
Height := 240;
Align := alLeft;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
GroupBoxAliases := TGroupBox.Create(AOwner);
With GroupBoxAliases Do
Begin
Parent := PanelAliases;
Left := 4;
Top := 4;
Width := 176;
Height := 232;
Align := alClient;
Caption := 'Aliases';
TabOrder := 0;
End;
Aliases := TListBox.Create(AOwner);
With Aliases Do
Begin
Parent := GroupBoxAliases;
Left := 2;
Top := 18;
Width := 172;
Height := 212;
Hint := 'Click on an alias to select it.';
Align := alClient;
ItemHeight := 16;
TabOrder := 0;
OnClick := AliasesClick;
End;
FieldsBase1 := TPanel.Create(AOwner);
With FieldsBase1 Do
Begin
Parent := Pages;
Left := 381;
Top := 0;
Width := 190;
Height := 248;
Align := alRight;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 2;
End;
FieldsBase2 := TPanel.Create(AOwner);
With FieldsBase2 Do
Begin
Parent := FieldsBase1;
Left := 4;
Top := 4;
Width := 182;
Height := 240;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
GroupBoxFields := TGroupBox.Create(AOwner);
With GroupBoxFields Do
Begin
Parent := FieldsBase2;
Left := 4;
Top := 4;
Width := 174;
Height := 232;
Align := alClient;
Caption := 'Fields';
TabOrder := 0;
End;
FieldsListBox := TListBox.Create(AOwner);
With FieldsListBox Do
Begin
Parent := GroupBoxFields;
Left := 2;
Top := 18;
Width := 170;
Height := 212;
Hint := 'Click on a field to select it.';
Align := alClient;
ItemHeight := 16;
TabOrder := 0;
OnClick := FieldsListBoxClick;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Destructor TFieldNameDlg_ads.Destroy;
Begin
ProcName := 'TFieldNameDlg_ads.Destroy'; Try
FieldsListBox .Free;
GroupBoxFields .Free;
FieldsBase2 .Free;
FieldsBase1 .Free;
Aliases .Free;
GroupBoxAliases .Free;
PanelAliases .Free;
AliasTables .Free;
GroupBoxTables .Free;
PanelTables .Free;
Page_Aliases .Free;
DirectoryListBox .Free;
GroupBox1 .Free;
PanelBaseDir .Free;
FilterComboBox .Free;
GroupBox4 .Free;
PanelFileType .Free;
FileListBox .Free;
GroupBox2 .Free;
PanelBaseFiles .Free;
DriveComboBox .Free;
GroupBox3 .Free;
PanelBaseDrive .Free;
PanelBaseFilesPlus.Free;
Page_Path .Free;
Pages .Free;
rg_Options .Free;
PanelSpacer .Free;
SelectedTable .Free;
PanelLabel .Free;
GroupBox5 .Free;
PanelBaseSelected .Free;
ButtonCancel .Free;
ButtonOK .Free;
PanelButtonSlider .Free;
PanelButtons .Free;
inherited Destroy;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function DlgDB_Tbl_Fld_Detail_ads(
Var DatabaseName : String; {Database Name}
Var TableName : String; {Table Name}
Var DataField : String; {Field Name}
Var Title : String; {stores the Dialog Title}
Var DataFieldMode : Boolean {True if this is a Datafield Dialog}
): Boolean;
Var
Dialog : TForm;
Form : TFieldNameDlg_ads;
Begin
Result := False;
Dialog := nil;
ProcName := 'DlgDBFieldName_ads'; Try
Try
Dialog := TForm.Create(nil);
Form := TFieldNameDlg_ads.Create(Dialog);
Form.Parent:= Dialog;
Form.Align := alClient;
With Dialog Do
Begin
Left := 367;
Top := 209;
Width := 579;
Height := 373;
BorderIcons := [biMaximize];
Caption := 'Select a Field';
Color := clBtnFace;
Font.Color := clWindowText;
Font.Height := -14;
Font.Name := 'System';
Font.Style := [];
OldCreateOrder := True;
Position := poScreenCenter;
OnActivate := Form.FormActivate;
OnCreate := Form.FormCreate;
OnDestroy := Form.FormDestroy;
OnResize := Form.FormResize;
PixelsPerInch := 96;
End;
Form.FormCreate(Dialog);
Form.DatabaseName := DatabaseName; {Database Name}
Form.TableName := TableName; {Table Name}
Form.DataField := DataField; {Field Name}
Dialog.Caption := Title; {stores the Dialog Title}
Form.DataFieldMode := DataFieldMode; {True if this is a Datafield Dialog}
Form.Show;
Dialog.ShowModal;
If Dialog.ModalResult = mrOK Then
Begin
//Do Something here
Result := True;
DatabaseName := Form.DatabaseName; {Database Name}
TableName := Form.TableName; {Table Name}
If DataFieldMode Then
Begin
DataField := Form.DataField; {Field Name}
End
Else
Begin
DataField := ''; {Field Name}
End;
End;
Finally
Dialog.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function DlgDBTableName_ads(
Var DatabaseName : String; {Database Name}
Var TableName : String {Table Name}
): Boolean;
Var
DataField : String; {Field Name}
Title : String; {stores the Dialog Title}
DataFieldMode : Boolean; {True if this is a Datafield Dialog}
Begin
Result := False;
ProcName := 'DlgDBTableName_ads'; Try
DataField := '';
Title := 'Select a Table';
DataFieldMode := False;
Result :=
DlgDB_Tbl_Fld_Detail_ads(
DatabaseName , {Database Name}
TableName , {Table Name}
DataField , {Field Name}
Title , {stores the Dialog Title}
DataFieldMode {True if this is a Datafield Dialog}
);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function DlgDBFieldName_ads(
Var DatabaseName : String; {Database Name}
Var TableName : String; {Table Name}
Var DataField : String {Field Name}
): Boolean;
Var
Title : String; {stores the Dialog Title}
DataFieldMode : Boolean; {True if this is a Datafield Dialog}
Begin
Result := False;
ProcName := 'DlgDBFieldName_ads'; Try
Title := 'Select a Field';
DataFieldMode := True;
Result :=
DlgDB_Tbl_Fld_Detail_ads(
DatabaseName , {Database Name}
TableName , {Table Name}
DataField , {Field Name}
Title , {stores the Dialog Title}
DataFieldMode {True if this is a Datafield Dialog}
);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Initialization
UnitName := 'ads_DlgDBFieldName';
ProcName := 'Unknown';
End.
//