// Use dbd.rv // DBD - Report object Use APS.pkg // Auto Positioning and Sizing classes for VDF Use ApsRptVw.pkg // aps.ReportView use cWinReport2.pkg Use WinPrint_ImageDefinition.pkg object oDbdReport is a aps.ReportView label "DB Description - Printed report" on_key kcancel send close_panel property integer phDbdSystem public 0 property integer phDbdView public 0 set Border_Style to BORDER_THICK // Make panel resizeable object oTableSelect is a aps.Group label "Select tables" set peAnchors to (anTop+anLeft+anRight+anBottom) set p_auto_column to 0 object oGrid is a aps.Grid send GridPrepare_AddCheckBoxColumn send GridPrepare_AddColumn "#" AFT_ASCII4 send GridPrepare_AddColumn "Table" AFT_ASCII30 send GridPrepare_AddColumn "Name" AFT_ASCII12 send GridPrepare_Apply self set select_mode to MULTI_SELECT set highlight_row_state to true on_key KNEXT_ITEM send switch on_key KPREVIOUS_ITEM send switch_back set peAnchors to (anTop+anLeft+anRight+anBottom) set peResizeColumn to rcSelectedColumn set piResizeColumn to 2 procedure HandleTable integer liId string lsName string lsLogic_name string lsPhysic_name integer liNot_found string lsOpenas_path string lsDescription integer liBase get item_count to liBase send Grid_AddCheckBoxItem self DFTRUE set aux_value item liBase to liId send add_item msg_none liId send add_item msg_none lsName send add_item msg_none lsLogic_name end_procedure procedure fill_list integer lhTableAccess move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess send delete_data set dynamic_update_state to false send Callback_All_Tables of lhTableAccess MSG_HandleTable self set dynamic_update_state to true send Grid_SetEntryState self DFFALSE end_procedure procedure select_toggling integer itm# integer i# integer ci# iColumns get Grid_Columns self to iColumns get current_item to ci# move ((ci#/iColumns)*iColumns) to ci# // Redirect to first column forward send select_toggling ci# i# end_procedure end_object procedure DoSelectAll send Grid_RowSelectAll (oGrid(self)) end_procedure procedure DoSelectNone send Grid_RowDeselectAll (oGrid(self)) end_procedure object oBtn1 is a aps.Multi_Button set peAnchors to (anRight+anBottom) on_item "Select all" send DoSelectAll end_object object oBtn1 is a aps.Multi_Button set peAnchors to (anRight+anBottom) on_item "Clear" send DoSelectNone end_object send aps_locate_multi_buttons end_object Object oOther is a aps.Group Label "Other:" snap SL_DOWN set peAnchors to (anLeft+anRight+anBottom) object oIncludeFieldAndIndex is a aps.CheckBox label "Include field and index descriptions" set checked_state to true end_object end_object Object oDestination is a aps.RadioGroup Label "Output Device:" snap SL_DOWN set peAnchors to (anLeft+anRight+anBottom) send tab_column_define 1 60 55 jmode_left Object oScreen is a aps.Radio label "Screen" Set Status_Help to "Preview the report to screen" End_Object Object oPrinter is a aps.Radio snap SL_RIGHT_SPACE label "Printer" Set Status_Help to "Send the report to the default printer" End_Object Procedure Notify_Select_State Integer iNewItem Integer iOldItem Forward Send Notify_Select_State iNewItem iOldItem If (iNewItem=0) Set Output_Device_Mode To PRINT_TO_WINDOW Else Set Output_Device_Mode To PRINT_TO_PRINTER End_Procedure Set Current_Radio to 0 End_Object // oDestination send aps_size_identical_max (oTableSelect(self)) (oDestination(self)) SL_HORIZONTAL send aps_size_identical_max (oOther(self)) (oDestination(self)) SL_HORIZONTAL on_key ksave_record send Run_Report object oBtn1 is a aps.Multi_Button set peAnchors to (anRight+anBottom) on_item "Run report" send Run_Report end_object object oBtn2 is a aps.Multi_Button set peAnchors to (anRight+anBottom) procedure DoSetup integer hoReport Get Report_Object_ID To hoReport Send DFPrintSetup To hoReport end_procedure on_item "Setup" send DoSetup end_object object oBtn3 is a aps.Multi_Button set peAnchors to (anRight+anBottom) on_item "Close" send close_panel end_object send aps_locate_multi_buttons Object oReport is a cWinReport2 Set No_Finding_State to TRUE property integer piId property string psName property string psLogic_name property string psPhysic_name property integer piNot_found property string psOpenas_path property string psDescription procedure PrintTable integer liId string lsName string lsLogic_name string lsPhysic_name integer liNot_found string lsOpenas_path string lsDescription integer liGrb set piId to liId set psName to lsName set psLogic_name to lsLogic_name set psPhysic_name to lsPhysic_name set piNot_found to liNot_found set psOpenas_path to lsOpenas_path set psDescription to lsDescription get handle_report_line to liGrb end_procedure procedure PrintSelectedTable integer liRow integer liBase integer liFile lhTableAccess move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess get aux_value of (oGrid(oTableSelect(self))) liBase to liFile send Callback_One_Table of lhTableAccess liFile msg_PrintTable self end_procedure Function Start_Report returns integer integer liOk string lsTitle move "DB Description" to lsTitle set Report_Title to lsTitle // set Report_SubTitle to lsTitle Set No_Finding_State to TRUE Forward Get Start_Report to liOk if (liOk=RPT_OK) begin send DFSetMargins to WinPrintID 2.5 1.5 1.5 1.5 send Grid_RowCallBackSelected (oGrid(oTableSelect(self))) msg_PrintSelectedTable self end Get End_Report liOk to liOk function_return liOk end_function object oBodyImage is a cWinPrint_ImageDefinition send Add_Column "#" 1.0 DF_BCD 0 DFFALSE DFFALSE set Bold_State to true send Add_Column "Logical name" 1.5 DF_ASCII 0 DFFALSE DFFALSE set Bold_State to true send Add_Column "Table" 4.5 DF_ASCII 0 DFFALSE DFFALSE set Bold_State to true end_object Procedure_Section Page_Top DFBeginHeader DFPageTop // Header of type DFPageTop DFHeaderPos HDR_LEFT // left justify the data in the header DFHeaderFrame HDR_MARGINS // Paint frame margin to margin DFFont "Arial" // Using Arial font size 20 DFFontSize 20 DFWritelnPos (Report_Title(self)) 0.5 FONT_BOLD DFFontSize 14 // DFWritePos "Sub title" 0.5 FONT_BOLD DFFont "Times New Roman" // Use font Times New Roman DFFontSize 12 // font size 14 DFWritePos "Page:" 13 (FONT_ITALIC+FONT_BOLD) DFWritePos "#pagecount#" 15 (FONT_ITALIC+FONT_BOLD) DFWriteln "" // print a blank line DFFontSize 10 send Output_Header to oBodyImage DFEndHeader End_Procedure // Page_Top Procedure Print_Text string lsLabel string lsValue move (trim(lsValue)) to lsValue if (lsValue<>"") begin DFWritePos lsLabel 1.6 //0 -1 0 DFWritePos lsValue 4.2 FONT_ITALIC -1 0 DFWriteLn "" end end_procedure Procedure_Section Body Send Update_Status (string(piId(self))+" "+psLogic_name(self)) send BlankForm_Image to oBodyImage send Print_Value to oBodyImage 0 (piId(self)) send Print_Value to oBodyImage 1 (psLogic_name(self)) send Print_Value to oBodyImage 2 (psName(self)) DFFontSize 10 DFWriteln "" // print a blank line send Output_Image to oBodyImage send Print_Text "Table description:" (psDescription(self)) forward send Body End_Procedure // Body Procedure_Section Page_Bottom DFFont "Times New Roman" DFFontSize 10 DFBeginHeader DFPageBottom // Header of type DFPageBottom DFHeaderPos HDR_CENTER // Center the data in the header DFHeaderFrame HDR_MARGINS // Frame margin to margin DFWrite "Printed on: " (FONT_ITALIC) // Using the RptToday property in DFReport to set the date DFWriteln (string(dSysDate())+" "+sSysTime()) (FONT_ITALIC) DFEndHeader End_Procedure Object oFieldReport is a WinReport Set No_Finding_State to TRUE property integer piTbl_Id property integer piFld_Pos property string psFld_Name property integer piFld_Not_Found property string psFld_Description property string psSuggested_Label property string psFld_Definition object oBodyImage is a cWinPrint_ImageDefinition send Add_Column "#" 3.1 DF_BCD 0 DFFALSE DFFALSE set Bold_State to true send Add_Column "Field" 3.6 DF_ASCII 0 DFFALSE DFFALSE set Bold_State to true send Add_Column "Type" 9.0 DF_ASCII 0 DFFALSE DFFALSE set Bold_State to true end_object procedure PrintField integer liTbl_Id integer liFld_Pos string lsFld_Name integer liFld_Not_Found string lsFld_Description string lsSuggested_Label string lsFld_Definition integer liGrb set piTbl_Id to liTbl_Id set piFld_Pos to liFld_Pos set psFld_Name to lsFld_Name set piFld_Not_Found to liFld_Not_Found set psFld_Description to lsFld_Description set psSuggested_Label to lsSuggested_Label set psFld_Definition to lsFld_Definition get handle_report_line to liGrb end_procedure Function Start_Report returns integer integer liOk lbRun liFile lhTableAccess liIndex move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess get checked_state of (oIncludeFieldAndIndex(oOther(self))) to lbRun Forward Get Start_Report to liOk if (liOk=RPT_OK) begin if lbRun begin get piId to liFile DFFontSize 10 //send Output_Header of oBodyImage move 2 to liIndex // 2=Ordered by position if (piId(self)=DBDLIB_DICTIONARY) move 1 to liIndex if (piId(self)=DBDLIB_CALENDAR ) move 1 to liIndex if (piId(self)=DBDLIB_ARTICLES ) move 1 to liIndex send Callback_TableFields of lhTableAccess liFile msg_PrintField self liIndex end end Get End_Report liOk to liOk function_return liOk end_function Procedure Print_Text string lsLabel string lsValue move (trim(lsValue)) to lsValue if (lsValue<>"") begin DFWritePos lsLabel 3.9 //0 -1 0 DFWritePos lsValue 6.5 FONT_ITALIC -1 0 DFWriteLn "" end end_procedure procedure_section Body send BlankForm_Image to oBodyImage send Print_Value to oBodyImage 0 (piFld_Pos(self)) send Print_Value to oBodyImage 1 (psFld_Name(self)) send Print_Value to oBodyImage 2 (psFld_Definition(self)) DFFontSize 10 // DFWriteln "" // print a blank line send Output_Image to oBodyImage send Print_Text "Field description:" (psFld_Description(self)) forward send Body end_procedure // Body end_object End_object procedure DestroyingDbdView integer lhView if (lhView=phDbdView(self)) send close_panel end_procedure procedure popup send fill_list of (oGrid(oTableSelect(self))) forward send popup end_procedure End_Object send aps_SetMinimumDialogSize (oDbdReport(self)) procedure popup_dbdreport integer lhDbdSystem integer lhView set phDbdSystem of oDbdReport to lhDbdSystem set phDbdView of oDbdReport to lhView send popup of oDbdReport end_procedure