unit ads_DlgDbSchema;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*
Description: ads_DlgDbSchema.pas.pas
This unit contains
*)
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_DlgDbSchema.pas This unit contains the following routines.
DBDlgSchema_ads TDBSchemaDlg_ads.BitBtn1Click TDBSchemaDlg_ads.ButtonCloseClick TDBSchemaDlg_ads.ButtonFontClick TDBSchemaDlg_ads.ButtonPrintClick TDBSchemaDlg_ads.ButtonTableClick TDBSchemaDlg_ads.CustomPrint TDBSchemaDlg_ads.DisplayStructure TDBSchemaDlg_ads.FormActivate TDBSchemaDlg_ads.FormCreate TDBSchemaDlg_ads.FormResize TDBSchemaDlg_ads.IndicesSelectCell TDBSchemaDlg_ads.IsField TDBSchemaDlg_ads.IsFieldKeyed TDBSchemaDlg_ads.IsTable TDBSchemaDlg_ads.PanelBevel TDBSchemaDlg_ads.ReSizeAll TDBSchemaDlg_ads.SetBevel TDBSchemaDlg_ads.SetBeveled TDBSchemaDlg_ads.SetDatabaseName TDBSchemaDlg_ads.SetMinFormHeight TDBSchemaDlg_ads.SetMinFormWidth TDBSchemaDlg_ads.SetReSizeNow TDBSchemaDlg_ads.SetTableName TDBSchemaDlg_ads.StringPad TDBSchemaDlg_ads.StrucSelectCell
*)
interface
{!~DBDlgSchema_ads
}
Function DBDlgSchema_ads(DatabaseName, TableName: String): Boolean;
implementation
Uses
ads_GraphicStrings,
ads_DlgDBFieldName,
ads_Exception,
Buttons,
Classes,
ComCtrls,
Controls,
{$WARNINGS OFF}Db,{$WARNINGS ON}
DBTables,
Dialogs,
ExtCtrls,
Forms,
Graphics,
Grids,
StdCtrls,
SysUtils,
Windows
;
Var
UnitName : String;
ProcName : String;
const
TFieldType_S_ads : array[TFieldType] of string =
//{Delphi 7}('Unknown','String','Smallint','Integer','Word','Boolean','Float','Currency','BCD','Date','Time','DateTime','Bytes','VarBytes','AutoInc','Blob','Memo','Graphic','FmtMemo','ParadoxOle','DBaseOle','TypedBinary','Cursor','FixedChar','WideString','Largeint','ADT','Array','Reference','DataSet','OraBlob','OraClob','Variant','Interface','IDispatch','Guid','TimeStamp','FMTBcd');
{Delphi XE3-XE10}('Unknown','String','Smallint','Integer','Word','Boolean','Float','Currency','BCD','Date','Time','DateTime','Bytes','VarBytes','AutoInc','Blob','Memo','Graphic','FmtMemo','ParadoxOle','DBaseOle','TypedBinary','Cursor','FixedChar','WideString','Largeint','ADT','Array','Reference','DataSet','OraBlob','OraClob','Variant','Interface','IDispatch','Guid','TimeStamp','FMTBcd','FixedWideChar','WideMemo','OraTimeStamp','OraInterval','LongWord','Shortint','Byte','Extended','Connection','Params','Stream','TimeStampOffset','Object','Single');
(*
{Delphi Seattle 10}
(
ftUnknown,
ftString,
ftSmallint,
ftInteger,
ftWord,
ftBoolean,
ftFloat,
ftCurrency,
ftBCD,
ftDate,
ftTime,
ftDateTime,
ftBytes,
ftVarBytes,
ftAutoInc,
ftBlob,
ftMemo,
ftGraphic,
ftFmtMemo,
ftParadoxOle,
ftDBaseOle,
ftTypedBinary,
ftCursor,
ftFixedChar,
ftWideString,
ftLargeint,
ftADT,
ftArray,
ftReference,
ftDataSet,
ftOraBlob,
ftOraClob,
ftVariant,
ftInterface,
ftIDispatch,
ftGuid,
ftTimeStamp,
ftFMTBcd,
ftFixedWideChar,
ftWideMemo,
ftOraTimeStamp,
ftOraInterval,
ftLongWord,
ftShortint,
ftByte,
ftExtended,
ftConnection,
ftParams,
ftStream,
ftTimeStampOffset,
ftObject,
ftSingle
);
{Delphi XE3}('Unknown','String','Smallint','Integer','Word','Boolean','Float','Currency','BCD','Date','Time','DateTime','Bytes','VarBytes','AutoInc','Blob','Memo','Graphic','FmtMemo','ParadoxOle','DBaseOle','TypedBinary','Cursor','FixedChar','WideString','Largeint','ADT','Array','Reference','DataSet','OraBlob','OraClob','Variant','Interface','IDispatch','Guid','TimeStamp','FMTBcd','FixedWideChar','WideMemo','OraTimeStamp','OraInterval','LongWord','Shortint','Byte','Extended','Connection','Params','Stream','TimeStampOffset','Object','Single');
{Delphi XE3}
(
'Unknown',
'String',
'Smallint',
'Integer',
'Word',
'Boolean',
'Float',
'Currency',
'BCD',
'Date',
'Time',
'DateTime',
'Bytes',
'VarBytes',
'AutoInc',
'Blob',
'Memo',
'Graphic',
'FmtMemo',
'ParadoxOle',
'DBaseOle',
'TypedBinary',
'Cursor',
'FixedChar',
'WideString',
'Largeint',
'ADT',
'Array',
'Reference',
'DataSet',
'OraBlob',
'OraClob',
'Variant',
'Interface',
'IDispatch',
'Guid',
'TimeStamp',
'FMTBcd',
'FixedWideChar',
'WideMemo',
'OraTimeStamp',
'OraInterval',
'LongWord',
'Shortint',
'Byte',
'Extended',
'Connection',
'Params',
'Stream',
'TimeStampOffset',
'Object',
'Single'
);
(
'Unknown',
'String',
'Smallint',
'Integer',
'Word',
'Boolean',
'Float',
'Currency',
'BCD',
'Date',
'Time',
'DateTime',
'Bytes',
'VarBytes',
'AutoInc',
'Blob',
'Memo',
'Graphic',
'Fmted Memo',
'Paradox Ole',
'DBase Ole',
'Typed Binary',
'Cursor',
'FixedChar',
'WideString',
'LargeInt',
'ADT',
'Array',
'Reference',
'DataSet'
);
*)
type
TDBSchemaDlg_ads = Class(TScrollingWinControl)
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Public
Table1: TTable;
PanelButtons: TPanel;
FontDialog1: TFontDialog;
PanelTop: TPanel;
PanelFields: TPanel;
GroupBoxFields: TGroupBox;
Struc: TStringGrid;
PanelIndices: TPanel;
GroupBoxIndices: TGroupBox;
Indices: TStringGrid;
PanelButtonSlider: TPanel;
ButtonPrint: TBitBtn;
ButtonFont: TBitBtn;
ButtonTable: TBitBtn;
ButtonClose: TBitBtn;
SaveDialog: TSaveDialog;
BitBtn1: TBitBtn;
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ButtonCloseClick(Sender: TObject);
procedure ButtonFontClick(Sender: TObject);
procedure ButtonTableClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure ButtonPrintClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure StrucSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure IndicesSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
private
{ Private declarations }
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}
FTable : TTable; {The initial table}
FColorOfGridFixed : TColor; {The color of the fixed cells in the grid}
FColorOfGrid : TColor; {The color of the non fixed cells in the grid}
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}
FDatabaseName: String;
FTableName: String; {Company Phone presented in shareware message}
procedure SetReSizeNow(Value : Boolean);
procedure SetMinFormWidth(Value : Integer);
procedure SetMinFormHeight(Value : Integer);
procedure SetBeveled(Value : Boolean);
procedure SetDatabaseName(Value: String);
procedure SetTableName(Value: String);
Procedure PanelBevel(Beveled : Boolean; Panel: TPanel);
Function IsFieldKeyed(DatabaseName, TableName, FieldName: String): Boolean;
Function IsTable(DatabaseName, TableName: String): Boolean;
Function IsField(DatabaseName, TableName, FieldName: String): Boolean;
Function StringPad(
InputStr,
FillChar: String;
StrLen: Integer;
StrJustify: Boolean): String;
public
{ Public declarations }
procedure ReSizeAll;
procedure SetBevel;
procedure CustomPrint(Print : Boolean);
procedure DisplayStructure;
property IsComponent : Boolean
Read FIsComponent
Write FIsComponent;
property ReSizeNow : Boolean
Read FReSizeNow
Write SetReSizeNow;
published
property Title : String {stores the Dialog Title}
read FTitle
write FTitle;
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 DatabaseName: String
Read FDatabaseName
Write SetDatabaseName;
property TableName: String
Read FTableName
Write SetTableName;
property Table : TTable
Read FTable
Write FTable;
property ColorOfGridFixed : TColor {The color of the fixed cells in the grid}
Read FColorOfGridFixed
Write FColorOfGridFixed;
property ColorOfGrid : TColor {The color of the non fixed cells in the grid}
Read FColorOfGrid
Write FColorOfGrid;
property MinFormWidth : Integer {Sets the form's Minimum Width}
Read FMinFormWidth
Write SetMinFormWidth;
property MinFormHeight : Integer {Sets the form's Minimum Height}
Read FMinFormHeight
Write SetMinFormHeight;
end;
//Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.ReSizeAll;
Var
ColW : Integer;
H : Integer;
Begin
ProcName := 'TDBSchemaDlg_ads.ReSizeAll'; Try
If Width < MinFormWidth Then Width := MinFormWidth;
If Height < MinFormHeight Then Height := MinFormHeight;
If PanelIndices.Visible Then
Begin
H := (Indices.RowCount * Indices.DefaultRowHeight) +
20 + {Height Addition for the GroupBox}
(PanelIndices.BorderWidth * 2) +
(PanelIndices.BevelWidth * 4) +
2 + {Single Line Border Style}
26 + {ScrollBars}
4; {Margin}
PanelIndices.Height := H;
End;
ColW := (Struc.Width div 9) -3;
Struc.ColWidths[0] := ColW * 1;
Struc.ColWidths[1] := ColW * 3;
Struc.ColWidths[2] := ColW * 2;
Struc.ColWidths[3] := ColW * 1;
Struc.ColWidths[4] := ColW * 2;
ColW := (Indices.Width div 8) -1;
Indices.ColWidths[0] := ColW * 2;
Indices.ColWidths[1] := ColW * 2;
Indices.ColWidths[2] := ColW * 2;
Indices.ColWidths[3] := ColW * 2;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.FormActivate(Sender: TObject);
Var
H : Integer;
Begin
ProcName := 'TDBSchemaDlg_ads.FormActivate'; Try
H := 24;
If IsComponent Then
Begin
{}
End
Else
Begin
Caption := Title; {stores the Dialog Title}
Struc.FixedColor := ColorOfGridFixed;
Indices.FixedColor := ColorOfGridFixed;
Struc.Color := ColorOfGrid;
Indices.Color := ColorOfGrid;
If ColorOfGrid = clNavy Then
Begin
Struc .Font.Color:= clWhite;
Indices.Font.Color:= clWhite;
End;
If Font.Size > 0 Then
Begin
H := ((Font.Size * 72) div Font.PixelsPerInch) * 3;
End;
Struc.DefaultRowHeight := H;
Indices.DefaultRowHeight := H;
SetBevel;
If Screen.Width < Width Then
Begin
Left := Screen.Width-26;
End
Else
Begin
Left := (Screen.Width - Width) div 2;
End;
If Screen.Height < Height Then
Begin
Top := Screen.Height-26;
End
Else
Begin
Top := (Screen.Height - Height) div 2;
End;
End;
If Not (Table = nil) Then
Begin
Table1 := Table;
End;
DisplayStructure;
ReSizeAll;
If Not (Table1.TableName = '') Then
Begin
TForm(Owner).
Caption :=
'Structure of ' +
UpperCase(Table1.DatabaseName) +
' : ' +
UpperCase(Table1.TableName);
End
Else
Begin
TForm(Owner).
Caption :=
'Structural Information';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.FormCreate(Sender: TObject);
begin
ProcName := 'TDBSchemaDlg_ads.FormCreate'; Try
Title := 'Structural Information';{stores the Dialog Title}
Beveled := False; {Selected panels have beveling if true}
ButtonsReSize := False; {Buttons resize if true}
ButtonsAlignment := taCenter; {taLeftJustify, taCenter, taRightJustify}
ButtonWidth := 75; {Sets Button Widths}
ButtonSpacer := 10; {Sets Button Spacer Width}
ApplyChanges := False; {True if changes should be made. = mrOk}
Table := nil;
ColorOfGridFixed := clNavy; {The color of the fixed cells in the grid}
ColorOfGrid := clNavy; {The color of the non fixed cells in the grid}
IsComponent := False; {True if Form is part of a component,
False if Form is a standalone form,
Default is False}
FMinFormWidth := 300; {Sets a Minimum FormWidth}
FMinFormHeight := 350; {Sets a Minimum FormHeight}
{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 TDBSchemaDlg_ads.ButtonCloseClick(Sender: TObject); begin ProcName := 'TDBSchemaDlg_ads.ButtonCloseClick'; Try Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.ButtonFontClick(Sender: TObject);
Var
H : Integer;
begin
ProcName := 'TDBSchemaDlg_ads.ButtonFontClick'; Try
H := 24;
FontDialog1.Font := Font;
If FontDialog1.Execute Then
Begin
Font := FontDialog1.Font;
If Font.Size > 0 Then
Begin
H := ((Font.Size * 72) div Font.PixelsPerInch) * 3;
End;
Struc.DefaultRowHeight := H;
Indices.DefaultRowHeight := H;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.ButtonTableClick(Sender: TObject);
Var
RowNo : Integer;
ColNo : Integer;
boRetVal : Boolean;
begin
ProcName := 'TDBSchemaDlg_ads.ButtonTableClick'; Try
boRetVal :=
DlgDBTableName_ads(
FDatabaseName,
FTableName);
If boRetVal Then
Begin
For ColNo := 0 To Struc.ColCount - 1 Do
Begin
For RowNo := 0 To Struc.RowCount - 1 Do
Begin
Struc.Cells[ColNo,RowNo] := '';
End;
End;
For ColNo := 0 To Indices.ColCount - 1 Do
Begin
For RowNo := 0 To Indices.RowCount - 1 Do
Begin
Indices.Cells[ColNo,RowNo] := '';
End;
End;
End
Else
Begin
Exit;
End;
Struc.ColCount := 5;
Struc.RowCount := 2;
Indices.ColCount := 4;
Indices.RowCount:= 2;
Table1.Active := False;
Table1.DatabaseName := DatabaseName;
Table1.TableName := TableName;
Table1.Active := True;
DisplayStructure;
ReSizeAll;
Caption :=
'Structure of ' +
DatabaseName +
' : ' +
TableName;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.DisplayStructure;
Var
RecNo : Integer;
i: Integer;
S: String;
begin
ProcName := 'TDBSchemaDlg_ads.DisplayStructure'; Try
If Table1.TableName = '' Then
Begin
PanelIndices.Visible := False;
Exit;
End;
Try
If Not Table1.Active Then Table1.Active := True;
Except
Exit;
End;
Struc.ColCount := 5;
Struc.RowCount := Table1.FieldCount+1;
For RecNo := 0 to Table1.FieldCount - 1 Do
Begin
Struc.Cells[0,RecNo+1] := IntToStr(Table1.FieldDefs.Items[RecNo].FieldNo);
End;
Struc.Cells[1,0] := 'Field Name';
For RecNo := 0 to Table1.FieldCount - 1 Do
Begin
Struc.Cells[1,RecNo+1] := Table1.FieldDefs.Items[RecNo].Name;
End;
Struc.Cells[2,0] := 'Data Type';
For RecNo := 0 to Table1.FieldCount - 1 Do
Begin
Struc.Cells[2,RecNo+1] :=
TFieldType_S_ads[Table1.FieldDefs.Items[RecNo].DataType];
End;
Struc.Cells[3,0] := 'Size';
For RecNo := 0 to Table1.FieldCount - 1 Do
Begin
Struc.Cells[3,RecNo+1] := IntToStr(Table1.FieldDefs.Items[RecNo].Size);
End;
Struc.Cells[4,0] := 'Key/Req''d';
For RecNo := 0 to Table1.FieldCount - 1 Do
Begin
If IsFieldKeyed(
Table1.DatabaseName,
Table1.TableName,
Table1.FieldDefs.Items[RecNo].Name)
Then
//If Table1.FieldDefs.Items[RecNo].Required Then
Begin
Struc.Cells[4,RecNo+1] := '*';
End;
End;
with Table1 do
begin
Open;
{Refresh IndexDefs object}
IndexDefs.Update;
if IndexDefs.Count > 0 then
begin
PanelIndices.Visible := True;
{Set up columns and rows in grid to match IndexDefs items}
Indices.ColCount := 4;
Indices.RowCount := IndexDefs.Count + 1;
{Set grid column labels to TIndexDef property names}
Indices.Cells[0, 0] := 'Name';
Indices.ColWidths[0] := 200;
Indices.Cells[1, 0] := 'Fields';
Indices.ColWidths[1] := 200;
Indices.Cells[2, 0] := 'Expression';
Indices.ColWidths[2] := 200;
Indices.Cells[3, 0] := 'Options';
Indices.ColWidths[3] := 300;
{Loop through IndexDefs.Items}
for i := 0 to IndexDefs.Count - 1 do begin
{Fill grid cells for current row}
Indices.Cells[0, i + 1] := IndexDefs.Items[i].Name;
Indices.Cells[1, i + 1] := IndexDefs.Items[i].Fields;
Indices.Cells[2, i + 1] := IndexDefs.Items[i].Expression;
if ixPrimary in IndexDefs.Items[i].Options then
S := 'ixPrimary, ';
if ixUnique in IndexDefs.Items[i].Options then
S := S + 'ixUnique, ';
if ixDescending in IndexDefs.Items[i].Options then
S := S + 'ixDescending, ';
if ixCaseInsensitive in IndexDefs.Items[i].Options then
S := S + 'ixCaseInsensitive, ';
if ixExpression in IndexDefs.Items[i].Options then
S := S + 'ixExpression, ';
if S > ' ' then begin
{Get rid of trailing ", "}
System.Delete(S, Length(S) - 1, 2);
Indices.Cells[3, i + 1] := S;
end;
end;
End
Else
Begin
PanelIndices.Visible := False;
end;
end;
If Not (Table1.TableName = '') Then
Begin
TForm(Owner).
Caption :=
'Structure of ' +
UpperCase(Table1.DatabaseName) +
' : ' +
UpperCase(Table1.TableName);
End
Else
Begin
TForm(Owner).
Caption :=
'Structural Information';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Indexprocedure TDBSchemaDlg_ads.FormResize(Sender: TObject); begin ProcName := 'TDBSchemaDlg_ads.FormResize'; Try ReSizeAll; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.ButtonPrintClick(Sender: TObject); begin ProcName := 'TDBSchemaDlg_ads.ButtonPrintClick'; Try CustomPrint(True); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.SetBevel; Begin ProcName := 'TDBSchemaDlg_ads.SetBevel'; Try PanelBevel(Beveled,PanelFields); PanelBevel(Beveled,PanelIndices); PanelBevel(Beveled,PanelButtons); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.SetBeveled(Value : Boolean); Begin ProcName := 'TDBSchemaDlg_ads.SetBeveled'; Try FBeveled := Value; SetBevel; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.SetReSizeNow(Value : Boolean); Begin ProcName := 'TDBSchemaDlg_ads.SetReSizeNow'; Try ReSizeAll; FReSizeNow := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.SetMinFormWidth(Value : Integer); Begin ProcName := 'TDBSchemaDlg_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 TDBSchemaDlg_ads.SetMinFormHeight(Value : Integer); Begin ProcName := 'TDBSchemaDlg_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 TDBSchemaDlg_ads.SetDatabaseName(Value: String); begin ProcName := 'TDBSchemaDlg_ads.SetDatabaseName'; Try FDatabaseName := Value; Table1.DatabaseName := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.SetTableName(Value: String); begin ProcName := 'TDBSchemaDlg_ads.SetTableName'; Try FTableName := Value; Table1.TableName := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
Procedure TDBSchemaDlg_ads.PanelBevel(Beveled : Boolean; Panel: TPanel);
Begin
ProcName := 'TDBSchemaDlg_ads.PanelBevel'; Try
If Not Beveled Then
Begin
Panel.BevelOuter := bvNone;
Panel.BevelInner := bvNone;
Panel.BorderStyle:= bsNone;
End
Else
Begin
Panel.BevelOuter := bvRaised;
Panel.BevelInner := bvLowered;
Panel.BorderStyle:= bsSingle;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function TDBSchemaDlg_ads.IsFieldKeyed(DatabaseName, TableName, FieldName: String): Boolean;
Var
Table : TTable;
FieldIndex : Integer;
i : Integer;
KeyCount : Integer;
LocalTable : Boolean;
ParadoxTbl : Boolean;
DBaseTable : Boolean;
TempString : String;
Begin
Result := False;
ProcName := 'TDBSchemaDlg_ads.IsFieldKeyed'; Try
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then Exit;
TempString := UpperCase(Copy(TableName,Length(TableName)-2,3));
ParadoxTbl := (Pos('.DB',TempString) > 0);
TempString := UpperCase(Copy(TableName,Length(TableName)-3,4));
DBaseTable := (Pos('.DBF',TempString) > 0);
LocalTable := (ParadoxTbl Or DBaseTable);
Table := TTable.Create(nil);
Try
Try
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
KeyCount := Table.IndexFieldCount;
FieldIndex := Table.FieldDefs.IndexOf(FieldName);
If LocalTable Then
Begin
If ParadoxTbl Then
Begin
Result := (FieldIndex < KeyCount);
End
Else
Begin
Table.IndexDefs.UpDate;
For i := 0 To Table.IndexDefs.Count-1 Do
Begin
{Need to check if FieldName is in the Expression listing}
If Pos(UpperCase(FieldName),UpperCase(Table.IndexDefs[i].Expression))>0 Then
Begin
Result := True;
Break;
End;
{Need to check if FieldName is in the Fields listing}
If Pos(UpperCase(FieldName),UpperCase(Table.IndexDefs[i].Fields))>0 Then
Begin
Result := True;
Break;
End;
End;
End;
End
Else
Begin
If Table.
FieldDefs[FieldIndex].
Required
Then
Begin
Result := True;
End;
End;
Except
End;
Finally
Table.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function TDBSchemaDlg_ads.IsTable(DatabaseName, TableName: String): Boolean;
Var
Query : TQuery;
Begin
Result := False;
ProcName := 'TDBSchemaDlg_ads.IsTable'; Try
Query := TQuery.Create(nil);
Try
Try
Query.DatabaseName := DatabaseName;
Query.Sql.Clear;
Query.Sql.Add('Select *');
Query.Sql.Add('From');
If (Pos('.DB', UpperCase(TableName)) > 0) Or
(Pos('.DBF',UpperCase(TableName)) > 0) Then
Begin
Query.Sql.Add('"'+TableName+'"');
End
Else
Begin
Query.Sql.Add(TableName);
End;
Query.Active := True;
Result := True;
Except
End;
Finally
Query.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function TDBSchemaDlg_ads.IsField(DatabaseName, TableName, FieldName: String): Boolean;
Var
Query : TQuery;
T : TTable;
i : Integer;
UpperFN : String;
TestFN : String;
Begin
Result := False;
ProcName:= 'TDBSchemaDlg_ads.IsField'; Try
UpperFN := UpperCase(FieldName);
If Not IsTable(DatabaseName, TableName) Then Exit;
Query := TQuery.Create(nil);
T := TTable.Create(nil);
Try
Try
Query.DatabaseName := DatabaseName;
Query.Sql.Clear;
Query.Sql.Add('Select ');
Query.Sql.Add('a.'+FieldName+' XYZ');
Query.Sql.Add('From');
If (Pos('.DB', UpperCase(TableName)) > 0) Or
(Pos('.DBF',UpperCase(TableName)) > 0) Then
Begin
Query.Sql.Add('"'+TableName+'" a');
End
Else
Begin
Query.Sql.Add(TableName+' a');
End;
Query.Active := True;
Result := True;
Except
Try
T.Active := False;
T.DatabaseName := DatabaseName;
T.TableName := TableName;
T.Active := True;
If T.FieldDefs.IndexOf(FieldName) > -1 Then
Begin
Result := True;
End
Else
Begin
For i := 0 To T.FieldDefs.Count -1 Do
Begin
TestFN := UpperCase(T.FieldDefs[i].Name);
If TestFN = UpperFN Then
Begin
Result := True;
Break;
End;
End;
End;
T.Active := False;
Except
End;
End;
Finally
Query.Free;
T.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
Function TDBSchemaDlg_ads.StringPad(
InputStr,
FillChar: String;
StrLen: Integer;
StrJustify: Boolean): String;
Var
TempFill: String;
Counter : Integer;
Begin
ProcName := 'TDBSchemaDlg_ads.StringPad'; Try
If Not (Length(InputStr) = StrLen) Then
Begin
If Length(InputStr) > StrLen Then
Begin
InputStr := Copy(InputStr,1,StrLen);
End
Else
Begin
TempFill := '';
For Counter := 1 To StrLen-Length(InputStr) Do
Begin
TempFill := TempFill + FillChar;
End;
If StrJustify Then
Begin
{Left Justified}
InputStr := InputStr + TempFill;
End
Else
Begin
{Right Justified}
InputStr := TempFill + InputStr ;
End;
End;
End;
Result := InputStr;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
//Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.CustomPrint(Print : Boolean);
Var
arIndicWidths : Array of Integer;
arStrucWidths : Array of Integer;
Grid : TStringGrid;
inCol : Integer;
inLen : Integer;
inMax : Integer;
inPad : Integer;
inRow : Integer;
lstText : TStringList;
RichText : TRichEdit;
sgCaption : String;
sgTemp : String;
Function IsObject(TestObject: TObject;AncestorClass: TClass): Boolean;
Begin
Result := (TestObject Is AncestorClass);
End;
begin
ProcName := 'TDBSchemaDlg_ads.CustomPrint'; Try
inPad := 5;
sgCaption := '';
If Self.Owner is TForm Then
Begin
sgCaption := TForm(Self.Owner).Caption;
If sgCaption = 'Structural Information' Then
Begin
ShowMessage('There is nothing to print.');
Exit;
End;
End
Else
Begin
If IsObject(Self,TForm) Then
Begin
sgCaption := TForm(Self).Caption;
If sgCaption = 'Structural Information' Then
Begin
ShowMessage('There is nothing to print.');
Exit;
End;
End;
End;
SetLength(arStrucWidths,Struc.ColCount);
SetLength(arIndicWidths,Indices.ColCount);
For inCol := 0 To Struc.ColCount - 1 Do
Begin
arStrucWidths[inCol] := 1;
End;
For inCol := 0 To Indices.ColCount - 1 Do
Begin
arIndicWidths[inCol] := 1;
End;
For inCol := 0 To Struc.ColCount - 1 Do
Begin
inMax := 1;
For inRow := 0 To Struc.RowCount - 1 Do
Begin
sgTemp := Struc.Cells[inCol,inRow];
inLen := Length(sgTemp);
If inLen > inMax Then inMax := inLen;
End;
arStrucWidths[inCol] := inMax+inPad;
End;
For inCol := 0 To Indices.ColCount - 1 Do
Begin
inMax := 1;
For inRow := 0 To Indices.RowCount - 1 Do
Begin
sgTemp := Indices.Cells[inCol,inRow];
inLen := Length(sgTemp);
If inLen > inMax Then inMax := inLen;
End;
arIndicWidths[inCol] := inMax+inPad;
End;
lstText := TStringList.Create();
RichText:= TRichEdit.Create(nil);
Try
RichText.Parent := Application.MainForm;
RichText.Visible := False;
RichText.Font.Name := 'Courier New';
lstText.Clear;
lstText.Add(sgCaption);
lstText.Add('');
lstText.Add('SCHEMA:');
Grid := Struc;
For inRow := 0 To Grid.RowCount - 1 Do
Begin
sgTemp := '';
For inCol := 0 To Grid.ColCount - 1 Do
Begin
inLen := arStrucWidths[inCol];
sgTemp := sgTemp + StringPad(Grid.Cells[inCol,inRow],' ',inLen,True);
End;
lstText.Add(sgTemp);
End;
lstText.Add('');
lstText.Add('INDICES:');
Grid := Indices;
For inRow := 0 To Grid.RowCount - 1 Do
Begin
sgTemp := '';
For inCol := 0 To Grid.ColCount - 1 Do
Begin
inLen := arIndicWidths[inCol];
sgTemp := sgTemp + StringPad(Grid.Cells[inCol,inRow],' ',inLen,True);
End;
lstText.Add(sgTemp);
End;
RichText.Lines.SetText(PChar(lstText.Text));
If Print Then
Begin
RichText.Print(sgCaption);
End
Else
Begin
If SaveDialog.Execute Then
Begin
RichText.Lines.SaveToFile(SaveDialog.FileName);
End;
End;
Finally
lstText .Free;
RichText.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Indexprocedure TDBSchemaDlg_ads.BitBtn1Click(Sender: TObject); begin ProcName := 'TDBSchemaDlg_ads.BitBtn1Click'; Try CustomPrint(False); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.StrucSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); begin ProcName := 'TDBSchemaDlg_ads.StrucSelectCell'; Try CanSelect := False; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TDBSchemaDlg_ads.IndicesSelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
ProcName := 'TDBSchemaDlg_ads.IndicesSelectCell'; Try
CanSelect := False;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
Constructor TDBSchemaDlg_ads.Create(AOwner: TComponent);
Function IsControl(Obj: TObject): Boolean;
Begin
Result := (Obj is TControl);
End;
Begin
ProcName := 'TDBSchemaDlg_ads.Create'; Try
inherited;
Self.Parent := TWincontrol(AOwner);
PanelButtons := TPanel.Create(AOwner);
With PanelButtons Do
Begin
If IsControl(PanelButtons) Then
Begin
Parent := Self;
End;
Left := 0;
Top := 320;
Width := 492;
Height := 58;
Align := alBottom;
BevelOuter := bvNone;
BorderWidth := 10;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
PanelButtonSlider := TPanel.Create(AOwner);
With PanelButtonSlider Do
Begin
Parent := PanelButtons;
Left := 288;
Top := 10;
Width := 194;
Height := 38;
Align := alRight;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
ButtonPrint := TBitBtn.Create(AOwner);
With ButtonPrint Do
Begin
Parent := PanelButtonSlider;
Left := 40;
Top := 0;
Width := 35;
Height := 33;
Hint := 'Print this schema.';
Caption := ' ';
TabOrder := 0;
OnClick := ButtonPrintClick;
StringToGlyph_ads(Glyph,'object TBitmap_ads Bitmap.Data = {'+
' 06020000424D0602000000000000760000002800000028000000140000000100'+
' 0400000000009001000000000000000000001000000010000000000000000000'+
' 8000008000000080800080000000800080008080000080808000C0C0C0000000'+
' FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333'+
' 333333333333333333333333333333333333333333333333333FFF3333333333'+
' FFF33300033333333330003333777FFFFFFFFFF777FF30000000000000000003'+
' 3777777777777777777F30F8888888888888880337F3333333333333337F30F8'+
' 888888888888880337F3333333333333337F30F8888888888899880337F33333'+
' 33333333337F30FFFFFFFFFFFFFFFF0337FFFFFFFFFFFFFFFF7F370077777777'+
' 7777007337777777777777777773333000000000000003333337777777777777'+
' 7F3333300FFFFFFFFFF0033333377F3FFFFFFFF7733333330F00000000F03333'+
' 33337F7777777737F33333330FFFFFFFFFF0333333337F3FFFFFFFF7F3333333'+
' 0F00000000F0333333337F7777777737F33333330FFFFFFFFFF0333333337F3F'+
' F3333337F33333330F00FFFFFFF0333333337F7733333337F33333330FFFFFFF'+
' FFF0333333337FFFFFFFFFF7F333333300000000000033333333777777777777'+
' 3333333333333333333333333333333333333333333333333333333333333333'+
' 33333333333333333333}end');
NumGlyphs := 2;
End;
ButtonFont := TBitBtn.Create(AOwner);
With ButtonFont Do
Begin
Parent := PanelButtonSlider;
Left := 79;
Top := 0;
Width := 35;
Height := 33;
Hint := 'Change the font.';
TabOrder := 1;
OnClick := ButtonFontClick;
StringToGlyph_ads(Glyph,'object TBitmap_ads Bitmap.Data = {'+
' 96010000424D9601000000000000760000002800000018000000180000000100'+
' 0400000000002001000000000000000000001000000010000000000000000000'+
' 8000008000000080800080000000800080008080000080808000C0C0C0000000'+
' FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333'+
' 3333333333333333333333333333333333333700000000000000000000033788'+
' 8888888888888888880337884488888888888888880337884488888888888888'+
' 8803378844888888888717888803378844488888888818888803378844888888'+
' 8888187888033788448888888888111888033788444488558888187888033788'+
' 8888888758881887880337888888888858871111880337888888888858888888'+
' 8803378888888885558888888803378888888888588888888803378888888888'+
' 5788888888033788888888888558888888033788888888888888888888033700'+
' 0000000000000000000337F0CCCCCCCCCCCCCC0F0F0337777777777777777777'+
' 7773333333333333333333333333333333333333333333333333}end');
End;
ButtonTable := TBitBtn.Create(AOwner);
With ButtonTable Do
Begin
Parent := PanelButtonSlider;
Left := 119;
Top := 0;
Width := 35;
Height := 33;
Hint := 'Select a table to view its structure.';
TabOrder := 2;
OnClick := ButtonTableClick;
StringToGlyph_ads(Glyph,'object TBitmap_ads Bitmap.Data = {'+
' 96010000424D9601000000000000760000002800000018000000180000000100'+
' 0400000000002001000000000000000000001000000010000000000000000000'+
' 8000008000000080800080000000800080008080000080808000C0C0C0000000'+
' FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF009999C9999999'+
' 9C99999999999999C99999999C99999999999999C99999999C99999999999999'+
' C99999999C99999999999999C99999999C99999999999999C99999999C999999'+
' 99999999C9999C999C9999C999999999C9999C999C9999C999999999CCCCCCCC'+
' CC9999C9999999999C33333333C999C99999999999C33333333C99C999999000'+
' 000C33333333C0C9999990880FFFCC3333333CC99999908F0F8F8CCCCCCCCCC9'+
' 999990880FFFFFFFFFFFFF099999908F0F8F8F8F8F8F8F09999990880FFFFFFF'+
' FFFFFF099999908F0F8F8F8F8F8F8F09999990880FFFFFFFFFFFFF0999999000'+
' 00000000000000099999908808F8F8F8F8F8F809999990F80888888888888809'+
' 9999900000000000000000099999999999999999999999999999}end');
End;
ButtonClose := TBitBtn.Create(AOwner);
With ButtonClose Do
Begin
Parent := PanelButtonSlider;
Left := 158;
Top := 0;
Width := 35;
Height := 33;
Hint := 'Close this window.';
ModalResult := 1;
TabOrder := 3;
OnClick := ButtonCloseClick;
StringToGlyph_ads(Glyph,'object TBitmap_ads Bitmap.Data = {'+
' 06020000424D0602000000000000760000002800000028000000140000000100'+
' 0400000000009001000000000000000000001000000010000000000000000000'+
' 80000080000000808000800000008000800080800000C0C0C000808080000000'+
' FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00377777777777'+
' 777777773FFFFFFFFFFFF333333F888888888888F7F7F7888888888888883333'+
' 33888888888888877F7F788888888888888F333FF88844444400888FFF444444'+
' 88888888888333888883333334D5007FFF433333333338F888F3338F33333333'+
' 345D50FFFF4333333333388788F3338F3333333334D5D0FFFF433333333338F8'+
' 78F3338F33333333345D50FEFE4333333333388788F3338F3333333334D5D0FF'+
' FF433333333338F878F3338F33333333345D50FEFE4333333333388788F3338F'+
' 3333333334D5D0FFFF433333333338F878F3338F33333333345D50FEFE433333'+
' 3333388788F3338F3333333334D5D0EFEF433333333338F878F3338F33333333'+
' 345D50FEFE4333333333388788F3338F3333333334D5D0EFEF433333333338F8'+
' F8FFFF8F33333333344444444443333333333888888888833333333333333333'+
' 3333333333333333FFFFFF333333333333300000033333333333333888888F33'+
' 333333333330AAAA0333333333333338FFFF8F33333333333330000003333333'+
' 33333338888883333333}end');
NumGlyphs := 2;
End;
BitBtn1 := TBitBtn.Create(AOwner);
With BitBtn1 Do
Begin
Parent := PanelButtonSlider;
Left := 0;
Top := 0;
Width := 35;
Height := 33;
Hint := 'Save the schema to file.';
TabOrder := 4;
OnClick := BitBtn1Click;
StringToGlyph_ads(Glyph,'object TBitmap_ads Bitmap.Data = {'+
' 76010000424D7601000000000000760000002800000020000000100000000100'+
' 04000000000000010000120B0000120B00001000000000000000000000000000'+
' 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000'+
' FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333'+
' 333333FFFFFFFFFFFFF33000077777770033377777777777773F000007888888'+
' 00037F3337F3FF37F37F00000780088800037F3337F77F37F37F000007800888'+
' 00037F3337F77FF7F37F00000788888800037F3337777777337F000000000000'+
' 00037F3FFFFFFFFFFF7F00000000000000037F77777777777F7F000FFFFFFFFF'+
' 00037F7F333333337F7F000FFFFFFFFF00037F7F333333337F7F000FFFFFFFFF'+
' 00037F7F333333337F7F000FFFFFFFFF00037F7F333333337F7F000FFFFFFFFF'+
' 00037F7F333333337F7F000FFFFFFFFF07037F7F33333333777F000FFFFFFFFF'+
' 0003737FFFFFFFFF7F7330099999999900333777777777777733}end');
NumGlyphs := 2;
End;
PanelTop := TPanel.Create(AOwner);
With PanelTop Do
Begin
If IsControl(PanelTop) Then
Begin
Parent := Self;
End;
Left := 0;
Top := 0;
Width := 492;
Height := 320;
Align := alClient;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
PanelFields := TPanel.Create(AOwner);
With PanelFields Do
Begin
Parent := PanelTop;
Left := 0;
Top := 0;
Width := 492;
Height := 223;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 10;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
GroupBoxFields := TGroupBox.Create(AOwner);
With GroupBoxFields Do
Begin
Parent := PanelFields;
Left := 10;
Top := 10;
Width := 472;
Height := 203;
Align := alClient;
Caption := 'Fields';
TabOrder := 0;
End;
Struc := TStringGrid.Create(AOwner);
With Struc Do
Begin
Parent := GroupBoxFields;
Left := 2;
Top := 18;
Width := 468;
Height := 183;
Align := alClient;
BorderStyle := bsNone;
Color := clNavy;
Ctl3D := False;
FixedColor := clNavy;
Font.Color := clWhite;
Font.Height := -13;
Font.Name := 'Arial';
Font.Style := [];
Options := [goColSizing, goColMoving, goThumbTracking];
ParentCtl3D := False;
ParentFont := False;
TabOrder := 0;
OnSelectCell := StrucSelectCell;
(*
ColWidths := (
64
118
109
124
94);
RowHeights := (
24
24
24
24
24);
*)
End;
PanelIndices := TPanel.Create(AOwner);
With PanelIndices Do
Begin
Parent := PanelTop;
Left := 0;
Top := 223;
Width := 492;
Height := 97;
Align := alBottom;
BevelOuter := bvNone;
BorderWidth := 10;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
GroupBoxIndices := TGroupBox.Create(AOwner);
With GroupBoxIndices Do
Begin
Parent := PanelIndices;
Left := 10;
Top := 10;
Width := 472;
Height := 77;
Align := alClient;
Caption := 'Indices';
TabOrder := 0;
End;
Indices := TStringGrid.Create(AOwner);
With Indices Do
Begin
Parent := GroupBoxIndices;
Left := 2;
Top := 18;
Width := 468;
Height := 57;
Align := alClient;
BorderStyle := bsNone;
Color := clNavy;
FixedColor := clNavy;
Font.Color := clWhite;
Font.Height := -13;
Font.Name := 'Arial';
Font.Style := [];
Options := [goRowSizing, goColSizing, goColMoving, goThumbTracking];
ParentFont := False;
TabOrder := 0;
OnSelectCell := IndicesSelectCell;
(*
ColWidths := (
64
118
109
124
94);
*)
End;
Table1 := TTable.Create(AOwner);
With Table1 Do
Begin
If IsControl(Table1) Then
Begin
Parent := Self;
End;
Left := 97;
Top := 209;
End;
FontDialog1 := TFontDialog.Create(AOwner);
With FontDialog1 Do
Begin
If IsControl(FontDialog1) Then
Begin
Parent := Self;
End;
Font.Color := clWindowText;
Font.Height := -17;
Font.Name := 'System';
Font.Style := [];
MinFontSize := 0;
MaxFontSize := 0;
Left := 129;
Top := 209;
End;
SaveDialog := TSaveDialog.Create(AOwner);
With SaveDialog Do
Begin
If IsControl(SaveDialog) Then
Begin
Parent := Self;
End;
DefaultExt := '.rtf';
FileName := 'Schema.rtf';
Filter := 'RichText|*.rtf';
Title := 'Save Schema';
Left := 168;
Top := 208;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Destructor TDBSchemaDlg_ads.Destroy;
Begin
ProcName := 'TDBSchemaDlg_ads.Destroy'; Try
SaveDialog .Free;
FontDialog1 .Free;
Table1 .Free;
Indices .Free;
GroupBoxIndices .Free;
PanelIndices .Free;
Struc .Free;
GroupBoxFields .Free;
PanelFields .Free;
PanelTop .Free;
BitBtn1 .Free;
ButtonClose .Free;
ButtonTable .Free;
ButtonFont .Free;
ButtonPrint .Free;
PanelButtonSlider.Free;
PanelButtons .Free;
inherited Destroy;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~DBDlgSchema_ads
}
//Unit Description UnitIndex Master Index
Function DBDlgSchema_ads(DatabaseName, TableName: String): Boolean;
Var
Dialog : TForm;
Form : TDBSchemaDlg_ads;
Begin
Result := False;
Dialog := nil;
ProcName := 'DBDlgSchema_ads'; Try
Try
Dialog := TForm.Create(nil);
Form := TDBSchemaDlg_ads.Create(Dialog);
Form.Parent:= Dialog;
Form.Align := alClient;
With Dialog Do
Begin
Left := 439;
Top := 172;
Width := 500;
Height := 405;
BorderIcons := [];
Caption := 'Structural Information';
Color := clBtnFace;
Font.Color := clBlack;
Font.Height := -13;
Font.Name := 'Arial';
Font.Style := [];
StringToIcon_ads(Icon,'object TIcon_ads Icon.Data = {'+
' 0000010001002020100000000000E80200001600000028000000200000004000'+
' 0000010004000000000080020000000000000000000000000000000000000000'+
' 0000000080000080000000808000800000008000800080800000C0C0C0008080'+
' 80000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF004444'+
' 4444444444444444444444444444444444444444444B44444444444444444444'+
' 44444444444B4444444444444444444444444B44444B4444B444444444444444'+
' 44444B44444B4444B444444B4444444B444444B4444B444B444444B444444444'+
' B44444B4444B444B44444B44444444444B44444B444B44B44444B44444444444'+
' 44B4444B444B44B4444B444444444444444B4444B44B4B4444B44444B4444444'+
' 4444B444B44B4B444B4444BB444444BB44444B44B44B4B44B444BB4444444444'+
' BB4444B44B4BB44B44BB44444444444444BBB44B4B4BB4B4BB44444444444444'+
' 44444BB4B4BB4BBB44444444444444444444444BBBBBBB444444444444444BBB'+
' BBBBBBBBBBBBBBBBBBBBBBBBBBB4444444444444BBBBBB444444444444444444'+
' 444444BB4BBB4BBBB4444444444444444444BB44BB4BB4B44BB4444444444444'+
' 44BB444B4B4BB44B444BBB4444444444BB4444B4B44B4B44B44444BB444444BB'+
' 44444B44B44B4B444B444444BB4444444444B444B44B4B4444B4444444444444'+
' 444B444B444B44B4444B44444444444444B4444B444B44B44444B44444444444'+
' 4B4444B4444B444B44444B4444444444B44444B4444B444B444444B44444444B'+
' 44444B44444B4444B44444444444444444444B44444B4444B444444444444444'+
' 44444444444B4444444444444444444444444444444444444444444444440000'+
' 0000000000000000000000000000000000000000000000000000000000000000'+
' 0000000000000000000000000000000000000000000000000000000000000000'+
' 0000000000000000000000000000000000000000000000000000000000000000'+
' 000000000000000000000000000000000000000000000000000000000000}end');
OldCreateOrder := True;
Position := poScreenCenter;
ShowHint := True;
OnActivate := Form.FormActivate;
OnCreate := Form.FormCreate;
OnResize := Form.FormResize;
PixelsPerInch := 96;
End;
Form.FormCreate(Dialog);
Form.DatabaseName := DatabaseName;
Form.TableName := TableName;
Dialog.ShowModal;
If Dialog.ModalResult = mrOK Then
Begin
//Do Something here
Result := True;
End;
Finally
Dialog.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Initialization
UnitName := 'ads_DlgDbSchema';
ProcName := 'Unknown';
End.
//