home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / dbstruct.zip / DB.PF3 next >
Text File  |  1990-12-03  |  9KB  |  306 lines
  1. Global   MultiSel()
  2. Global   MoveBar()
  3. Global   Menu[1000,2], Item, Bar, Tkey, NumItems, Selection
  4. Global   ItemOrder
  5.  
  6. Global DbFields()
  7. Global FileName All
  8.  
  9. Local BinNumOfFiles NumOfFiles BinHeader BinDummy
  10. Local BinFileName AllfileNames Ctr
  11. Local BinFNLength FNLength BinDead Dead
  12.  
  13. BUFFER BinDead        SIZE 55
  14. BUFFER BinHeader      SIZE 55
  15. BUFFER BinNumOfFiles  SIZE 2
  16. BUFFER BinDummy       SIZE 62
  17. BUFFER BinFNLength    SIZE 2              'Length of file name.
  18. BUFFER BinFileName    SIZE 30
  19.  
  20. AllFileNames = Null
  21.  
  22. FileName = Upper(Ask("Enter FileName:"))
  23.  
  24. If FileName ! ".VW"
  25.  
  26. Fopen FileName As 1
  27.  Fseek 1 6
  28.  Fread 1 Binary 2 Into BinDead
  29.  UnPack BinDead "B" Dead
  30.  Fseek 1 55+Dead
  31.  Fread 1 Binary 2 Into BinNumOfFiles
  32.  UnPack BinNumOfFiles "B" NumOfFiles
  33.  Fseek 1 117+Dead
  34.  '  Fread 1 Binary 60 Into BinDummy
  35.    Fread 1 Binary 2 Into BinFNLength
  36.    UnPack BinFNLength "B" FNLength
  37.    Fread 1 Binary FNLength Into BinFileName
  38.    UnPack BinFileName "S" FileName
  39.    AllFileNames = FileName
  40.  For Ctr = 2 To NumOfFiles
  41.    Fread 1 Binary 20 Into BinDummy
  42.    Fread 1 Binary 2 Into BinFNLength
  43.    UnPack BinFNLength "B" FNLength
  44.    Fread 1 Binary FNLength Into BinFileName
  45.    UnPack BinFileName "S" FileName
  46.    AllFileNames = AllFileNames & FileName
  47.  End For
  48. Fclose 1
  49.  
  50.    FileName = Group(AllFileNames,1)|".db"
  51.    DbFields()
  52.  For Ctr = 2 To NumOfFiles
  53.    FileName = Group(AllFileNames,Ctr)|".db"
  54.    DbFields()
  55.  End For
  56.  
  57. ElseIf FileName ! ".DB"
  58.   DbFields()
  59. Else
  60.  exit main
  61. End If
  62.  
  63. beep
  64. MultiSel(trim(All),chr(32),1,1,15,1,15,12)
  65.  
  66.  
  67. Function DbFields()
  68.  Local NumOfFields Ctr
  69.  Local BinHeader BinNumOfFields BinDummy
  70.  Local  BinFieldLength   BinFieldOffset   BinFieldType   BinFieldName
  71.  Local  FieldLength   FieldOffset   FieldType   FieldName
  72.  
  73.   BUFFER BinHeader         SIZE 2080
  74.   BUFFER BinNumOfFields    SIZE 2
  75.   BUFFER BinDummy          SIZE 22
  76.  
  77.   BUFFER BinFieldLength    SIZE 2
  78.   BUFFER BinFieldOffset    Size 2
  79.   BUFFER BinFieldType      Size 2
  80.  
  81.   BUFFER BinFieldName      Size 22
  82.  
  83.  
  84. Fopen FileName as 1
  85.     Fread 1 Binary 2080 Into BinHeader
  86.     Fread 1 Binary 2 Into BinNumOfFields
  87.     UnPack BinNumOfFields "B" NumOfFields
  88.     Fread 1 Binary 22 Into BinDummy
  89.  
  90. For Ctr = 1 to NumOfFields
  91.     Fread 1 Binary 2 Into BinFieldLength
  92.     UnPack BinFieldLength "B" FieldLength
  93.     Fread 1 Binary 2 Into BinFieldOffset
  94.     UnPack BinFieldLength "B" FieldOffset
  95.     Fread 1 Binary 2 Into BinFieldType
  96.     UnPack BinFieldType "B" FieldType
  97.     Fread 1 Binary 22 Into BinFieldName
  98.     UnPack BinFieldName "S" FieldName
  99.     All = All & fieldname
  100. End For
  101. fclose 1
  102.  
  103. End Function
  104.  
  105.  
  106.  
  107.  
  108. '----------------------------------------------------------------------------
  109. 'MultiSel function
  110. '----------------------------------------------------------------------------
  111. 'Function       To return multiple choices from the selection menu.
  112. '
  113. 'Usage          MultiSel(InData,Delim,Lr,Lc,FG,BG,HFG,HBG)
  114. '   Where:
  115. '               InData
  116. '                  Is any text file with each selection item
  117. '                  on a separate line,
  118. '                 or
  119. '                  A variable that contains all of the possible
  120. '                  items separated by a common delimitor.
  121. '               Delim
  122. '                  Can be any character from 0..255.
  123. '                  But should be limited to unique characters.
  124. '
  125. '               Lr = Left row coordinate.
  126. '               Lc = Left column coordinate.
  127. '               FG = Foreground color.
  128. '               BG = Background color.
  129. '               HFG = Hilighter Foreground color.
  130. '               HBG = Hilighter Background color.
  131. '
  132. 'Returns        Null when Escape is pressed.
  133. '               All choices delimited by Delim when Enter
  134. '               is pressed.
  135. '
  136. 'Restrictions   If InData is a variable it may contain no
  137. '               more than 1000 characters.
  138. '
  139. '********************************************************************
  140. '* BUG - When deselecting items; if the item being deselected is in *
  141. '*       a position after another item that contains the same text  *
  142. '*       then the first matching text will be deleted.              *
  143. '********************************************************************
  144.  
  145. 'Remarks        F6 is used to select/deselect items from
  146. '               the menu. Items are returned in the order
  147. '               that they were selected and separated by
  148. '               Delim.
  149. '
  150. 'See Also       SingleSel function.
  151. '
  152. 'Examples:      External MultiSel(8)
  153. '               Local MyVar Choices
  154. '
  155. '               Let MyVar = "Item1;Item2;Item3"
  156. '               Let Choices = MultiSel(MyVar,";",1,1,15,1,15,7)
  157. '
  158. '----------------------------------------------------------------------------
  159. FUNCTION MultiSel(InData,Delim,Lr,Lc,FG,BG,HFG,HBG)
  160.  Local  _Key, Width, Rr, Rc
  161.  Local  TopItem, TEMP
  162.  Local  Text, I, FCOUNT
  163.  
  164. Width = 0
  165. Clear Menu[]
  166. Clear ItemOrder
  167. IF FILE(InData) and (Group(InData,2) = Null)
  168.   FOPEN InData AS 1
  169.     Width=0
  170.     Item=1
  171.     WHILE NOT(EOF(1))
  172.       FREAD 1 INTO Menu[Item,1]
  173.       Menu[Item,2] = 0
  174.       IF Len(Menu[Item,1]) > Width
  175.         Width = Len(Menu[Item,1])
  176.       END IF
  177.       Item=Item+1
  178.     END WHILE
  179.   FCLOSE 1
  180. ELSE
  181.   Item = 1
  182.   FOR I = 1 TO LEN(InData)
  183.    IF InData[I] <> asc(Delim)
  184.      Menu[Item,1] = Menu[Item,1] | CHR(InData[I])
  185.    ELSE
  186.      IF LEN(Menu[Item,1]) > Width
  187.       Width = LEN(Menu[Item,1])
  188.      END IF
  189.      Item = Item+1
  190.    END IF
  191.   END FOR
  192.      IF LEN(Menu[Item,1]) > Width
  193.       Width = LEN(Menu[Item,1])
  194.      END IF
  195.      Item = Item + 2
  196. END IF
  197.  
  198.  
  199.   Rr = MIN((Lr+Item-1),(Lr+11))
  200.   Rc = MIN((Lc+Width+6),80)
  201.  
  202. '  Explode(Lr,Lc,Rr,Rc,FG,BG,10,1,400,1,"")
  203. SCREEN CLEAR BOX Lr Lc Rr Rc FG BG
  204.   Screen Print Lr Lc 15 BG "F6:Select"
  205.   Screen Print Rr Lc 15 BG "Esc:Cancel"
  206.   NumItems = Item-2
  207.  
  208.   Item=1
  209.   FOR Item = 1 TO MIN(NumItems,10)                 'display items on screen
  210.     SCREEN PRINT Lr+Item Lc+5 FG BG Menu[Item,1]
  211.   END FOR
  212.  
  213.   Item = 1
  214.   TopItem = 1
  215.   SCREEN PRINT Lr+1 Lc+3 FG BG "√"     'Highlight first item.
  216.  
  217.   Bar = Lr+1
  218.   LET _Key = OLDKEY(INCHAR)
  219.       Tkey = UPPER(CHR(_Key))
  220.   WHILE _Key <> 27
  221.      IF _Key = 20480                     'Down arrow
  222.        IF Item < NumItems
  223.          IF Bar < Rr-1
  224.            MoveBar("DOWN",Lr,Lc,FG,BG,HFG,HBG)
  225.          ELSE
  226.            SCREEN PRINT Lr+10 Lc+3 BG BG "√"
  227.            Item=Item+1
  228.            TopItem=TopItem+1
  229.            SCREEN SCROLL UP Lr+1 Lc+1 Rr-1 Rc-1 FG BG 1
  230.            IF Menu[Item,2] = 1
  231.              SCREEN PRINT Lr+10 Lc+5 HFG HBG Menu[Item,1]
  232.            ELSE
  233.              SCREEN PRINT Lr+10 Lc+5 FG BG Menu[Item,1]
  234.            END IF
  235.            SCREEN PRINT Lr+10 Lc+3 FG BG "√"
  236.          END IF
  237.        END IF
  238.      ELSEIF _Key = 18432                     'Up arrow
  239.        IF Item > 1
  240.          IF Bar > Lr+1
  241.            MoveBar("UP",Lr,Lc,FG,BG,HFG,HBG)
  242.          ELSE
  243.            SCREEN PRINT Lr+1 Lc+3 BG BG "√"
  244.            Item=Item-1
  245.            TopItem=TopItem-1
  246.            SCREEN SCROLL DOWN Lr+1 Lc+1 Rr-1 Rc-1 FG BG 1
  247.            IF Menu[Item,2] = 1
  248.              SCREEN PRINT Lr+1 Lc+5 HFG HBG Menu[Item,1]
  249.            ELSE
  250.              SCREEN PRINT Lr+1 Lc+5 FG BG Menu[Item,1]
  251.            END IF
  252.            SCREEN PRINT Lr+1 Lc+3 FG BG "√"
  253.          END IF
  254.        END IF
  255. '********************************************************************
  256. '* BUG - When deselecting items; if the item being deselected is in *
  257. '*       a position after another item that contains the same text  *
  258. '*       then the first matching text will be deleted.              *
  259. '********************************************************************
  260.      ELSEIF _Key = 16384                     'F6
  261.        IF Menu[Item,2] = 0
  262.           Menu[Item,2] = 1
  263.           ItemOrder = ItemOrder | Menu[Item,1] | Delim
  264.           SCREEN PRINT Bar Lc+5 HFG HBG Menu[Item,1]
  265.        ELSE
  266.           Menu[Item,2] = 0
  267.           ItemOrder = REPLACE(ItemOrder,FIND(Menu[Item,1],ItemOrder,0),LEN(Menu[Item,1])+1,NULL)
  268.           SCREEN PRINT Bar Lc+5 FG BG Menu[Item,1]
  269.        END IF
  270.        SmartPoke $_key keyvalue("down")
  271.  
  272.      ELSEIF _Key = 13                      'Enter
  273.        ItemOrder = REPLACE(ItemOrder,LEN(ItemOrder)-1,1,NULL)
  274.        RETURN ItemOrder
  275.      END IF
  276.      SCREEN CLEAR BOX 25 1 25 80 FG BG No-Border
  277.      Screen Print 25 1 FG BG right(ItemOrder,78)
  278.      LET _Key = OLDKEY(INCHAR)
  279.      Tkey = UPPER(CHR(_Key))
  280.    END WHILE
  281.    Repaint
  282.  RETURN NULL
  283. END FUNCTION
  284.  
  285.  
  286. '--------------------------------------------
  287. 'Function MoveBar() Moves the highlighter Bar
  288. '--------------------------------------------
  289. FUNCTION MoveBar(DIR,Lr,Lc,FG,BG,HFG,HBG)
  290.     SCREEN PRINT Bar Lc+3 BG BG "√"
  291.   CASE DIR
  292.     WHEN "UP"
  293.       Item = Item - 1
  294.       Bar = Bar - 1
  295.     WHEN "DOWN"
  296.       Item = Item + 1
  297.        Bar = Bar + 1
  298.     END CASE
  299.     SCREEN PRINT Bar Lc+3 FG BG "√"
  300. END FUNCTION
  301.  
  302.  
  303.  
  304.  
  305.  
  306.