********************************************************************** * Program...: DB-LAYOUT-ENU.PRG * Developer.: Marcos Alejandro Barrios Pérez (Based in the Boudewijn Lutgerink TableLayout.prg program) * Date......: October,2003 * Compiler..: Visual FoxPro 8.0 * Purpose...: Get the table layout of each table in a selected database ********************************************************************** loWord = CREATEOBJECT("Word.Application") IF VARTYPE(loWord) # "O" MESSAGEBOX("Microsoft Word is not installed in your system") ELSE fp = SET("Fullpath") SET FULLPATH ON #DEFINE wdLine 5 #DEFINE wdCell 12 #DEFINE wdColorGris RGB(200,200,200) #DEFINE wdToggle 9999998 #DEFINE wdFieldPage 33 CLOSE TABLES ALL LOCAL laLayout[1], lnI as Integer, lcDB as String , lcTotal_Tables as String lcDB = GETFILE('dbc','Select the database container','Open') OPEN DATABASE (lcDB) SET PATH TO JUSTPATH(lcDB) ADBOBJECTS(SelectedTable, "TABLE") lcTotal_Tables = ALEN(SelectedTable,1) IF lcTotal_Tables > 0 THEN WITH loWord .Documents.add .Visible = .T. .ActiveDocument.PageSetup.Orientation = 1 && wdOrientLandscape WITH .Selection * First Page .ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter .Text = "Database Layout " + ALLTRIM(SET("Database")) .BoldRun .EndKey .MoveDown .BoldRun .TypeParagraph .TypeParagraph .TypeParagraph .ParagraphFormat.Alignment = 0 && wdAlignParagraphLeft .Text = "Database Layout" .Tables.Add(loword.Selection.Range,1,4) .Text = "Name" .Tables(1).Cell(1, 2).select .Text = "Description" .Tables(1).Cell(1, 3).select .Text = "Path" .Tables(1).Cell(1, 4).select .Text = "No. Tables" .Tables(1).Rows(1).Select .BoldRun .InsertRowsBelow .BoldRun .Tables(1).Rows(1).Select .Cells.Shading.BackgroundPatternColor = wdColorGris .Rows.HeadingFormat = wdToggle .Tables(1).Cell(2, 1).select .Text = LOWER(SET("Database")) + '.dbc' .Tables(1).Cell(2, 2).select .Text = "'Not available'" .Tables(1).Cell(2, 3).select .Text = ADDBS(JUSTPATH(lcDB)) .Tables(1).Cell(2, 4).select .Text = lcTotal_Tables .EndKey(wdLine) .MoveDown .TypeParagraph .TypeParagraph .TypeParagraph .ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter .Text = "Tables Layout" .BoldRun .EndKey(wdLine) .TypeParagraph .BoldRun .TypeParagraph .ParagraphFormat.Alignment = 0 && wdAlignParagraphLeft .Tables.Add(loword.Selection.Range,1,4) .Text = "Table Name" .Tables(1).Cell(1, 2).select .Text = "Description" .Tables(1).Cell(1, 3).select .Text = "Path" .Tables(1).Cell(1, 4).select .Text = "No. Fields" .Tables(1).Rows(1).Select .BoldRun .InsertRowsBelow .BoldRun .Tables(1).Rows(1).Select .Cells.Shading.BackgroundPatternColor = wdColorGris .Rows.HeadingFormat = wdToggle FOR x = 1 TO lcTotal_Tables USE SelectedTable(x) IN 0 SELECT SelectedTable(x) AFIELDS(laLayout,ALIAS()) IF AFIELDS(laLayout)>0 .Tables(1).Rows(x + 1).Select .Tables(1).Cell(x + 1, 1).select .Text = LOWER(laLayout[12]) + '.dbf' .Tables(1).Cell(x + 1, 2).select .Text = laLayout[16] .Tables(1).Cell(x + 1, 3).select .Text = JUSTPATH(FULLPATH(DBC())) .Tables(1).Cell(x + 1, 4).select .Text = ALEN(laLayout,1) IF x < lcTotal_Tables .InsertRowsBelow ENDIF ENDIF ENDFOR CLOSE TABLES .EndKey(wdLine) .MoveDown .InsertBreak FOR x = 1 TO lcTotal_Tables USE SelectedTable(x) IN 0 SELECT SelectedTable(x) AFIELDS(laLayout,ALIAS()) IF AFIELDS(laLayout)>0 * Table comment or name .ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter IF !EMPTY(laLayout[16]) .Text = UPPER(TRANSFORM(laLayout[16])) + " (" + LOWER(ALIAS()) + ".dbf)" ELSE .Text = UPPER(ALIAS()) + " (" + LOWER(ALIAS()) + ".dbf)" ENDIF .ItalicRun .BoldRun .EndKey .ItalicRun .BoldRun .TypeParagraph .ParagraphFormat.Alignment = 0 && wdAlignParagraphLeft .Text = "Table Layout" .ItalicRun .EndKey .ItalicRun .TypeParagraph * Add table layout .Tables.Add(loword.Selection.Range,1,4) .Text = "Field Name" .Tables(1).Cell(1, 2).select .Text = "Data Type" .Tables(1).Cell(1, 3).select .Text = "Width" .Tables(1).Cell(1, 4).select .Text = "Decimals" .Tables(1).Rows(1).Select .BoldRun .InsertRowsBelow .BoldRun .Tables(1).Rows(1).Select .Cells.Shading.BackgroundPatternColor = wdColorGris .Rows.HeadingFormat = wdToggle FOR lnI = 1 TO ALEN(laLayout, 1) .Tables(1).Cell(lnI + 1, 1).select .Text = laLayout[lnI, 1] .Tables(1).Cell(lnI + 1, 2).select DO CASE CASE laLayout[lnI, 2] = 'C' .Text = 'Character' CASE laLayout[lnI, 2] = 'D' .Text = 'Date' CASE laLayout[lnI, 2] = 'L' .Text = 'Logical' CASE laLayout[lnI, 2] = 'M' .Text = 'Memo' CASE laLayout[lnI, 2] = 'N' .Text = 'Numeric' CASE laLayout[lnI, 2] = 'F' .Text = 'Float' CASE laLayout[lnI, 2] = 'I' .Text = 'Integer' CASE laLayout[lnI, 2] = 'B' .Text = 'Double' CASE laLayout[lnI, 2] = 'Y' .Text = 'Currency' CASE laLayout[lnI, 2] = 'T' .Text = 'DateTime' CASE laLayout[lnI, 2] = 'G' .Text = 'General' ENDCASE .Tables(1).Cell(lnI + 1, 3).select .Text = TRANSFORM(laLayout[lnI, 3]) .Tables(1).Cell(lnI + 1, 4).select .Text = TRANSFORM(laLayout[lnI, 4]) IF lnI < FCOUNT() .InsertRowsBelow ENDIF ENDFOR .EndKey(wdLine) .MoveDown .TypeParagraph ENDIF * Add indexes information only if a least one index exist FOR lnI = 1 TO TAGCOUNT() IF lnI = 1 THEN .Text = "Indexes information" .ItalicRun .EndKey(wdLine) .ItalicRun .TypeParagraph .Tables.Add(loword.Selection.Range,1,2) .Tables(1).Cell(1, 1).select .Text = "Name" .Tables(1).Cell(1, 2).select .Text = "Expression" .Tables(1).Rows(1).Select .BoldRun .InsertRowsBelow .BoldRun .Tables(1).Rows(1).Select .Cells.Shading.BackgroundPatternColor= wdColorGris ENDIF .Tables(1).Cell(lnI + 1, 1).select .Text = TAG(lnI) .Tables(1).Cell(lnI + 1, 2).select .Text = KEY(lnI) IF lnI < TAGCOUNT() .InsertRowsBelow ENDIF ENDFOR .MoveDown .TypeParagraph .TypeParagraph ENDFOR ENDWITH * Add the pagefooter with the page number .ActiveWindow.ActivePane.View.SeekView = 10 && wdSeekCurrentPageFooter .Selection.ParagraphFormat.Alignment = 2 && wdAlignParagraphRight .Selection.Text = "Page " .Selection.ItalicRun .Selection.EndKey(wdLine) .Selection.Fields.Add(loword.Selection.Range, wdFieldPage) .Selection.ItalicRun .ActiveWindow.ActivePane.View.SeekView = 0 && wdSeekMainDocument ENDWITH ELSE =MESSAGEBOX("The database doesn't have any table", 16, "ERROR") ENDIF SET FULLPATH &fp CLOSE TABLES CLEAR ALL ENDIF