home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / UPDATDBW.MPC < prev    next >
Text File  |  1997-04-30  |  6KB  |  192 lines
  1. PROCEDURE Update_DB_with_WKS;
  2. {Revised 6/1/96}
  3. LABEL 1,2,3,4,5;
  4. CONST
  5.  
  6. {DATA LABEL OBJECT NAMES}
  7.  
  8.     kWorksheetName='Edit This!';
  9.     kDLinkRec ='Links';
  10.     kDLinkID ='Linked to';
  11.     kDLinkFldName ='Item';
  12.     kRec ='Instruments';
  13.  
  14. {***** OTHER LOCAL CONSTANTS *****}
  15.  
  16.     kNameString = 'Name';
  17.     kMaxArray = 20;
  18.     kNameCol = 1;
  19.     kFieldRow = 1;
  20. VAR
  21.     targetHandle,recHandle,txtHan,wksHan : HANDLE;
  22.     worksheetName, str1, str2, str3, str4, str5, str6,str7 : STRING;
  23.     cancel, finished, flag, updateLabels, deleteWorksheet : BOOLEAN;
  24.     item, x1, x2 : INTEGER;
  25.     targetName,fieldValue,fieldName,recName : STRING;
  26.     recIndex,numRecs,numRows,numCols,numFieldsUsed : INTEGER;
  27.     numFlds,c,i,j,k,r : INTEGER; {** counter variables }
  28.     fieldNameList : ARRAY[1..kMaxArray] OF STRING;
  29.     
  30.     PROCEDURE CenterDialog(dX1,dX2 : INTEGER; VAR x1,x2 : INTEGER);
  31.     VAR
  32.         scrX1,scrY1,scrX2,scrY2,w : INTEGER;
  33.     BEGIN
  34.         GetScreen(scrX1,scrY1,scrX2,scrY2);
  35.         w := dX2 - dX1;
  36.         x1 := ((scrX1 + scrX2) DIV 2) - (w DIV 2);
  37.         x2 := x1 + w;
  38.     END;
  39.  
  40. PROCEDURE DoUpdate(myHandle : HANDLE);
  41. var
  42. DBRef, myName, myFieldName : STRING;
  43. BEGIN
  44.     DBRef := CONCAT('(''',kDLinkRec,'''.''',kDLinkID,''')');
  45.     myName := EvalStr(myHandle,DBRef);
  46.     DBRef := CONCAT('(''',kDLinkRec,'''.''',kDLinkFldName,''')');
  47.     myFieldName := EvalStr(myHandle,DBRef);
  48.     DBRef := CONCAT('(''',kRec,'''.''',myFieldName,''')');
  49.     SetText(myHandle, EvalStr(GetObject(myName), DBRef));
  50. END;
  51.  
  52. BEGIN
  53.     PUSHATTRS;
  54. {**  Aquire valid Worksheet}
  55.         wksHan := GETOBJECT(kWorksheetName);
  56. {** Try active worksheet}
  57.     IF (wksHan = NIL) THEN wksHan := ActSSheet;
  58. {** Try getting worksheet name from user}
  59.     IF (wksHan = NIL) THEN BEGIN
  60.          worksheetName := STRDIALOG('Enter the name of the worksheet to be processed.','Worksheet 1');
  61.         wksHan := GETOBJECT(worksheetName);
  62.     END;
  63. {** If no worksheet then punch out with dialog╔}
  64.     IF ((wksHan=NIL) | (GetType(wksHan)<>18)) THEN BEGIN
  65.         SYSBEEP;
  66.         ALRTDIALOG('I can╒t find a worksheet by that name.');
  67.         GOTO 1;
  68.     END;
  69.     worksheetName := GETNAME(wksHan);
  70. {** Get permission }
  71.     SetCursor(ARROWC);
  72.     str3 := CONCAT('Update ╘',kRec,'╒ database');
  73.     str6 := CONCAT('with information from the worksheet');
  74.     str7 := CONCAT('╘',worksheetName,'╒.');
  75.     CENTERDIALOG(0,302,x1,x2);
  76.     BEGINDIALOG(1,1,x1,165,x2,366);
  77.     ADDBUTTON('OK',1,1,228,166,292,189);
  78.     ADDBUTTON('Cancel',2,1,146,166,210,189);
  79.     ADDFIELD(str3,3,1,19,14,240,32);
  80.     ADDFIELD(str6,4,1,19,37,287,37);
  81.     ADDFIELD(str7,5,1,19,60,121,78);
  82.     ADDBUTTON('Update Data Labels',6,2,11,98,168,116);
  83.     ADDBUTTON('Delete worksheet when complete',7,2,11,125,271,143);
  84.     ENDDIALOG;
  85.     
  86.     GetDialog(1);
  87.     finished := FALSE;
  88.     cancel:= FALSE;
  89.     SetItem(6,FALSE);
  90.     SetItem(7,TRUE);
  91.     REPEAT DialogEvent(item);
  92.         IF item = 1 THEN finished := TRUE;
  93.         IF item = 2 THEN
  94.         BEGIN
  95.             finished := TRUE;
  96.             cancel := TRUE;
  97.         END;
  98.         IF (item > 5) THEN SetItem(item,NOT(ItemSel(item)));
  99.     UNTIL finished;
  100.     updateLabels := ItemSel(6);
  101.     deleteWorksheet := ItemSel(7);
  102.     CLRDIALOG;
  103.     IF cancel THEN GOTO 1;
  104.  
  105.     MESSAGE('One moment please╔');
  106.     SETCURSOR(WATCHC);
  107.     SelectSS(wksHan);
  108.     SprdSize(wksHan,numRows,numCols);
  109. {** Check if array limit is big enough}
  110.     IF numCols > kMaxArray THEN BEGIN
  111.         str5:= CONCAT('Increase CONST kMaxArray to at least ',numCols,'.');
  112.         ALRTDIALOG(str5);
  113.         GOTO 1;
  114.     END;
  115.     
  116. {** Set up array with names of fields }
  117.     numFieldsUsed := 1;
  118.     FOR c := 1 TO numCols DO BEGIN
  119.         IF c = kNameCol THEN BEGIN
  120.             numFieldsUsed := numFieldsUsed - 1;
  121.             GOTO 2;
  122.         END;
  123.         IF cellHasStr(wksHan,kFieldRow,c) THEN str1 := getCellStr(wksHan,kFieldRow,c) ELSE sysBeep;
  124.         IF str1 = kNameString THEN GOTO 2;
  125.         numFieldsUsed := numFieldsUsed + 1;
  126.         fieldNameList[c] := str1;
  127.     2:END; { of FOR c := 1 TO numCols loop }
  128.     
  129. {** Verifying existance of database name╔}
  130.      numRecs := NumRecords(NIL);
  131.      k := 0;
  132.      REPEAT
  133.             k := k + 1;
  134.          recHandle := (GetRecord( NIL, k ));
  135.          recName := GetName(recHandle);
  136.          IF recName = kRec THEN BEGIN
  137.              recIndex := k;
  138.              numFlds := NumFields(recHandle);
  139.              k := numRecs;
  140.          END;
  141.      UNTIL k = numRecs;
  142.      IF recName <> kRec THEN BEGIN
  143.          str2 := CONCAT('Could not find your ╘',kRec,'╒ database in the list.');
  144.          ALRTDIALOG(str2);
  145.          GOTO 1;
  146.      END;
  147.      
  148.  {** Verify that titles in column kNameCol of worksheet match field names}
  149.      FOR i := 1 to numFieldsUsed DO BEGIN
  150.          IF (i = kNameCol) THEN GOTO 3;
  151.          str1 := fieldNameList[i];
  152.             flag := FALSE;
  153.             j := 0;
  154.          REPEAT
  155.                 j := j + 1;
  156.              IF str1 = GetFldName(recHandle, j) THEN flag := TRUE;
  157.          UNTIL (flag) | (j = numFlds);
  158.         IF (flag = FALSE) THEN BEGIN
  159.             str4 := CONCAT('Not all worksheet column titles match a field in the ╘',kRec,'╒ record format.');
  160.          ALRTDIALOG(str4);
  161.          GOTO 1;
  162.         3:END;
  163.      END;
  164.      
  165.  {** Update the database, also update labels if checkbox is checked}
  166.     FOR r:= 1 TO numRows DO BEGIN
  167.         IF r = kFieldRow THEN GOTO 4;
  168.         MESSAGE('Updating database with row ',r,' of ',numRows);
  169.         IF CELLHASSTR(wksHan,r,kNameCol) THEN BEGIN
  170.             targetName := GETCELLSTR(wksHan,r,kNameCol);
  171.             FOR c := 1 TO numCols DO BEGIN
  172.                 IF c = kNameCol THEN GOTO 5;
  173.                 IF cellHasStr(wksHan,r,c) THEN fieldValue := getCellStr(wksHan,r,c);
  174.                 targetHandle := GetObject(targetName);
  175.                 SetRField(targetHandle,kRec,fieldNameList[c],fieldValue);
  176.             5:END;
  177.         4:END;
  178.     END;
  179.     IF updateLabels THEN BEGIN
  180.         Message('Updating Data Labels╔');
  181.         ForEachObject(DoUpdate,(R IN [kDLinkRec]));
  182.         RedrawAll;
  183.     END;
  184.     IF deleteWorksheet THEN BEGIN
  185.         DelObject(wksHan);
  186.         DSelectAll;
  187.         DeleteObjs; {** To flush the name list. }
  188.     END;
  189.     1:POPATTRS;
  190.     CLRMESSAGE;
  191. END; {of MAIN}
  192. RUN(Update_DB_with_WKS);