hotswap/delphi-database-v2
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial project structure: directories, empty files, requirements.txt, and logo

Browse Source
This commit is contained in:
HotSwapp
2025-10-06 18:18:47 -05:00
commit 36dffd5372
113 changed files with 7103 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

597
old-database/FORM_MGR.SC Executable file
View File

@@ -0,0 +1,597 @@
MESSAGE "Writing forms procedures to library..."
PROC Select_Forms()
; read list of form files on disk, match with descriptions in form table
; and place info in dialog box for user to select forms
PRIVATE Form_Table, Main_Drv, New_Form_Dir,
File_1, File_2, Form_Array, Form_Description, Button, Element
PROC Get_Form_Info(Key)
PRIVATE Form_Array
GETRECORD Form_Table UPPER(Key) TO Form_Array
if RetVal then
Key = Form_Array["Memo"]
else Key = "This file not listed in table of form names!"
endif
RETURN Key
ENDPROC; Get_Form_Info
PROC Process_Save_As_Dialog(TriggerType, TagValue, EventValue, ElementValue)
PRIVATE FileInfo
if (TriggerType = "SELECT") AND (TagValue = "Pick_Tag") then
PARSEFILENAME Pick_File TO FileInfo
File_Name = UPPER(FileInfo["FILE"])
REFRESHCONTROL "Accept_Tag"
RETURN TRUE
endif; SELECT
if (TriggerType = "ACCEPT") then
if (File_Name = "") then
MESSAGE "Error! File name cannot be blank!"
RETURN FALSE
else Text_File = PRIVDIR() + File_Name + ".MRG"
if ISFILE(Text_File) then
if Response_Is_Yes("Warning: Duplicate File Name!", "File exists, replace?") then
RETURN TRUE ; replace file
else RETURN FALSE ; do not replace file
endif
else RETURN TRUE ; file does not already exist
endif
endif
endif
RETURN TRUE
ENDPROC; Process_Save_As_Dialog
PROC Save_As_Dialog(File_Name)
PRIVATE Pick_File, Button_Val
SHOWDIALOG "Save Merge Configuration"
PROC "Process_Save_As_Dialog"
TRIGGER "SELECT", "ACCEPT"
@4,20 HEIGHT 16 WIDTH 40
@1,3 ?? "Save File As:"
ACCEPT @1,20
WIDTH 11 "A8"
PICTURE "*!"
TAG "Accept_Tag"
TO File_Name
PICKFILE @3,3 HEIGHT 8 WIDTH 32
COLUMNS 2
PRIVDIR() + "*.MRG"
TAG "Pick_Tag"
TO Pick_File
PUSHBUTTON @12,5 WIDTH 12
"~Y~es"
OK
DEFAULT
VALUE "OK"
TAG "OK_Button"
TO Button_Val
PUSHBUTTON @12,22 WIDTH 12
"~N~o"
CANCEL
VALUE "Cancel"
TAG "Cancel_Button"
TO Button_Val
ENDDIALOG
RETURN RetVal
ENDPROC; Save_As_Dialog
PROC Process_Dialog(TriggerType, TagValue, EventValue, ElementValue)
PRIVATE New_Dir, Text_File, Ch, L, Continue
if (TriggerType = "OPEN") then
SELECTCONTROL "Available_Tag"
Form_Description = Get_Form_Info(File_1)
REFRESHCONTROL "Description_Tag"
RETURN TRUE
endif; OPEN
if (TriggerType = "ARRIVE") then
RESYNCDIALOG
if (TagValue = "Available_Tag") then
Form_Description = Get_Form_Info(File_1)
else if (TagValue = "Selected_Tag") then
Form_Description = Get_Form_Info(File_2)
endif
endif
REFRESHCONTROL "Description_Tag"
RETURN TRUE
endif; ARRIVE
if (TriggerType = "UPDATE") then
if (TagValue = "Available_Tag") OR (TagValue = "Selected_Tag") then
Form_Description = Get_Form_Info(EventValue)
REFRESHCONTROL "Description_Tag"
RETURN TRUE
endif
; if user selects new subdirectory, verify then load file list
if (TagValue = "Directory_Tag") then
New_Dir = EventValue
if NOT MATCH(New_Dir, "..\\") then
New_Dir = New_Dir + "\\"
endif
if (New_Dir = Form_Dir) then
RETURN TRUE
endif
if (DIREXISTS(New_Dir) = 1) then ; change directory string
Form_Dir = New_Dir
New_Form_Dir = Form_Dir
File_1 = ""
File_2 = ""
FOREACH Element IN Form_Array
RELEASE VARS Form_Array[Element]
ENDFOREACH
REFRESHCONTROL "Available_Tag"
REFRESHCONTROL "Selected_Tag"
REFRESHCONTROL "Description_Tag"
RETURN TRUE
else BEEP
MESSAGE "Invalid subdirectory. Press any key to continue."
Ch = GETCHAR()
RETURN FALSE
endif
endif; Directory_Tag
endif; UPDATE
if (TriggerType = "SELECT") then
if (TagValue = "Available_Tag") then
if NOT ISFILE(Form_Dir + File_1) then
Form_Dir = SUBSTR(Main_Drv,1,2) + RELATIVEFILENAME(Form_Dir + File_1)
New_Form_Dir = Form_Dir
File_1 = ""
File_2 = ""
FOREACH Element IN Form_Array
RELEASE VARS Form_Array[Element]
ENDFOREACH
REFRESHCONTROL "Available_Tag"
REFRESHCONTROL "Selected_Tag"
REFRESHCONTROL "Description_Tag"
REFRESHCONTROL "Directory_Tag"
RETURN TRUE
else Form_Array[File_1] = File_1
REFRESHCONTROL "Selected_Tag"
endif
else if (TagValue = "Selected_Tag") then
RELEASE VARS Form_Array[File_2]
REFRESHCONTROL "Selected_Tag"
Form_Description = Get_Form_Info(File_2)
REFRESHCONTROL "Description_Tag"
endif
endif
RETURN TRUE
endif; SELECT
if (TriggerType = "ACCEPT") then
if (TagValue = "Save") OR (TagValue = "Run") then
if (DYNARRAYSIZE(Form_Array) <= 0) then
BEEP
SELECTCONTROL "Available_Tag"
MESSAGE("No form(s) selected. Press any key to continue.")
Ch = GETCHAR()
RETURN FALSE
endif
; if (TagValue = "Save") then
; if (USERNAME() <> "") then
; L = LEN(USERNAME())
; if (L > 8) then
; L = 8
; endif
; Text_File = SUBSTR(USERNAME(), 1, L)
; else Text_File = "ASSEMBLE"
; endif
; if ISFILE(PRIVDIR() + Text_File + ".MRG") then
; Text_File = "" ; if file exists, set name to blank
; endif
; Continue = Save_As_Dialog(Text_File)
; else Continue = True
; Text_File = PRIVDIR() + "$$$$$$$$.MRG"
; endif
Text_File = "R:\\PRIVATE\\$$$$$$$$.MRG"
Continue = True
if Continue then
FILEWRITE Text_File FROM Main_Dir + "\n" ; data subdirectory
PRINT FILE Text_File Main_Drv, "DOCUMENT\\WPDOCS\\DOCS\\", "\n" ; target subdirectory
PRINT FILE Text_File UPPER(Main_Table), "\n" ; rolodex, files, etc.
MOVETO Subset_Table
FORMKEY ; show table form view
CTRLHOME
TAB
SCAN
PRINT FILE Text_File FIELDSTR(), "\n"
ENDSCAN
FORMKEY ; return to form view
PRINT FILE Text_File "FORMS\n" ; print full file name for each selected form
if NOT MATCH(Form_Dir, "..\\") then
Form_Dir = Form_Dir + "\\"
endif
FOREACH Element IN Form_Array
PRINT FILE Text_File Form_Dir, Form_Array[Element], "\n"
ENDFOREACH
if (TagValue = "Run") then
MESSAGE "Executing document assembly program..."
RUN BIG "R:\\PRIVATE\\GO.BAT" ; run external dos merge program
MESSAGE ""
else MESSAGE "Configuration file saved successfully."
endif
endif;
RETURN FALSE ; return to dialog box
endif; Save Or Run
if (TagValue = "Tag_All") then
; method to select all available form files
RETURN FALSE
else if (TagValue = "UnTag_All") then
FOREACH Element IN Form_Array
RELEASE VARS Form_Array[Element]
ENDFOREACH
REFRESHCONTROL "Selected_Tag"
REFRESHCONTROL "Description_Tag"
RETURN FALSE
else RETURN TRUE
endif
endif; Tag_All
endif; ACCEPT
RETURN TRUE
ENDPROC; Process_Dialog
; Main procedure begins here
MOUSE SHOW
if (DIREXISTS(Form_Dir) <> 1) then ; does initial subdir exist
Form_Dir = Main_Dir
endif
New_Form_Dir = Form_Dir
Main_Drv = SUBSTR(Main_Dir, 1, 3)
Form_Table = Main_Dir + "FORMS\\FORM_LST"
File_1 = ""
File_2 = ""
DYNARRAY Form_Array[]
ECHO OFF
SHOWDIALOG "Select Forms To Merge With Data"
PROC "Process_Dialog"
TRIGGER "UPDATE", "ARRIVE", "SELECT", "OPEN", "ACCEPT"
@2, 4 HEIGHT 21 WIDTH 71
LABEL @1,1
"~C~urrent Directory:"
FOR "Directory_Tag"
ACCEPT @2,2 WIDTH 65 "A80" PICTURE "*!"
TAG "Directory_Tag"
TO Form_Dir
LABEL @4,1
"~A~vailable Forms: (Space = Tag)"
FOR "Available_Tag"
PICKFILE @5,2 HEIGHT 10 WIDTH 32
COLUMNS 2
Form_Dir
SHOWDIRS
TAG "Available_Tag"
TO File_1
LABEL @16,1
"~F~orm Description:"
FOR "Description_Tag"
ACCEPT @17,2 WIDTH 65
"A150"
TAG "Description_Tag"
TO Form_Description
LABEL @4,36
"~S~elected Forms: (Space = Untag)"
FOR "Selected_Tag"
PICKDYNARRAY @5,37 HEIGHT 10 WIDTH 15
Form_Array
TAG "Selected_Tag"
TO File_2
PUSHBUTTON @6,55 WIDTH 12
"~R~un"
OK
DEFAULT
VALUE ""
TAG "Run"
TO Button
PUSHBUTTON @8,55 WIDTH 12
"~S~ave"
OK
VALUE ""
TAG "Save"
TO Button
PUSHBUTTON @10,55 WIDTH 12
"~T~ag All"
OK
VALUE "ACCEPT"
TAG "Tag_All"
TO Button
PUSHBUTTON @12,55 WIDTH 12
"~U~nTag All"
OK
VALUE "ACCEPT"
TAG "UnTag_All"
TO Button
PUSHBUTTON @14,55 WIDTH 12
"~Q~uit"
CANCEL
VALUE ""
TAG "Cancel"
TO Button
ENDDIALOG
Form_Dir = New_Form_Dir ; use current subdir as default next time
MOUSE HIDE
MOVETO Subset_Table
ENDPROC
WRITELIB Off_Lib Select_Forms
;=============================================================================
PROC Form_Wait()
PRIVATE Fld_Prompt, Answer_Menu
PROC Process_Dialog(TriggerType, TagValue, EventValue, ElementValue)
if (TriggerType = "SELECT") then
if (TagValue = "IndexArrayTag") then
Search_Words[I_Word] = I_Word
else if (TagValue = "SearchArrayTag") then
RELEASE VARS Search_Words[S_Word]
endif
endif
REFRESHCONTROL "SearchArrayTag"
endif
RETURN TRUE
ENDPROC; Process_Dialog
PROC Ask_Form()
; user selects a subset of forms table based on search criteria
PRIVATE Index_Words, Search_Words, I_Word, S_Word, Name, Description, Status, Element
FORMKEY ; switch to table view
SHOWPULLDOWN ; hide main menu
ENDMENU
CLEARSPEEDBAR ; clear form speedbar
PROMPT "Press Search to find matching forms; ESC or Cancel to quit."
MOUSE SHOW
DYNARRAY Index_Words[]
DYNARRAY Search_Words[]
Name = ""
Description = ""
Status = ""
ECHO OFF
; load all index words into a dynamic array
VIEW "Inx_Lkup"
SCAN
Index_Words[STRVAL([Keyword])] = [Keyword]
ENDSCAN
CLEARIMAGE
SHOWDIALOG "Form Selection Criteria"
PROC "Process_Dialog"
TRIGGER "SELECT", "ARRIVE"
@2, 6 HEIGHT 21 WIDTH 68
@1, 2 ?? "Name"
ACCEPT @1,15
WIDTH 48 "A80" PICTURE "*!"
TAG "Name_Tag"
TO Name
@2, 2 ?? "Description"
ACCEPT @2,15
WIDTH 48 "A80"
TAG "Desc_Tag"
TO Description
@3, 2 ?? "Status"
ACCEPT @3,15
WIDTH 15 "A40"
TAG "Status_Tag"
TO Status
LABEL @5,2
"~I~ndex List: (Space = Add)"
FOR "IndexArrayTag"
PICKDYNARRAY @6,2 HEIGHT 10 WIDTH 28
Index_Words
TAG "IndexArrayTag"
TO I_Word
LABEL @5,35
"~S~earch For: (Space = Delete)"
FOR "SearchArrayTag"
PICKDYNARRAY @6,35 HEIGHT 10 WIDTH 28
Search_Words
TAG "SearchArrayTag"
TO S_Word
PUSHBUTTON @17,20 WIDTH 10
"~S~earch"
OK
DEFAULT
VALUE ""
TAG "OK"
TO Button
PUSHBUTTON @17,40 WIDTH 10
"~C~ancel"
CANCEL
VALUE ""
TAG "Cancel"
TO Button
ENDDIALOG
PROMPT ""
if (RetVal = True) then
MESSAGE "Searching..."
ECHO OFF
{Ask} {Form_lst} Check Tab Example "link"
if NOT ISBLANK(Name) then
TYPEIN (", " + Name)
endif
TAB
if NOT ISBLANK(Description) then
TYPEIN Description
endif
TAB
if NOT ISBLANK(Status) then
TYPEIN Status
endif
{Ask} {Form_inx}
FOREACH Element IN Search_Words
if NOT ISBLANK(Search_Words[Element]) then
TAB
EXAMPLE "link"
TAB
TYPEIN Search_Words[Element]
RIGHT
endif
ENDFOREACH
DO_IT!
Subset_Table = PRIVDIR() + "SUBSET"
RENAME TABLE() Subset_Table
MOVETO "Form_lst(Q)" CLEARIMAGE
MOVETO "Form_inx(Q)" CLEARIMAGE
MOVETO Subset_Table
if ISEMPTY(Subset_Table) then
CLEARIMAGE
No_Matches_Found()
else ; copy form and display on screen
{Tools} {Copy} {JustFamily} {Form_lst} TYPEIN Subset_Table ENTER {Replace}
View_Answer_Table(Subset_Table, 1, 3)
DOWNIMAGE
IMAGERIGHTS READONLY
UPIMAGE
Form_Answer_Wait()
endif
endif
FORMKEY ; return to form view
MOUSE HIDE
ENDPROC; Ask_Form
PROC Form_Answer_Menu()
SHOWPULLDOWN
"Modify" : "Toggle between edit and main mode" : "Modify"
SUBMENU
"Edit Mode - F9" : "Allow data to be edited, deleted, etc." : "Edit\Mode",
"Main Mode - F2" : "Discontinue editing" : "Main\Mode"
ENDSUBMENU,
"Reports" : "Choose report to generate" : "Reports"
SUBMENU
"Form List" : "Print list of matching forms" : "Form_List"
ENDSUBMENU,
"Return" : "Return to previous menu" : ""
SUBMENU
"No " : "Continue working with selected data" : "Return\No",
"Yes - F8" : "Return to complete data set" : "Return\Yes"
ENDSUBMENU
ENDMENU
if (SYSMODE() = "Main") then
MENUDISABLE "Main\Mode"
else MENUDISABLE "Edit\Mode"
MENUDISABLE "Reports"
endif
Form_Speedbar()
ENDPROC; Form_Answer_Menu
PROC Form_Answer_Wait_Proc(TriggerType, EventInfo, CycleNumber)
if (EventInfo["TYPE"] = "MESSAGE") And
(EventInfo["MESSAGE"] = "MENUSELECT") And
(EventInfo["MENUTAG"] = "Form_List") then
SHOWPULLDOWN
ENDMENU
CLEARSPEEDBAR
MESSAGE "One moment please..."
ECHO OFF
Print_Report(Subset_Table, "1", "")
EXECPROC Answer_Menu
RETURN 1
else RETURN Answer_Table_Wait_Proc(TriggerType, EventInfo, CycleNumber)
endif
ENDPROC; Form_Answer_Wait_Proc
PROC Form_Answer_Wait()
Form_Answer_Menu()
Sound_Off()
ECHO NORMAL
Message_Box("Search Completed", "Matching Form Entries: " + STRVAL(NRECORDS(Subset_Table)))
WAIT WORKSPACE
PROC "Form_Answer_Wait_Proc"
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD"
KEY -60, -66, -67, -83, -50
; DO_IT Clear Edit Delete Memo
; F2 F8 F9 DEL Alt-M
ENDWAIT
CLEARSPEEDBAR
MESSAGE ""
ENDPROC; Form_Answer_Wait
PROC Form_Wait_Proc(TriggerType, EventInfo, CycleNumber)
PRIVATE Key_Code, Menu_Pick
if (TriggerType = "ARRIVEFIELD") then
PROMPT Fld_Prompt[FIELD()]
RETURN 1
endif
if (EventInfo["TYPE"] = "KEY") then
Key_Code = EventInfo["KEYCODE"]
SWITCH
; F9 - COEDIT
CASE (Key_Code = -67) : RETURN Main_Table_Edit()
; F2 - DO_IT!
CASE (Key_Code = -60) : if ISEMPTY(Main_Table) then
RETURN Main_Table_Clear()
else RETURN Main_Table_End_Edit()
endif
; F8 - CLEAR
CASE (Key_Code = -66) : RETURN Main_Table_Clear()
; Alt-M - Memo
CASE (Key_Code = -50) : Display_Memo(Main_Table)
Main_Table_Menu()
Form_Speedbar()
RETURN 1
; DELETE
CASE (Key_Code = -83) : if (SYSMODE() = "CoEdit") then
RETURN Display_Delete_Box()
else RETURN 1
endif
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
if (EventInfo["MESSAGE"] = "MENUSELECT") then
Menu_Pick = EventInfo["MENUTAG"]
SWITCH
CASE (Menu_Pick = "Edit\Mode") : RETURN Main_Table_Edit()
CASE (Menu_Pick = "Main\Mode") : if ISEMPTY(Main_Table) then
RETURN Main_Table_Clear()
else RETURN Main_Table_End_Edit()
endif
CASE (Menu_Pick = "Ask") : Ask_Form()
Main_Table_Menu()
Form_Speedbar()
RETURN 1
CASE (Menu_Pick = "Close\Yes") : RETURN Main_Table_Clear()
CASE (Menu_Pick = "Close\No") : RETURN 1
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
SOUND 400 100 RETURN 1 ; safety valve
ENDPROC; Form_Wait_Proc
PROC Form_Speedbar()
CLEARSPEEDBAR
SPEEDBAR "~F10~ Menu":-68, "~Alt-M~ Memo":-50
PROMPT Fld_Prompt[FIELD()]
ENDPROC; Form_Speedbar
; MAIN PROCEDURE BEGINS HERE
ECHO OFF
SETDIR "FORMS"
Answer_Menu = "Form_Answer_Menu"
DYNARRAY Fld_Prompt[]
Fld_Prompt["Name"] = "Unique form name (required)."
Fld_Prompt["Memo"] = "Description of form and its usage."
Fld_Prompt["Status"] = "Status code indicating merge availability."
Fld_Prompt["Keyword"] = "Indexed keywords for form. F1 for lookup help."
Main_Table_View(Main_Table, 1, 3)
Form_Speedbar()
ECHO NORMAL
WAIT WORKSPACE
PROC "Form_Wait_Proc"
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD"
KEY -60, -66, -67, -83, -50
; DO_IT Clear Edit Delete Alt-M
; F2 F8 F9 DEL Memo
ENDWAIT
CLEARSPEEDBAR
PROMPT ""
MESSAGE ""
ECHO OFF
if ISTABLE(Subset_Table) then
DELETE Subset_Table
endif
SETDIR Main_Dir
ENDPROC
WRITELIB Off_Lib Form_Wait
RELEASE PROCS ALL