Chip 1998 March/Chip_1998-03_cd.bin/tema/MINICAD/MC7DEMO/MINICAD.1/WORKSHT.TXT

Text File | 1997-04-22 | 7KB | 302 lines

<!-------------------------------------------------------->
Procedure ActivateWS(theWkshtName:STRING);
VAR
    SSHd:HANDLE;
BEGIN
    SSHd:=GetObject(theWkshtName);
    SelectSS(SSHd);
END;
<!-------------------------------------------------------->
Function WSExistH(WSName:STRING;VAR WSHd:HANDLE):BOOLEAN;
BEGIN
    WSHd:=GetObject(WSName);
    IF WSHd <> NIL THEN
        WSExist:=True
    ELSE
        WSExist:=False;
END;
<!-------------------------------------------------------->
Function WSExist(WSName:STRING):BOOLEAN;
VAR
    WSHd:HANDLE;
BEGIN
    WSHd:=GetObject(WSName);
    IF WSHd <> NIL THEN
        WSExist:=True
    ELSE
        WSExist:=False;
END;
<!-------------------------------------------------------->
Procedure BuildWorksheetDB(WSName,RecordName:STRING;StartRow:INTEGER);
VAR
    Q,CriteriaString:STRING;

Procedure ActivateWS(theWkshtName:STRING);
VAR
    SSHd:HANDLE;
BEGIN
    SSHd:=GetObject(theWkshtName);
    SelectSS(SSHd);
END;


BEGIN
    Q:=Chr(39);

    CriteriaString:=Concat('=Database((R IN[',Q,RecordName,Q,']))');
    ActivateWS(WSName);

    LoadCell(StartRow,0,CriteriaString);
END;
<!-------------------------------------------------------->
Procedure BuildDBColumnRF(WSName,Record,Field:STRING;Row,Column:INTEGER);
VAR
    theCriteria:STRING;


Procedure ActivateWS(theWkshtName:STRING);
VAR
    SSHd:HANDLE;
BEGIN
    SSHd:=GetObject(theWkshtName);
    SelectSS(SSHd);
END;

Function BuildRecCrit(Record,Field:STRING;RecordOnly,UseEqual:BOOLEAN):STRING;
VAR
    Q,CriteriaString:STRING;
BEGIN
    Q:=Chr(39);

    IF RecordOnly THEN BEGIN
        CriteriaString:=Concat('(R IN[',Q,Record,Q,'])');
        IF UseEqual THEN
            CriteriaString:=Concat('=',CriteriaString);
    END
    ELSE BEGIN
        CriteriaString:=Concat('(',Q,Record,Q,'.',Q,Field,Q,')');
        IF UseEqual THEN
            CriteriaString:=Concat('=',CriteriaString);
    END;

    BuildRecCrit:=CriteriaString;
END;

BEGIN
    ActivateWS(WSName);
    LoadCell(Row,Column,BuildRecCrit(Record,Field,FALSE,TRUE));
END;
<!-------------------------------------------------------->
Procedure BuildDBColumn(WksheetName,CriteriaString:STRING;Row,Column:INTEGER);
VAR
    theCriteria:STRING;


Procedure ActivateWS(theWkshtName:STRING);
VAR
    SSHd:HANDLE;
BEGIN
    SSHd:=GetObject(theWkshtName);
    SelectSS(SSHd);
END;

BEGIN
    ActivateWS(WksheetName);
    LoadCell(Row,Column,CriteriaString);
END;
<!-------------------------------------------------------->
Procedure Form2Number(WSName:STRING;StartRow,StartCol,EndRow,EndCol:INTEGER);
VAR
    theValue:REAL;
    SSHd:HANDLE;
    i,j:INTEGER;
BEGIN
    i:=StartCol;
    j:=StartRow;
    SSHd:=GetObject(WSName);
    SelectSS(SSHd);
    WHILE i <= EndCol DO BEGIN
        WHILE j<=EndRow DO BEGIN
            IF CellHasNum(SSHd,j,i) THEN BEGIN
                theValue:=GetCellNum(SSHd,j,i);
                LoadCell(j,i,Num2Str(3,theValue));
            END;
            j:=j+1;
        END;
        i:=i+1;
        j:=StartRow;
    END;
END;
<!-------------------------------------------------------->
Procedure WKSExport(WkshtName,TargetFile:STRING;StartRow,StartCol,EndRow,EndCol:INTEGER;Formulas:BOOLEAN);
VAR
    Rows,Cols,RCount,CCount:INTEGER;
    CellValue,CR:STRING;
    SSHd:HANDLE;
    Stop:BOOLEAN;

Function BoundsChk(Rows,Cols,RStart,REnd,CStart,CEnd:INTEGER):BOOLEAN;
VAR
    errorFound:BOOLEAN;
BEGIN
    IF (RStart <= 0) OR (RStart > Rows) OR (REnd > Rows) OR (RStart > REnd) OR
    (CStart <= 0) OR (CStart > Cols) OR (CEnd > Cols) OR (CStart > CEnd) THEN BEGIN
        errorFound:=True;
    END
    ELSE BEGIN
        errorFound:=False;
    END;

    BoundsChk:=errorFound;
END;

BEGIN
    RCount:=StartRow;
    CCount:=StartCol;
    CR:=Chr(13);

    SSHd:=GetObject(WkshtName);
    SprdSize(SSHd,Rows,Cols);

    Stop:=BoundsCheck(Rows,Cols,StartRow,EndRow,StartCol,EndCol);
    IF NOT Stop THEN BEGIN
        Rewrite(TargetFile);
        WHILE RCount <= EndRow DO BEGIN
            WHILE CCount <= EndCol DO BEGIN
                IF Formulas THEN BEGIN
                    CellValue:=GetCellStr(SSHd,RCount,CCount);
                END
                ELSE BEGIN
                    CellValue:=Num2Str(3,GetCellNum(SSHd,RCount,CCount));
                END;
                Write(CellValue);
                IF CCount < EndCol THEN BEGIN
                    Tab(1);
                END
                ELSE BEGIN
                    Write(CR);
                END;
                CCount:=CCount+1;
            END;
            RCount:=RCount+1;
            CCount:=StartCol;
        END;

        Close(TargetFile);
    END;
END;
Run(WKSExport);
<!-------------------------------------------------------->
Procedure VFind(WSName,MatchValue:STRING; LookupCol,RangeStart,RangeEnd:INTEGER;VAR hitLocation:INTEGER);
VAR
    totalRows,totalCols:INTEGER;
    SSHd:HANDLE;
    CellVal:STRING;
    Found,Stop:BOOLEAN;

Function BoundsChk(Rows,Cols,RStart,REnd,LCol:INTEGER):BOOLEAN;
VAR
    errorFound:BOOLEAN;
BEGIN
    IF (RStart <= 0) OR (RStart > Rows) OR (REnd > Rows) OR (RStart >= REnd) OR
    (LCol <= 0) OR (LCol>Cols) THEN BEGIN
        errorFound:=True;
    END
    ELSE BEGIN
        errorFound:=False;
    END;

    BoundsChk:=errorFound;
END;

BEGIN
    SSHd:=GetObject(WSName);
    SprdSize(SSHd,totalRows,totalCols);
    Stop:=BoundsChk(totalRows,totalCols,RangeStart,RangeEnd,LookupCol);

    IF NOT Stop THEN BEGIN
        REPEAT
            CellVal:=GetCellStr(SSHd,RangeStart,LookupCol);
            IF CellVal = MatchValue THEN BEGIN
                hitLocation:=RangeStart;
                Found:=True;
            END
            ELSE BEGIN
                RangeStart:=RangeStart+1;
                IF RangeStart > RangeEnd THEN BEGIN
                    Found:=True;
                    AlrtDialog('Error: Value not found');
                END;
            END;
        UNTIL Found OR (RangeStart > RangeEnd);
    END
    ELSE BEGIN
        AlrtDialog('Error : Bad range value');
    END;
    Found:=False;
END;
<!-------------------------------------------------------->
Procedure HOffsetReturn(WSName:STRING;baseRow,targetCol:INTEGER;retFormula:BOOLEAN;VAR targetValue:STRING);
VAR
    SSHd:HANDLE;
    hasFormula:BOOLEAN;
BEGIN
    SSHd:=GetObject(WSName);
    hasFormula:=CellHasNum(SSHd,baseRow,targetCol);

    IF hasFormula AND NOT retFormula THEN BEGIN
        targetValue:=Num2Str(2,GetCellNum(SSHd,baseRow,targetCol));
    END
    ELSE BEGIN
            targetValue:=GetCellStr(SSHd,baseRow,targetCol);
    END;
END;
<!-------------------------------------------------------->
Procedure VSeek(WSName,MatchString:STRING; LookupCol,RangeStart,RangeEnd,TargetCol:INTEGER;VAR targetValue:STRING);
VAR
    totalRows,totalCols:INTEGER;
    SSHd:HANDLE;
    CellVal:STRING;
    Found,Stop:BOOLEAN;

Function BoundsChk(Rows,Cols,RStart,REnd,LCol,TCol:INTEGER):BOOLEAN;
VAR
    errorFound:BOOLEAN;
BEGIN
    IF (RStart <= 0) OR (RStart > Rows) OR (REnd > Rows) OR (RStart >= REnd) OR
    (LCol <= 0) OR (TCol <= 0) OR (LCol>Cols) OR (TCol>Cols) THEN BEGIN
        errorFound:=True;
    END
    ELSE BEGIN
        errorFound:=False;
    END;

    BoundsChk:=errorFound;
END;

BEGIN
    SSHd:=GetObject(WSName);
    SprdSize(SSHd,totalRows,totalCols);
    Stop:=BoundsChk(totalRows,totalCols,RangeStart,RangeEnd,LookupCol,TargetCol);

    IF NOT Stop THEN BEGIN
        REPEAT
            CellVal:=GetCellStr(SSHd,RangeStart,LookupCol);
            IF Pos(MatchStr,CellVal) <> 0 THEN BEGIN
                targetValue:=GetCellStr(SSHd,RangeStart,TargetCol);
                Found:=True;
            END
            ELSE BEGIN
                RangeStart:=RangeStart+1;
                IF RangeStart > RangeEnd THEN BEGIN
                    Found:=True;
                    AlrtDialog('Error: Value not found');
                END;
            END;
        UNTIL Found OR (RangeStart > RangeEnd);
    END
    ELSE BEGIN
        AlrtDialog('Error : Bad range value');
    END;
END;