Use APS Use LangSymb.pkg // Language symbols define LNG_DEFAULT for lng_english /FastView.KnownIssues // V FastView 'Known issues' 1 No longer an issue 2 I have not been able to do anything about the irritating select toggling when expanding/collapsing with the mouse in the field selector. Reason: TreeView wasn't built for multi selection. Impact: Annoying (aren't they all?) 3 Complex overlap structures (multi- layer) may fool FastView into not asking whether child fields should be replaced by parent fields. Reason: I was too busy. Impact: View does not work properly when child fields are used. 4 Program goes into infinate loop on error 90. Reason: Missing parent record (data inconsistancy) Impact: Program must be terminated. 5 No longer an issue /* /FastView.Log FastView for Visual DataFlex Please use this Data Access public newsgroup for questions and suggestions: news://dataaccess.com/dac-public-newsgroups.visual-dataflex-support Use www.sture.com/wasp (which is a heavy duty intelligent search page, that I did) for searching newsgroups for previous content Programmed by Sture ApS (CPH, Denmark) Tel: +45 40 59 70 20 E-mail: sture.aps@mail.tele.dk --- Version 2.9b --- 06-02-04 "Close all tables" temporarily button added to menus. - DBD View is now refreshed when when reading table definitions. - Explore 'Data' Folder --- Version 2.9 --- 15-05-03 FTS Monitoring system feature 21-07-03 DBD feature 22-11-03 FastView home folder is now specific to each windows user. --- Version 2.0 --- 11-05-02 Auto-recompile feature turned into source code warning feature. --- Version 1.92 --- 13-04-02 Explicit pathing ignored in fvc files. 05-04-02 If child table no longer has a 'sensible' relationship to the header table, it was not possible to edit the view. This is fixed 22-03-02 Now also opens system files when WS DD's are used 09-03-02 Enter key now works as tab key - Alt+F2 now saves without clearing --- Version 1.91 --- 26-02-02 Enabled delta sizing of dbGrids columns - Enabled resizing FastViews (anchors) - New tool bar - Less irritating mechanism when saving (or not) view definitions 11-02-02 Cosmetics --- Version 1.9 --- 10-02-02 Restructured for shorter compile time 08-02-02 Adapted for VDF 8.1 - Auto-recompile detection 20-01-02 Fixed positioning error when Edit object was used in sidecar section preceeding other objects. --- Version 1.0 --- 11-01-02 Final version prepared --- Version 0.993 --- 09-01-02 Cmd line param '-view ' added - Cmd line param '-collection ' added --- Version 0.992 --- 08-01-02 Bug introduced in 0.991 fixed - Not possible to select text fields to a grid object --- Version 0.991 --- 07-01-02 FastLoad option implemented - Cmd line parameter '-filelist ' added - First unique index is now assigned as ordering to grid views --- Version 0.99 --- 06-01-02 Ctrl+I displays table definition, except in Wiz comboforms that do not allow for capturing ctrl keys - Focus problem can not be reproduced - No longer prompts for auto-load - dbEdit in sidecar problem fixed - Cmd line parameter '-noload' added - Cmd line parameter '-ws ' added - 'Re-load definition' to right- click menu - Field options Capslock and Promptlist added. - 'Edit properties' grid re-worked --- Version 0.93 --- 05-01-02 fvw file format changed to prepare for future enhancements (existing fvw files are now invalid, please delete) - Fixed broken Auto prompt (Ctrl+F) - Now writes a ReadMe.txt file when creating a FastView directory that explains why it's there - Fixed SaveEnvironment problem - Grids and Lists now responds to dbl click whenever appropriate - Whenever you save or delete from a 'sidecar' field focus will now go back to the first focusable column of the current row of the grid. - Ctrl+F1 in a view will now popup a DD inspection thing 04-01-02 'Use generic DD' checkbox'es are now disabled if none are available - Generic DD classes are now neatly wrapped. FastView automatically determines if they are applicable - Table selector now only displays applicable main tables when H/D - Alternative table selector for large filelist.cfg's - 'Administrator mode' may now be switched off by using cmdline parameter -USER - Error in relation detection mechanism fixed when a relating overlap type field was selected - Now automatically test DD classes for appropriate class to use on field level --- Version 0.92 --- 04-01-02 Comboforms now size according to the field they represent - Preparations for using generic DD classes - Indication of function keys in 'Edit properties' panel - It is now possible to omit the prompt for 'Save definition' on exiting of 'Edit properties' panel --- Version 0.91 --- 03-01-02 Extended tab settings now also in effect for sidecar fields - Top labels added to wizard pages - Now offers to use parent fields whenever child fields are selected - Wizard now offers to save the view definition on exit - Edit dialog now offers to save on exit --- Version 0.90 --- 02-01-02 A lot of fixes /FastView_CmdLineOptions FastView understands these command line parameters: -noload Disables the automatic loading of views on start up -ws Makes FastView load the specified WS on start up (instead of the default) -filelist FastView loads the specified (full path to a filelist.cfg) on start up -collection FastView loads the view collection of that name on start-up -view FastView loads the specified view on start-up Each of the following only have an impact if the feature they turn off, was enabled in the compiled program. -nopkgcheck FastView does not check for changes in DD packages (Disables the 'should I re-compile myself?' logic) -readonly User is not allowed to edit data. -noddbypass User is not allowed to disable using the workspace DD's (when they are present) -nowschange User is not allowed to point FastView to another WS -user Disables the editing and creating view definitions ('security by obscurity' as Wil van Antwerpen points out). /* Use Splash.utl // Graphic splish-splash Use About.utl // About dialog set AppInfo AI_TITLE to "FastView" set AppInfo AI_SUBTITLE to "Visual DataFlex" set AppInfo AI_VERSION to "11" set AppInfo AI_REVISION to "" set AppInfo AI_AUTHOR to "Sture ApS" set AppInfo AI_WATERMARK to "11" set AppInfo AI_RELEASEDATE to "" set AppInfo AI_LOG_IMAGE to FastView.Log.N set AppInfo AI_KNOWN_ISSUES to FastView.KnownIssues.N object oSplash is a cGraphicSplash end_object Use CmdLine.nui // Simple thing for reading command line parameters procedure FV_DoCmdLineHelp integer liLogImage string lsLog if (CmdLineFindParamValue("?",DFTRUE)<>-1 or CmdLineFindParamValue("-?",DFTRUE)<>-1 or CmdLineFindParamValue("-h",DFTRUE)<>-1 or CmdLineFindParamValue("-help",DFTRUE)<>-1) begin move FastView_CmdLineOptions.N to liLogImage get sTextFromDfImage liLogImage to lsLog send DoDisplayText "FastView command line options" lsLog end end_procedure send FV_DoCmdLineHelp integer ghClientArea_FastView enumeration_list DEFINE FVSETUP_OLD_PKG_CHECK // Check for old packages YES NO DEFINE FVSETUP_USER_CHG_DATA // Allow changing data YES NO DEFINE FVSETUP_USER_BYPASS_WS_DD // Allow bypassing WS DD's YES NO DEFINE FVSETUP_USER_CHG_WS // Allow changing WS YES NO DEFINE FVSETUP_USER_EDIT_VIEWS // Allow create/change views YES NO DEFINE FVSETUP_WORKSPACE_NAME DEFINE FVSETUP_WORKSPACE end_enumeration_list object oFVSetup is a cArray item_property_list item_property string psName.i item_property integer psValue.i // 0=FALSE 1=TRUE item_property string psCmdLineToken.i end_item_property_list procedure DefineValue integer liRow string lsName string lsDefault string lsCmdLineToken set psName.i liRow to lsName set psValue.i liRow to lsDefault set psCmdLineToken.i liRow to lsCmdLineToken end_procedure // Default---V send DefineValue FVSETUP_OLD_PKG_CHECK "Check for old packages" DFTRUE "-NOPKGCHECK" send DefineValue FVSETUP_USER_CHG_DATA "Allow changing data" DFTRUE "-READONLY" send DefineValue FVSETUP_USER_BYPASS_WS_DD "Allow bypassing WS DD's" DFTRUE "-NODDBYPASS" send DefineValue FVSETUP_USER_CHG_WS "Allow changing WS" DFTRUE "-NOWSCHANGE" send DefineValue FVSETUP_USER_EDIT_VIEWS "Allow create/change views" DFTRUE "-NOVIEWEDIT" send DefineValue FVSETUP_WORKSPACE_NAME "Workspace name" "" "" send DefineValue FVSETUP_WORKSPACE "Workspace id" "" "" procedure DoCmdLine integer liRow liMax liParam lbValue string lsCmdLineToken get row_count to liMax decrement liMax for liRow from 0 to liMax if (liRow<>FVSETUP_WORKSPACE_NAME and liRow<>FVSETUP_WORKSPACE) begin get psCmdLineToken.i liRow to lsCmdLineToken get CmdLineFindParamValue lsCmdLineToken DFTRUE to liParam if (liParam<>-1) set psValue.i liRow to 0 end loop end_procedure end_object function FVSetupValue global integer liItem returns string function_return (psValue.i(oFVSetup(self),liItem)) end_function procedure set FVSetupValue integer liItem string lsValue set psValue.i of (oFVSetup(self)) liItem to lsValue end_procedure GoSub RegisterRestrictions // Gosub setup rutine at the bottom send DoCmdLine to (oFVSetup(self)) if (FVSetupValue(FVSETUP_WORKSPACE_NAME)="") set AppInfo AI_SUBTITLE2 to "(No Workspace DD classes included)" else set AppInfo AI_SUBTITLE2 to ("(Including DD classes for '"+FVSetupValue(FVSETUP_WORKSPACE_NAME)+"')") send activate to (oSplash(self)) // <<<-----------SPLASH ON function FV_AdminMode global returns integer integer liParam get CmdLineFindParamValue "-USER" DFTRUE to liParam function_return (liParam=-1) end_function function FV_NoLoad global returns integer integer liParam get CmdLineFindParamValue "-NOLOAD" DFTRUE to liParam function_return (liParam<>-1) end_function function FV_CmdLineWS global returns string integer liParam string lsWS get CmdLineFindParamValue "-WS" DFTRUE to liParam if (liParam<>-1) begin get CmdLineParamValue (liParam+1) to lsWS end else move "" to lsWS function_return lsWS end_function function FV_CmdLineFileList global returns string integer liParam string lsWS get CmdLineFindParamValue "-FILELIST" DFTRUE to liParam if (liParam<>-1) begin get CmdLineParamValue (liParam+1) to lsWS end else move "" to lsWS function_return lsWS end_function function FV_CmdLineView global returns string integer liParam string lsWS get CmdLineFindParamValue "-VIEW" DFTRUE to liParam if (liParam<>-1) begin get CmdLineParamValue (liParam+1) to lsWS if (lowercase(right(lsWS,4))<>".fvw") move (lsWS+".fvw") to lsWS end else move "" to lsWS function_return lsWS end_function function FV_CmdLineViewCollection global returns string integer liParam string lsWS get CmdLineFindParamValue "-COLLECTION" DFTRUE to liParam if (liParam<>-1) begin get CmdLineParamValue (liParam+1) to lsWS if (lowercase(right(lsWS,4))<>".fvc") move (lsWS+".fvc") to lsWS end else move "" to lsWS function_return lsWS end_function Use MdiExt.utl Use OpenStat.nui // cTablesOpenStatus class Use Version.nui // **************************************************************************** // *** Control the print interface ***************************************** // **************************************************************************** // If you use WinPrint2: Use VDFQuery.utl // DFQUERY for Visual DataFlex (WinPrint2 version) // If you use VPE: //define VPE_USE_EMBEDDED_PREVIEW for 0 //Use VpeQuery.utl // DFQUERY for Visual DataFlex (VPE version) // **************************************************************************** // **************************************************************************** // **************************************************************************** Use VDFSort.utl // Sort utility on_key key_ctrl+key_d send Request_Popup_Calendar on_key key_ctrl+key_p send Request_CreateNewQuery Use cApplication.pkg Object oApplication is a cApplication set pbEnterKeyAsTabKey to DFTRUE End_Object // oApplication integer ghoWorkSpace get phoWorkspace of ghoApplication to ghoWorkSpace use OpenStat.pkg Use Login.utl Use SelectWorkspace.dg Use WorkSpc.utl Use WS.nui // register_object Main register_object Client_Area Procedure Do_Select_WorkSpace integer hoWorkspace eOpened string sWorkspace get phoWorkspace of ghoApplication To hoWorkspace get WorkSpc_SelectWS to sWorkspace If (sWorkspace<>"") Begin if (WS_Select(sWorkspace)) begin send FastView_OpenDefaultCollection end End end_procedure use FDX.nui procedure Do_Select_FileList string lsFileList integer hoWorkspace string lsCurrentEffectiveID get WS_CurrentEffectiveID to lsCurrentEffectiveID broadcast recursive send WS_OnCloseWorkSpace to desktop lsCurrentEffectiveID get phoWorkspace of ghoApplication To hoWorkspace Send DoClearPaths of hoWorkspace send FLIST_SetOpenPath (SEQ_ExtractPathFromFileName(lsFileList)) send FLIST_SetCurrentFilelist lsFileList broadcast recursive send WS_OnOpenWorkSpace to desktop "" // Procedure Do_Select_FileList send FastView_OpenDefaultCollection end_procedure procedure Do_Select_FileList_Browse string lsFileList move (SEQ_SelectFile("Open FILELIST.CFG","filelist.cfg|filelist.cfg|*.cfg|*.CFG")) to lsFileList if (lsFileList<>"") send Do_Select_FileList lsFileList end_procedure object oWatchedPackages is a cArray property string psFastViewPath property number pnFastViewCompileTime item_property_list item_property string psPackage.i item_property integer pbFound.i item_property string psPath.i item_property number pnTimeStamp.i end_item_property_list procedure add_package string lsPack integer liRow get row_count to liRow set psPackage.i liRow to lsPack set pbFound.i liRow to DFFALSE set psPath.i liRow to "" set pnTimeStamp.i liRow to 0 end_procedure procedure DoTimeStamps integer liRow liMax string lsMakePath lsPackage lsPath get WS_MakePath to lsMakePath get row_count to liMax decrement liMax for liRow from 0 to liMax get psPackage.i liRow to lsPackage get SEQ_FindFileAlongPath lsMakePath lsPackage to lsPath if (lsPath="") begin move (lsPackage+".pkg") to lsPackage get SEQ_FindFileAlongPath lsMakePath lsPackage to lsPath end if (lsPath<>"") begin get SEQ_ComposeAbsoluteFileName lsPath lsPackage to lsPackage // if (SEQ_FileExists(lsPackage)=SEQIT_FILE) begin if DFTRUE begin set pbFound.i liRow to DFTRUE set pnTimeStamp.i liRow to (SEQ_FileModTime(lsPackage)) set psPath.i liRow to lsPath end else begin set pbFound.i liRow to DFFALSE set pnTimeStamp.i liRow to 0 set psPath.i liRow to "" end end else begin set pbFound.i liRow to DFFALSE set pnTimeStamp.i liRow to 0 set psPath.i liRow to "" end loop get API_OtherAttr_Value OA_RUNTIME_NAME to lsPackage get SEQ_ExtractPathFromFileName lsPackage to lsPath set psFastViewPath to lsPath set pnFastViewCompileTime to (SEQ_FileModTime(lsPackage)) end_procedure function bIsProgramTooOld returns integer integer liRow liMax number lnFastViewTime get pnFastViewCompileTime to lnFastViewTime get row_count to liMax decrement liMax for liRow from 0 to liMax if (pnTimeStamp.i(self,liRow)>lnFastViewTime) function_return DFTRUE loop function_return DFFALSE end_function property integer pbWarningAlreadyGiven public DFFALSE procedure UserWarning integer liRow liMax number lnFastViewTime string lsRval ls10 ifnot (pbWarningAlreadyGiven(self)) begin move (character(10)) to ls10 move ("The following packages are found to be newer than the current Fastview compilation:"+ls10) to lsRval get pnFastViewCompileTime to lnFastViewTime get row_count to liMax decrement liMax for liRow from 0 to liMax if (pnTimeStamp.i(self,liRow)>lnFastViewTime) move (lsRval+psPackage.i(self,liRow)+ls10) to lsRval loop move (lsRval+ls10+"Perhaps it's time to recompile FastView...") to lsRval send obs lsRval set pbWarningAlreadyGiven to DFTRUE end // function_return lsRval // move (lsRval+"Do you want to re-compile fastview?") to lsRval end_procedure property integer pbDontAskTwiceIts public DFFALSE procedure DoTheCheck integer lbError lbHome string lsQuestion lsMakePath lsCompilerPath lsFastViewPath if (integer(FVSetupValue(FVSETUP_OLD_PKG_CHECK))) begin ifnot (pbDontAskTwiceIts(self)) begin set pbDontAskTwiceIts to DFTRUE get FastView_GenericDDsApplicable to lbHome if lbHome begin send DoTimeStamps if (bIsProgramTooOld(self)) begin send UserWarning end end end set pbDontAskTwiceIts to DFFALSE end end_procedure end_object object oWatchedPackagesPanel is a aps.ModalPanel label "Watched packages" set locate_mode to CENTER_ON_SCREEN on_key kcancel send close_panel property integer piResult public DFFALSE object oLst is a aps.Grid send GridPrepare_AddColumn "Package" AFT_ASCII20 send GridPrepare_AddColumn "Time stamp" AFT_ASCII20 send GridPrepare_AddColumn "Path" AFT_ASCII50 send GridPrepare_Apply self on_key KEY_CTRL+KEY_R send sort_data on_key KEY_CTRL+KEY_W send DoWriteToFile set size to 150 0 set peAnchors to (anTop+anLeft+anRight+anBottom) Set peResizeColumn to rcSelectedColumn // make sure mode is correct Set piResizeColumn to 2 // this is the column to resize procedure DoWriteToFile send Grid_DoWriteToFile self end_procedure function iSpecialSortValueOnColumn.i integer liColumn returns integer if liColumn eq 1 function_Return 1 end_function function sSortValue.ii integer liColumn integer liItem returns string number lnTS if liColumn eq 1 begin get TS_ConvertStringToTS (value(self,liItem)) to lnTS function_return (IntToStrR(lnTS,14)) end end_function procedure sort_data.i integer liColumn send Grid_SortByColumn self liColumn end_procedure procedure sort_data integer liCC get Grid_CurrentColumn self to liCC send sort_data.i liCC end_procedure procedure header_mouse_click integer liItem send sort_data.i liItem forward send header_mouse_click liItem end_procedure procedure fill_list.i integer lhArray integer liMax liRow send delete_data get row_count of lhArray to liMax decrement liMax for liRow from 0 to liMax send add_item MSG_NONE (psPackage.i(lhArray,liRow)) if (pbFound.i(lhArray,liRow)) begin send add_item MSG_NONE (TS_ConvertToString(pnTimeStamp.i(lhArray,liRow))) send add_item MSG_NONE (psPath.i(lhArray,liRow)) end else begin send add_item MSG_NONE "-" send add_item MSG_NONE "-" end loop send Grid_SetEntryState self DFFALSE send sort_data.i 1 // Sort by time end_procedure end_object object oBtn1 is a aps.Multi_Button on_item t.btn.close send close_panel set peAnchors to (anBottom+anRight) end_object send aps_locate_multi_buttons set Border_Style to BORDER_THICK // Make panel resizeable procedure popup integer lhObj string lsLabel set piResult to DFFALSE move (oWatchedPackages(self)) to lhObj send fill_list.i to (oLst(self)) lhObj move "Workspace DD packages (FastView compiled #, #)" to lsLabel move (replace("#",lsLabel,TS_ConvertToString(pnFastViewCompileTime(lhObj)))) to lsLabel move (replace("#",lsLabel,psFastViewPath(lhObj))) to lsLabel set label to lsLabel if (item_count(oLst(self))) forward send popup else send obs "You have not compiled any DD packages into this version of Fastview" ("(Located here: "+psFastViewPath(lhObj)+")") end_procedure end_object // oWatchedPackagesPanel send aps_SetMinimumDialogSize (oWatchedPackagesPanel(self)) procedure FastView_Display_UserPackages send DoTimeStamps to (oWatchedPackages(self)) send popup to (oWatchedPackagesPanel(self)) end_procedure procedure FastView_Check_UserPackages send DoTheCheck to (oWatchedPackages(self)) end_procedure Use FvGeneri.pkg // gosub RegisterReferencedTables integer giGenericDDsAlreadyCreated move 0 to giGenericDDsAlreadyCreated object oFastViewPreferences is a cArray property integer pbOnGenericTables object oTablesOpenStatus is a cTablesOpenStatus end_object procedure WS_OnOpenWorkSpace string lsWS set pbOnGenericTables to (FV_GenericTablesPresent() and FV_GenericTablesUnderUs()) if (pbOnGenericTables(self)) begin ifnot giGenericDDsAlreadyCreated begin move 1 to giGenericDDsAlreadyCreated CREATE_OBJECT_GROUP OG_WorkspaceDDs PARENT desktop send RegisterCurrentOpenFiles to (oTablesOpenStatus(self)) // send FastView_Check_UserPackages end else begin // Re-create the situation as it were immediately after calling // the programmer defined DD code the first time. send RestoreFiles to (oTablesOpenStatus(self)) end end else send OpenStat_CloseAllFiles end_procedure end_object function FastView_GenericDDsApplicable global returns integer function_return (pbOnGenericTables(oFastViewPreferences(self))) end_function enumeration_list define DDP_CLASS end_enumeration_list Use DDCreate.nui // Create generic DDO structures (using global FDX object) function FastView_DDProbe integer liFile integer liField integer liWhat returns string integer lhDD string lsRval if (FastView_GenericDDsApplicable()) begin send DDC_OpenFile liFile get iDD_Object liFile to lhDD // Defined in fieldinf.pkg if lhDD begin if (liWhat=DDP_CLASS) get Field_Class_Name of lhDD liField to lsRval end end function_return lsRval end_function define DEBUG$BYPASSWARNING for 1 Use DD_Debug.utl // DDO States on Ctrl+F1 //Use Debug.utl // Various debug code... Use FdxGlObj.nui // Global FDX object (ghFDX) Use FvOption.pkg object oMustBeIncapsulated is a cArray // If these procedures are located directly on the // desktop the hole thing locks on WS selection! procedure WS_OnCloseWorkSpace string lsOldWS broadcast recursive send Close_Query_View to desktop send DataDictionary_Objects_Destroy send OpenStat_CloseAllFiles end_procedure procedure WS_OnOpenWorkSpace string lsNewWS integer liGrb liChannel get DBMS_OpenFileAs "CODEMAST" CodeMast.file_number DF_SHARE 0 to liGrb ifnot liGrb send obs "Attempt to open CodeMast table failed (maybe that's OK)" send cursor_wait to (cursor_control(self)) send FastView_SetupHomeDirectory get FastView_DirectInput "FastLoad.fdx" to liChannel if (liChannel>=0) begin send SEQ_Read to ghFDX liChannel send SEQ_CloseInput liChannel end else send FDXGL_ReadCurrentFileList to ghFDX FDX_ALL_FILES broadcast recursive send delete_fieldinfo_data to desktop // Clears some arrays in fieldinf.pkg send cursor_ready to (cursor_control(self)) end_procedure end_object procedure SetupDefaultWS integer liExists string lsWS lsFileList get FV_CmdLineFileList to lsFileList if (lsFileList<>"") begin get SEQ_FileExists lsFileList to liExists if (liExists=SEQIT_FILE) send Do_Select_FileList lsFileList else if (liExists=SEQIT_DIRECTORY) begin get SEQ_ComposeAbsoluteFileName lsFileList "filelist.cfg" to lsFileList get SEQ_FileExists lsFileList to liExists if (liExists=SEQIT_FILE) send Do_Select_FileList lsFileList else send obs "Filelist.cfg not found" "(as specified on the command line)" end else send obs "Filelist.cfg not found" "(as specified on the command line)" end else begin get FV_CmdLineWS to lsWS if (lsWS="") begin get FVSetupValue FVSETUP_WORKSPACE to lsWS if (lsWS="") get WS_CurrentDefaultID to lsWS end if (WS_Select(lsWS)) begin send FastView_OpenDefaultCollection end else send obs "Invalid default Workspace" end end_procedure function FastViewAppLabel global string lsNewWS returns string integer lbGeneric string lsRval lsFileList get FastView_GenericDDsApplicable to lbGeneric if lbGeneric move (AppInfo(AI_TITLE)+" DD Ver. "+AppInfo(AI_VERSION)) to lsRval else move (AppInfo(AI_TITLE)+" Ver. "+AppInfo(AI_VERSION)) to lsRval if (lsNewWS<>"") move (lsRval+" ("+WS_CurrentEffectiveDescription()+")") to lsRval else begin get FLIST_CurrentFilelist to lsFileList move (lsRval+" ("+lsFileList+")") to lsRval end function_return lsRval end_function object oExternalViews is a cArray item_property_list item_property string psTitle.i item_property integer piMsg.i end_item_property_list end_object procedure set ViewActivateMessage string lsTitle integer liMsg integer lhArr liRow move (oExternalViews(self)) to lhArr get row_count of lhArr to liRow set psTitle.i of lhArr liRow to lsTitle set piMsg.i of lhArr liRow to liMsg end_procedure class cFastViewPopupMenu is a ViewPopupMenu procedure construct_object forward send construct_object property integer phMenuData end_procedure procedure OnInitMenu integer lhMenu lhData move self to lhMenu get phMenuData to lhData send delete_data send fill_menu of lhData lhMenu end_procedure Procedure Redirect_Message Returns Integer Integer lhMsg liAux liRval liCurItm lhData Get Message To lhMsg Get Aux_Value To liAux // If lhMsg Begin // Since Menupopup Is 0, This Will Get Skipped If liAux Eq 0 Begin // If No Destination Get Focus of desktop To liAux // Try To Send To Focus If liAux Le Desktop ; // As Long As Focus Is Not The Desktop. Move 0 To liAux End get current_item to liCurItm get phMenuData to lhData //showln (current_item(self)) send item_action of lhData liCurItm If liAux Get lhMsg Of liAux To liRval Procedure_Return liRval End end_procedure end_class // cFastViewPopupMenu // This blasted integer is only used in the next 10 lines or so, and was the // only way I could find that bypasses the VDF WS tendensy to create subkeys // depending on which WS is selected. integer ghOh_WhatCanYouDO? move ghoWorkSpace to ghOh_WhatCanYouDO? move 0 to ghoWorkSpace Object Main is a Panel // ghoWorkSpace must be 0 while this object is created move ghOh_WhatCanYouDO? to ghoWorkSpace property integer pbHtmlTestOutput property integer pbAutoPreview procedure OnActivateApp send FastView_Check_UserPackages end_procedure Procedure Save_Environment move ghoWorkSpace to ghOh_WhatCanYouDO? move 0 to ghoWorkSpace // ghoWorkSpace must be 0 while calling this procedure forward send Save_Environment move ghOh_WhatCanYouDO? to ghoWorkSpace end_procedure set label to (FastViewAppLabel("")) procedure WS_OnOpenWorkSpace string lsNewWS set delegation_mode to DELEGATE_TO_PARENT set label to (FastViewAppLabel(lsNewWS)) end_procedure DFCreate_Menu Main_Menu DFCreate_Menu "&File" FilePullDown is a ViewPopupMenu if (FV_AdminMode()) begin on_item "Create a view" send FastView_CreateNew end on_item "Create a query" send Activate_Query_Vw on_item "" send none on_item "Open view" send FastView_Open on_item "Close all views" send FastView_CloseAll on_item "" send none on_item "Open view collection" send FastView_OpenLayout on_item "Save view collection" send FastView_SaveLayout on_item "" send none if (integer(FVSetupValue(FVSETUP_USER_CHG_WS))) begin on_item "Select workspace" send Do_Select_WorkSpace on_item "Select filelist" send Do_Select_FileList_Browse on_item "" send none end on_item "Workspace options" send FastView_WSOptions on_item "Close all tables" send FastView_CloseTables on_item "Explore data folder" send FastView_ExploreDataFolder on_item "" send none on_item "DBMS Login" send DoLogin on_item "" send none on_item "Exit \aAlt+F4" send exit_application End_Menu DFCreate_Menu "&Views" ViewPullDown is a cFastViewPopupMenu End_Menu DFCreate_Menu "&Queries" QueryPullDown is a cFastViewPopupMenu End_Menu DFCreate_Menu "&External Views" ExternalViewPullDown is a ViewPopupMenu procedure OnInitMenu integer lhArr liMax liRow send delete_data move (oExternalViews(self)) to lhArr get row_count of lhArr to liMax decrement liMax for liRow from 0 to liMax send add_item (piMsg.i(lhArr,liRow)) (psTitle.i(lhArr,liRow)) loop end_procedure End_Menu DFCreate_Menu "Tools" FunctionPullDown is a ViewPopupMenu on_item "&Document your database \aCtrl+2" send Popup_DBD_View on_item "&Document your source \aCtrl+3" send Popup_PkgDoc_View on_item "&System pounder" send popup_systempounder // on_item "&HTML page prototyper" send Activate_HtmlPagePrototyper on_item "&FTS Subsystem" send Popup_FTS_ControlPanel // on_item "&FTS Drop tables" send Popup_FTS_DropTablesWizard // on_item "&FTS Create tables" send Popup_FTS_CreateTablesWizard on_item "" send none on_item "DAW-Tool: Database &Builder" send OpenStat.Chain_DbBuilder on_item "DAW-Tool: Database &Explorer" send OpenStat.Chain_DbExplor on_item "Repair index files" send Activate_Sort_Vw on_item "" send none on_item "Save snap shot of table definitions" send activate_fvtool_01 on_item "Show Workspace DD packages" send FastView_Display_UserPackages on_item "" send none // DFCreate_Menu "Odd tool box" OddToolBoxPullDown is a ViewPopupMenu // on_item "Split file" send Activate_FileSplit_Vw // on_item "Join files" send Activate_FileJoin_Vw // End_Menu on_item "About" send DoAbout End_Menu //DFCreate_Menu "Web" WebToolsPullDown is a ViewPopupMenu // procedure Toggle_HtmlOutput // integer lbSelect // get pbHtmlTestOutput to lbSelect // set pbHtmlTestOutput to (not(lbSelect)) // end_procedure // procedure Toggle_AutoPreview // integer lbSelect // get pbAutoPreview to lbSelect // set pbAutoPreview to (not(lbSelect)) // end_procedure // procedure OnInitMenu // set select_state item (item_count(self)-2) to (pbAutoPreview(self)) // set select_state item (item_count(self)-1) to (pbHtmlTestOutput(self)) // end_procedure // on_item "Layout designer (table)" send Activate_WebLayoutTableDesigner // on_item "Layout designer (div)" send Activate_WebLayoutDivDesigner // on_item "CSS Designer" send Activate_WebCssSelector // on_item "Web form designer" send Activate_WebFormDesigner // on_item "" send none // on_item "Auto preview" send Toggle_AutoPreview to self // on_item "Preview as HTML" send Toggle_HtmlOutput to self //End_Menu #include Win_PM.inc // Window of available views End_Menu Use cToolbar.pkg Object oToolBar is a cToolBar Set pbShowLabels To True // display the psLabel property on the button Set pbList To True // show the psLapel property to the right of the image Object oImages is a cImageList Set piMaxImages To 12 Procedure OnCreate Integer iVoid Get AddTransparentImage "bgn.bmp" clLtGray To iVoid // 0 Get AddTransparentImage "prev.bmp" clLtGray To iVoid // 1 Get AddTransparentImage "next.bmp" clLtGray To iVoid // 2 Get AddTransparentImage "end.bmp" clLtGray To iVoid // 3 Get AddTransparentImage "Prompt16.bmp" clFuchsia To iVoid // 4 Get AddTransparentImage "clr.bmp" clLtGray To iVoid // 5 Get AddTransparentImage "clra.bmp" clLtGray To iVoid // 6 Get AddTransparentImage "Save16.bmp" clFuchsia To iVoid // 7 Get AddTransparentImage "Delete16.bmp" clFuchsia To iVoid // 8 Get AddTransparentImage "Cut16.bmp" clFuchsia To iVoid // 9 Get AddTransparentImage "Copy16.bmp" clFuchsia To iVoid // 10 Get AddTransparentImage "Paste16.bmp" clFuchsia To iVoid // 11 End_Procedure End_Object Object oImagesHot is a cImageList // These images are shown when the mouse cursor hovers over the button // There must be a matching number of images in all imagelists. Set piMaxImages To 12 Procedure OnCreate Integer iVoid Get AddTransparentImage "BgnHot.bmp" clLtGray To iVoid // 0 Get AddTransparentImage "PrevHot.bmp" clLtGray To iVoid // 1 Get AddTransparentImage "NextHot.bmp" clLtGray To iVoid // 2 Get AddTransparentImage "EndHot.bmp" clLtGray To iVoid // 3 Get AddTransparentImage "Prompt16.bmp" clFuchsia To iVoid // 4 Get AddTransparentImage "clr.bmp" clLtGray To iVoid // 5 Get AddTransparentImage "clra.bmp" clLtGray To iVoid // 6 Get AddTransparentImage "Save16.bmp" clFuchsia To iVoid // 7 Get AddTransparentImage "Delete16.bmp" clFuchsia To iVoid // 8 Get AddTransparentImage "Cut16.bmp" clFuchsia To iVoid // 9 Get AddTransparentImage "Copy16.bmp" clFuchsia To iVoid // 10 Get AddTransparentImage "Paste16.bmp" clFuchsia To iVoid // 11 End_Procedure End_Object Set phoImageList To (oImages(self)) Set phoImageListHot To (oImagesHot(self)) Object oFirst is a cToolbarButton Set pbAutoSize To True Set psTooltip To 'Navigation:\n\nGo to the first record in the file\n(or the first record in the Constrained set)' Set psStatusHelp To 'Find the First record (Ctrl+Home)' Set piImage To 0 Procedure OnClick Send DoSendToDeoFocus msg_beginning_of_data End_Procedure End_Object Object oPrevious is a cToolbarButton Set pbAutoSize To True Set psTooltip To 'Find Previous' Set psStatusHelp To 'Find the Previous record (F7)' Set piImage To 1 Procedure OnClick Send DoSendToDeoFocus msg_find_previous End_Procedure End_Object Object oNext is a cToolbarButton Set pbAutoSize To True Set psTooltip To 'Find Next' Set psStatusHelp To 'Find the Next record (F8)' Set piImage To 2 Procedure OnClick Send DoSendToDeoFocus msg_find_next End_Procedure End_Object Object oLast is a cToolbarButton Set pbAutoSize To True Set psTooltip To 'End of File' Set psStatusHelp To 'Find the Last record (Ctrl+End)' Set piImage To 3 Procedure OnClick Send DoSendToDeoFocus msg_end_of_data End_Procedure End_Object Object oSeparator is a cToolbarButton Set peStyle To bsSeparator End_Object Object oPrompt is a cToolbarButton Set psLabel To "Prompt" Set pbAutoSize To True Set psTooltip To 'Prompt' Set psStatusHelp To 'Show available selections (F4)' Set piImage To 4 Procedure OnClick Send DoSendToDeoFocus msg_prompt End_Procedure End_Object Object oClear is a cToolbarButton Set psLabel To "Clear" Set pbAutoSize To True Set psTooltip To 'Clear' Set psStatusHelp To 'Clear current record / Add a new record (F5)' Set piImage To 5 Procedure OnClick Send DoSendToDeoFocus msg_request_clear End_Procedure End_Object Object oClearAll is a cToolbarButton Set psLabel To "Clear All" Set pbAutoSize To True Set psTooltip To 'Clear All' Set psStatusHelp To 'Clear all data from view (Ctrl+F5)' Set piImage To 6 Procedure OnClick Send DoSendToDeoFocus msg_request_clear_all End_Procedure End_Object Object oSeparator is a cToolbarButton Set peStyle To bsSeparator End_Object Object oSave is a cToolbarButton Set psLabel To "Save" Set pbAutoSize To True Set psTooltip To 'Save' Set psStatusHelp To 'Save the current record (F2)' Set piImage To 7 Procedure OnClick Send DoSendToDeoFocus msg_request_save End_Procedure End_Object Object oDelete is a cToolbarButton Set psLabel To "Delete" Set pbAutoSize To True Set psTooltip To 'Delete' Set psStatusHelp To 'Delete the current record (Shift+F2)' Set piImage To 8 Procedure OnClick Send DoSendToDeoFocus msg_request_delete End_Procedure End_Object Object oSeparator is a cToolbarButton Set peStyle To bsSeparator End_Object Object oCut is a cToolbarButton Set psLabel To "Cut" Set pbAutoSize To True Set psTooltip To 'Cut' Set psStatusHelp To 'Cuts the selection and puts it on the Clipboard' Set piImage To 9 Procedure OnClick Send DoSendToDeoFocus msg_cut End_Procedure End_Object Object oCopy is a cToolbarButton Set psLabel To "Copy" Set pbAutoSize To True Set psTooltip To 'Copy' Set psStatusHelp To 'Copies the selection and puts it on the Clipboard' Set piImage To 10 Procedure OnClick Send DoSendToDeoFocus msg_copy End_Procedure End_Object Object oPaste is a cToolbarButton Set psLabel To "Paste" Set pbAutoSize To True Set psTooltip To 'Paste' Set psStatusHelp To 'Inserts Clipboard contents' Set piImage To 11 Procedure OnClick Send DoSendToDeoFocus msg_paste End_Procedure End_Object End_Object // oMainToolbar Object Client_Area IS A AppClientArea procedure DoLogin get DBMS_GetDriverLogin 0 to windowindex end_procedure Use VdfQuery.rv // VDFQuery #IFDEF VPE_USE_EMBEDDED_PREVIEW move self to glMainClientId# #ENDIF move self to ghClientArea_FastView Use VdfSort.vw // Reindexing routines Use FTSCreate.pkg // Wizard for creating a set of FTS tables Use FTSCtrlVw.pkg // FTS Control Panel //Use FastView.pkg Use FvDynamo.pkg // Part that generates the view based on vw-definition Use FvVwDefn.pkg // FastView, View definition cls (cFastView_ViewDefinition) Use FvWizard.pkg // FastView, Wizard for creating a FastView Use FvMenu.pkg // FastView menu system set phMenuData of (ViewPullDown(main_menu(self))) to (oViewMenuData(self)) set phMenuData of (QueryPullDown(main_menu(self))) to (oQueryMenuData(self)) Use ObjTree.pkg // popup_objecttree procedure Use DBD.vw Use PkgDoc.vw Use fv_tools.vw use menuedit.pkg on_key KEY_CTRL+KEY_4 send FastView_RefreshMenuData // Activate_MenuEditor Use fvsystempounder // // Use Fv_OddToolbox.vw // Use WebCssDesigner.vw // CSS designer // Use WebLayoutDesignerDiv.vw // Layout disigner (DIV) // Use WebLayoutDesignerTable.vw // Layout disigner (TABLE) // Use WebFormDesigner.vw // Web form designer procedure DoExternalViews if (FastView_GenericDDsApplicable()) begin CREATE_OBJECT_GROUP OG_WorkspaceFunctions end end_procedure procedure FastView_CreateNewQ send Request_CreateNewQuery end_procedure procedure FastView_CreateNew integer lhDef get FastView_CreateViewDefinition to lhDef send popup.i to (oFastViewWizard(self)) lhDef end_procedure procedure FastView_CloseAll broadcast recursive send Close_Query_View to desktop end_procedure // Close all tables temporarily to allow for access to DB Builder or the like procedure FastView_CloseTables integer lbOk lhPanel liVM lbWarningAlreadyGiven // The warning referred to is a warning about DD packages being newer // than the FastView compile itself. get pbWarningAlreadyGiven of (oWatchedPackages(self)) to lbWarningAlreadyGiven set pbWarningAlreadyGiven of (oWatchedPackages(self)) to true // Disable warnings until we're ready send OpenStat_RegisterFiles // Take a snap shot of the number of open tables send OpenStat_CloseAllFiles // Close all tables move (parent(self)) to lhPanel // Handle for main panel of the FastView application get view_mode of lhPanel to liVM // Get current view_mode set view_mode of lhPanel to VIEWMODE_ICONIZE // Minimize application send obs "Now you can work with Database Builder in exclusive mode" ; "while FastView temporarily sits here." ; "" ; "Click OK when you're done..." repeat get OpenStat_RestoreFilesFunction 1 to lbOk // Restore open tables according to snap shot (1=Quiet=no error msg) ifnot lbOk begin get MB_Verify4 "FastView could not re-open its tables." ; "" ; "Do you want to it try again?" ; "(If you select 'No' Fastview will terminate)" 1 to lbOk if lbOk begin move 0 to lbOk end else begin system // Goodbye end end until lbOk set view_mode of lhPanel to liVM // Restore view_mode set pbWarningAlreadyGiven of (oWatchedPackages(self)) to lbWarningAlreadyGiven // Now we're ready // If changes were made (in DB Bldr) and warnings have not yet // been given then warn me: send FastView_Check_UserPackages end_procedure procedure FastView_ExploreDataFolder integer lbOK string lsPath get MB_Verify4 "Explorer will now be launced on the data folder of the workspace." ; "" ; "Please note that editing, deleting or renaming files will destroy the data." ; "Continue?" 0 to lbOK if lbOK begin get SEQ_FindFileAlongDFPath "filelist.cfg" to lsPath send html_StartDoc lsPath end end_procedure procedure FastView_Open integer lhDef get FastView_CreateViewDefinition to lhDef send DoOpenDefinition to lhDef send PopupPanel to lhDef end_procedure object oFastViewToolThing is a aps.View label "Stuff" send tab_column_define 1 25 20 JMODE_LEFT // Default column setting set p_auto_column to 1 object oSnap is a aps.ComboForm label "Snap:" abstract AFT_ASCII10 set focus_mode to NONFOCUSABLE end_object object oClass is a aps.ComboForm label "Class:" abstract AFT_ASCII10 set focus_mode to NONFOCUSABLE end_object send tab_column_define 1 20 15 JMODE_LEFT // Default column setting object oCbNoLabel is a aps.CheckBox label "No label" set focus_mode to NONFOCUSABLE end_object object oCbNoenter is a aps.CheckBox label "NoEnter" set focus_mode to NONFOCUSABLE end_object object oCbCapslock is a aps.CheckBox label "Capslock" set focus_mode to NONFOCUSABLE end_object object oCbPrompt is a aps.CheckBox label "Prompt" set focus_mode to NONFOCUSABLE end_object object oBtn is a aps.Button set focus_mode to NONFOCUSABLE on_item "Apply" send DoApply end_object procedure DoApply end_procedure end_object procedure FastViewToolPanel // send popup to (oFastViewToolThing(self)) end_procedure on_key KEY_CTRL+KEY_F2 send FastViewToolPanel procedure IFL_CreateSimple end_procedure procedure IFL_CreateGrid end_procedure procedure IFL_CreateHD end_procedure object oPopupMenu is a FloatingPopupMenu if (FV_AdminMode()) begin send Add_Item MSG_FastView_CreateNew "Create a view" end send Add_Item MSG_FastView_CreateNewQ "Create a query" send Add_Item MSG_None "" send Add_Item MSG_FastView_Open "Open view" send Add_Item MSG_FastView_CloseAll "Close all views" send Add_Item MSG_None "" send Add_Item MSG_FastView_OpenLayout "Open view collection" send Add_Item MSG_FastView_SaveLayout "Save view collection" send Add_Item MSG_None "" if (integer(FVSetupValue(FVSETUP_USER_CHG_WS))) begin send Add_Item MSG_Do_Select_WorkSpace "Select workspace" send Add_Item MSG_Do_Select_FileList_Browse "Select filelist" send Add_Item MSG_None "" end send Add_Item MSG_FastView_WSOptions "Workspace options" send Add_Item MSG_FastView_CloseTables "Close all tables" end_object procedure DoPopupMenu if (FV_AdminMode()) begin send popup to (oPopupMenu(self)) end end_procedure procedure Mouse_Up2 // Right click send DoPopupMenu end_procedure End_Object // Client_Area Object Status_Bar is a cSturesStatusBar End_Object // On_Key Key_Ctrl+Key_1 Send To Client_Area On_Key Key_Ctrl+Key_2 Send Popup_DBD_View To Client_Area On_Key Key_Ctrl+Key_3 Send Popup_PkgDoc_View To Client_Area On_Key Key_Ctrl+Key_9 send Popup_ObjectTree // use tooltip.pkg End_Object // Main send deactivate to (oSplash(self)) procedure FastView_OpenDefaultCollection integer lbLoad liChannel lhDef lbViewLoaded string lsHome lsFile lsViewDef ifnot (FV_NoLoad()) begin get FastView_HomeDirectory to lsHome if (lsHome<>"") begin get FV_CmdLineViewCollection to lsFile if (lsFile="") begin get FV_CmdLineView to lsViewDef move "default.fvc" to lsFile end get SEQ_ComposeAbsoluteFileName lsHome lsFile to lsFile if (lsViewDef="" and SEQ_FileExists(lsFile)) begin //get MB_Verify "Do you want to load default views for this WS?" 1 to lbLoad move DFTRUE to lbLoad if lbLoad begin get SEQ_DirectInput lsFile to liChannel if (liChannel>=0) begin send SEQ_ReadArrayItems liChannel (oFastViewLayout(self)) send SEQ_CloseInput liChannel send OpenLayouts to (oFastViewLayout(self)) procedure_return end end end // OK! Maybe he wants to open a single view? move DFFALSE to lbViewLoaded if (lsViewDef<>"") begin get SEQ_ComposeAbsoluteFileName lsHome lsViewDef to lsViewDef if (SEQ_FileExists(lsViewDef)) begin get FastView_CreateViewDefinition to lhDef send SEQ_Read_FileName to lhDef lsViewDef send PopupPanel to lhDef move DFTRUE to lbViewLoaded end end ifnot lbViewLoaded begin send ReadDirectory to (oFastViewsOnDisk(self)) lsHome "*.fvw" if (row_count(oFastViewsOnDisk(self))) begin move (sPopup.s(oFastViewOpenFileSL(self),"Open existing FastView definition")) to lsViewDef if (lsViewDef<>"") begin get FastView_CreateViewDefinition to lhDef send SEQ_Read_FileName to lhDef lsViewDef send PopupPanel to lhDef end end else move "" to lsViewDef if (lsViewDef="") send FastView_CreateNew to (Client_Area(Main(self))) end end end end_procedure send SetupDefaultWS send FastView_Check_UserPackages send DoExternalViews to (Client_Area(Main(self))) send FastView_RefreshMenuData to (Client_Area(Main(self))) Start_UI #REPLACE USE OLD$USE // Get rid of existing USE command (directive) #COMMAND USE // Define a new one. #IFSUB '!1.EXISTS' #ELSE #IFSUB '!1.EXISTS_AGAIN?' #ELSE send add_package to (oWatchedPackages(self)) "!1" #REPLACE !1.EXISTS_AGAIN? |CI!a #ENDIF #USE !1 #ENDIF #ENDCOMMAND