Changeset e58c684 in tol for vbtol/source/datatype.cpp


Ignore:
Timestamp:
Nov 14, 2008, 5:59:17 PM (18 years ago)
Author:
Liván Ramírez Dorta <livanr68@…>
Branches:
1941-docker-image-to-test, devel, master
Children:
5e8293f
Parents:
722cbff
Message:

changes from CVS not merged previously

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@159 be4846ae-f051-483a-831f-b64e7d08527f

File:
1 edited

Legend:

Unmodified
Added
Removed

  • vbtol/source/datatype.cpp

    r722cbff re58c684  
    1 #include <windows.h>
    2 #include <string.h>
    3 
    4 extern BSTR ChartoBSTR(char* str);
    5 
    6 char module[101];
    7 short initVar = 10;
    8 
    9 // Simple Sub Call
    10 void __declspec(dllexport) CALLBACK TestSub()
    11 {
    12         GetModuleFileName(NULL,(LPTSTR)module,100);
    13         ::MessageBox(NULL,module,"Location of the client",0);
    14 }
    15 
    16 // Receives a value and returns one.
    17 short __declspec(dllexport) CALLBACK SimpleFunc(short value)
    18 {
    19         return value * initVar;
    20 }
    21 
    22 //// Receives a double value and returns one.
    23 double __declspec(dllexport) CALLBACK DoubleExample(double value)
    24 {
    25         return value * initVar;
    26 }
    27 
    28 // Receives a value and returns one through an argument.
    29 void __declspec(dllexport) CALLBACK FuncByRef(short value,short *returnVar)
    30 {
    31         *returnVar = value * initVar;
    32 }
    33 
    34 // Receives a string argument and returns one.
    35 BSTR __declspec(dllexport) CALLBACK StringExample(BSTR stringVar)
    36 {
    37         LPSTR buffer;
    38         buffer = (LPSTR)stringVar; // The address is coerced into an LPSTR.
    39         ::MessageBox(NULL,buffer,"in C++",0);
    40         buffer = _strrev(buffer);
    41         return(SysAllocString(stringVar)); // Since buffer has the address, the argument
    42                                                                            // can still be returned.
    43 }
    44 
    45 //// Receives a string argument and returns a transformed one.
    46 BSTR __declspec(dllexport) CALLBACK MyStringExample(BSTR stringVar)
    47 {
    48         LPSTR buffer;
    49 
    50         buffer = (LPSTR)stringVar; // The address is coerced into an LPSTR.
    51         ::MessageBox(NULL,buffer,"in C++",0);
    52 
    53         int size = strlen(buffer)*2+4;
    54     char * st = new char[size];
    55         strcpy_s(st, size, buffer);
    56         strcat_s(st, size, " ó ");
    57         strcat_s(st, size, buffer);
    58 
    59         BSTR str = SysAllocStringByteLen(st, strlen(st));
    60         delete[] st;
    61         return (str);
    62 }
    63 
    64 // Receives an array and returns one of its elements.
    65 BSTR __declspec(dllexport) CALLBACK ArrayExample(LPSAFEARRAY FAR *data,short index)
    66 {
    67         BSTR *tempArray;
    68 //      index--;                        // Arrays begin at zero in C/C++ and at one in Visual Basic.
    69         tempArray = (BSTR*)(*data)->pvData;
    70         return(SysAllocString(tempArray[index]));
    71 }
    72 
    73 // Receives an array of integer and returns one of its elements.
    74 short __declspec(dllexport) CALLBACK MyArrayExample(LPSAFEARRAY FAR *data,short index)
    75 {
    76         short *tempArray;
    77         tempArray = (short*)(*data)->pvData;
    78         return tempArray[index];
    79 }
    80 
    81 // Receives an array of double and returns one of its elements.
    82 double __declspec(dllexport) CALLBACK My2ArrayExample(LPSAFEARRAY FAR *data,short index)
    83 {
    84         double *tempArray;
    85         tempArray = (double*)(*data)->pvData;
    86         return tempArray[index];
    87 }
    88 
    89 // Receives an array of double and modifies it.
    90 void __declspec(dllexport) CALLBACK MyModArrayExample(LPSAFEARRAY FAR *data)
    91 {
    92         double *tempArray;
    93         tempArray = (double*)(*data)->pvData;
    94     for(int i=0; i<=5; ++i)
    95                 tempArray[i] *= 10;
    96 }
    97 
    98 // Receives an array of double and return another.
    99 short __declspec(dllexport) CALLBACK MyNewArrayExample(LPSAFEARRAY FAR *data)
    100 {
    101         // Create a new 1-D array of Integers.
    102   SAFEARRAY * psaiNew;
    103   SAFEARRAYBOUND aDim[1];
    104   aDim[0].lLbound = 1;
    105   aDim[0].cElements = 8;
    106   // Equivalent to: Dim aiNew(1 To 8) As Integer.
    107   psaiNew = SafeArrayCreate(/*VT_I2 - short*/ /*double - */VT_R8, 1, aDim);
    108   //  if (psaiNew == NULL) throw ERROR_NOT_ENOUGH_MEMORY;
    109   if (psaiNew == NULL)
    110         return 0;
    111 
    112   //  if (hres = SafeArrayDestroy(psaiNew)) throw hres;
    113   if (SafeArrayDestroy(*data))
    114         return 0;
    115 
    116   *data = psaiNew;
    117 
    118   // Use array.
    119   double * tempArray;
    120   tempArray = (double*)(*data)->pvData;
    121   for(int i=0; i<8; ++i)
    122         tempArray[i] = i+10.1;
    123 
    124   return 1;
    125 }
    126 
    127 // Receives a matrix of double and modifies it.
    128 void __declspec(dllexport) CALLBACK MyMatrixExample(LPSAFEARRAY FAR *data)
    129 {
    130   SAFEARRAYBOUND * aDims = (*data)->rgsabound;
    131   // Modify 2-D array with SafeArrayGetElement and SafeArrayGetElement.
    132   long ai[2];
    133   double iVal;
    134   int yMin = aDims[0].lLbound;
    135   int yMax = yMin + (int)aDims[0].cElements - 1;
    136   int xMin = aDims[1].lLbound;
    137   int xMax = xMin + (int)aDims[1].cElements - 1;
    138   for (int x = xMin; x <= xMax; x++) {
    139     ai[0] = x;
    140     for (int y = yMin; y <= yMax; y++) {
    141       ai[1] = y;
    142       if (SafeArrayGetElement(*data, ai, &iVal))
    143                 return;
    144       // Equivalent to: aiInOut(x, y) = aiInOut(x, y) + 1.
    145       iVal *= 10;
    146       iVal += 1000;
    147       if (SafeArrayPutElement(*data, ai, &iVal))
    148                 return;
    149     }
    150   }
    151 }
    152 
    153 // Structure for the struc argument example.
    154 struct testStruct
    155 {
    156         short shortVar;
    157         unsigned char ucharVar;
    158         float floatVar;
    159         BSTR stringVar;
    160 };
    161 
    162 // Receives a structure and alters it.
    163 void __declspec(dllexport) CALLBACK StructExample(testStruct *data)
    164 {
    165         data->shortVar += 1234;
    166         data->ucharVar += 12;
    167         data->floatVar = (float)-3.4;
    168 }
    169 
    170 // Receives a structure, alters it and returns one of its elements.
    171 BSTR __declspec(dllexport) CALLBACK MyStructExample(testStruct *data)
    172 {
    173         BSTR tempArray;
    174         data->shortVar += 1234;
    175         data->ucharVar += 12;
    176         data->floatVar = (float)-3.4;
    177         tempArray = data->stringVar;
    178 //      return SysAllocString(tempArray);
    179         int size = 8;
    180     char * st = new char[size];
    181         strcpy_s(st, size, "1234567");
    182         BSTR str = SysAllocStringByteLen(st, strlen(st));
    183         delete[] st;
    184         return (str);
    185 }
    186 
    187 // Receives a structure, incorporates it in a list and
    188 // returns a concatenation of one of its fields.
    189 
    190 typedef struct smytestStruct
    191 {
    192         short shortVar;
    193         unsigned char ucharVar;
    194         float floatVar;
    195         BSTR stringVar;
    196     smytestStruct * next;
    197 } mytestStruct;
    198 
    199 typedef mytestStruct * pstruct;
    200 
    201 pstruct head = NULL;
    202 
    203 BSTR __declspec(dllexport) CALLBACK MyListExample(testStruct *data)
    204 {
    205         pstruct p = new mytestStruct;
    206 
    207         LPSTR buffer;
    208         buffer = (LPSTR)data->stringVar;
    209         ::MessageBox(NULL,buffer,"in C++",0);
    210         int size = strlen(buffer)+1;
    211     char * st = new char[size];
    212         strcpy_s(st, size, buffer);
    213         BSTR str = SysAllocStringByteLen(st, size);
    214         delete[] st;
    215         p->next = NULL;
    216     p->stringVar = str;
    217         p->shortVar = data->shortVar;
    218         p->ucharVar = data->ucharVar;
    219         p->floatVar = data->floatVar;
    220     if (head)
    221           p->next = head;
    222         head = p;
    223  
    224     st = new char[100];
    225         st[0] = '\0';
    226         for (p=head; p; p=p->next) {
    227           buffer = (LPSTR)p->stringVar;
    228           ::MessageBox(NULL,buffer,"in C++",0);
    229           strcat_s(st, 100, buffer);
    230           strcat_s(st, 100, " + ");
    231         }
    232         str = SysAllocStringByteLen(st, strlen(st));
    233         delete[] st;
    234         return (str);
    235 }
    236 
    237 // VARIANTS.
    238 VARIANT __declspec(dllexport) CALLBACK VariantExample(VARIANT data)
    239 {
    240         short i = data.iVal;
    241         VARIANT v;
    242         VariantInit(&v);
    243         v.vt = VT_R8;
    244         v.dblVal = i * 0.1;
    245         return v;
    246 }
    247 /*
    248 // Receives the address of a Visual Basic function and calls it.
    249 void __declspec(dllexport) CALLBACK CallbackExample(long Addr1)
    250 {
    251         typedef void (__stdcall *FNPTR)(BSTR stringVar);
    252         FNPTR FunctionCall;
    253         FunctionCall = (FNPTR)Addr1;
    254 //      BSTR temp = ChartoBSTR("hello");
    255         BSTR temp0 = BSTR("hello");
    256 //      BSTR temp = SysAllocStringByteLen("hello", 6);
    257         BSTR temp = SysAllocString(temp0);
    258 
    259 //    char * st = new char[10];
    260 //      strcpy_s(st, 10, "hello");
    261 //    ::MessageBox(NULL,st,"in C++",0);
    262 //      BSTR temp = SysAllocStringByteLen(st, strlen(st));
    263 //      delete[] st;
    264  
    265 //      FunctionCall(SysAllocString(temp));
    266         FunctionCall(temp);
    267 //      FunctionCall(SysAllocStringByteLen(st, strlen(st)));
    268 //      FunctionCall(SysAllocString("hello"));
    269 }
    270 */
    271 /*
    272 // Receives the address of a Visual Basic function and calls it.
    273 void __declspec(dllexport) CALLBACK CallbackExample(long Addr1)
    274 {
    275         typedef void (__stdcall *FNPTR)(double dVar);
    276         FNPTR FunctionCall;
    277         FunctionCall = (FNPTR)Addr1;
    278     double temp = 3.1415;
    279         FunctionCall(temp);
    280 }
    281 */
    282 
    283 // Receives the address of a Visual Basic function and calls it.
    284 
    285 typedef void (__stdcall *FNPTR)(double dVar);
    286 FNPTR FunctionCall;
    287 
    288 void __declspec(dllexport) CALLBACK SetCallbackExample(long Addr1)
    289 {
    290         FunctionCall = (FNPTR)Addr1;
    291 }
    292 
    293 void __declspec(dllexport) CALLBACK CallbackExample()
    294 {
    295     static double temp = 3.1415;
    296         temp += 1;
    297         FunctionCall(temp);
    298 }
    299 
    300 typedef void (__stdcall *FN2PTR)(BSTR dVar);
    301 
    302 FN2PTR Function2Call = NULL;
    303 
    304 void __declspec(dllexport) CALLBACK Set2CallbackExample(long Addr1)
    305 {
    306   Function2Call = (FN2PTR)Addr1;
    307 }
    308 
    309 void __declspec(dllexport) CALLBACK Call2backExample()
    310 {
    311 //      BSTR temp = SysAllocStringByteLen("hello", 6);
    312 //    Function2Call(temp);
    313 
    314         char buffer[] = "Helló BSTR";
    315         ::MessageBox(NULL,buffer,"ín C++",0);
    316         int size = strlen(buffer)*2+4;
    317     char * st = new char[size];
    318         strcpy_s(st, size, buffer);
    319         strcat_s(st, size, " + ");
    320         strcat_s(st, size, buffer);
    321 
    322 //      BSTR temp = SysAllocStringByteLen(st, strlen(st));
    323 //      p->stringVar = SysAllocStringByteLen(st, strlen(st));
    324 
    325     BSTR temp = ChartoBSTR(st);
    326         BSTR ret = SysAllocString(temp);
    327         Function2Call(ret);
    328         delete[] st;
    329         delete[] temp;
    330 }
    331 
    332 // Receives a currency argument and returns one.
    333 __int64 __declspec(dllexport) CALLBACK CurrencyExample(__int64 c1,__int64 c2)
    334 {
    335         return(c1 + c2);
    336 }
     1/* datatype.cpp: This file implements an interface between objects in tol
     2                  and "objects" in Visual Basic
     3                  This file define a set of utils functions.
     4                  GNU/VBTol Library
     5
     6   Copyright (C) 2001, 2002, 2003 - Bayes Decisión, SL
     7
     8   This program is free software; you can redistribute it and/or modify
     9   it under the terms of the GNU General Public License as published by
     10   the Free Software Foundation; either version 2, or (at your option)
     11   any later version.
     12
     13   This program is distributed in the hope that it will be useful,
     14   but WITHOUT ANY WARRANTY; without even the implied warranty of
     15   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     16   GNU General Public License for more details.
     17
     18   You should have received a copy of the GNU General Public License
     19   along with this program; if not, write to the Free Software
     20   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
     21   USA.
     22 */
    33723
    33824#include <config.h>
    33925#include <tol_init.h>
    34026#include <tol_bgrammar.h>
     27#include <tol/tol_bdat.h>
    34128#include <tol/tol_bdatgra.h>
    34229#include <tol/tol_blanguag.h>
    … …  
    34431#include <tol/tol_bmatgra.h>
    34532
    346 //---------------------------------------------------------------------------
    347 short __declspec(dllexport) CALLBACK TolGetReal(BSTR lvalue, double * retvalue)
    348 //---------------------------------------------------------------------------
    349 {
    350   LPSTR str_lvalue = (LPSTR)lvalue;
    351   short ret = 0;
    352 
    353   BSyntaxObject * so = GraReal()->EvaluateExpr(str_lvalue);
    354   if (so) {
    355     BDat & d = Dat(so);
    356         *retvalue = d.Value();
    357     DESTROY(so);
    358         ret = 1;
    359   }
    360   return ret;
    361 }
    362 
    363 //---------------------------------------------------------------------------
    364 short __declspec(dllexport) CALLBACK TolCreateReal(BSTR name, double value)
    365 //---------------------------------------------------------------------------
    366 {
    367   LPSTR str_name = (LPSTR)name;
    368   short ret = 0;
    369 
    370   new BContensDat(str_name, value, str_name);
    371 
    372 /*  if (so) {
    373     BDat & d = Dat(so);
    374         *retvalue = d.Value();
    375     DESTROY(so);
    376         ret = 1;
    377   }*/
    378   return ret;
    379 }
    380 
     33#include "VButils.h"
     34
     35/*
     36 *  Obtains the value of an object TOL of type Text
     37 *
     38 *  lvalue - Name of the object TOL
     39 *  retvalue - Variable where the value of the object will be returned
     40 *
     41 *  returns 1 if the object was found and its value returned, otherwise 0
     42 */
    38143//---------------------------------------------------------------------------
    38244short __declspec(dllexport) CALLBACK TolGetText(BSTR lvalue, BSTR * retvalue)
    … …  
    39052    BText & d = Text(so);
    39153    char * st = (char *)(d.String());
    392 
    393         SysFreeString(*retvalue);
    394         *retvalue = SysAllocStringByteLen(st, strlen(st));
    395 
    396         DESTROY(so);
    397         ret = 1;
     54          SysFreeString(*retvalue);
     55          *retvalue = SysAllocStringByteLen(st, strlen(st));
     56          DESTROY(so);
     57          ret = 1;
    39858  }
    39959  return ret;
    40060}
    40161
    402 //---------------------------------------------------------------------------
    403 short __declspec(dllexport) CALLBACK TolGetMatrix(BSTR lvalue, LPSAFEARRAY FAR * retvalue)
     62/*
     63 *  Creates an object TOL of type Text
     64 *
     65 *  name - Name of the object TOL
     66 *  value - Value of the object
     67 *
     68 *  returns 1 if the object was created, otherwise returns 0
     69 */
     70//---------------------------------------------------------------------------
     71short __declspec(dllexport) CALLBACK TolCreateText(BSTR name, BSTR value)
     72//---------------------------------------------------------------------------
     73{
     74  LPSTR str_name = (LPSTR)name;
     75  LPSTR str_value = (LPSTR)value;
     76  short ret = 0;
     77
     78  BSyntaxObject * so = new BContensText(str_name, str_value, "");
     79  if (so) {
     80    BList* result = NIL;
     81    BList* aux = NIL;
     82    LstFastAppend(result, aux, so);
     83    VB_concat(&VB_stack, result);
     84          ret = 1;
     85  }
     86  return ret;
     87}
     88
     89//---------------------------------------------------------------------------
     90
     91#define Known 0
     92#define Unknown 1
     93#define Pos_Inf 2
     94#define Neg_Inf 3
     95
     96// Structure for the Real Tol object.
     97struct stolreal
     98{
     99        short kind;      // support for special values
     100        double value;
     101};
     102
     103/*
     104 *  Obtains the value of an object TOL of type Real
     105 *
     106 *  lvalue - Name of the object TOL
     107 *  retvalue - Variable where the value of the object will be returned
     108 *
     109 *  returns 1 if the object was found and its value returned, otherwise 0
     110 */
     111//---------------------------------------------------------------------------
     112short __declspec(dllexport) CALLBACK TolGetReal(BSTR lvalue, stolreal * retvalue)
    404113//---------------------------------------------------------------------------
    405114{
    … …  
    407116  short ret = 0;
    408117
     118  BSyntaxObject * so = GraReal()->EvaluateExpr(str_lvalue);
     119  if (so) {
     120    BDat & d = Dat(so);
     121    retvalue->value = d.Value();
     122    if (d.IsKnown()) {
     123      if (d.IsFinite())
     124        retvalue->kind = Known;
     125      else
     126        if (d.IsPosInf())
     127          retvalue->kind = Pos_Inf;
     128        else
     129          retvalue->kind = Neg_Inf;
     130    }
     131    else
     132      retvalue->kind = Unknown;
     133    DESTROY(so);
     134          ret = 1;
     135  }
     136  return ret;
     137}
     138
     139/*
     140 *  Creates an object TOL of type Real
     141 *
     142 *  name - Name of the object TOL
     143 *  value - Value of the object
     144 *
     145 *  returns 1 if the object was created, otherwise returns 0
     146 */
     147//---------------------------------------------------------------------------
     148short __declspec(dllexport) CALLBACK TolCreateReal(BSTR name, stolreal * value)
     149//---------------------------------------------------------------------------
     150{
     151  LPSTR str_name = (LPSTR)name;
     152  short ret = 0;
     153  BDat d;
     154
     155  if (value->kind==Known)
     156    d.PutValue(value->value);
     157  else
     158    if (value->kind==Unknown)
     159      d.PutKnown(BUNKNOWN);
     160    else
     161      if (value->kind==Pos_Inf)
     162        d.PutValue(BDat::PosInf());
     163      else
     164        if (value->kind==Neg_Inf)
     165          d.PutValue(BDat::NegInf());
     166        else
     167          return 0;
     168  BSyntaxObject * so = new BContensDat(str_name, d, "");
     169  if (so) {
     170    BList* result = NIL;
     171    BList* aux = NIL;
     172    LstFastAppend(result, aux, so);
     173    VB_concat(&VB_stack, result);
     174          ret = 1;
     175  }
     176  return ret;
     177}
     178
     179//---------------------------------------------------------------------------
     180
     181// Structure of the masks cells with special values
     182struct smaskcell
     183{
     184        long r, c;       // index row and column
     185        short kind;      // special value
     186};
     187
     188// List of cells of the mask
     189struct listcell
     190{
     191        smaskcell cell;
     192        listcell * next;
     193};
     194
     195/*
     196 *  Gets the value of a range of an object TOL of type Matrix
     197 *
     198 *  See functions TolGetRange, TolGetMatrix, TolGetRow,
     199 *   TolGetColumn and TolGetCell below
     200 */
     201//---------------------------------------------------------------------------
     202short GetMatrixRange(BSTR lvalue,
     203                     long frow, long lrow,
     204                     long fcol, long lcol,
     205                     LPSAFEARRAY FAR * retvalue,
     206                     LPSAFEARRAY FAR * retmask)
     207//---------------------------------------------------------------------------
     208{
     209  LPSTR str_lvalue = (LPSTR)lvalue;
     210  short ret = 0;
     211
     212  if (!retmask || !(*retmask))          // check parameter retmask
     213    return -1;
     214  if ((*retmask)->cDims != 1)
     215    return -1;
     216  if ((*retmask)->cbElements != sizeof(smaskcell))
     217    return -1;
     218  if (!((*retmask)->rgsabound))
     219    return -1;
     220  unsigned short fFeatures = (*retmask)->fFeatures;
     221  if (fFeatures & FADF_STATIC || fFeatures & FADF_FIXEDSIZE)  // not sized with BasicŽs ReDim
     222    return -1;
     223
    409224  if (SafeArrayDestroy(*retvalue))    // Free previous array
    410225    return -1;
     226  *retvalue = NULL;
     227                                      // Get Tol Object
    411228  BSyntaxObject * so = GraMatrix()->EvaluateExpr(str_lvalue);
    412229  if (so) {
    413     BMat & d = Mat(so);
    414     BInt cols = d.Columns();
    415     BInt rows = d.Rows();
    416 
    417         // Create a new 2-D array of Doubles
    418     // Equivalent to: Dim aiNew(1 To rows, 1 To cols) As Double
    419     SAFEARRAY * psaiNew;
     230    BMat & m = Mat(so);       // Tol Matrix
     231    BInt cols = m.Columns();
     232    BInt rows = m.Rows();
     233
     234    if (lrow>rows || lcol>cols) {   // check the validity of the range
     235      DESTROY(so);
     236      return 0;
     237    }
     238    if (!frow)               // update values of the range without definition
     239      frow = 1;
     240    if (!fcol)
     241      fcol = 1;
     242    if (!lrow)
     243      lrow = rows;
     244    if (!lcol)
     245      lcol = cols;
    420246    SAFEARRAYBOUND aDims[2];
     247               // Create a new 2-D array of Doubles
     248               // Equivalent to: Dim retvalue(1 To rows, 1 To cols) As Double
    421249    aDims[0].lLbound = 1;
    422     aDims[0].cElements = cols;
     250    aDims[0].cElements = lrow-frow+1;
    423251    aDims[1].lLbound = 1;
    424     aDims[1].cElements = rows;
    425     psaiNew = SafeArrayCreate(VT_R8, 2, aDims);
    426         if (psaiNew==NULL) {                  // ERROR_NOT_ENOUGH_MEMORY
     252    aDims[1].cElements = lcol-fcol+1;
     253    *retvalue = SafeArrayCreate(VT_R8, 2, aDims);
     254          if (*retvalue==NULL) {         // ERROR_NOT_ENOUGH_MEMORY
    427255      DESTROY(so);
    428           return -1;
    429         }
    430 
    431         // Use 2-D array with SafeArrayGetElement and SafeArrayGetElement
    432 /*    long ai[2];
     256            return -1;
     257          }
     258                                      // Get values
     259    // Modify 2-D array with SafeArrayPtrOfIndex, SafeArrayLock and SafeArrayUnlock
     260          long ai[2];
    433261    double iVal;
    434     for (int x = 1; x <= cols; x++) {
    435       ai[0] = x;
    436       for (int y = 1; y <= rows; y++) {
    437         ai[1] = y;
    438         iVal = d(x-1,y-1).Value();
    439         assert (!SafeArrayPutElement(psaiNew, ai, &iVal));
     262          double * pInOut = NIL;
     263    HRESULT hres_SafeArrayLock,
     264            hres_SafeArrayUnlock,
     265            hres_SafeArrayPtrOfIndex;
     266    long cells = 0;
     267    listcell * fcell = NULL, * pcell;
     268
     269    hres_SafeArrayLock = SafeArrayLock(*retvalue);
     270    assert(!hres_SafeArrayLock);
     271    for (int r=1; r<=lrow-frow+1; ++r) {
     272      ai[0] = r;
     273      for (int c=1; c<=lcol-fcol+1; ++c) {
     274        ai[1] = c;
     275        BDat & d = m(frow+r-2, fcol+c-2);
     276        iVal = d.Value();
     277        hres_SafeArrayPtrOfIndex = SafeArrayPtrOfIndex(*retvalue, ai, (void **)&pInOut);
     278        assert (!hres_SafeArrayPtrOfIndex);
     279                    *pInOut = iVal;
     280        if (d.IsUnknown() || !d.IsFinite()) {
     281          ++cells;
     282          pcell = new listcell;
     283          pcell->cell.c = c;
     284          pcell->cell.r = r;
     285          pcell->cell.kind = d.IsUnknown() ? Unknown :
     286                             d.IsPosInf() ? Pos_Inf : Neg_Inf;
     287          pcell->next = fcell;
     288          fcell = pcell;
     289        }
    440290      }
    441291    }
    442 */
    443 
     292    hres_SafeArrayUnlock = SafeArrayUnlock(*retvalue);
     293    assert(!hres_SafeArrayUnlock);
     294                                       // Redim a 1-D array of MaskCell
     295    SAFEARRAYBOUND maskaDims;
     296    maskaDims.lLbound = 1;
     297    maskaDims.cElements = cells;
     298    HRESULT hres_SafeArrayRedim;
     299    hres_SafeArrayRedim = SafeArrayRedim(*retmask, &maskaDims);
     300    if (hres_SafeArrayRedim) {
     301      DESTROY(so);
     302      while (pcell = fcell) {
     303        fcell = fcell->next;
     304        delete pcell;
     305      }
     306      return -1;
     307    }
     308                                      // Get mask for special values
     309    if (retmask && *retmask && cells) {
     310      hres_SafeArrayLock = SafeArrayLock(*retmask);
     311      assert(!hres_SafeArrayLock);
     312          smaskcell * maskpInOut = (smaskcell *)((*retmask)->pvData);
     313      for (int i=0; i<cells; ++i) {
     314        maskpInOut[i] = fcell->cell;
     315        pcell = fcell;
     316        fcell = fcell->next;
     317        delete pcell;
     318      }
     319      hres_SafeArrayUnlock = SafeArrayUnlock(*retmask);
     320      assert(!hres_SafeArrayUnlock);
     321    }
     322
     323    DESTROY(so);
     324          ret = 1;
     325  }
     326  return ret;
     327}
     328
     329/*
     330 *  Gets the value of a range of an object TOL of type Matrix
     331 *
     332 *  lvalue - Name of the object TOL
     333 *  retvalue - Variable where the values of the range will be returned
     334 *  retmask - Variable where the cells with special values will be returned
     335 *  frow, lrow, fcol, lcol - first row, last row, first column, last column
     336 *                           that define the range
     337 *
     338 *  returns 1 if the object was found, the specified range was correct and
     339 *            its value returned; otherwise 0,
     340 *  also it returns -1 when a critical error has happened like
     341 *  a memory allocation error or
     342 *  an incorrect type of the array retmask given as a parameter
     343 */
     344//---------------------------------------------------------------------------
     345short __declspec(dllexport) CALLBACK TolGetRange(BSTR lvalue,
     346                                                 long frow, long lrow,
     347                                                 long fcol, long lcol,
     348                                                 LPSAFEARRAY FAR * retvalue,
     349                                                 LPSAFEARRAY FAR * retmask)
     350//---------------------------------------------------------------------------
     351{
     352  if (frow<1 || fcol<1 || frow>lrow || fcol>lcol) // check the definition of range
     353    return 0;
     354  return GetMatrixRange(lvalue, frow, lrow, fcol, lcol, retvalue, retmask);
     355}
     356
     357/*
     358 *  Obtains the value of an object TOL of type Matrix
     359 *
     360 *  lvalue - Name of the object TOL
     361 *  retvalue - Variable where the value of the object will be returned
     362 *  retmask - Variable where the cells with special values will be returned
     363 *
     364 *  returns 1 if the object was found and its value returned, otherwise 0,
     365 *  also it returns -1 when a critical error has happened like
     366 *  a memory allocation error or
     367 *  an incorrect type of the array retmask given as a parameter
     368 */
     369//---------------------------------------------------------------------------
     370short __declspec(dllexport) CALLBACK TolGetMatrix(BSTR lvalue,
     371                                                  LPSAFEARRAY FAR * retvalue,
     372                                                  LPSAFEARRAY FAR * retmask)
     373//---------------------------------------------------------------------------
     374{
     375  return GetMatrixRange(lvalue, 0, 0, 0, 0, retvalue, retmask);
     376}
     377
     378/*
     379 *  Gets the value of a row of an object TOL of type Matrix
     380 *
     381 *  lvalue - Name of the object TOL
     382 *  retvalue - Variable where the values of the row will be returned
     383 *  retmask - Variable where the cells with special values will be returned
     384 *  row - index of the row to obtain
     385 *
     386 *  returns 1 if the object was found, the specified row was correct and
     387 *            its value returned; otherwise 0,
     388 *  also it returns -1 when a critical error has happened like
     389 *  a memory allocation error or
     390 *  an incorrect type of the array retmask given as a parameter
     391 */
     392//---------------------------------------------------------------------------
     393short __declspec(dllexport) CALLBACK TolGetRow(BSTR lvalue, long row,
     394                                               LPSAFEARRAY FAR * retvalue,
     395                                               LPSAFEARRAY FAR * retmask)
     396//---------------------------------------------------------------------------
     397{
     398  if (row<1)      // check the definition of the row
     399    return 0;
     400  return GetMatrixRange(lvalue, row, row, 0, 0, retvalue, retmask);
     401}
     402
     403/*
     404 *  Gets the value of a column of an object TOL of type Matrix
     405 *
     406 *  lvalue - Name of the object TOL
     407 *  retvalue - Variable where the values of the column will be returned
     408 *  retmask - Variable where the cells with special values will be returned
     409 *  col - index of the column to obtain
     410 *
     411 *  returns 1 if the object was found, the specified column was correct and
     412 *            its value returned; otherwise 0,
     413 *  also it returns -1 when a critical error has happened like
     414 *  a memory allocation error or
     415 *  an incorrect type of the array retmask given as a parameter
     416 */
     417//---------------------------------------------------------------------------
     418short __declspec(dllexport) CALLBACK TolGetColumn(BSTR lvalue, long col,
     419                                                  LPSAFEARRAY FAR * retvalue,
     420                                                  LPSAFEARRAY FAR * retmask)
     421//---------------------------------------------------------------------------
     422{
     423  if (col<1)      // check the definition of the column
     424    return 0;
     425  return GetMatrixRange(lvalue, 0, 0, col, col, retvalue, retmask);
     426}
     427
     428/*
     429 *  Gets the value of a cell of an object TOL of type Matrix
     430 *
     431 *  lvalue - Name of the object TOL
     432 *  retvalue - Variable where the value of the cell will be returned
     433 *  row, col - position of the cell to obtain
     434 *
     435 *  returns 1 if the object was found, the specified position of the cell
     436 *            was correct and its value returned; otherwise returns 0.
     437 */
     438//---------------------------------------------------------------------------
     439short __declspec(dllexport) CALLBACK TolGetCell(BSTR lvalue, long row, long col,
     440                                                stolreal * retvalue)
     441//---------------------------------------------------------------------------
     442{
     443  if (row<1 || col<1)      // check the position of the cell
     444    return 0;
     445  LPSTR str_lvalue = (LPSTR)lvalue;
     446  short ret = 0;
     447                                      // Get Tol Matrix Object
     448  BSyntaxObject * so = GraMatrix()->EvaluateExpr(str_lvalue);
     449  if (so) {
     450    BMat & m = Mat(so);       // Tol Matrix
     451    if (row>m.Rows() || col>m.Columns()) {   // check the validity of the position
     452      DESTROY(so);
     453      return 0;
     454    }
     455    BDat & d = m(row-1, col-1);       // Tol Real (Cell)
     456    retvalue->value = d.Value();   // Get value
     457    if (d.IsKnown()) {
     458      if (d.IsFinite())
     459        retvalue->kind = Known;
     460      else
     461        if (d.IsPosInf())
     462          retvalue->kind = Pos_Inf;
     463        else
     464          retvalue->kind = Neg_Inf;
     465    }
     466    else
     467      retvalue->kind = Unknown;
     468    DESTROY(so);
     469          ret = 1;
     470  }
     471  return ret;
     472}
     473
     474/*
     475 *  Puts the values of a range of an object TOL of type Matrix
     476 *
     477 *  See functions TolPutRange, TolPutMatrix, TolPutRow,
     478 *   TolPutColumn and TolPutCell below
     479 */
     480//---------------------------------------------------------------------------
     481short PutMatrixRange(BSTR lvalue, long row, long col,
     482                     LPSAFEARRAY FAR * value,
     483                     LPSAFEARRAY FAR * mask)
     484//---------------------------------------------------------------------------
     485{
     486  LPSTR str_lvalue = (LPSTR)lvalue;
     487  short ret = 0;
     488
     489  if (!value || !(*value))          // check parameter value
     490    return -1;
     491  if ((*value)->cDims != 2)
     492    return -1;
     493  SAFEARRAYBOUND * aDims = (*value)->rgsabound;
     494  if (!aDims)
     495    return -1;
     496  int cMin = aDims[0].lLbound;
     497  int rMin = aDims[1].lLbound;
     498  BInt v_cols = aDims[0].cElements;
     499  BInt v_rows = aDims[1].cElements;
     500  if (v_cols<=0 || v_rows<=0)
     501    return -1;
     502
     503  int cells;                        // check parameter mask
     504  if (!mask || !(*mask))
     505    cells = 0;
     506  else {
     507    if ((*mask)->cDims != 1)
     508      return -1;
     509    if ((*mask)->cbElements != sizeof(smaskcell))
     510      return -1;
     511    SAFEARRAYBOUND * maskaDims = (*mask)->rgsabound;
     512    if (!maskaDims)
     513      return -1;
     514    cells = maskaDims->cElements;
     515    if (cells<0)
     516      return -1;
     517  }
     518                                      // Get Tol Object
     519  BSyntaxObject * so = GraMatrix()->EvaluateExpr(str_lvalue);
     520  if (so) {
     521    BMat & d = Mat(so);       // Tol Matrix
     522    BInt m_cols = d.Columns();
     523    BInt m_rows = d.Rows();
     524
     525    if (!row)               // update values of the range without definition
     526      row = 1;
     527    if (!col)
     528      col = 1;
     529    if (row+v_rows-1 > m_rows || col+v_cols-1 > m_cols) {   // check the validity of the range
     530      DESTROY(so);
     531      return 0;
     532    }
     533                               // Put values
    444534        // Use 2-D array with SafeArrayPtrOfIndex, SafeArrayLock and SafeArrayUnlock
    445     assert (!SafeArrayLock(psaiNew));
    446         long ai[2];
    447     double iVal;
    448         double * piInOut;
    449     for (int x = 1; x <= cols; x++) {
    450       ai[0] = x;
    451       for (int y = 1; y <= rows; y++) {
    452         ai[1] = y;
    453         iVal = d(x-1,y-1).Value();
    454         assert (!SafeArrayPtrOfIndex(psaiNew, ai, (void **)&piInOut));
    455                 *piInOut = iVal;
     535    long ai[2];
     536    double * pInOut = NULL;
     537    HRESULT hres_SafeArrayLock,
     538            hres_SafeArrayUnlock,
     539            hres_SafeArrayPtrOfIndex;
     540   
     541    hres_SafeArrayLock = SafeArrayLock(*value);
     542    assert(!hres_SafeArrayLock);
     543    for (int r=0; r<v_rows; ++r) {
     544      ai[0] = r + rMin;
     545      for (int c=0; c<v_cols; ++c) {
     546        ai[1] = c + cMin;
     547        hres_SafeArrayPtrOfIndex = SafeArrayPtrOfIndex(*value, ai, (void **)(&pInOut));
     548        assert(!hres_SafeArrayPtrOfIndex);
     549                    d(r+row-1, c+col-1) = *pInOut;
    456550      }
    457551    }
    458         assert (!SafeArrayUnlock(psaiNew));
    459        
    460         *retvalue = psaiNew;                // Assing new array
     552    hres_SafeArrayUnlock = SafeArrayUnlock(*value);
     553    assert(!hres_SafeArrayUnlock);
     554                               // Put special values
     555    if (cells) {
     556      hres_SafeArrayLock = SafeArrayLock(*mask);
     557      assert(!hres_SafeArrayLock);
     558      smaskcell * maskpInOut = (smaskcell *)((*mask)->pvData);
     559      for (int i=0; i<cells; ++i) {
     560        long p_row = maskpInOut[i].r - rMin;
     561        long p_col = maskpInOut[i].c - cMin;
     562        if (p_row<0 || p_row>=v_rows || p_col<0 || p_col>=v_cols ) {
     563          hres_SafeArrayUnlock = SafeArrayUnlock(*mask);
     564          assert(!hres_SafeArrayUnlock);
     565          DESTROY(so);
     566          return 0;
     567        }
     568        short kind = maskpInOut[i].kind;
     569        if (kind==Unknown)
     570          d(p_row+row-1, p_col+col-1).PutKnown(BUNKNOWN);
     571        else
     572          if (kind==Pos_Inf)
     573            d(p_row+row-1, p_col+col-1).PutValue(BDat::PosInf());
     574          else
     575            if (kind==Neg_Inf)
     576              d(p_row+row-1, p_col+col-1).PutValue(BDat::NegInf());
     577            else
     578              if (kind==Known)
     579                ;
     580              else {
     581                hres_SafeArrayUnlock = SafeArrayUnlock(*mask);
     582                assert(!hres_SafeArrayUnlock);
     583                DESTROY(so);
     584                return 0;
     585              }
     586      }
     587      hres_SafeArrayUnlock = SafeArrayUnlock(*mask);
     588      assert(!hres_SafeArrayUnlock);
     589    }
     590
    461591    DESTROY(so);
    462         ret = 1;
     592          ret = 1;
    463593  }
    464594  return ret;
    465595}
     596
     597/*
     598 *  Puts the values of a range of an object TOL of type Matrix
     599 *
     600 *  lvalue - Name of the object TOL
     601 *  value - Values of the range
     602 *  mask - Array of mask cells with special values
     603 *  row, col - position of the begining of the range
     604 *
     605 *  returns 1 if the object was found, the specified range was correct and
     606 *            its values updated; otherwise 0,
     607 *  also it returns -1 when a critical error has happened like
     608 *  incorrect dimensions of the array given as a parameter or
     609 *  an incorrect type of the array mask given as a parameter
     610 */
     611//---------------------------------------------------------------------------
     612short __declspec(dllexport) CALLBACK TolPutRange(BSTR lvalue, long row, long col,
     613                                                 LPSAFEARRAY FAR * value,
     614                                                 LPSAFEARRAY FAR * mask)
     615//---------------------------------------------------------------------------
     616{
     617  if (row<1 || col<1)             // check the begining of the range
     618    return 0;
     619  return PutMatrixRange(lvalue, row, col, value, mask);
     620}
     621
     622/*
     623 *  Puts the values of a row of an object TOL of type Matrix
     624 *
     625 *  lvalue - Name of the object TOL
     626 *  value - Values of the row
     627 *  mask - Array of mask cells with special values
     628 *  row - index of the row
     629 *
     630 *  returns 1 if the object was found, the specified row was correct and
     631 *            its values updated; otherwise 0,
     632 *  also it returns -1 when a critical error has happened like
     633 *  incorrect dimensions of the array given as a parameter or
     634 *  an incorrect type of the array mask given as a parameter
     635 */
     636//---------------------------------------------------------------------------
     637short __declspec(dllexport) CALLBACK TolPutRow(BSTR lvalue, long row,
     638                                               LPSAFEARRAY FAR * value,
     639                                               LPSAFEARRAY FAR * mask)
     640//---------------------------------------------------------------------------
     641{
     642  if (row<1)             // check the index of the row
     643    return 0;
     644  return PutMatrixRange(lvalue, row, 0, value, mask);
     645}
     646
     647/*
     648 *  Puts the values of a column of an object TOL of type Matrix
     649 *
     650 *  lvalue - Name of the object TOL
     651 *  value - Values of the column
     652 *  mask - Array of mask cells with special values
     653 *  col - index of the column
     654 *
     655 *  returns 1 if the object was found, the specified column was correct and
     656 *            its values updated; otherwise 0,
     657 *  also it returns -1 when a critical error has happened like
     658 *  incorrect dimensions of the array given as a parameter or
     659 *  an incorrect type of the array mask given as a parameter
     660 */
     661//---------------------------------------------------------------------------
     662short __declspec(dllexport) CALLBACK TolPutColumn(BSTR lvalue, long col,
     663                                                  LPSAFEARRAY FAR * value,
     664                                                  LPSAFEARRAY FAR * mask)
     665//---------------------------------------------------------------------------
     666{
     667  if (col<1)             // check the index of the column
     668    return 0;
     669  return PutMatrixRange(lvalue, 0, col, value, mask);
     670}
     671
     672/*
     673 *  Puts the value of a cell of an object TOL of type Matrix
     674 *
     675 *  lvalue - Name of the object TOL
     676 *  value - Value of the cell
     677 *  row, col - position of the cell
     678 *
     679 *  returns 1 if the object was found, the specified position of the cell
     680 *            was correct and its value updated; otherwise returns 0.
     681 */
     682//---------------------------------------------------------------------------
     683short __declspec(dllexport) CALLBACK TolPutCell(BSTR lvalue, long row, long col,
     684                                                stolreal * value)
     685//---------------------------------------------------------------------------
     686{
     687  if (row<1 || col<1)      // check the position of the cell
     688    return 0;
     689  LPSTR str_lvalue = (LPSTR)lvalue;
     690  short ret = 0;
     691                                      // Get Tol Matrix Object
     692  BSyntaxObject * so = GraMatrix()->EvaluateExpr(str_lvalue);
     693  if (so) {
     694    BMat & m = Mat(so);       // Tol Matrix
     695    if (row>m.Rows() || col>m.Columns()) {   // check the validity of the position
     696      DESTROY(so);
     697      return 0;
     698    }
     699    BDat & d = m(row-1, col-1);       // Tol Real (Cell)
     700    if (value->kind==Known)
     701      d.PutValue(value->value);
     702    else
     703      if (value->kind==Unknown)
     704        d.PutKnown(BUNKNOWN);
     705      else
     706        if (value->kind==Pos_Inf)
     707          d.PutValue(BDat::PosInf());
     708        else
     709          if (value->kind==Neg_Inf)
     710            d.PutValue(BDat::NegInf());
     711          else {
     712            DESTROY(so);
     713            return 0;
     714          }
     715    DESTROY(so);
     716          ret = 1;
     717  }
     718  return ret;
     719}
     720
     721/*
     722 *  Creates an object TOL of type Matrix
     723 *
     724 *  name - Name of the object TOL
     725 *  value - Value of the object
     726 *  mask - Array of mask cells with special values
     727 *
     728 *  returns 1 if the object was created, otherwise returns 0,
     729 *  also it returns -1 when a critical error has happened like
     730 *  incorrect dimensions of the array given as a parameter or
     731 *  an incorrect type of the array retmask given as a parameter
     732 */
     733//---------------------------------------------------------------------------
     734short __declspec(dllexport) CALLBACK TolCreateMatrix(BSTR name,
     735                                                     LPSAFEARRAY FAR * value,
     736                                                     LPSAFEARRAY FAR * mask)
     737//---------------------------------------------------------------------------
     738{
     739  LPSTR str_name = (LPSTR)name;
     740  short ret = 0;
     741 
     742  if (!value || !(*value))          // check parameter value
     743    return -1;
     744  if ((*value)->cDims != 2)
     745    return -1;
     746  SAFEARRAYBOUND * aDims = (*value)->rgsabound;
     747  if (!aDims)
     748    return -1;
     749  int cMin = aDims[0].lLbound;
     750  int rMin = aDims[1].lLbound;
     751  BInt cols = aDims[0].cElements;
     752  BInt rows = aDims[1].cElements;
     753  if (cols<=0 || rows<=0)
     754    return -1;
     755
     756  int cells;                        // check parameter mask
     757  if (!mask || !(*mask))
     758    cells = 0;
     759  else {
     760    if ((*mask)->cDims != 1)
     761      return -1;
     762    if ((*mask)->cbElements != sizeof(smaskcell))
     763      return -1;
     764    SAFEARRAYBOUND * maskaDims = (*mask)->rgsabound;
     765    if (!maskaDims)
     766      return -1;
     767    cells = maskaDims->cElements;
     768    if (cells<0)
     769      return -1;
     770  }
     771
     772  BMat d(rows, cols);   // Tol Matrix
     773                               // Put values
     774        // Use 2-D array with SafeArrayPtrOfIndex, SafeArrayLock and SafeArrayUnlock
     775  long ai[2];
     776  double * pInOut = NULL;
     777  HRESULT hres_SafeArrayLock,
     778          hres_SafeArrayUnlock,
     779          hres_SafeArrayPtrOfIndex;
     780   
     781  hres_SafeArrayLock = SafeArrayLock(*value);
     782  assert(!hres_SafeArrayLock);
     783  for (int r=0; r<rows; ++r) {
     784    ai[0] = r + rMin;
     785    for (int c=0; c<cols; ++c) {
     786      ai[1] = c + cMin;
     787      hres_SafeArrayPtrOfIndex = SafeArrayPtrOfIndex(*value, ai, (void **)(&pInOut));
     788      assert(!hres_SafeArrayPtrOfIndex);
     789                  d(r, c) = *pInOut;
     790    }
     791  }
     792  hres_SafeArrayUnlock = SafeArrayUnlock(*value);
     793  assert(!hres_SafeArrayUnlock);
     794                               // Put special values
     795  if (cells) {
     796    hres_SafeArrayLock = SafeArrayLock(*mask);
     797    assert(!hres_SafeArrayLock);
     798    smaskcell * maskpInOut = (smaskcell *)((*mask)->pvData);
     799    for (int i=0; i<cells; ++i) {
     800      long row = maskpInOut[i].r - rMin;
     801      long col = maskpInOut[i].c - cMin;
     802      if (row<0 || row>=rows || col<0 || col>=cols ) {
     803        hres_SafeArrayUnlock = SafeArrayUnlock(*mask);
     804        assert(!hres_SafeArrayUnlock);
     805        return 0;
     806      }
     807      short kind = maskpInOut[i].kind;
     808      if (kind==Unknown)
     809        d(row, col).PutKnown(BUNKNOWN);
     810      else
     811        if (kind==Pos_Inf)
     812          d(row, col).PutValue(BDat::PosInf());
     813        else
     814          if (kind==Neg_Inf)
     815            d(row, col).PutValue(BDat::NegInf());
     816          else
     817            if (kind==Known)
     818              ;
     819            else {
     820              hres_SafeArrayUnlock = SafeArrayUnlock(*mask);
     821              assert(!hres_SafeArrayUnlock);
     822              return 0;
     823            }
     824    }
     825    hres_SafeArrayUnlock = SafeArrayUnlock(*mask);
     826    assert(!hres_SafeArrayUnlock);
     827  }
     828                               // Create Tol Object
     829  BSyntaxObject * so = new BContensMat(str_name, d, "");
     830  if (so) {
     831    BList* result = NIL;
     832    BList* aux = NIL;
     833    LstFastAppend(result, aux, so);
     834    VB_concat(&VB_stack, result);
     835          ret = 1;
     836  }
     837  return ret;
     838}
     839
Note: See TracChangeset for help on using the changeset viewer.