Bu unit program database alanları ile ilgili işleminde kullanılır.
Kod: Tümünü seç
unit ads_DlgDBFieldName;
{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.
}
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
ads_Exception,
ads_GraphicStrings,
Buttons,
Classes,
Controls,
DBTables,
Dialogs,
ExtCtrls,
FileCtrl,
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;
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;
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;
procedure TFieldNameDlg_ads.FormResize(Sender: TObject);
begin
ProcName := 'TFieldNameDlg_ads.FormResize'; Try
ReSizeAll;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
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;
function TFieldNameDlg_ads.GetDatabaseName: TFileName;
begin
ProcName := 'TFieldNameDlg_ads.GetDatabaseName'; Try
Result := FDatabaseName;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
function TFieldNameDlg_ads.GetTableName: TFileName;
begin
ProcName := 'TFieldNameDlg_ads.GetTableName'; Try
Result := FTableName;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
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;
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;
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;
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;
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;
procedure TFieldNameDlg_ads.ButtonOKClick(Sender: TObject);
begin
ProcName := 'TFieldNameDlg_ads.ButtonOKClick'; Try
ApplyChanges := True;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
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;
Procedure 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;
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;
procedure 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;
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;
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;
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;
procedure TFieldNameDlg_ads.FormDestroy(Sender: TObject);
begin
ProcName := 'TFieldNameDlg_ads.FormDestroy'; Try
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
procedure TFieldNameDlg_ads.AliasTablesClick(Sender: TObject);
begin
ProcName := 'TFieldNameDlg_ads.AliasTablesClick'; Try
AliasTablesClicker;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
procedure TFieldNameDlg_ads.FieldsListBoxClick(Sender: TObject);
begin
ProcName := 'TFieldNameDlg_ads.FieldsListBoxClick'; Try
FieldsListBoxClicker;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TFieldNameDlg_ads.FileListBoxChange(Sender: TObject);
begin
ProcName := 'TFieldNameDlg_ads.FileListBoxChange'; Try
FileListBoxChanger;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
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;
procedure 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;
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;
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;
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;
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;
procedure 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;
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;
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;
procedure TFieldNameDlg_ads.FileListBoxEnter(Sender: TObject);
begin
FileListBox.Tag := 0;
end;
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