Attribute VB_Name = "MASSLYNX" '**************************************************************************************** ' ' File: MASSLYNX.BAS ' ' Author: Roberto Raso ' Date: 17th June 1994 ' '**************************************************************************************** ' ' Purpose: Provide a collection of general MassLynx functions. ' '**************************************************************************************** '**************************************************************************************** ' ' Constant/Global declarations. ' '**************************************************************************************** Option Explicit 'Open window timeouts Global Const OPEN_WIN_TIMEOUT_SEC = 5 'Seconds Global Const OPEN_WIN_TIMEOUT = 5000 'Milliseconds 'Mass Measure Mode Global Const MASS_MEAS_STD = 0 Global Const MASS_MEAS_QTOF = 1 Global Const MASS_MEAS_MTOF = 2 Const RAW_MAX_SAMPDESC_LENGTH = 120 'Windows message CLOSE WINDOW. Const ID_FILE_OPENDATAFILE = 32787 Const ID_FILE_PRINT_SETUP = 57606 'Printer set-up Const LANDSCAPE = &H421 Const PORTRAIT = &H420 'Constants for adding, replacing or new windows. 'Used in functions like ChroFile and SpeFile. Global Const ADD = 0 Global Const REPLACE = 1 Global Const NEW_WINDOW = 2 '--- '--- Data Browser and History Dialogue Boxes Constants '--- Global Const ID_BRO_FILENAME = 1214 Global Const SPEC_OPEN = 1 Global Const CHRO_OPEN = 2 Global Const ID_BRO_ADD = 110 Global Const ID_BRO_REPLACE = 111 Global Const ID_BRO_NEW_WIND = 112 Const ID_CHK_CHRO = 107 Const ID_CHK_SPEC = 109 Const ID_FUNC_LIST = &H69 Const SAVED = "SAVED" 'Constants used for MASSLYNX.INI and VG global access. Global Const DATA_EXT = ".RAW" ' Global Const SYSPARAGRAPH = "SystemList" Const INI_FILE_SEP = "," Const PPS_BUF_SIZE = 128 Const PROC_STUB = "_PROC" Const FUNC_STUB = "_FUNC" Const DATA_FILE_EXT = "DAT" Const CMD_HISTORY = &H71 Const BROWSER_CAPTION = "Data Browser" Const HISTORY_CAPTION = "History Selector" Const ID_LB_HISTORY = 80 'Constants used by MLRawFileOpen sub-routine. 'Constants used bt MLCustSysGlobals sub-routine. Global Const AXIS_D = 0 Global Const AXIS_M = 1 Global Const AXIS_U = 2 'Constants for MassLynx program. Global Const ML_CAPTION = "MassLynx" Global Const ML_PROGRAM = "C:\MASSLYNX\MLYNX4" 'MassLynx applictaion codes Const NUM_APPLICATIONS = 25 Global Const APP_CLI = 0 Global Const APP_SPEC = 1 Global Const APP_CHRO = 2 Global Const APP_FIND = 3 Global Const APP_QUAN = 4 Global Const APP_ACQU = 5 Global Const APP_STATUS = 6 Global Const APP_TUNE = 7 Global Const APP_MACRO = 8 Global Const APP_LOG = 9 Global Const APP_ELE = 10 Global Const APP_GLOBALS = 11 Global Const APP_LIB = 12 Global Const APP_PRES = 13 Global Const APP_READ = 14 Global Const APP_INLET = 15 Global Const APP_ASAMP = 16 Global Const APP_SCAN = 17 Global Const APP_PEP = 18 Global Const APP_MAP = 19 Global Const APP_EMBL = 20 Global Const APP_SAMPLE = 21 Global Const RAW_MAX_CALIB_ORDER = 5 Global Const RAW_MAX_COVARIANCES = ((RAW_MAX_CALIB_ORDER + 1) * (RAW_MAX_CALIB_ORDER + 2)) / 2 Global Const RAW_MAX_CALIB_SEGMENTS = 12 'DmGetHandle function options Global Const DM_DISCARDABLE = 1 Global Const DM_SWAPABLE = 2 Global Const DM_CREATE = 4 Global Const DM_FROZEN = 8 'Data type definitions Global Const DM_RAW_SPEC = 2 Global Const DM_RAW_SPEC_MASS = 0 Global Const DM_RAW_SPEC_INT = 1 'Datafile types for DM Global Const DM_RAW = 0 'DmGetData function options Global Const DM_REFRESH = 1 Global Const DM_NOKEEP = 2 'Status codes Global Const DM_OK = 0 Global Const DM_ERR = -1 '*** NT messaging constants for MassLynx *** Global Const WM_GETGLOBALDIALOGWND = (WM_USER + 50) 'Sendmessage returns window handle of modeless 'dialog box, NULL if not active. 'wParam - Dialog ID code. 'lParam - Not used. Global Const WM_UPDATEINIGLOBALS = (WM_USER + 51) 'Writes MassLynx globals to INI file. 'wParam - Not used. 'lParam - Not used. Global Const WM_GETAPPLICATIONWND = (WM_USER + 52) 'Sendmessage returns window handle of MassLynx application, 'NULL if non-existant. 'wParam - Application ID (APP_???). 'lParam - Not used. Global Const GD_CHRO_INTEGRATE = 25 'File constants Global Const MAX_PATH = 260 Global Const MAX_FNAME = 256 Global Const MAX_EXT = 256 Global Const RHI_MAX_PIC_FUNCTIONS = 256 'Maximum number of PIC functions '**************************************************************************************** ' ' Data type declarations. ' '**************************************************************************************** '*** '*** SUPASTRING *** '*** ''Type SUPASTRING ''sz64 As String * 64 ''End Type '*** '*** ONEKBUFFER *** '*** Type ONEKBUFFER Buffer As String * 1024 End Type '*** '*** SINTEGER *** '*** Type SINTEGER w As Integer End Type '*** '*** SLONG *** '*** Type SLONG dw As Long End Type '*** '*** SSINGLE *** '*** Type SSINGLE f As Single End Type '*** '*** SDOUBLE *** '*** Type SDOUBLE lf As Double End Type '*** '*** SCURRENCY *** '*** Type SCURRENCY c As Currency End Type '*** '*** SCHAR *** '*** Type SCHAR char As String * 1 End Type '*** '*** APPTYPE *** '*** Type APPTYPE hWindowHandle As Long '; /* Handle to Main Application Window */ lWindow(4) As Long '; /* Position and size of the window */ lRunning As Long '; /* Set to TRUE if Active */ nStyle As Integer '; /** Maybe SW_SHOWNORAL, SW_SHOWMINIMIZED, '*** SW_SHOWMAXIMIZED '**/ End Type '*** '*** VGFILE *** '*** MassLynx file information. '*** Type VGFILE wtype As Integer szDirectory As String * MAX_PATH szName As String * MAX_FNAME szExtension As String * MAX_EXT dwEntry As Long dwSize As Long End Type '*** '*** VGRAWFILE *** '*** Same as VGFILE except function information '*** and process information is required. '*** Type VGRAWFILE lpVGFile As VGFILE wFunc As Integer wProc As Integer End Type '*** '*** RAWHEADER *** '*** Used at the RAW level of MassLynx. '*** Type RAWHEADER nVersionMajor As Integer 'Major version of file format. nVersionMinor As Integer 'Minor version of file format. szAcquName As String * MAX_PATH 'Acquired filename, no extn. szAcquDate As String * 40 'Acquired date. szAcquTime As String * 40 'Acquired time. szJobCode As String * 80 szTaskCode As String * 80 szUserName As String * 80 szLabName As String * 80 szInstrument As String * 80 szConditions As String * 80 szSampleDesc As String * 121 'Sample description. szSubmitter As String * 80 szSampleID As String * 80 szBottleNumber As String * 20 lfSolventDelay As Double 'Solvent delay in decimal minutes. bResolved As Long 'TRUE if resolved data file. szPepFileName As String * MAX_PATH 'Assoc pep/embl filename-inc. dir+ext. szProcess As String * 81 bEncypted As Long 'Fields added for Maldi-Tof support SCR nAutosamplerType As Long szGasName As String * 25 szInstrumentType As String * 25 'Plate description string szPlateDesc As String * 121 'Analogue chanel offset times afAnalogOffset(1 To 4) As Single nMuxStream As Long 'Method names szInletMethodName As String * MAX_PATH 'Inlet Method name szInletPreRunMethodName As String * MAX_PATH 'Inlet Pre run Method name szInletPostRunMethodName As String * MAX_PATH 'Inlet Post run Method name szInletSwitchMethodName As String * MAX_PATH 'Inlet Switch Method name szHPLCMethodName As String * MAX_PATH 'HPLC Method name szMSMethodName As String * MAX_PATH 'MS Method name szTuneMethodName As String * MAX_PATH 'Tune file name szFractionLynxName As String * MAX_PATH 'FractionLynx method name 'Spare fields szSpare(1 To 5) As String * MAX_PATH 'Number of data quality monitor reinjections nReinjections As Long 'PIC Scan fields, arrays of MRM, Scans and total stored. anPICMRMFunctions(RHI_MAX_PIC_FUNCTIONS - 1) As Long anPICScanFunctions(RHI_MAX_PIC_FUNCTIONS - 1) As Long nPICFunctions As Long End Type '*** '*** DMRAWHEADER *** '*** Used at the DM level of MassLynx. '*** Type DMRAWHEADER sRawHeader As RAWHEADER wFuncsInFile As Integer wAnalogsInFile As Integer End Type ' 'MTof Support structure ' Type MTOF wLinearDetectorVoltage As Integer wLinearSensitivity As Integer wReflectronLensVoltage As Integer wReflectronDetectorVoltage As Integer wReflectronSensitivity As Integer wLaserRepetitionRate As Integer wCoarseLaserControl As Integer wFineLaserControl As Integer fLaserAimXPos As Single fLaserAimYPos As Single wNumShotsSummed As Integer wNumShotsPerformed As Integer wSegmentNumber As Integer nTFMWell As Integer wPSDSegmentType As Integer fSourceRegion1 As Single fSourceRegion2 As Single fReflectronLength As Single fReflectronFieldLength As Single fReflectronVoltage As Single fSamplePlateVoltage As Single fReflectronFieldLengthAlt As Single fReflectronLengthAlt As Single fPSDMajorStep As Single fPSDMinorStep As Single fPSDFactor1 As Single 'Fields for Q-TOF wNeedle As Integer wCounterElectrodeVoltage As Integer wSamplingConeVoltage As Integer wSkimmerLens As Integer wSkimmer As Integer wProbeTemperature As Integer wSourceTemperature As Integer wRFVoltage As Integer wSourceAperture As Integer wSourceCode As Integer wLMResolution As Integer wHMResolution As Integer fCollisionEnergy As Single wIonEnergy As Integer wMultiplier1 As Integer wMultiplier2 As Integer wTransportDC As Integer wTOFAperture As Integer wAccVoltage As Integer wSteering As Integer wFocus As Integer wEntrance As Integer wGuard As Integer wTOF As Integer wReflection As Integer wCollisionRF As Integer wTransportRF As Integer fSetMass As Single 'Fields for all instrument use bReference As Byte 'TGR 62 - Added 5/12/00 to prevent memory misalignment (CMS) bytUseLockMassCorrection As Byte fLockMassCorrection As Single bytUseTempCorrection As Byte fTempCorrection As Single fTempCoefficient As Single 'FAIMS fFaimsCV As Single End Type Type RAWSCANSTATSEX sMTof As MTOF fTIC_A As Single fTIC_B As Single bAccurateMass As Long 'Is the data accurate mass data wAccurateMassFlags As Integer 'If bAccurateMass is false then this parameter 'contains flags indicating what went wrong fPICRetentionTime As Single 'Retention time of associated PIC scan fPICFunctionNum As Single 'Associated PIC function number fPICChannelNum As Single 'Associated PIC channel number fSwaveNormalisationFactor As Single 'Normalisation factor for scanwave data End Type '*** '*** DMRAWSTATS *** '*** Scan Statistics structure definition, at DM level. '*** Type DMRAWSTATS fLoMass As Single fHiMass As Single bMolecularMass As Long bCalibrated As Long 'Data is calibrated. fRT As Single 'Retention time in minutes. dwPeaksInScan As Long fTIC As Single fBPI As Single fBPM As Single wOverload As Integer bContinuum As Long nIonMode As Long nSegment As Long ' Scan segment ID number bGotExtended As Long ' TRUE if extended information valid sEx As RAWSCANSTATSEX ' Extended scan statistics End Type '*** '*** DMRAWIDSPEC *** '*** Raw ID for spectra structure definition, at DM level. '*** Type DMRAWIDSPEC szFileName As String * FILENAME_MAX_PLUS_ONE 'Raw data file name wTypeID As Integer 'Raw data type wFuncNum As Integer 'Function Number wProcNum As Integer 'Process Number bCalibrated As Long 'Return calibrated data lHideLMPeaks As Long 'Determines whether the handle that is returned 'accesses data with or without lock mass information nIndex As Long 'Reserved for internal use to keep track of 'index assigned to file nSpare1 As Long 'Unused at present lSpare2 As Long 'Unused at present bTime As Long 'Determines if actual scan number or time is to be used. fNearestTime As Single 'If times are being used, returns scan 'with closest RT to this value. dwScanNo As Long 'Scan number to read if not using times. If 'times are used, returns number of the scan 'nearest time. bFlags As Long 'True if peak Flags buffer is to be read/written sStats As DMRAWSTATS 'Returns scan statistics End Type '*** '*** COMBPARAM *** '*** Combine Parameters '*** Type COMB_PARAM lStartA As Long 'Range A scan start lNumberA As Long 'Number of scans in range A lStartB As Long 'Range B scan start lNumberB As Long 'Number of scans in range B lStartC As Long 'Range C start scan lNumberC As Long 'Number of scans in range C fFactor As Single 'Range BC multiplication factor fMassDefect As Single 'In Da per Da fPeakWidth As Single 'Expected peak width in Da bAutoDau As Long 'Is the function automated daughter fSetMass As Single 'Set mass of auto daughter function fSetMassWindow As Single 'Set mass window for auto daughter function lTotalAutoDau As Long End Type Type RAWCALIBCOEFFS nOrder As Long lfCoefficients(RAW_MAX_CALIB_ORDER) As Double nType As Long lfStdDev As Double lfCovariances(RAW_MAX_COVARIANCES - 1) As Double End Type Type RAWCALIBFUNC nNumSegCals As Long ' Number of segment calibrations for this function asSegCal(RAW_MAX_CALIB_SEGMENTS - 1) As RAWCALIBCOEFFS 'Modification calibration applied after segment calibration ' Required for Maldi-Tof support bGotModification As Long sModification As RAWCALIBCOEFFS End Type '*** '*** PKD_WAT_PARAMS '*** Type PKD_WAT_PARAMS fThreshold As Single 'Detection threshold fWidth As Single 'Peak width fUpThreshold As Single 'Baseline start percentage threshold fDownThreshold As Single 'Baseline end threshold nOperations As Long 'Operational flags End Type '*** '*** PKD_QTOF_PARAMS '*** Type PKD_QTOF_PARAMS fRes As Single 'Resolution parameter fLockMass As Single 'Lock (calibration) mass fMassWindow As Single 'Lock (calibration) mass window fMassRange As Single 'Acquisition mass range (TOF only) fCycleTime As Single 'Scan time (TOF only) sFuncCal As RAWCALIBFUNC 'QTOF function calibration nPack1 As Long 'Structure packing variable, not used lfLteff As Double 'QTOF mass/time calibration constants lfVeff As Double fNpMultiplier As Single 'Np Multiplier lpsRefCalib As Long 'Returns reference calibration (Pointer in VC++) lpsAppCalib As Long 'Apply this calibration instead of lock mass (Pointer in VC++) nLockSprayAverage As Long 'No of scans to average first-order term over fTDCFrequency As Single 'TDC frequency in GHz nPack2 As Long 'Structure packing variable, not used End Type '*** '*** MASS_MEASURE_PARAM *** '*** Mass Measure Parameters '*** Type MASS_MEASURE_PARAM nMassMeasMode As Long 'QTOF or standard nPkdHalfWidth As Long 'Peak detect half width fPkdCentTop As Single 'Centroid top (%) nPkdMethod As Long 'Top or centroid bSmooth As Long 'TRUE if smoothing required? fSmoothWidth As Single 'Smoothing window width nSmoothIterates As Long 'No of smooths nSmoothMethod As Long 'SG or Mean bSubtract As Long 'TRUE if subtraction required nSubPolyOrder As Long 'Subtract polynomial fSubBelowCurve As Single 'Fraction below curve bUseArrays As Long 'TRUE = float arrays 'FALSE = DM handles bEnableQTOF As Long 'Enable QTOF mass correction features nPack1 As Long 'Structure packing variable, not used sPkdQTOFParams As PKD_QTOF_PARAMS 'QTOF Accurate Mass Params bLockSpray As Long 'Lockspray data? bRealTime As Long 'Peak detect params will be based on the 'instrument resolution bAutoTof As Long 'Use automatic parameters 'i.e. resolution and np from extern.inf bDeadTime As Long 'Do dead time correction bLockMass As Long 'Do lock mass correction bDoAdaptiveSubtract As Long 'Do adaptive background subtract nPkdType As Long 'Areas or heights for centroiding End Type '*** '*** TRACESTATS *** '*** Collection of statistics calculated from '*** ChroStats() and SpecStats() functions. '*** Type TRACESTATS Num As Integer Min As Single Max As Single Ave As Single SD As Single NoiseMin As Single NoiseMax As Single NoiseAve As Single NoiseSD As Single End Type '**************************************************************************************** ' ' Function declarations. ' '**************************************************************************************** Declare Function AiFileName Lib "ml_vb32.dll" () As String Declare Function AiSampleNumber Lib "ml_vb32.dll" () As Integer Declare Function AiScanStatus Lib "ml_vb32.dll" () As Integer Declare Function AiScanNumber Lib "ml_vb32.dll" () As Integer Declare Function BroFileOpen Lib "dm32.dll" Alias "_BroFileOpen@16" (ByVal hWnd As Long, lpsInfo As VGRAWFILE, dwFlags As Long, ByVal szTitle As String) As Integer Declare Function DmRawIsDADFunction Lib "dm32.dll" Alias "_DmRawIsDadFunction@8" (sVGRawFile As VGRAWFILE, ByVal nFunc As Integer) As Integer Declare Function DmRawIsAnalogTraceDesc Lib "dm32.dll" Alias "_DmRawIsAnalogTraceDesc@4" (ByVal strTrace As String) As Integer Declare Sub DmRawClose Lib "dm32.dll" Alias "_DmRawClose@0" () Declare Function DmRawReadHeaderVB Lib "dm32.dll" Alias "_DmRawReadHeaderVB@8" (LPVGRAWFILE As VGRAWFILE, lpDMRawHeader As DMRAWHEADER) As Integer Declare Function DmRawReadScanStatsVB Lib "dm32.dll" Alias "_DmRawReadScanStatsVB@16" (LPVGRAWFILE As VGRAWFILE, ByVal dwScanNumber As Long, ByVal wCalibrate As Integer, lpDmRawStats As DMRAWSTATS) As Integer Declare Function DmRawReadSpectrumVB Lib "dm32.dll" Alias "_DmRawReadSpectrumVB@28" (LPVGRAWFILE As VGRAWFILE, ByVal dwScanNumber As Long, ByVal wCalibrate As Integer, ByVal dwStartPeak As Long, ByVal dwNumPeaks As Long, lpMass As Single, lpIntensity As Single) As Long Declare Function DmRawScansInFunction Lib "dm32.dll" Alias "_DmRawScansInFunction@4" (lpRawFile As VGRAWFILE) As Long Declare Function DmRawScanToTime Lib "dm32.dll" Alias "_DmRawScanToTime@8" (lpRawFile As VGRAWFILE, ByVal dwScan As Long) As Single Declare Function DmRawTimeToScan Lib "dm32.dll" Alias "_DmRawTimeToScan@8" (lpRawFile As VGRAWFILE, ByVal fRetTime As Single) As Long Declare Function GetGlobalString Lib "ml_vb32.dll" (ByVal szParagraph As String, ByVal szKey As String, ByVal szDefault As String, ByVal szResult As String, ByVal nMaxSize As Integer) As Integer Declare Function GetGlobalLong Lib "ml_vb32.dll" (ByVal szParagraph As String, ByVal szKey As String, ByVal lDefault As Long, lResult As Long) As Integer Declare Function GetGlobalDouble Lib "ml_vb32.dll" (ByVal szParagraph As String, ByVal szKey As String, lfDefault As Double, lfResult As Double) As Integer Declare Function GetGlobalFile Lib "ml_vb32.dll" (ByVal szParagraph As String, ByVal szKey As String, sDefault As VGFILE, szResult As VGFILE) As Integer Declare Sub GetMassLynxWorkingDir Lib "ml_vb32.dll" (ByVal lpString As String) Declare Function GetApplicationWnd Lib "ml_vb32.dll" (ByVal nAppCode As Integer) As Long Declare Function GetGlobalDialogWnd Lib "genutil.dll" Alias "_GetGlobalDialogWnd@4" (ByVal wDialogCode As Integer) As Integer Declare Function IsMassLynxEnabled Lib "ml_vb32.dll" () As Integer Declare Function SetGlobalFile Lib "ml_vb32.dll" (ByVal szParagraph As String, ByVal szKey As String, sNew As VGFILE, ByVal wAppend As Integer) As Integer Declare Function GetSampleListFileVB Lib "ml_vb32.dll" Alias "_GetSampleListFileVB@4" (lpsFile As VGRAWFILE) As Long Declare Function Combine Lib "Combin32.dll" Alias "_Combine@24" (ByVal hWnd As Long, ByVal hDm As Long, lpFileA As VGRAWFILE, lpFileBC As Any, lpParam As COMB_PARAM, ByVal wFlags As Integer) As Integer Declare Function MassMeasureSpectrum Lib "Massme32.dll" Alias "_MassMeasureSpectrum@20" (ByVal hWnd As Long, lpRawFile As VGRAWFILE, lpParams As MASS_MEASURE_PARAM, phDm As Any, ByVal bSubtract As Integer) As Integer Declare Function CombineDlgModal Lib "Combin32.dll" Alias "_CombineDlgModal@8" (ByVal hWnd As Long, lpParam As COMB_PARAM) As Integer Declare Function CombineGetIniFile Lib "Combin32.dll" Alias "_CombineGetIniFile@8" (ByVal szPara As String, sCombParam As COMB_PARAM) As Long Declare Function CombineSetIniFile Lib "Combin32.dll" Alias "_CombineSetIniFile@8" (ByVal szPara As String, sCombParam As COMB_PARAM) As Integer Declare Function CombineGetIniRange Lib "Combin32.dll" Alias "_CombineGetIniRange@8" (ByVal szPara As String, sCombParam As COMB_PARAM) As Integer Declare Function CombineSetIniRange Lib "Combin32.dll" Alias "_CombineSetIniRange@8" (ByVal szPara As String, sCombParam As COMB_PARAM) As Integer Declare Function MassMeasureGetIniFile Lib "Massme32.dll" Alias "_MassMeasureGetIniFile@8" (ByVal szPara As String, sMassMeasParams As MASS_MEASURE_PARAM) As Integer Declare Function MassMeasureSetIniFile Lib "Massme32.dll" Alias "_MassMeasureSetIniFile@8" (ByVal szPara As String, sMassMeasParams As MASS_MEASURE_PARAM) As Integer Declare Function MassMeasureEditParam Lib "Massme32.dll" Alias "_MassMeasureEditParam@8" (ByVal hWnd As Long, sMassMeasParams As MASS_MEASURE_PARAM) As Integer Declare Function AutoPeakDetectGetIniFile Lib "Massme32.dll" Alias "_AutoPeakDetectGetIniFile@8" _ (ByVal szPara As String, sMassMeasParams As MASS_MEASURE_PARAM) As Integer Declare Function AutoPeakDetectSetIniFile Lib "Massme32.dll" Alias "_AutoPeakDetectSetIniFile@8" _ (ByVal szPara As String, sMassMeasParams As MASS_MEASURE_PARAM) As Integer Declare Sub DmRawFileToID Lib "dm32.dll" Alias "_DmRawFileToID@8" (lpRawFile As VGRAWFILE, lpRawID As DMRAWIDSPEC) Declare Function DmGetHandle Lib "dm32.dll" Alias "_DmGetHandle@24" (ByVal wTypeID As Integer, ByVal wIDSize As Integer, ByVal szIDInf As String, ByVal wNumData As Integer, ByVal dwEltSize As Long, ByVal wFlags As Integer) As Integer Declare Function DmLockID Lib "dm32.dll" Alias "_DmLockID@4" (ByVal hDm As Long) As Long Declare Function DmUnlockID Lib "dm32.dll" Alias "_DmUnlockID@4" (ByVal hDm As Long) As Integer Declare Function DmReleaseHandle Lib "dm32.dll" Alias "_DmReleaseHandle@8" (ByVal hDm As Long, ByVal wFlags As Integer) As Integer Declare Function DmGetData Lib "dm32.dll" Alias "_DmGetData@16" (ByVal hDm As Long, ByVal dwStart As Long, ByVal dwNumber As Long, ByVal wOptions As Integer) As Integer Declare Function DmLockData Lib "dm32.dll" Alias "_DmLockData@16" (ByVal hDm As Long, ByVal nID As Long, dwStart As Long, dwNumber As Long) As Long Declare Function DmUnlockData Lib "dm32.dll" Alias "_DmUnlockData@8" (ByVal hDm As Long, ByVal nID As Long) As Integer Declare Function DmRawSaveProcess Lib "dm32.dll" Alias "_DmRawSaveProcess@12" (lpID As DMRAWIDSPEC, ByVal bSave As Integer, ByVal bSign As Integer) As Integer '**************************************************************************************** ' ' Purpose: Routine to activate MassLynx. ' If not active it is activated/started. ' When active focus is switched to it. ' '**************************************************************************************** Function ActivateML() As Long Dim wActivity As Integer Dim lpMLCaption As String Dim lpMLProgram As String lpMLCaption = ML_CAPTION lpMLProgram = ML_PROGRAM If FindWindowCaption(lpMLCaption) = False Then wActivity = Shell(lpMLProgram, 1) Do While Not FindWindowCaption(lpMLCaption) DoEvents Loop End If ActivateML = FindWindowCaption(lpMLCaption) End Function Function CBoxSelString(hWnd As Long, wID As Long, lpSelString As String) As Integer 'Dim dwMsgRtn As Long 'Dim lpMsg As SUPASTRING 'lpMsg.sz64 = lpSelString + Chr$(0) 'dwMsgRtn = SendDlgItemMessage(hWnd, wID, CB_SELECTSTRING, -1, lpMsg) 'If dwMsgRtn = CB_ERR Then 'CBoxSelString = False 'Else 'CBoxSelString = True 'End If Dim hCBox As Long Dim lMsgRtn As Long hCBox = DlgItemValidate(hWnd, wID) If hCBox <> 0 Then lMsgRtn = SendMessageAPI(hCBox, CB_FINDSTRING, -1, ByVal lpSelString) lMsgRtn = SendMessage(hCBox, CB_SETCURSEL, CInt(lMsgRtn), 0) Else lMsgRtn = CB_ERR End If If lMsgRtn = CB_ERR Then CBoxSelString = False Else CBoxSelString = True End If End Function '**************************************************************************************** ' ' Purpose: Provide a collection of general MassLynx functions. ' '**************************************************************************************** Function CheckMenuItem(hWnd As Long, wID As Long, wCheck As Integer) As Integer Dim hMenu As Long Dim wState As Long hMenu = GetMenu(hWnd) wState = GetMenuState(hMenu, wID, MF_BYCOMMAND) If Not ((wState And MF_CHECKED) = MF_CHECKED) And wCheck Then wState = PostMessage(hWnd, WM_COMMAND, wID, 0) ElseIf ((wState And MF_CHECKED) = MF_CHECKED) And Not wCheck Then wState = PostMessage(hWnd, WM_COMMAND, wID, 0) End If CheckMenuItem = GetMenuState(hMenu, wID, MF_BYCOMMAND) End Function '**************************************************************************************** ' ' Purpose: Convert strings into SendKeys format. ' '**************************************************************************************** Function Conv4SK(lpStringToCheck As String) As String Dim wCharPos As Integer Dim lpCharToCheck As String Dim lpConvertedString As String lpConvertedString = "" For wCharPos = 1 To Len(lpStringToCheck) lpCharToCheck = Right$(Left$(lpStringToCheck, wCharPos), 1) If lpCharToCheck = "+" Then lpCharToCheck = "{+}" End If lpConvertedString = lpConvertedString + lpCharToCheck Next wCharPos Conv4SK = lpConvertedString End Function '**************************************************************************************** ' ' Purpose: Copy buffer of record to current record in table. ' Buffer should be allocated,locked and filled to obtain start address. ' Make sure size of record is known. ' '**************************************************************************************** Sub CpyBuffToDBRec(tbl As Table, dwBuffStart As Long, lpFdSize() As Long) Dim wFdNum As Integer Dim wNumFds As Integer Dim wEndFd As Integer Dim dwBuffOS As Long Dim lpStr As String Dim lpsInt As SINTEGER Dim lpsLng As SLONG Dim lpsSng As SSINGLE Dim lpsDbl As SDOUBLE Dim lpsCur As SCURRENCY Dim lpsChr As SCHAR On Error GoTo ReadBuffError tbl.Edit dwBuffOS = 0 wEndFd = UBound(lpFdSize) For wFdNum = 0 To wEndFd Select Case tbl.Fields(wFdNum).Type Case DB_BOOLEAN, DB_BYTE, DB_INTEGER Call hmemcpyTolp(lpsInt, (dwBuffStart + dwBuffOS), lpFdSize(wFdNum)) tbl.Fields(wFdNum).Value = lpsInt.w Case DB_LONG Call hmemcpyTolp(lpsLng, (dwBuffStart + dwBuffOS), lpFdSize(wFdNum)) tbl.Fields(wFdNum).Value = lpsLng.dw Case DB_CURRENCY Call hmemcpyTolp(lpsCur, (dwBuffStart + dwBuffOS), lpFdSize(wFdNum)) tbl.Fields(wFdNum).Value = lpsCur.c Case DB_SINGLE Call hmemcpyTolp(lpsSng, (dwBuffStart + dwBuffOS), lpFdSize(wFdNum)) tbl.Fields(wFdNum).Value = lpsSng.f Case DB_DOUBLE, DB_DATE Call hmemcpyTolp(lpsDbl, (dwBuffStart + dwBuffOS), lpFdSize(wFdNum)) tbl.Fields(wFdNum).Value = lpsDbl.lf Case DB_STRING, DB_TEXT, DB_LONGBINARY, DB_MEMO Call CpyBuffToStr(lpStr, (dwBuffStart + dwBuffOS), lpFdSize(wFdNum)) tbl.Fields(wFdNum).Value = lpStr End Select Debug.Print tbl.Fields(wFdNum).Value dwBuffOS = dwBuffOS + lpFdSize(wFdNum) Next wFdNum tbl.Update Exit Sub ReadBuffError: On Error GoTo 0 Resume Next End Sub '**************************************************************************************** ' ' Purpose: Copy from hmem to a string lpStr. ' lpStr is will be initialised to an empty string. ' '**************************************************************************************** Sub CpyBuffToStr(lpStr As String, dwBuffStart As Long, dwBytes As Long) Dim dwByte As Long Dim dwBuffByte As Long Dim lpsChar As SCHAR lpStr = Space$(0) If dwBytes > 0 Then For dwByte = 0 To dwBytes - 1 dwBuffByte = dwBuffStart + dwByte Call hmemcpyTolp(lpsChar, dwBuffByte, 1) lpStr = lpStr & lpsChar.char Next dwByte End If End Sub '**************************************************************************************** ' ' Purpose: Copy one record to another inside a data base table. ' '**************************************************************************************** Sub CpyDBRec(tbl As Table, dwRecOrig As Long, dwRecDest As Long) Dim hBuff As Long Dim wRtn As Integer Dim lpFdSize() As Long Dim dwBuffSize As Long Dim dwBuffStart As Long If SetDBRec(tbl, dwRecOrig) Then dwBuffSize = RecSize(tbl, lpFdSize()) hBuff = GlobalAlloc(GMEM_FIXED + GMEM_ZEROINIT, dwBuffSize) dwBuffStart = GlobalLock(hBuff) Call CpyDBRecToBuff(tbl, dwBuffStart, lpFdSize()) If SetDBRec(tbl, dwRecDest) Then Call CpyBuffToDBRec(tbl, dwBuffStart, lpFdSize()) End If wRtn = GlobalUnlock(hBuff) wRtn = GlobalFree(hBuff) End If End Sub '**************************************************************************************** ' ' Purpose: Copy current record from table to the supplied buffer. ' Buffer should be allocated and locked to obtain start address. ' Make sure size of record is known. ' '**************************************************************************************** Sub CpyDBRecToBuff(tbl As Table, dwBuffStart As Long, lpFdSize() As Long) Dim wFdNum As Integer Dim wNumFds As Integer Dim wEndFd As Integer Dim dwBuffOS As Long Dim lpStr As String Dim lpsInt As SINTEGER Dim lpsLng As SLONG Dim lpsSng As SSINGLE Dim lpsDbl As SDOUBLE Dim lpsCur As SCURRENCY Dim lpsChr As SCHAR dwBuffOS = 0 wEndFd = UBound(lpFdSize) For wFdNum = 0 To wEndFd Debug.Print wFdNum, tbl.Fields(wFdNum).Value If Not IsNull(tbl.Fields(wFdNum).Value) Then Select Case tbl.Fields(wFdNum).Type Case DB_BOOLEAN, DB_BYTE, DB_INTEGER lpsInt.w = tbl.Fields(wFdNum).Value Call hmemcpyFromLp((dwBuffStart + dwBuffOS), lpsInt, lpFdSize(wFdNum)) Case DB_LONG lpsLng.dw = tbl.Fields(wFdNum).Value Call hmemcpyFromLp((dwBuffStart + dwBuffOS), lpsLng, lpFdSize(wFdNum)) Case DB_CURRENCY lpsCur.c = tbl.Fields(wFdNum).Value Call hmemcpyFromLp((dwBuffStart + dwBuffOS), lpsCur, lpFdSize(wFdNum)) Case DB_SINGLE lpsSng.f = tbl.Fields(wFdNum).Value Call hmemcpyFromLp((dwBuffStart + dwBuffOS), lpsSng, lpFdSize(wFdNum)) Case DB_DOUBLE, DB_DATE lpsDbl.lf = tbl.Fields(wFdNum).Value Call hmemcpyFromLp((dwBuffStart + dwBuffOS), lpsDbl, lpFdSize(wFdNum)) Case DB_STRING, DB_TEXT, DB_LONGBINARY, DB_MEMO lpStr = tbl.Fields(wFdNum).Value Call CpyStrToBuff(lpStr, (dwBuffStart + dwBuffOS)) End Select End If dwBuffOS = dwBuffOS + lpFdSize(wFdNum) Next wFdNum End Sub '**************************************************************************************** ' ' Purpose: Copies the field to buffer at dwDest. ' dwDest must be allocated and locked. ' The return value is the number of bytes copied. ' '**************************************************************************************** Function CpyFieldToMem(fdField As Field, dwDest As Long) As Integer Dim wInt As Integer Dim dwLng As Long Dim dwBytes As Long Dim dwLong As Long Dim dwDbl As Long Dim fSng As Single Dim dfDbl As Double Dim lpStr As ONEKBUFFER dwBytes = fdField.Size Select Case fdField.Type Case DB_BOOLEAN wInt = fdField.Value Call hmemcpyFromLp(dwDest, wInt, fdField.Size) CpyFieldToMem = False Case DB_BYTE wInt = fdField.Value Call hmemcpyFromLp(dwDest, wInt, fdField.Size) CpyFieldToMem = False Case DB_INTEGER wInt = fdField.Value Call hmemcpyFromLp(dwDest, wInt, fdField.Size) CpyFieldToMem = fdField.Size Case DB_LONG dwLng = fdField.Value Call hmemcpyFromLp(dwDest, dwLong, fdField.Size) CpyFieldToMem = fdField.Size Case DB_CURRENCY dwDbl = fdField.Value Call hmemcpyFromLp(dwDest, dwLong, fdField.Size) CpyFieldToMem = fdField.Size Case DB_SINGLE fSng = fdField.Value Call hmemcpyFromLp(dwDest, fSng, fdField.Size) CpyFieldToMem = fdField.Size Case DB_DOUBLE dfDbl = fdField.Value Call hmemcpyFromLp(dwDest, dwDbl, fdField.Size) CpyFieldToMem = fdField.Size Case DB_DATE lpStr.Buffer = fdField.Value Call hmemcpyFromLp(dwDest, lpStr, fdField.Size) CpyFieldToMem = fdField.Size Case DB_TEXT lpStr.Buffer = fdField.Value Call hmemcpyFromLp(dwDest, lpStr, fdField.Size) CpyFieldToMem = fdField.Size Case DB_LONGBINARY lpStr.Buffer = fdField.Value Call hmemcpyFromLp(dwDest, lpStr, fdField.Size) CpyFieldToMem = fdField.Size Case DB_MEMO lpStr.Buffer = fdField.Value Call hmemcpyFromLp(dwDest, lpStr, fdField.Size) CpyFieldToMem = fdField.Size Case Else CpyFieldToMem = False End Select End Function '**************************************************************************************** ' ' Purpose: Copy from string lpStr to a hmem buffer. ' Buffer must be allocated and locked. ' '**************************************************************************************** Sub CpyStrToBuff(lpStr As String, dwBuffStart As Long) Dim dwByte As Long Dim dwBytes As Long Dim lpsChar As SCHAR dwBytes = Len(lpStr) If dwBytes > 0 Then For dwByte = 1 To dwBytes lpsChar.char = Mid$(lpStr, dwByte, 1) Call hmemcpyFromLp((dwBuffStart + dwByte - 1), lpsChar, 1) Next dwByte End If End Sub '---------------------------------------------------------------------------------------- ' ' Process: DataBrowserChroSpec ' ' Author: Roberto Raso ' Date: 28th April 1995 ' ' Purpose: Sets the Chromatogram and/or Spectrum check boxes in the Data Browser. ' ' Parameters: sVGRawFile holds the raw file and process that should be opened. ' hBrowser is the handle of the Data Browser dialogue box. If it ' is zero then the function assumes that the function is being called ' in a standalone mode and will set the sVGRawFile as the current raw file, ' otherwise it assumes the current raw file has been set and Data Browser ' is already open. ' ' Return: Returns nChroSpec or GEN_ERROR if there is an error. ' '---------------------------------------------------------------------------------------- Function DataBrowserChroSpec(hBrowser As Long, nChroSpec As Integer) As Integer Dim hThisBrowser As Long Dim nChroSpecSet As Integer nChroSpecSet = GEN_ERROR hThisBrowser = hBrowser If hThisBrowser = 0 Then hThisBrowser = DataBrowserShow() End If If hThisBrowser Then nChroSpecSet = 0 If (nChroSpec And CHRO_OPEN) = CHRO_OPEN Then Call CheckDlgButton32(hThisBrowser, ID_CHK_CHRO, True) nChroSpecSet = CHRO_OPEN Else Call CheckDlgButton32(hThisBrowser, ID_CHK_CHRO, False) End If If (nChroSpec And SPEC_OPEN) = SPEC_OPEN Then Call CheckDlgButton32(hThisBrowser, ID_CHK_SPEC, True) nChroSpecSet = nChroSpecSet + SPEC_OPEN Else Call CheckDlgButton32(hThisBrowser, ID_CHK_SPEC, False) End If If hBrowser = 0 Then If DlgBoxClose(hThisBrowser, IDOK, CDbl(CVDate("00:00:10"))) Then DataBrowserChroSpec = nChroSpecSet End If Else DataBrowserChroSpec = nChroSpecSet End If End If End Function '---------------------------------------------------------------------------------------- ' ' Process: DataBrowserShow ' ' Author: Roberto Raso ' Date: 28th April 1995 ' ' Purpose: Displays the MassLynx data browser dialogue box. ' ' Parameters: None. ' ' Return: The window handle of the dialogue box, if it has been found. ' '---------------------------------------------------------------------------------------- Function DataBrowserShow() As Long Dim hMassLynx As Long Dim hBrowser As Long hBrowser = 0 hMassLynx = MLAppActive(APP_CLI) If hMassLynx Then 'Open data browser hBrowser = MassLynxCommand("app.launch[default:DataFileOpen]()", OPEN_WIN_TIMEOUT) hBrowser = FindWindowCaption("Data Browser") End If DataBrowserShow = hBrowser End Function '---------------------------------------------------------------------------------------- ' ' Process: DataFileExists ' ' Author: Roberto Raso ' Date: 26th April 1995 ' ' Purpose: Checks to see if a required function/process number actually exists. ' ' Parameters: sVGFile is the VG file to check. ' nData is the number of the required file. ' strDataStub is the prefix for the data file e.g. _PROC or _FUNC. ' strDataExt is the file extension for the required data file. e.g. DAT. ' ' Return: Returns the data file number or GEN_ERROR if the file does not exist. ' '---------------------------------------------------------------------------------------- Function DataFileExists(sVGFile As VGFILE, nData As Integer, strDataStub As String, strDataExt As String) As Integer Dim nDataFile As Integer Dim nDataFiles As Integer Dim strRawFile As String Dim strDataFile As String Dim aszDataFile() As String * 16 DataFileExists = GEN_ERROR strRawFile = SZToVB(sVGFile.szDirectory) + SZToVB(sVGFile.szName) nDataFiles = GetRawProcessFiles(strRawFile, aszDataFile(), strDataStub, strDataExt) For nDataFile = 0 To nDataFiles - 1 strDataFile = TrimWS(aszDataFile(nDataFile)) strDataFile = MidStr(strDataFile, Len(strDataStub) + 1, Len(strDataFile) - (Len(strDataExt) + 1)) If CInt(strDataFile) = nData Then DataFileExists = nData Exit For End If Next nDataFile End Function '---------------------------------------------------------------------------------------- ' ' Process: DataFunctionSelect ' ' Author: Roberto Raso ' Date: 28th April 1995 ' ' Purpose: Opens the required file and function. ' ' Parameters: sVGRawFile holds the raw file and function that should be opened. ' hBrowser is the handle of the Data Browser dialogue box. If it ' is zero then the function assumes that the function is being called ' in a standalone mode and will set the sVGRawFile as the current raw file, ' otherwise it assumes the current raw file has been set and Data Browser ' is already open. ' ' Return: Returns the function number or GEN_ERROR if the file does not exist. ' '---------------------------------------------------------------------------------------- Function DataFunctionSelect(sVGRawFile As VGRAWFILE, hBrowser As Long) As Integer Dim hThisBrowser As Long Dim hCtrl As Long Dim nFuncs As Integer Dim lMsgRtn As Long DataFunctionSelect = GEN_ERROR hThisBrowser = hBrowser If hThisBrowser = 0 Then If SetGlobalFile(SYSPARAGRAPH, "RAW" + Chr$(0), sVGRawFile.lpVGFile, True) = 0 Then Exit Function Else hThisBrowser = DataBrowserShow() End If End If If IsWindow(hThisBrowser) Then nFuncs = CInt(SendDlgItemMessage(DataBrowserShow(), ID_FUNC_LIST, CB_GETCOUNT, 0, 0)) If sVGRawFile.wFunc <= nFuncs Then If CInt(SendDlgItemMessage(DataBrowserShow(), ID_FUNC_LIST, CB_SETCURSEL, ByVal (sVGRawFile.wFunc - 1), 0)) = sVGRawFile.wFunc - 1 Then hCtrl = GetDlgItem32(DataBrowserShow(), ID_FUNC_LIST) lMsgRtn = SendMessage(DataBrowserShow(), WM_COMMAND, MakeLong(CBN_SELCHANGE, ID_FUNC_LIST), hCtrl) DataFunctionSelect = sVGRawFile.wFunc End If End If If hBrowser = 0 Then If DlgBoxClose(hThisBrowser, IDOK, CDbl(CVDate("00:00:10"))) Then DataFunctionSelect = sVGRawFile.wFunc Else DataFunctionSelect = GEN_ERROR End If End If End If End Function '---------------------------------------------------------------------------------------- ' ' Process: DataProcessSelect ' ' Author: Roberto Raso ' Date: 25th April 1995 ' ' Purpose: Opens the required file and process. ' ' Parameters: sVGRawFile holds the raw file and process that should be opened. ' hBrowser is the handle of the Data Browser dialogue box. If it ' is zero then the function assumes that the function is being called ' in a standalone mode and will set the sVGRawFile as the current raw file, ' otherwise it assumes the current raw file has been set and Data Browser ' is already open. ' ' Return: Returns the process number or GEN_ERROR if the file does not exist. ' '---------------------------------------------------------------------------------------- Function DataProcessSelect(sVGRawFile As VGRAWFILE, hBrowser As Long) As Integer Dim bSaved As Integer Dim hThisBrowser As Long Dim hHistory As Long Dim nProcFound As Integer Dim nProc As Integer Dim nProcs As Integer Dim nText As Integer Dim lMsgRtn As Long Dim strText As String DataProcessSelect = GEN_ERROR bSaved = False hThisBrowser = hBrowser If hThisBrowser = 0 Then If SetGlobalFile(SYSPARAGRAPH, "RAW" + Chr$(0), sVGRawFile.lpVGFile, True) = 0 Then Exit Function Else hThisBrowser = DataBrowserShow() End If End If If IsWindow(hThisBrowser) Then hHistory = MnuDlg_Disp(hThisBrowser, CMD_HISTORY, HISTORY_CAPTION, 10, True) If hHistory Then nProcs = CInt(SendDlgItemMessage(hHistory, ID_LB_HISTORY, LB_GETCOUNT, 0, 0)) For nProc = 0 To nProcs - 1 nProcFound = LoWord(SendDlgItemMessage(hHistory, ID_LB_HISTORY, LB_GETITEMDATA, ByVal nProc, 0)) If nProcFound = sVGRawFile.wProc Then nText = CInt(SendDlgItemMessage(hHistory, ID_LB_HISTORY, LB_GETTEXTLEN, ByVal nProc, 0)) strText = String$(nText + 1, 0) 'Allocate memory for process description Dim hBuff As Long hBuff = GlobalAlloc(GMEM_FIXED + GMEM_ZEROINIT, Len(strText)) nText = CInt(SendDlgItemMessage(hHistory, ID_LB_HISTORY, LB_GETTEXT, ByVal nProc, ByVal hBuff)) 'Retrieve the description from memory and clear Call CpyBuffToStr(strText, hBuff, Len(strText)) hBuff = GlobalFree(hBuff) If InStr(1, strText, SAVED, 1) Then bSaved = True nProc = CInt(SendDlgItemMessage(hHistory, ID_LB_HISTORY, LB_SETCURSEL, ByVal nProc, 0)) Exit For End If End If Next nProc End If End If If bSaved Then lMsgRtn = PostMessage(hHistory, WM_COMMAND, IDOK, 0) DataProcessSelect = nProcFound Else lMsgRtn = PostMessage(hHistory, WM_COMMAND, IDCANCEL, 0) End If Do While IsWindow(hHistory) DoEvents Loop End Function '**************************************************************************************** ' ' Purpose: Idle loop for wDelay seconds. ' '**************************************************************************************** Sub Delay(wDelay As Integer) Dim wEndWait As Integer Dim wWait As Integer Dim lpEntryTime As Variant lpEntryTime = Now wEndWait = False Do Until wWait >= wDelay wWait = Second(Now - lpEntryTime) DoEvents Loop End Sub '**************************************************************************************** ' ' Purpose: Checks that the specified function in the raw file, is valid. ' Return value is TRUE/FALSE. ' '**************************************************************************************** Function DMVerifyFunction(lpFile As String, wFunc As Integer, lpRawFile As VGRAWFILE) As Integer Dim wFuncOK As Long Dim lpRawHeader As DMRAWHEADER Dim lpsDebug As String Dim lpsTemp As String wFuncOK = True If GetMLFileInfo("RAW", lpRawFile.lpVGFile) Then lpRawFile.lpVGFile.szName = Trim$(lpFile) + Chr$(0) Else wFuncOK = False End If 'lpsDebug = SZToVB(lpRawFile.lpVGFile.szDirectory) + " : " + CStr(InStr(lpRawFile.lpVGFile.szDirectory, Chr$(0))) + Chr$(13) + Chr$(10) 'lpsDebug = lpsDebug + SZToVB(lpRawFile.lpVGFile.szName) + " : " + CStr(InStr(lpRawFile.lpVGFile.szName, Chr$(0))) + Chr$(13) + Chr$(10) 'lpsDebug = lpsDebug + SZToVB(lpRawFile.lpVGFile.szExtension) + " : " + CStr(InStr(lpRawFile.lpVGFile.szExtension, Chr$(0))) + Chr$(13) + Chr$(10) 'MsgBox lpsDebug If DmRawReadHeaderVB(lpRawFile, lpRawHeader) Then If wFunc > 0 And wFunc <= lpRawHeader.wFuncsInFile Then lpRawFile.wFunc = wFunc Else wFuncOK = False End If Else wFuncOK = False End If DMVerifyFunction = wFuncOK End Function '**************************************************************************************** ' ' Purpose: Checks that the specified function in the raw file, is valid. ' Return value is TRUE/FALSE. This version assumes VGRAWFILE structure has ' been supplied. ' '**************************************************************************************** Function DMCheckFunction(wFunc As Integer, lpRawFile As VGRAWFILE) As Integer Dim wFuncOK As Long Dim lpRawHeader As DMRAWHEADER Dim lpsDebug As String Dim lpsTemp As String wFuncOK = True 'lpsDebug = SZToVB(lpRawFile.lpVGFile.szDirectory) + " : " + CStr(InStr(lpRawFile.lpVGFile.szDirectory, Chr$(0))) + Chr$(13) + Chr$(10) 'lpsDebug = lpsDebug + SZToVB(lpRawFile.lpVGFile.szName) + " : " + CStr(InStr(lpRawFile.lpVGFile.szName, Chr$(0))) + Chr$(13) + Chr$(10) 'lpsDebug = lpsDebug + SZToVB(lpRawFile.lpVGFile.szExtension) + " : " + CStr(InStr(lpRawFile.lpVGFile.szExtension, Chr$(0))) + Chr$(13) + Chr$(10) 'MsgBox lpsDebug If DmRawReadHeaderVB(lpRawFile, lpRawHeader) Then If wFunc > 0 And wFunc <= lpRawHeader.wFuncsInFile Then lpRawFile.wFunc = wFunc Else wFuncOK = False End If Else wFuncOK = False End If DMCheckFunction = wFuncOK End Function '**************************************************************************************** ' ' Purpose: Checks that the specified retention time in the required function ' of the raw file, is valid. ' Return value is scan number. ' '**************************************************************************************** Function DMVerifyRT(lpFile As String, wFunc As Integer, fTime As Single, lpRawFile As VGRAWFILE) As Long Dim wFuncOK As Long wFuncOK = True If DMVerifyFunction(lpFile, wFunc, lpRawFile) Then wFuncOK = DmRawTimeToScan(lpRawFile, fTime) Else wFuncOK = False End If DMVerifyRT = wFuncOK End Function '**************************************************************************************** ' ' Purpose: Checks that the specified retention time in the required function ' of the raw file, is valid. This vesion assumes that a VGRAWFILE ' is supplied. ' Return value is scan number. ' '**************************************************************************************** Function DMCheckRT(wFunc As Integer, fTime As Single, lpRawFile As VGRAWFILE) As Long Dim wFuncOK As Long wFuncOK = True If DMCheckFunction(wFunc, lpRawFile) Then wFuncOK = DmRawTimeToScan(lpRawFile, fTime) Else wFuncOK = False End If DMCheckRT = wFuncOK End Function '**************************************************************************************** ' ' Purpose: Checks that the specified scan in the required function ' of the raw file. ' '**************************************************************************************** Function DMVerifyScan(lpFile As String, wFunc As Integer, dwScan As Long, lpRawFile As VGRAWFILE) As Long Dim wFuncOK As Long wFuncOK = True If DMVerifyFunction(lpFile, wFunc, lpRawFile) Then If dwScan > 0 And dwScan <= DmRawScansInFunction(lpRawFile) Then wFuncOK = dwScan Else wFuncOK = False End If Else wFuncOK = False End If DMVerifyScan = wFuncOK End Function '**************************************************************************************** ' ' Purpose: Checks that the specified scan is in the required function ' of the raw file. This version assumes that VGRAWFILE structure ' is passed in. ' '**************************************************************************************** Function DMCheckScan(wFunc As Integer, dwScan As Long, lpRawFile As VGRAWFILE) As Long Dim wFuncOK As Long wFuncOK = True If DMCheckFunction(wFunc, lpRawFile) Then If dwScan > 0 And dwScan <= DmRawScansInFunction(lpRawFile) Then wFuncOK = dwScan Else wFuncOK = False End If Else wFuncOK = False End If DMCheckScan = wFuncOK End Function '**************************************************************************************** ' ' Purpose: Fill a VGRAWFILE file structure. ' wFunc must be a valid function for file. ' Returns TRUE if operation was successful. ' '**************************************************************************************** Function FileToRawFile(lpFile As String, wFunc As Integer, lpRawFile As VGRAWFILE) As Integer If DMVerifyFunction(lpFile, wFunc, lpRawFile) Then FileToRawFile = True Else FileToRawFile = False End If End Function '**************************************************************************************** ' ' Process: FirstSampleListEntry ' ' Author: Anthony Holland ' Date: 29th August 1997 ' ' Purpose: Get the number of the first entry in the Sample List. ' ' Return: The number indicated above. ' '**************************************************************************************** Function FirstSampleListEntry() As Integer Dim lpSampleListFile As String lpSampleListFile = "C:\Temp\MLCurSmp.txt" FirstSampleListEntry = GetPrivateProfileInt("Batch", "First Sample", 1, lpSampleListFile) End Function '**************************************************************************************** ' ' Process: LastSampleListEntry ' ' Author: Anthony Holland ' Date: 29th August 1997 ' ' Purpose: Get the number of the last entry in the Sample List. ' ' Return: The number indicated above. ' '**************************************************************************************** Function LastSampleListEntry() As Integer Dim nEntry As Integer Dim lpSampleListFile As String lpSampleListFile = "C:\Temp\MLCurSmp.txt" LastSampleListEntry = GetPrivateProfileInt("Batch", "Last Sample", 1, lpSampleListFile) End Function '**************************************************************************************** ' ' Process: CurrentSampleListEntry ' ' Author: Anthony Holland ' Date: 29th August 1997 ' ' Purpose: Get the number of the current entry in the Sample List. ' ' Return: The number indicated above. ' '**************************************************************************************** Function CurrentSampleListEntry() As Integer Dim lpReturned As String * 128 Dim lpSampleListFile As String lpSampleListFile = "C:\Temp\MLCurSmp.txt" CurrentSampleListEntry = GetPrivateProfileInt("Batch", "Current Sample", 1, lpSampleListFile) End Function '**************************************************************************************** ' ' Process: CurrentSPLFile ' ' Author: Anthony Holland ' ' Date: 7th November 1997 ' ' Purpose: Get the name of the current Sample List (.SPL) file. ' ' Return: The Sample List file name (incl. directory path). ' '**************************************************************************************** Function CurrentSPLFile() As String Dim lpAppName As String Dim lpKeyName As String Dim lpSampleListFile As String lpAppName = "Batch" lpKeyName = "Batch File Name" lpSampleListFile = "C:\Temp\MLCurSmp.txt" CurrentSPLFile = GetPrivateProfileStr(lpAppName, lpKeyName, lpSampleListFile) End Function '**************************************************************************************** ' ' Process: GetMLFile ' ' Author: Roberto Raso ' Date: 19th September 1994 ' ' Purpose: Get the whole file descriptor for a MassLynx ' global file i.e. Path, name and extension. ' Return: String of file information ' '**************************************************************************************** Function GetMLFile(lpFileType As String) As String GetMLFile = GetMLFileDir(lpFileType) + GetMLFileName(lpFileType) + DOS_EXT_SEP + GetMLFileExt(lpFileType) End Function Function GetMLFileDir(FileType As String) As String 'Returns the current directory that MassLynx is using, for FileType. Dim MLFile As VGFILE If GetMLFileInfo(FileType, MLFile) = True Then GetMLFileDir = Left$(MLFile.szDirectory, InStr(MLFile.szDirectory, Chr$(0)) - 1) Else GetMLFileDir = "" End If End Function Function GetMLFileEntry(FileType As String) As Long 'Returns the current entry number that MassLynx is using, for FileType. Dim MLFile As VGFILE If GetMLFileInfo(FileType, MLFile) = True Then GetMLFileEntry = MLFile.dwEntry Else GetMLFileEntry = 0 End If End Function Function GetMLFileExt(FileType As String) As String 'Returns the current extension that MassLynx is using, for FileType. Dim MLFile As VGFILE If GetMLFileInfo(FileType, MLFile) = True Then GetMLFileExt = Left$(MLFile.szExtension, InStr(MLFile.szExtension, Chr$(0)) - 1) Else GetMLFileExt = "" End If End Function Function GetMLFileInfo(FileType As String, MLFileInfo As VGFILE) As Integer 'Gets MassLynx file information into VGFILE type. Dim ReturnStatus As Integer Dim ListDefault As VGFILE ListDefault.wtype = 0 ListDefault.szDirectory = "" ListDefault.szName = "" ListDefault.szExtension = "" ListDefault.dwEntry = 0 ListDefault.dwSize = 0 ReturnStatus = GetGlobalFile(SYSPARAGRAPH, FileType, ListDefault, MLFileInfo) If ReturnStatus = 1 Then GetMLFileInfo = True Else GetMLFileInfo = False End If End Function Function GetMLFileName(FileType As String) As String 'Returns the current filename that MassLynx is using, for FileType. Dim MLFile As VGFILE If GetMLFileInfo(FileType, MLFile) = True Then GetMLFileName = Left$(MLFile.szName, InStr(MLFile.szName, Chr$(0)) - 1) Else GetMLFileName = "" End If End Function '**************************************************************************************** ' ' Process: GetMLFileSize ' ' Author: Roberto Raso ' Date: 18th August 1994 ' ' Purpose: Get the number of entries in a file. ' Return: Number of entries. ' '**************************************************************************************** Function GetMLFileSize(lpFileType As String) As Long Dim lpMLFile As VGFILE If GetMLFileInfo(lpFileType, lpMLFile) = True Then GetMLFileSize = lpMLFile.dwSize Else GetMLFileSize = 0 End If End Function Function GetMLIniFileInfo(lpSection As String, lpEntry As String, lpFileInfo As VGFILE, lpMLIniFile As String) As Integer Dim nStartPos As Integer Dim nEndPos As Integer Dim lpReturn As String * 128 If GetPrivateProfileString(lpSection, ByVal lpEntry, "", lpReturn, PPS_BUF_SIZE, lpMLIniFile) Then nStartPos = 1 nEndPos = InStr(nStartPos, lpReturn, INI_FILE_SEP) lpFileInfo.wtype = CInt(Mid$(lpReturn, nStartPos, nEndPos - nStartPos)) nStartPos = nEndPos + 1 nEndPos = InStr(nStartPos, lpReturn, INI_FILE_SEP) lpFileInfo.szDirectory = Mid$(lpReturn, nStartPos, nEndPos - nStartPos) + Chr$(0) nStartPos = nEndPos + 1 nEndPos = InStr(nStartPos, lpReturn, INI_FILE_SEP) lpFileInfo.szName = Mid$(lpReturn, nStartPos, nEndPos - nStartPos) + Chr$(0) nStartPos = nEndPos + 1 nEndPos = InStr(nStartPos, lpReturn, INI_FILE_SEP) lpFileInfo.szExtension = Mid$(lpReturn, nStartPos, nEndPos - nStartPos) + Chr$(0) nStartPos = nEndPos + 1 nEndPos = InStr(nStartPos, lpReturn, INI_FILE_SEP) lpFileInfo.dwEntry = CLng(Mid$(lpReturn, nStartPos, nEndPos - nStartPos)) nStartPos = nEndPos + 1 nEndPos = InStr(nStartPos, lpReturn, Chr$(0)) lpFileInfo.dwSize = CLng(Mid$(lpReturn, nStartPos, nEndPos - nStartPos)) GetMLIniFileInfo = True Else GetMLIniFileInfo = False End If End Function '**************************************************************************************** ' ' Purpose: Get the current process files for the MassLynx raw file ' lpRawFile. The files found are written to lpProcessFile(). ' The return is the number of files found. ' lpRawFile must include directory but not extension. ' '**************************************************************************************** Function GetRawProcessFiles(lpRawFile As String, lpProcessFile() As String * 16, lpProcStub As String, lpProcExt As String) As Integer Dim wNumProcs As Integer Dim lpSearchPath As String lpSearchPath = Trim$(lpRawFile) + DOS_EXT_SEP + GetMLFileExt("RAW") + DOS_DIR_SEP + lpProcStub + "*" + DOS_EXT_SEP + lpProcExt wNumProcs = FileSearch(lpSearchPath, lpProcessFile()) GetRawProcessFiles = wNumProcs End Function '**************************************************************************************** ' ' Purpose: Gets the list of printers that are available ' to a Windows for WorkGroups Node/PC. ' lpWinIniFile can be a remote PC's WIN.INI file. ' lpzPrinters() is the array for zero terminated strings to fill. ' The return value is the number of printers listed. ' '**************************************************************************************** Function GetWrkGrpPrinters(lpWinIniFile As String, lpzPrinters() As String * 64) As Integer Dim wNumPrinters As Integer Dim wPrinter As Integer Dim wPrinterLen As Integer Dim lpPrinterCode As String Dim lpPrinter As String * 64 Dim lpOrder As String * 64 wNumPrinters = GetPrivateProfileString("MRU_Printers", ByVal "Order", "", lpOrder, Len(lpOrder), lpWinIniFile) If wNumPrinters Then ReDim lpzPrinters(wNumPrinters - 1) For wPrinter = 1 To wNumPrinters lpPrinterCode = Mid$(lpOrder, wPrinter, 1) wPrinterLen = GetPrivateProfileString("MRU_Printers", ByVal lpPrinterCode, "", lpPrinter, Len(lpPrinter), lpWinIniFile) lpzPrinters(wPrinter - 1) = Left$(lpPrinter, wPrinterLen) + Chr$(0) Next wPrinter End If GetWrkGrpPrinters = wNumPrinters End Function '**************************************************************************************** ' ' Purpose: Returns the value of the High order word ' of a long integer. ' '**************************************************************************************** Function HiWord(dwLong As Long) As Integer HiWord = dwLong / &H10000 End Function '**************************************************************************************** ' ' Purpose: Returns the last process file that was generated, ' for the raw file lpRawFile. ' lpRawFile must include directory, but no extension. ' The return value is the process number, zero if there are no processes. ' '**************************************************************************************** Function LastRawProcess(lpRawFile As String) As Integer Dim w1stFile As Integer Dim wLstFile As Integer Dim wFile As Integer Dim wYoungest As Integer Dim wNumFiles As Integer Dim lpWholeFile As String Dim lpCurFile As String Dim lpRawExt As String Dim lpProcStub As String Dim lpProcExt As String Dim lpProc As String Dim lpProcessFile() As String * 16 lpRawExt = GetMLFileExt("RAW") lpProcStub = "_PROC" lpProcExt = "DAT" lpWholeFile = Trim$(lpRawFile) + DOS_EXT_SEP + lpRawExt If FileExists(lpWholeFile) Then wNumFiles = GetRawProcessFiles(lpRawFile, lpProcessFile(), lpProcStub, lpProcExt) If wNumFiles Then lpRawExt = DOS_EXT_SEP + lpRawExt + DOS_DIR_SEP w1stFile = LBound(lpProcessFile) wLstFile = UBound(lpProcessFile) wYoungest = w1stFile For wFile = w1stFile To wLstFile If FileDateTime(lpRawFile + lpRawExt + Trim$(lpProcessFile(wFile))) > FileDateTime(lpRawFile + lpRawExt + Trim$(lpProcessFile(wYoungest))) Then wYoungest = wFile End If Next lpProc = Left$(lpProcessFile(wYoungest), InStr(1, lpProcessFile(wYoungest), DOS_EXT_SEP) - 1) lpProc = Right$(lpProc, Len(lpProc) - Len(lpProcStub)) LastRawProcess = CInt(lpProc) Else LastRawProcess = 0 End If Else LastRawProcess = 0 End If End Function Function LBoxSelString(hWnd As Long, wID As Long, lpSelString As String) As Integer Dim hLBox As Long Dim dwMsgRtn As Long hLBox = DlgItemValidate(hWnd, wID) If hLBox <> 0 Then dwMsgRtn = SendMessageAPI(hLBox, LB_FINDSTRING, -1, ByVal lpSelString) dwMsgRtn = SendMessage(hLBox, LB_SETSEL, -1, dwMsgRtn) Else dwMsgRtn = LB_ERR End If If dwMsgRtn = LB_ERR Then LBoxSelString = False Else LBoxSelString = True End If End Function '**************************************************************************************** ' ' Purpose: Returns the value of the Low order word ' of a long integer. ' '**************************************************************************************** Function LoWord(dwLong As Long) As Integer LoWord = dwLong - HiWord(dwLong) * &H10000 End Function '**************************************************************************************** ' ' Purpose: Combines two integers to give one long. ' '**************************************************************************************** Function MakeLong(wHiWord As Integer, wLoWord As Integer) As Long Dim dwHigh As Long Dim dwLow As Long dwHigh = wHiWord * &H10000 dwLow = CLng(wLoWord) And &HFFFF MakeLong = dwHigh Or dwLow End Function '**************************************************************************************** ' ' Purpose: Returns the window handle for MassLynx. ' '**************************************************************************************** Function MassLynxhWnd() As Long MassLynxhWnd = MLAppActive(APP_CLI) End Function '**************************************************************************************** ' ' Purpose: Displays File menu bar. ' Only if Alt+F is valid. ' '**************************************************************************************** Sub mbFile() SendKeys "%F", True DoEvents End Sub '**************************************************************************************** ' ' Purpose: Exit the current application. ' No file checking is carried out. ' mbFile and "X" must be valid for application. ' '**************************************************************************************** Sub mbFileExit() mbFile SendKeys "X", True DoEvents End Sub '**************************************************************************************** ' ' Purpose: New file for current application. ' No file checking is carried out. ' File must be saved as. ' mbFile and "N" must be valid for application. ' '**************************************************************************************** Sub mbFileNew() mbFile SendKeys "N", True DoEvents End Sub '**************************************************************************************** ' ' Purpose: Open an existing file. ' No file checking is carried out. ' lpFileToOpen can include directory etc. ' mbFile and "O" must be valid for application. ' '**************************************************************************************** Sub mbFileOpen(lpFileToOpen As String) mbFile SendKeys "O", True DoEvents SendKeys Trim$(lpFileToOpen), True SendKeys "{ENTER}", True DoEvents End Sub '---------------------------------------------------------------------------------------- ' ' Process: MLAppActive ' ' Author: Roberto Raso ' Date: 23rd November 1995 ' ' Purpose: Gets the window handle of a MassLynx application. ' ' Parameters: nMLApp is the ID of the MassLynx application. ' ' Return: The window handle of the MassLynx application, if running. ' '---------------------------------------------------------------------------------------- Function MLAppActive(nMLApp As Integer) As Long MLAppActive = GetApplicationWnd(nMLApp) End Function '**************************************************************************************** ' ' Purpose: Set the global default display, file access and Spec-Chro link. ' From the MassLynx top menu bar. ' '**************************************************************************************** Sub MLCustSysGlobals(bScan As Boolean, bUseAcquFile As Boolean, nAxis As Integer) 'Scan is either True or False. 'True=Use scan numbers to get scans in Spectrum. 'False=Use retention times to get scans in Spectrum. 'UseAcquFile is either True or False. 'True=Use the current acquired data file as default with Process Spectrum/Chromatogram. 'False=Use the last used data file as default with Process Spectrum/Chromatogram. 'DaPere is either True or False. 'AXIS_D=Display Spectrum mass scale as Daltons/Fundamental Charge. 'AXIS_M=Display Spectrum as Mass/Charge. 'AXIS_U=Display Spectrum as the un-SI unit/Fundamental Charge Dim hOptions As Long AppActivate "MassLynx" hOptions = MassLynxCommand("app.launch[tools:Options]()", OPEN_WIN_TIMEOUT) hOptions = FindWindowCaption("Options") If hOptions Then 'Set the display type If bScan Then SendKeys "%S", True Else SendKeys "%R", True End If 'Set Use Acquired File SendKeys "%U", True If bUseAcquFile Then SendKeys "{+}", True Else SendKeys "-", True End If 'Set Axes Label SendKeys "%A", True Select Case nAxis Case AXIS_D SendKeys "D", True Case AXIS_M SendKeys "M", True Case AXIS_U SendKeys "U", True End Select SendKeys "{ENTER}", True DoEvents End If End Sub '________________________________________________________________________________________ ' ' Process: MLFilesList ' ' Author: Roberto Raso ' Date: 12th May 1995 ' ' Purpose: Gets a list of current MassLynx files, of the required type. ' ' Parameters: strFileType is the type of MassLynx file required e.g. TUNE_DB. ' astrMLFile() is an array that will hold the list of files. ' ' Return: The number of files found. '________________________________________________________________________________________ Function MLFilesList(strFileType As String, astrMLFile() As String) As Integer Dim nFile As Integer Dim nFiles As Integer Dim nDirSepPos As Integer Dim strSearch As String Dim sVGFile As VGFILE Dim astrDOSFile() As String * 16 If GetMLFileInfo(strFileType, sVGFile) Then strSearch = SZToVB(sVGFile.szDirectory) + "*." + SZToVB(sVGFile.szExtension) nFiles = FileSearch(strSearch, astrDOSFile()) If nFiles = 0 Then MLFilesList = 0 Exit Function End If ReDim astrMLFile(nFiles - 1) For nFile = 0 To nFiles - 1 nDirSepPos = InStr(astrDOSFile(nFile), ".") If nDirSepPos Then astrMLFile(nFile) = Left$(astrDOSFile(nFile), nDirSepPos - 1) End If Next nFile End If MLFilesList = nFile End Function '**************************************************************************************** ' ' Purpose: Open a MassLynx raw data file. ' '**************************************************************************************** Sub MLRawFileOpen(lpRawFile As String, wProcesses As Integer) Dim hWndML As Long Dim hWndDB As Long Dim hCtrl As Long Dim dwMsgRtn As Long hWndML = ActivateML() hWndDB = MassLynxCommand("app.launch[default:DataFileOpen]()", OPEN_WIN_TIMEOUT) hWndDB = WaitForProcessStart("Data Browser", 10) If hWndDB Then hCtrl = GetDlgItem32(hWndDB, ID_BRO_FILENAME) 'Filename dwMsgRtn = SendMessageText(hCtrl, lpRawFile) If (wProcesses And CHRO_OPEN) = CHRO_OPEN Then Call CheckDlgButton32(hWndDB, ID_CHK_CHRO, True) Else Call CheckDlgButton32(hWndDB, ID_CHK_CHRO, False) End If If (wProcesses And SPEC_OPEN) = SPEC_OPEN Then Call CheckDlgButton32(hWndDB, ID_CHK_SPEC, True) Else Call CheckDlgButton32(hWndDB, ID_CHK_SPEC, False) End If dwMsgRtn = PostMessage(hWndDB, WM_COMMAND, IDOK, 0) End If If (wProcesses And CHRO_OPEN) = CHRO_OPEN Then CHROM End If If (wProcesses And SPEC_OPEN) = SPEC_OPEN Then SPECT End If End Sub '**************************************************************************************** ' ' Purpose: Pauses the print manager. ' '**************************************************************************************** Function PausePrintManager(wPause As Integer) As Integer Dim hPMgr As Long Dim wPauseState As Integer Dim wID As Long Dim dwMsgRtn As Long hPMgr = ProcessActive("Print Manager") If wPause Then wID = 2 Else wID = 3 End If If hPMgr Then dwMsgRtn = PostMessage(hPMgr, WM_SYSCOMMAND, SC_RESTORE, 0) DoEvents dwMsgRtn = PostMessage(hPMgr, WM_COMMAND, wID, 0) DoEvents dwMsgRtn = PostMessage(hPMgr, WM_SYSCOMMAND, SC_MINIMIZE, 0) DoEvents End If PausePrintManager = hPMgr End Function '**************************************************************************************** ' ' Process: PrinterOrient ' ' Author: Roberto Raso ' Date: 7th November 1994 ' ' Purpose: Sets up printer for MassLynx. ' ' Parameters: bPortrait sets Portrait or Landscape printer mode. ' ' Return: True if successful. ' '**************************************************************************************** Function PrinterOrient(bPortrait As Integer) As Integer Dim hMassLynx As Long Dim hPrinter As Long Dim idPortrait As Long Dim dwMsgRtn As Long Dim strPrinterCaption As String hMassLynx = MassLynxhWnd() strPrinterCaption = "Print Setup" If hMassLynx Then hPrinter = FindChildWindow(hMassLynx, strPrinterCaption) If hPrinter = 0 Then dwMsgRtn = PostMessage(hMassLynx, WM_COMMAND, ID_FILE_PRINT_SETUP, 0) hPrinter = WaitForChildWindow(hMassLynx, strPrinterCaption, 10) End If If hPrinter Then If bPortrait Then idPortrait = PORTRAIT MsgBox ("Portrait check") Else idPortrait = LANDSCAPE MsgBox ("Landscape check") End If dwMsgRtn = SendMessage(hPrinter, WM_COMMAND, idPortrait, 0) dwMsgRtn = SendMessage(hPrinter, WM_COMMAND, IDOK, 0) Do While IsWindow(hPrinter) DoEvents Loop PrinterOrient = True End If End If End Function '**************************************************************************************** ' ' Process: ProcDialog_OK ' ' Author: Roberto Raso ' Date: 6th February 1995 ' ' Purpose: Call up a dialogue box and then OK it, sometimes to ' activate a process. ' ' Parameters: hParent is the handle of the window that the dialogue ' box will be generated from. ' nID is the command ID of the menu or tool bar item that ' will call the up the dialogue box. ' strDlgCaption is the caption of the dialogue box that will ' be activated when nID is sent to hParent. ' strProcDlg is the caption of the processing type dialogue box. ' This can be a Chr$(0) if no processing box is displayed. ' ' Return: void. ' '**************************************************************************************** Sub ProcDialog_OK(hParent As Long, nID As Long, strDlgCaption As String, strProcDlg As String) Dim dwMsgRtn As Long Dim hDlg As Long Dim hProc As Long If IsWindow(hParent) Then hDlg = FindChildWindow(hParent, strDlgCaption) If hDlg = 0 Then dwMsgRtn = PostMessage(hParent, WM_COMMAND, nID, 0) hDlg = WaitForChildWindow(hParent, strDlgCaption, 5) End If If hDlg Then dwMsgRtn = SendMessage(hDlg, WM_COMMAND, IDOK, 0) If strProcDlg <> Chr$(0) Then hProc = WaitForProcessStart(strProcDlg, 5) If hProc Then Do While IsWindow(hProc) DoEvents Loop End If End If End If End If End Sub '**************************************************************************************** ' ' Process: ProDirPath ' ' Author: Anthony Holland ' ' Date: 12th November 1997 ' ' Purpose: Get the directory path of the current ".PRO" project directory. ' ' Return: The directory path of the project directory. ' '**************************************************************************************** Function ProDirPath() As String Dim lCharPos1 As Long Dim lProDirEnd As Long Dim szSPLFile As String lCharPos1 = InStr(1, CurrentSPLFile(), ".PRO", 1) lProDirEnd = lCharPos1 + 4 ProDirPath = Mid(CurrentSPLFile(), 1, lProDirEnd) End Function '**************************************************************************************** ' ' Purpose: Get the size of the current record from table tbl. ' The array of field sizes is filled. ' '**************************************************************************************** Function RecSize(tbl As Table, lpFdSize() As Long) As Long Dim wFdNum As Integer Dim dwRecSize As Integer dwRecSize = 0 ReDim lpFdSize(tbl.Fields.Count - 1) For wFdNum = 0 To tbl.Fields.Count - 1 lpFdSize(wFdNum) = tbl.Fields(wFdNum).Size If (tbl.Fields(wFdNum).Type = DB_LONGBINARY) Or (tbl.Fields(wFdNum).Type = DB_MEMO) Then lpFdSize(wFdNum) = tbl.Fields(wFdNum).FieldSize() End If dwRecSize = dwRecSize + lpFdSize(wFdNum) Next wFdNum RecSize = dwRecSize End Function '**************************************************************************************** ' ' Purpose: Send a text message to the relevant window handle. ' '**************************************************************************************** Function SendMessageText(hWnd As Long, lpMsg As String) As Long SendMessageText = SendMessageAPI(hWnd, WM_SETTEXT, 0, ByVal lpMsg) DoEvents End Function '**************************************************************************************** ' ' Purpose: Set the current record to dwRec. ' Returns TRUE if record inside range of records in table. ' Returns FALSE if outside range. ' '**************************************************************************************** Function SetDBRec(tbl As Table, dwRec As Long) As Integer Dim bRecOK As Integer Dim dwCurRec As Long bRecOK = ((tbl.RecordCount >= dwRec) And (dwRec > 0)) If bRecOK Then dwCurRec = 1 tbl.MoveFirst Do While dwCurRec < dwRec tbl.MoveNext dwCurRec = dwCurRec + 1 Loop SetDBRec = True Else SetDBRec = False End If End Function '**************************************************************************************** ' ' Purpose: Set the default MassLynx file, for file type lpFileType. ' The file is first assumed to exist in the current ' directory with the current extension. Therefore only name is required. ' If file does not exist in default form lpFileName is assumed to be the ' comlete path descriptor for file i.e. Directory and extension must be included. ' ' '**************************************************************************************** Function SetGlobalFileML(lpFileType As String, lpFileName As String) As Integer Dim bSetable As Integer Dim wVGFile As Integer Dim lpVGFile As VGFILE wVGFile = GetMLFileInfo(lpFileType, lpVGFile) If wVGFile Then bSetable = False If FileExists(SZToVB(lpVGFile.szDirectory) + lpFileName + "." + SZToVB(lpVGFile.szExtension)) Then lpVGFile.szName = lpFileName + Chr$(0) bSetable = True ElseIf FileExists(lpFileName) Then lpVGFile.szDirectory = GetDOSFilePath(lpFileName) + Chr$(0) lpVGFile.szName = GetDOSFileName(lpFileName) + Chr$(0) lpVGFile.szExtension = GetDOSFileExt(lpFileName) + Chr$(0) bSetable = True End If If bSetable Then SetGlobalFileML = SetGlobalFile(SYSPARAGRAPH, lpFileType, lpVGFile, True) End If Else SetGlobalFileML = False End If End Function '**************************************************************************************** ' ' Purpose: Set a Windows for Workgroup printer. ' If the printer port (lpPort) or ' the printer (lpPrinter) is invalid then ' the configuration is not changed. ' '**************************************************************************************** Sub SetWrkGrpPrinter(lpPrinter As String, lpPort As String) Dim hPMgr As Long Dim hInst As Long Dim hCon As Long Dim hPath As Long Dim hWarning As Long Dim wPortItem As Integer Dim dwMsgRtn As Long Dim lpPMgr As String Dim lpCon As String Dim lpWarning As String lpPMgr = "Print Manager" lpCon = "Connect Network Printer" lpWarning = "Windows for Workgroups" hPMgr = ProcessActive(lpPMgr) If hPMgr = 0 Then hInst = Shell("PRINTMAN.EXE", 1) hPMgr = WaitForProcessStart(lpPMgr, 5) End If If hPMgr Then dwMsgRtn = PostMessage(hPMgr, WM_SYSCOMMAND, SC_RESTORE, 0) DoEvents hCon = ProcessActive(lpCon) If hCon = 0 Then dwMsgRtn = PostMessage(hPMgr, WM_COMMAND, 8022, 0) 'Connect menu item DoEvents hCon = WaitForProcessStart(lpCon, 5) End If If hCon Then wPortItem = TextInCB(hCon, 603, lpPort) 'Is printer port available? If wPortItem > -1 Then dwMsgRtn = SendDlgItemMessage(hCon, 603, CB_SETCURSEL, wPortItem, 0) End If hPath = GetDlgItem32(hCon, 601) 'Path text box handle. dwMsgRtn = SendMessageText(hPath, lpPrinter) dwMsgRtn = PostMessage(hCon, WM_COMMAND, IDOK, 0) hWarning = WaitForProcessStart(lpWarning, 10) If hWarning Then dwMsgRtn = PostMessage(hWarning, WM_COMMAND, IDOK, 0) DoEvents dwMsgRtn = PostMessage(hCon, WM_COMMAND, IDCANCEL, 0) DoEvents End If End If dwMsgRtn = PostMessage(hPMgr, WM_SYSCOMMAND, SC_MINIMIZE, 0) DoEvents End If End Sub '**************************************************************************************** ' ' Process: Spare1SampleListEntry ' ' Author: Anthony Holland ' Date: 20th January 1998 ' ' Purpose: Get the current value of the entry "Spare1" in the Sample List. ' ' Return: The value indicated above. ' '**************************************************************************************** Function Spare1SampleListEntry() As String Dim lpSampleListFile As String lpSampleListFile = "C:\Temp\MLCurSmp.txt" Spare1SampleListEntry = GetPrivateProfileStr("Sample", "Spare1", lpSampleListFile) End Function '**************************************************************************************** ' ' Process: Spare2SampleListEntry ' ' Author: Anthony Holland ' Date: 21st January 1998 ' ' Purpose: Get the current value of the entry "Spare2" in the Sample List. ' ' Return: The value indicated above. ' '**************************************************************************************** Function Spare2SampleListEntry() As String Dim lpSampleListFile As String lpSampleListFile = "C:\Temp\MLCurSmp.txt" Spare2SampleListEntry = GetPrivateProfileStr("Sample", "Spare2", lpSampleListFile) End Function '**************************************************************************************** ' ' Process: SPLFileName ' ' Author: Anthony Holland ' ' Date: 12th November 1997 ' ' Purpose: Get the filename of the current ".SPL" Sample List file. ' ' Return: The ".SPL" filename. ' '**************************************************************************************** Function SPLFileName() As String Dim lCharPos2 As Long Dim lCharPos3 As Long Dim lStart As Long 'Find the last occurrence of the "\" character in the .SPL filename, using the 'Do Loop below. InStr returns a zero the first time "\" is not found in the string. 'Upon exit from the Do Loop, lCharPos2 is the character pos. of the last "\". lStart = 1 Do While InStr(lStart, CurrentSPLFile(), "\", 1) <> 0 lCharPos2 = InStr(lStart, CurrentSPLFile(), "\", 1) lStart = lCharPos2 + 1 Loop lCharPos3 = InStr(lCharPos2 + 1, CurrentSPLFile(), ".SPL", 1) SPLFileName = Mid(CurrentSPLFile(), lCharPos2 + 1, lCharPos3 - lCharPos2 - 1) End Function Function SqrBrRem(StringToStrip As String) As String Dim LenOfExpr As Integer Dim LenOfExp As Integer Dim sWork As String Dim FirstChar As String Dim LastChar As String FirstChar = "[" LastChar = "]" If Left(StringToStrip, 1) = FirstChar Then LenOfExp = Len(StringToStrip) - 1 sWork = Right$(StringToStrip, LenOfExp) LenOfExp = LenOfExp - 1 SqrBrRem = Left$(sWork, LenOfExp) Else SqrBrRem = StringToStrip End If End Function '**************************************************************************************** ' ' Purpose: Close down process with selected window caption ' Returns TRUE if lpProcess was active. ' '**************************************************************************************** Function StopProcess(lpProcess As String) As Integer Dim hWnd As Long Dim dwSendMsgRtn As Long StopProcess = False hWnd = FindWindow(vbNullString, Trim$(lpProcess)) If hWnd Then dwSendMsgRtn = PostMessage(hWnd, WM_CLOSE, 0, 0) Call WaitForProcessEnd(lpProcess) StopProcess = True Else StopProcess = False End If End Function Function Str2Sng(NumStr As String) As Single 'Converts a string (from ClipBoard?) to single. Dim CharInStr As String Dim PosInStr As Integer Dim MantDone As Integer Dim ExpDone As Integer Dim ValMant As Single Dim ValExp As Single MantDone = False PosInStr = 1 Do While MantDone = False CharInStr = UCase$(Mid$(NumStr, PosInStr, 1)) If CharInStr = "E" Or PosInStr = Len(NumStr) Then ValMant = Val(Left$(NumStr, PosInStr)) MantDone = True End If PosInStr = PosInStr + 1 Loop If PosInStr > Len(NumStr) Then ValExp = 0 Else ValExp = Val(Right$(NumStr, Len(NumStr) - PosInStr + 1)) End If Str2Sng = ValMant * (10 ^ ValExp) End Function '**************************************************************************************** ' ' Purpose: Convert as string to an array of characters. ' '**************************************************************************************** Function StrToArray(lpString As String, lpArray() As String * 1) As Long Dim wStart As Integer Dim wChar As Integer Dim dwStrLen As Long wStart = &H8000 dwStrLen = Len(lpString) ReDim lpArray(wStart To wStart + dwStrLen) For wChar = 1 To dwStrLen lpArray(wStart + wChar - 1) = Mid$(lpString, wChar, 1) Next wChar StrToArray = wChar - 1 End Function '**************************************************************************************** ' ' Purpose: Check to see if the text lpText is in any one of the ' ComboBox entries, the first index containing lpText is returned. ' If lpText is not found -1 is returned. ' The text search is not case sensitive, do not be surprised ' if this function gives the 'wrong' result. ' '**************************************************************************************** Function TextInCB(hDlg As Long, wCBID As Integer, lpText As String) As Integer Dim wItems As Integer Dim wItem As Integer Dim wFound As Integer Dim dwMsgRtn As Long Dim lpItem As String wFound = 0 wItems = SendDlgItemMessage(hDlg, wCBID, CB_GETCOUNT, 0, 0) For wItem = 0 To (wItems - 1) dwMsgRtn = SendDlgItemMessage(hDlg, wCBID, CB_GETITEMDATA, ByVal wItem, 0) Call hmemcpyTolp(lpItem, dwMsgRtn, 64) ''wFound = InStr(1, lpItem.sz64, lpText, 1) wFound = InStr(1, lpItem, lpText, 1) If wFound > 0 Then Exit For End If Next wItem If wFound > 0 Then TextInCB = wItem Else TextInCB = -1 End If End Function '**************************************************************************************** ' ' Purpose: Check to see if the text lpText is in any one of the ' ListBox entries, the first index containing lpText is returned. ' If lpText is not found -1 is returned. ' The text search is not case sensitive, do not be surprised ' if this function gives the 'wrong' result. ' '**************************************************************************************** Function TextInLB(hDlg As Long, wLBID As Integer, lpText As String) Dim wItems As Integer Dim wItem As Integer Dim wFound As Integer Dim dwMsgRtn As Long Dim lpItem As String wFound = 0 wItems = SendDlgItemMessage(hDlg, wLBID, LB_GETCOUNT, 0, 0) Debug.Print "wItems"; wItems For wItem = 0 To (wItems - 1) dwMsgRtn = SendDlgItemMessage(hDlg, wLBID, LB_GETITEMDATA, ByVal wItem, 0) Debug.Print "Size "; GlobalSize(dwMsgRtn) Debug.Print "GETITEM "; dwMsgRtn 'Call hmemcpyTolp(lpItem, dwMsgRtn, 64) 'Debug.Print lpItem.sz64 'wFound = InStr(1, lpItem.sz64, lpText, 1) 'If wFound > 0 Then 'Exit For 'End If Next wItem 'If wFound > 0 Then 'TextInLB = wItem 'Else 'TextInLB = -1 'End If TextInLB = wItems End Function '---------------------------------------------------------------------------------------- ' ' Process: VGRawFileOpen ' ' Author: Roberto Raso ' Date: 25th April 1995 ' ' Purpose: Opens the required file, function and/or process. ' ' Parameters: sVGRawFile is the VG raw file to open. ' Note: sVGRawFile.wFunc or sVGRawFile.wProc must be set and valid. ' nChroSpec is a bit field holding CHRO_OPEN and/or SPEC_OPEN. ' ' Return: True if successful. ' '---------------------------------------------------------------------------------------- Function VGRawFileOpen(sVGRawFile As VGRAWFILE, nChroSpec As Integer) As Integer Dim bDataFile As Integer Dim hMassLynx As Long Dim hBrowser As Long Dim hHistory As Long Dim nDataFile As Integer bDataFile = False VGRawFileOpen = bDataFile hMassLynx = MLAppActive(APP_CLI) If hMassLynx Then If FileExists(SZToVB(sVGRawFile.lpVGFile.szDirectory) + SZToVB(sVGRawFile.lpVGFile.szName) + "." + SZToVB(sVGRawFile.lpVGFile.szExtension) + "\*.dat") = 0 Then VGRawFileOpen = False Exit Function End If If SetGlobalFile(SYSPARAGRAPH, "RAW" + Chr$(0), sVGRawFile.lpVGFile, True) Then 'Open data browser hBrowser = DataBrowserShow() If hBrowser Then If sVGRawFile.wProc > 0 Then If sVGRawFile.wProc = DataFileExists(sVGRawFile.lpVGFile, sVGRawFile.wProc, PROC_STUB, DATA_FILE_EXT) Then If DataProcessSelect(sVGRawFile, hBrowser) = sVGRawFile.wProc Then bDataFile = True End If End If ElseIf sVGRawFile.wFunc > 0 Then If sVGRawFile.wFunc = DataFileExists(sVGRawFile.lpVGFile, sVGRawFile.wFunc, FUNC_STUB, DATA_FILE_EXT) Then If DataFunctionSelect(sVGRawFile, hBrowser) = sVGRawFile.wFunc Then bDataFile = True End If End If Else bDataFile = True End If If bDataFile And DataBrowserChroSpec(hBrowser, nChroSpec) = nChroSpec Then VGRawFileOpen = DlgBoxClose(hBrowser, IDOK, -1) Else bDataFile = DlgBoxClose(hBrowser, IDCANCEL, -1) VGRawFileOpen = False End If End If End If End If End Function '**************************************************************************************** ' ' Purpose: Waits for the MassLynx application to start. ' If the application is not started within the wTimeOut ' period (in seconds), then 0 is returned. If the application ' is active its window handle is returned. ' wMLApp is the MassLynx applictaion code. ' '**************************************************************************************** Function WaitForMLApp(wMLApp As Integer, wTimeout As Integer) As Long Dim bEndWait As Integer Dim hAppWnd As Long Dim wWait As Integer Dim lpEntryTime As Variant lpEntryTime = Now bEndWait = False hAppWnd = 0 Do Until bEndWait Or hAppWnd wWait = Second(Now - lpEntryTime) hAppWnd = MLAppActive(wMLApp) If wWait > wTimeout Then bEndWait = True End If DoEvents Loop WaitForMLApp = hAppWnd End Function '**************************************************************************************** ' ' Purpose: Wait for MassLynx to finish printing. ' '**************************************************************************************** Sub WaitForMLPrint() Dim hPrint As Long Dim lpPrint As String lpPrint = "Printing..." hPrint = WaitForProcessStart(lpPrint, 120) Call WaitForProcessEnd("Printing...") End Sub Sub WaitForProcessEnd(WindowCaption As String) 'Wait for the process window to disapear. Do While FindWindow(vbNullString, WindowCaption) DoEvents Loop End Sub Function WaitForProcessStart(Process As String, Timeout As Integer) As Long 'Looks for the Window with caption Process. If the Window 'has not been found in Timeout seconds then function returns false. Dim EndWait As Integer Dim Wait As Integer Dim EntryTime As Variant EntryTime = Now Do Until EndWait Wait = Second(Now - EntryTime) If ProcessActive(Process) Then EndWait = True ElseIf Wait > Timeout Then EndWait = True Else DoEvents End If Loop WaitForProcessStart = ProcessActive(Process) End Function '**************************************************************************************** ' ' Purpose: Wait for the window, identified by hWnd to close down. ' '**************************************************************************************** Sub WaitForWindowClose(hWnd As Long) Do While GetWindow(hWnd, GW_HWNDFIRST) DoEvents Loop End Sub Function WrkGrpPrintPause(bPause As Integer) Dim hPMgr As Long Dim hInst As Long Dim hCon As Long Dim hPath As Long Dim hWarning As Long Dim wPortItem As Integer Dim dwMsgRtn As Long Dim lpPMgr As String Dim lpCon As String Dim lpWarning As String lpPMgr = "Print Manager" lpCon = "Connect Network Printer" lpWarning = "Windows for Workgroups" hPMgr = ProcessActive(lpPMgr) If hPMgr = 0 Then hInst = Shell("PRINTMAN.EXE", 1) hPMgr = WaitForProcessStart(lpPMgr, 5) End If If hPMgr Then dwMsgRtn = PostMessage(hPMgr, WM_SYSCOMMAND, SC_RESTORE, 0) DoEvents wPortItem = TextInLB(hPMgr, 403, "OL-400") Debug.Print "WrkGrpPrintPause "; wPortItem End If End Function