Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Database Documentation
Message
 
To
29/06/2006 16:54:46
General information
Forum:
Visual FoxPro
Category:
Reports & Report designer
Environment versions
Visual FoxPro:
VFP 9 SP1
OS:
Windows XP
Network:
Windows 2000 Server
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01132896
Message ID:
01137974
Views:
20
Try www.foxite.com/downloads - "databaselayout.zip" ID : 94
or
save this code to databaselayout.prg :
**********************************************************************
* 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
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform