Написал eJuiceCalculator для Мака

**svoemesto** · 18.09.2011 12:29

Первая часть:

Код:

Public Class frmCalc

    Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
    Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Long
    'Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpszSection$, ByVal lpszKey$, ByVal lpszDefault$, ByVal lpszReturnBuffer$, ByVal cchReturnBuffer&, ByVal lpszFile$)

    Public blTypeChangeManual As Boolean
    Public blLoadINI As Boolean

    Private Function INI_SetValue(ByVal Section As String, ByVal Key As String, ByVal strValue As String, ByVal fFileName As String) As String
        Call WritePrivateProfileString(Section, Key, strValue, fFileName)
    End Function

    Private Function INI_GetValue(ByVal Section As String, ByVal Key As String, ByVal fFileName As String, Optional ByVal DefaultValue As String = "") As String
        Dim Data As String
        Dim i As Long
        Data = "" : For i = 1 To 1000 : Data = Data & " " : Next i
        'Data = Space(1000)
        If GetPrivateProfileString(Section, Key, "", Data, Len(Data), fFileName) > 0 Then
            INI_GetValue = Trim(Data)
        Else
            INI_GetValue = DefaultValue
        End If
        Exit Function
    End Function

    Function GetFromString_FileName(ByVal strFileNameAndFolder As String) As String
        Dim i As Long
        Dim str As String
        str = ""
        For i = 1 To Len(strFileNameAndFolder)
            If Mid(strFileNameAndFolder, Len(strFileNameAndFolder) - i + 1, 1) <> "\" Then
                str = Mid(strFileNameAndFolder, Len(strFileNameAndFolder) - i + 1, 1) & str
            Else
                Exit For
            End If
        Next i
        GetFromString_FileName = str
    End Function

    Function GetFromString_FileFolder(ByVal strFileNameAndFolder As String) As String
        Dim i As Long
        Dim str As String
        str = ""
        GetFromString_FileFolder = ""
        For i = 1 To Len(strFileNameAndFolder)
            If Mid(strFileNameAndFolder, Len(strFileNameAndFolder) - i + 1, 1) = "\" Then
                GetFromString_FileFolder = Mid(strFileNameAndFolder, 1, Len(strFileNameAndFolder) - i)
                Exit For
            End If
        Next i
    End Function

    Function GetFromString_FileExt(ByVal strFileNameAndFolder As String) As String
        Dim i As Long
        Dim str As String
        str = ""
        For i = 1 To Len(strFileNameAndFolder)
            If Mid(strFileNameAndFolder, Len(strFileNameAndFolder) - i + 1, 1) <> "." Then
                str = Mid(strFileNameAndFolder, Len(strFileNameAndFolder) - i + 1, 1) & str
            Else
                Exit For
            End If
        Next i
        GetFromString_FileExt = str
    End Function

    Sub INI_SaveToFile()
        Dim strFileName As String, strFilePath As String, strAppExtPath As String, strFileNameAndPath As String
        Dim strListItems As String, i As Long

        strAppExtPath = Application.ExecutablePath
        strFilePath = GetFromString_FileFolder(strAppExtPath)
        strFileName = Mid(GetFromString_FileName(strAppExtPath), 1, Len(GetFromString_FileName(strAppExtPath)) - Len(GetFromString_FileExt(strAppExtPath)) - 1) & ".ini"
        strFileNameAndPath = strFilePath & "\" & strFileName


        Call INI_SetValue("Main", "ctlALG1_PGinBASE", ctlALG1_PGinBASE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_VGinBASE", ctlALG1_VGinBASE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_ADinBASE", ctlALG1_ADinBASE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_NICinBASE", ctlALG1_NICinBASE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_BASE_VOL", ctlALG1_BASE_VOL.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_BASE_PRICE", ctlALG1_BASE_PRICE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_PG_VOL", ctlALG1_PG_VOL.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_PG_PRICE", ctlALG1_PG_PRICE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_VG_VOL", ctlALG1_VG_VOL.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_VG_PRICE", ctlALG1_VG_PRICE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_AD_VOL", ctlALG1_AD_VOL.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_AD_PRICE", ctlALG1_AD_PRICE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_AR_VOL", ctlALG1_AR_VOL.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_AR_PRICE", ctlALG1_AR_PRICE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_DROPSinML", ctlALG1_DROPSinML.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_NICinNEED", ctlALG1_NICinNEED.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_PGinNEED", ctlALG1_PGinNEED.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_VGinNEED", ctlALG1_VGinNEED.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_ADinNEED", ctlALG1_ADinNEED.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_ARinNEED", ctlALG1_ARinNEED.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_VOLinNEED", ctlALG1_VOLinNEED.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_MLinDAY", ctlALG1_MLinDAY.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG1_DAYS", ctlALG1_DAYS.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_PGinBASE1", ctlALG2_PGinBASE1.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_VGinBASE1", ctlALG2_VGinBASE1.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_ADinBASE1", ctlALG2_ADinBASE1.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_NICinBASE1", ctlALG2_NICinBASE1.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_PGinBASE2", ctlALG2_PGinBASE2.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_VGinBASE2", ctlALG2_VGinBASE2.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_ADinBASE2", ctlALG2_ADinBASE2.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_NICinBASE2", ctlALG2_NICinBASE2.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_BASE1_VOL", ctlALG2_BASE1_VOL.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_BASE1_PRICE", ctlALG2_BASE1_PRICE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_BASE2_VOL", ctlALG2_BASE2_VOL.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_BASE2_PRICE", ctlALG2_BASE2_PRICE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_AR_VOL", ctlALG2_AR_VOL.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_AR_PRICE", ctlALG2_AR_PRICE.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_DROPSinML", ctlALG2_DROPSinML.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_NICinNEED", ctlALG2_NICinNEED.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_ARinNEED", ctlALG2_ARinNEED.Text, strFileNameAndPath)
        Call INI_SetValue("Main", "ctlALG2_VOLinNEED", ctlALG2_VOLinNEED.Text, strFileNameAndPath)
        Call INI_SetValue("Language", "ctlLanguage", ctlLanguage.Text, strFileNameAndPath)
        Call INI_SetValue("Currency", "ctlCurrency", ctlCurrency.Text, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_PGinBASE.Items.Count - 1
            strListItems = strListItems & ctlALG1_PGinBASE.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_PGinBASE", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_VGinBASE.Items.Count - 1
            strListItems = strListItems & ctlALG1_VGinBASE.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_VGinBASE", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_ADinBASE.Items.Count - 1
            strListItems = strListItems & ctlALG1_ADinBASE.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_ADinBASE", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_NICinBASE.Items.Count - 1
            strListItems = strListItems & ctlALG1_NICinBASE.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_NICinBASE", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_DROPSinML.Items.Count - 1
            strListItems = strListItems & ctlALG1_DROPSinML.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_DROPSinML", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_NICinNEED.Items.Count - 1
            strListItems = strListItems & ctlALG1_NICinNEED.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_NICinNEED", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_PGinNEED.Items.Count - 1
            strListItems = strListItems & ctlALG1_PGinNEED.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_PGinNEED", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_VGinNEED.Items.Count - 1
            strListItems = strListItems & ctlALG1_VGinNEED.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_VGinNEED", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_ADinNEED.Items.Count - 1
            strListItems = strListItems & ctlALG1_ADinNEED.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_ADinNEED", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_ARinNEED.Items.Count - 1
            strListItems = strListItems & ctlALG1_ARinNEED.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_ARinNEED", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_VOLinNEED.Items.Count - 1
            strListItems = strListItems & ctlALG1_VOLinNEED.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_VOLinNEED", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_MLinDAY.Items.Count - 1
            strListItems = strListItems & ctlALG1_MLinDAY.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_MLinDAY", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG1_DAYS.Items.Count - 1
            strListItems = strListItems & ctlALG1_DAYS.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG1_DAYS", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_PGinBASE1.Items.Count - 1
            strListItems = strListItems & ctlALG2_PGinBASE1.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_PGinBASE1", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_VGinBASE1.Items.Count - 1
            strListItems = strListItems & ctlALG2_VGinBASE1.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_VGinBASE1", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_ADinBASE1.Items.Count - 1
            strListItems = strListItems & ctlALG2_ADinBASE1.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_ADinBASE1", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_NICinBASE1.Items.Count - 1
            strListItems = strListItems & ctlALG2_NICinBASE1.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_NICinBASE1", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_PGinBASE2.Items.Count - 1
            strListItems = strListItems & ctlALG2_PGinBASE2.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_PGinBASE2", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_VGinBASE2.Items.Count - 1
            strListItems = strListItems & ctlALG2_VGinBASE2.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_VGinBASE2", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_ADinBASE2.Items.Count - 1
            strListItems = strListItems & ctlALG2_ADinBASE2.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_ADinBASE2", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_NICinBASE2.Items.Count - 1
            strListItems = strListItems & ctlALG2_NICinBASE2.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_NICinBASE2", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_DROPSinML.Items.Count - 1
            strListItems = strListItems & ctlALG2_DROPSinML.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_DROPSinML", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_NICinNEED.Items.Count - 1
            strListItems = strListItems & ctlALG2_NICinNEED.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_NICinNEED", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_ARinNEED.Items.Count - 1
            strListItems = strListItems & ctlALG2_ARinNEED.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_ARinNEED", strListItems, strFileNameAndPath)

        strListItems = ""
        For i = 0 To ctlALG2_VOLinNEED.Items.Count - 1
            strListItems = strListItems & ctlALG2_VOLinNEED.Items(i).ToString & ";"
        Next i
        strListItems = Mid(strListItems, 1, Len(strListItems) - 1)
        Call INI_SetValue("List", "ctlALG2_VOLinNEED", strListItems, strFileNameAndPath)


    End Sub

    Function FileUtils_IsFilePresent(ByVal strFileName As String) As Boolean
        Dim strTmp As String 'Временная переменная
        FileUtils_IsFilePresent = False
        On Error Resume Next
        strTmp = Dir(strFileName)
        If Err.Number <> 0 Then Exit Function
        If strTmp <> "" Then FileUtils_IsFilePresent = True
    End Function
    Sub INI_LoadFromFile()
        Dim strFileName As String, strFilePath As String, strAppExtPath As String, strFileNameAndPath As String
        Dim strListItems As String, i As Long

        strAppExtPath = Application.ExecutablePath
        strFilePath = GetFromString_FileFolder(strAppExtPath)
        strFileName = Mid(GetFromString_FileName(strAppExtPath), 1, Len(GetFromString_FileName(strAppExtPath)) - Len(GetFromString_FileExt(strAppExtPath)) - 1) & ".ini"
        strFileNameAndPath = strFilePath & "\" & strFileName

        If FileUtils_IsFilePresent(strFileNameAndPath) = False Then Exit Sub

        blLoadINI = True

        ctlALG1_PGinBASE.Text = INI_GetValue("Main", "ctlALG1_PGinBASE", strFileNameAndPath)
        ctlALG1_VGinBASE.Text = INI_GetValue("Main", "ctlALG1_VGinBASE", strFileNameAndPath)
        ctlALG1_ADinBASE.Text = INI_GetValue("Main", "ctlALG1_ADinBASE", strFileNameAndPath)
        ctlALG1_NICinBASE.Text = INI_GetValue("Main", "ctlALG1_NICinBASE", strFileNameAndPath)
        ctlALG1_BASE_VOL.Text = INI_GetValue("Main", "ctlALG1_BASE_VOL", strFileNameAndPath)
        ctlALG1_BASE_PRICE.Text = INI_GetValue("Main", "ctlALG1_BASE_PRICE", strFileNameAndPath)
        ctlALG1_PG_VOL.Text = INI_GetValue("Main", "ctlALG1_PG_VOL", strFileNameAndPath)
        ctlALG1_PG_PRICE.Text = INI_GetValue("Main", "ctlALG1_PG_PRICE", strFileNameAndPath)
        ctlALG1_VG_VOL.Text = INI_GetValue("Main", "ctlALG1_VG_VOL", strFileNameAndPath)
        ctlALG1_VG_PRICE.Text = INI_GetValue("Main", "ctlALG1_VG_PRICE", strFileNameAndPath)
        ctlALG1_AD_VOL.Text = INI_GetValue("Main", "ctlALG1_AD_VOL", strFileNameAndPath)
        ctlALG1_AD_PRICE.Text = INI_GetValue("Main", "ctlALG1_AD_PRICE", strFileNameAndPath)
        ctlALG1_AR_VOL.Text = INI_GetValue("Main", "ctlALG1_AR_VOL", strFileNameAndPath)
        ctlALG1_AR_PRICE.Text = INI_GetValue("Main", "ctlALG1_AR_PRICE", strFileNameAndPath)
        ctlALG1_DROPSinML.Text = INI_GetValue("Main", "ctlALG1_DROPSinML", strFileNameAndPath)
        ctlALG1_NICinNEED.Text = INI_GetValue("Main", "ctlALG1_NICinNEED", strFileNameAndPath)
        ctlALG1_PGinNEED.Text = INI_GetValue("Main", "ctlALG1_PGinNEED", strFileNameAndPath)
        ctlALG1_VGinNEED.Text = INI_GetValue("Main", "ctlALG1_VGinNEED", strFileNameAndPath)
        ctlALG1_ADinNEED.Text = INI_GetValue("Main", "ctlALG1_ADinNEED", strFileNameAndPath)
        ctlALG1_ARinNEED.Text = INI_GetValue("Main", "ctlALG1_ARinNEED", strFileNameAndPath)
        ctlALG1_VOLinNEED.Text = INI_GetValue("Main", "ctlALG1_VOLinNEED", strFileNameAndPath)
        ctlALG1_MLinDAY.Text = INI_GetValue("Main", "ctlALG1_MLinDAY", strFileNameAndPath)
        ctlALG1_DAYS.Text = INI_GetValue("Main", "ctlALG1_DAYS", strFileNameAndPath)
        ctlALG2_PGinBASE1.Text = INI_GetValue("Main", "ctlALG2_PGinBASE1", strFileNameAndPath)
        ctlALG2_VGinBASE1.Text = INI_GetValue("Main", "ctlALG2_VGinBASE1", strFileNameAndPath)
        ctlALG2_ADinBASE1.Text = INI_GetValue("Main", "ctlALG2_ADinBASE1", strFileNameAndPath)
        ctlALG2_NICinBASE1.Text = INI_GetValue("Main", "ctlALG2_NICinBASE1", strFileNameAndPath)
        ctlALG2_PGinBASE2.Text = INI_GetValue("Main", "ctlALG2_PGinBASE2", strFileNameAndPath)
        ctlALG2_VGinBASE2.Text = INI_GetValue("Main", "ctlALG2_VGinBASE2", strFileNameAndPath)
        ctlALG2_ADinBASE2.Text = INI_GetValue("Main", "ctlALG2_ADinBASE2", strFileNameAndPath)
        ctlALG2_NICinBASE2.Text = INI_GetValue("Main", "ctlALG2_NICinBASE2", strFileNameAndPath)
        ctlALG2_BASE1_VOL.Text = INI_GetValue("Main", "ctlALG2_BASE1_VOL", strFileNameAndPath)
        ctlALG2_BASE1_PRICE.Text = INI_GetValue("Main", "ctlALG2_BASE1_PRICE", strFileNameAndPath)
        ctlALG2_BASE2_VOL.Text = INI_GetValue("Main", "ctlALG2_BASE2_VOL", strFileNameAndPath)
        ctlALG2_BASE2_PRICE.Text = INI_GetValue("Main", "ctlALG2_BASE2_PRICE", strFileNameAndPath)
        ctlALG2_AR_VOL.Text = INI_GetValue("Main", "ctlALG2_AR_VOL", strFileNameAndPath)
        ctlALG2_AR_PRICE.Text = INI_GetValue("Main", "ctlALG2_AR_PRICE", strFileNameAndPath)
        ctlALG2_DROPSinML.Text = INI_GetValue("Main", "ctlALG2_DROPSinML", strFileNameAndPath)
        ctlALG2_NICinNEED.Text = INI_GetValue("Main", "ctlALG2_NICinNEED", strFileNameAndPath)
        ctlALG2_ARinNEED.Text = INI_GetValue("Main", "ctlALG2_ARinNEED", strFileNameAndPath)
        ctlALG2_VOLinNEED.Text = INI_GetValue("Main", "ctlALG2_VOLinNEED", strFileNameAndPath)

        ctlLanguage.Text = INI_GetValue("Language", "ctlLanguage", strFileNameAndPath)
        ctlCurrency.Text = INI_GetValue("Currency", "ctlCurrency", strFileNameAndPath)

        strListItems = INI_GetValue("List", "ctlALG1_PGinBASE", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_PGinBASE.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_PGinBASE.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_VGinBASE", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_VGinBASE.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_VGinBASE.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_ADinBASE", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_ADinBASE.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_ADinBASE.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_NICinBASE", strFileNameAndPath)
        strListItems = SortList(strListItems, ";")
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_NICinBASE.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_NICinBASE.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_DROPSinML", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_DROPSinML.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_DROPSinML.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_NICinNEED", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_NICinNEED.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_NICinNEED.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_PGinNEED", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_PGinNEED.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_PGinNEED.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_VGinNEED", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_VGinNEED.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_VGinNEED.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_ADinNEED", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_ADinNEED.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_ADinNEED.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_ARinNEED", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_ARinNEED.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_ARinNEED.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_VOLinNEED", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_VOLinNEED.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_VOLinNEED.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_MLinDAY", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_MLinDAY.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_MLinDAY.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG1_DAYS", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG1_DAYS.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG1_DAYS.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG2_PGinBASE1", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_PGinBASE1.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_PGinBASE1.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG2_VGinBASE1", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_VGinBASE1.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_VGinBASE1.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG2_ADinBASE1", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_ADinBASE1.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_ADinBASE1.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG2_NICinBASE1", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_NICinBASE1.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_NICinBASE1.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG2_PGinBASE2", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_PGinBASE2.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_PGinBASE2.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG2_VGinBASE2", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_VGinBASE2.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_VGinBASE2.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG2_ADinBASE2", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_ADinBASE2.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_ADinBASE2.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If

        strListItems = INI_GetValue("List", "ctlALG2_NICinBASE2", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_NICinBASE2.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_NICinBASE2.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If
        blLoadINI = False

        strListItems = INI_GetValue("List", "ctlALG2_DROPSinML", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_DROPSinML.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_DROPSinML.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If
        blLoadINI = False

        strListItems = INI_GetValue("List", "ctlALG2_NICinNEED", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_NICinNEED.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_NICinNEED.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If
        blLoadINI = False

        strListItems = INI_GetValue("List", "ctlALG2_ARinNEED", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_ARinNEED.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_ARinNEED.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If
        blLoadINI = False

        strListItems = INI_GetValue("List", "ctlALG2_VOLinNEED", strFileNameAndPath)
        If Len(strListItems) <> 1000 Then
            If Mid(strListItems, Len(strListItems) - 1, 1) <> ";" Then strListItems = strListItems & ";"
            ctlALG2_VOLinNEED.Items.Clear()
            For i = 1 To StrUtils_GetCountSubStrings(strListItems, ";", 1)
                ctlALG2_VOLinNEED.Items.Add(StrUtils_GetWordDec(strListItems, i, ";"))
            Next
        End If
        blLoadINI = False

    End Sub

    Function StrUtils_GetCountSubStrings(ByVal strText1 As String, ByVal strText2 As String, Optional ByVal lngStartPosition As Long = 1) As Integer
        Dim lngPosition As Integer     'Текущая позиция подстроки strText2 в строке strText1
        Dim lngCount As Long        'Счетчик вхождений подстроки strText2 в строке strText1
        lngPosition = lngStartPosition - Len(strText2)
        lngCount = -1
        Do 'Цикл
            lngPosition = InStr(lngPosition + Len(strText2), strText1, strText2)
            lngCount = lngCount + 1
        Loop Until lngPosition = 0 'Заканчиваем цикл если текущая позиция = 0
        StrUtils_GetCountSubStrings = lngCount
    End Function

    Function StrUtils_GetWordDec(ByVal strText As String, ByVal lngNumber As Long, ByVal strDec As String) As String
        Dim lngFirstPos As Long
        Dim lngNextPos As Long
        Dim lngStartPosition As Long
        Dim lngPosition As Integer
        Dim lngCount As Long
        strText = " " & strDec & strText & strDec & " "
        lngStartPosition = 2
        lngPosition = lngStartPosition - Len(strDec)
        lngCount = 0
        Do
            lngPosition = InStr(lngPosition + Len(strDec), strText, strDec)
            If lngPosition <> 0 Then
                lngCount = lngCount + 1
                If lngNumber = lngCount Then
                    lngFirstPos = lngPosition
                End If
                If lngNumber + 1 = lngCount Then
                    lngNextPos = lngPosition
                    Exit Do
                End If
            End If
        Loop Until lngPosition = 0
        If lngFirstPos <> 0 And lngNextPos <> 0 Then
            StrUtils_GetWordDec = Mid(strText, lngFirstPos + 1, lngNextPos - lngFirstPos - 1)
        End If
    End Function

---------- Сообщение отправлено в 10:29 ---------- Предыдущее сообщение отправлено в 10:27 ----------

Вторая часть:

Код:

    Private Sub CalcMe()

        'Декларируем переменные
        Dim dblNICinBASE1 As Double, dblPGinBASE1 As Double, dblVGinBASE1 As Double, dblADinBASE1 As Double, dblDROPSinML1 As Double
        Dim dblNICinBASE2 As Double, dblPGinBASE2 As Double, dblVGinBASE2 As Double, dblADinBASE2 As Double, dblDROPSinML2 As Double
        Dim dblNICinNEED As Double, dblPGinNEED As Double, dblVGinNEED As Double, dblADinNEED As Double, dblARinNEED As Double, dblVOLinNEED As Double
        Dim dblBASE1toOUTml As Double, dblBASE2toOUTml As Double, dblPGtoOUTml As Double, dblVGtoOUTml As Double, dblADtoOUTml As Double, dblARtoOUTml As Double
        Dim dblPGinADDml As Double, dblVGinADDml As Double, dblADinADDml As Double, dblARinADDml As Double
        Dim dblBASE1toOUTdr As Double, dblBASE2toOUTdr As Double, dblPGtoOUTdr As Double, dblVGtoOUTdr As Double, dblADtoOUTdr As Double, dblARtoOUTdr As Double
        Dim dblPGinOUT As Double, dblVGinOUT As Double, dblADinOUT As Double, dblARinOUT As Double, dblVOLinOUT As Double, dblNICinOUT As Double
        Dim dblDIFFml As Double
        Dim dblWidthDelta As Double, dblHeightDelta As Double
        Dim lngAlgoritm As Long
        Dim dblPartBase1InOUT As Double, dblPartBase2InOUT As Double

        Dim dblALG1_BASE_VOL As Double, dblALG1_PG_VOL As Double, dblALG1_VG_VOL As Double, dblALG1_AD_VOL As Double, dblALG1_AR_VOL As Double
        Dim dblALG1_BASE_PRICE As Double, dblALG1_PG_PRICE As Double, dblALG1_VG_PRICE As Double, dblALG1_AD_PRICE As Double, dblALG1_AR_PRICE As Double
        Dim dblALG1_BASE_RUB As Double, dblALG1_PG_RUB As Double, dblALG1_VG_RUB As Double, dblALG1_AD_RUB As Double, dblALG1_AR_RUB As Double
        Dim dblALG1_TOTAL_ML As Double, dblALG1_TOTAL_DR As Double, dblALG1_TOTAL_RUB As Double

        Dim dblALG2_BASE1_VOL As Double, dblALG2_BASE2_VOL As Double, dblALG2_AR_VOL As Double
        Dim dblALG2_BASE1_PRICE As Double, dblALG2_BASE2_PRICE As Double, dblALG2_AR_PRICE As Double
        Dim dblALG2_BASE1_RUB As Double, dblALG2_BASE2_RUB As Double, dblALG2_AR_RUB As Double
        Dim dblALG2_TOTAL_ML As Double, dblALG2_TOTAL_DR As Double, dblALG2_TOTAL_RUB As Double



        lngAlgoritm = ctlPagesAlgoritm.SelectedIndex

        Select Case lngAlgoritm

            Case 0

                'Если один из введенных параметров не цифровой - на выход
                If (Not IsNumeric(ctlALG1_NICinBASE.Text)) Or (Not IsNumeric(ctlALG1_PGinBASE.Text)) Or (Not IsNumeric(ctlALG1_VGinBASE.Text)) _
                     Or (Not IsNumeric(ctlALG1_ADinBASE.Text)) Or (Not IsNumeric(ctlALG1_NICinNEED.Text)) Or (Not IsNumeric(ctlALG1_PGinNEED.Text)) _
                     Or (Not IsNumeric(ctlALG1_VGinNEED.Text)) Or (Not IsNumeric(ctlALG1_ADinNEED.Text)) Or (Not IsNumeric(ctlALG1_ARinNEED.Text)) _
                     Or (Not IsNumeric(ctlALG1_VOLinNEED.Text)) Then
                    GoTo ErrInInput_Alg1
                End If

                Call InitValues()

                'Присваиваем переменным входные значения
                dblNICinBASE1 = CDbl(ctlALG1_NICinBASE.Text)
                dblPGinBASE1 = CDbl(ctlALG1_PGinBASE.Text)
                dblVGinBASE1 = CDbl(ctlALG1_VGinBASE.Text)
                dblADinBASE1 = CDbl(ctlALG1_ADinBASE.Text)
                dblDROPSinML1 = CDbl(ctlALG1_DROPSinML.Text)
                dblNICinNEED = CDbl(ctlALG1_NICinNEED.Text)
                dblPGinNEED = CDbl(ctlALG1_PGinNEED.Text)
                dblVGinNEED = CDbl(ctlALG1_VGinNEED.Text)
                dblADinNEED = CDbl(ctlALG1_ADinNEED.Text)
                dblARinNEED = CDbl(ctlALG1_ARinNEED.Text)
                dblVOLinNEED = CDbl(ctlALG1_VOLinNEED.Text)
                dblALG1_BASE_VOL = CDbl(ctlALG1_BASE_VOL.Text)
                dblALG1_PG_VOL = CDbl(ctlALG1_PG_VOL.Text)
                dblALG1_VG_VOL = CDbl(ctlALG1_VG_VOL.Text)
                dblALG1_AD_VOL = CDbl(ctlALG1_AD_VOL.Text)
                dblALG1_AR_VOL = CDbl(ctlALG1_AR_VOL.Text)
                dblALG1_BASE_PRICE = CDbl(ctlALG1_BASE_PRICE.Text)
                dblALG1_PG_PRICE = CDbl(ctlALG1_PG_PRICE.Text)
                dblALG1_VG_PRICE = CDbl(ctlALG1_VG_PRICE.Text)
                dblALG1_AD_PRICE = CDbl(ctlALG1_AD_PRICE.Text)
                dblALG1_AR_PRICE = CDbl(ctlALG1_AR_PRICE.Text)

                'Если содержание никотина в базовой жидкости меньше необходимого или общий объем меньше 0 - на выход
                If dblNICinBASE1 < dblNICinNEED Or dblVOLinNEED <= 0 Then GoTo ErrInInput_Alg1

                'Рассчитываем количество базовой жидкости исходя из необходимой концентрации никотина
                If dblNICinNEED <= 0 Then
                    dblBASE1toOUTml = 0
                    dblPGinADDml = 0
                    dblVGinADDml = 0
                    dblADinADDml = 0
                Else
                    dblBASE1toOUTml = CDbl((dblNICinNEED / dblNICinBASE1) * dblVOLinNEED)
                    dblPGinADDml = dblBASE1toOUTml * dblPGinBASE1 / 100
                    dblVGinADDml = dblBASE1toOUTml * dblVGinBASE1 / 100
                    dblADinADDml = dblBASE1toOUTml * dblADinBASE1 / 100
                End If

                'Расчитываем количество пропиленгликоля
                If dblPGinNEED > 0 Then
                    dblPGtoOUTml = CDbl(dblPGinNEED * dblVOLinNEED / 100) - dblPGinADDml
                    If dblPGtoOUTml < 0 Then
                        dblPGtoOUTml = 0
                    Else
                        dblPGinADDml = dblPGinADDml + dblPGtoOUTml
                    End If
                End If

                'Расчитываем количество глицерина
                If dblVGinNEED > 0 Then
                    dblVGtoOUTml = CDbl(dblVGinNEED * dblVOLinNEED / 100) - dblVGinADDml
                    If dblVGtoOUTml < 0 Then
                        dblVGtoOUTml = 0
                    Else
                        dblVGinADDml = dblVGinADDml + dblVGtoOUTml
                    End If
                End If

                'Расчитываем количество дистиллированной воды
                If dblADinNEED > 0 Then
                    dblADtoOUTml = CDbl(dblADinNEED * dblVOLinNEED / 100) - dblADinADDml
                    If dblADtoOUTml < 0 Then
                        dblADtoOUTml = 0
                    Else
                        dblADinADDml = dblADinADDml + dblADtoOUTml
                    End If
                End If

                'Расчитываем количество ароматизатора
                If dblARinNEED > 0 Then
                    dblARtoOUTml = CDbl(dblARinNEED * dblVOLinNEED / 100)
                    dblARinADDml = dblARtoOUTml
                End If

                'Выравниваем получившееся количество мл. с необходимым
                dblDIFFml = dblPGinADDml + dblVGinADDml + dblADinADDml + dblARinADDml - dblVOLinNEED
                If dblDIFFml > 0 Then
                    If dblVGtoOUTml > dblDIFFml Then
                        dblVGtoOUTml = dblVGtoOUTml - dblDIFFml
                        dblVGinADDml = dblVGinADDml - dblDIFFml
                    ElseIf dblPGtoOUTml > dblDIFFml Then
                        dblPGtoOUTml = dblPGtoOUTml - dblDIFFml
                        dblPGinADDml = dblPGinADDml - dblDIFFml
                    End If
                ElseIf dblDIFFml < 0 Then
                    If dblVGinNEED > 0 Then
                        dblVGtoOUTml = dblVGtoOUTml + dblDIFFml
                        dblVGinADDml = dblVGinADDml + dblDIFFml
                    ElseIf dblPGinNEED > 0 Then
                        dblPGtoOUTml = dblPGtoOUTml + dblDIFFml
                        dblPGinADDml = dblPGinADDml + dblDIFFml
                    End If
                End If

                dblVOLinOUT = dblPGinADDml + dblVGinADDml + dblADinADDml + dblARinADDml
                dblNICinOUT = dblNICinBASE1 * dblBASE1toOUTml / dblVOLinOUT

                dblPGinOUT = (dblPGinADDml / dblVOLinOUT) * 100
                dblVGinOUT = (dblVGinADDml / dblVOLinOUT) * 100
                dblADinOUT = (dblADinADDml / dblVOLinOUT) * 100
                dblARinOUT = (dblARinADDml / dblVOLinOUT) * 100

                'Пересчитываем миллилитры в капли
                If dblDROPSinML1 <= 0 Then
                    GoTo ErrInInput_Alg1
                Else
                    dblBASE1toOUTdr = Int(dblDROPSinML1 * dblBASE1toOUTml)
                    dblPGtoOUTdr = Int(dblDROPSinML1 * dblPGtoOUTml)
                    dblVGtoOUTdr = Int(dblDROPSinML1 * dblVGtoOUTml)
                    dblADtoOUTdr = Int(dblDROPSinML1 * dblADtoOUTml)
                    dblARtoOUTdr = Int(dblDROPSinML1 * dblARtoOUTml)
                End If

                dblALG1_BASE_RUB = dblBASE1toOUTml * IIf(dblALG1_BASE_VOL = 0, 0, dblALG1_BASE_PRICE / dblALG1_BASE_VOL)
                dblALG1_PG_RUB = dblPGtoOUTml * IIf(dblALG1_PG_VOL = 0, 0, dblALG1_PG_PRICE / dblALG1_PG_VOL)
                dblALG1_VG_RUB = dblVGtoOUTml * IIf(dblALG1_VG_VOL = 0, 0, dblALG1_VG_PRICE / dblALG1_VG_VOL)
                dblALG1_AD_RUB = dblADtoOUTml * IIf(dblALG1_AD_VOL = 0, 0, dblALG1_AD_PRICE / dblALG1_AD_VOL)
                dblALG1_AR_RUB = dblARtoOUTml * IIf(dblALG1_AR_VOL = 0, 0, dblALG1_AR_PRICE / dblALG1_AR_VOL)

                dblALG1_TOTAL_ML = dblBASE1toOUTml + dblPGtoOUTml + dblVGtoOUTml + dblADtoOUTml + dblARtoOUTml
                dblALG1_TOTAL_DR = dblBASE1toOUTdr + dblPGtoOUTdr + dblVGtoOUTdr + dblADtoOUTdr + dblARtoOUTdr
                dblALG1_TOTAL_RUB = dblALG1_BASE_RUB + dblALG1_PG_RUB + dblALG1_VG_RUB + dblALG1_AD_RUB + dblALG1_AR_RUB

                'Заполняем поля вывода
                ctlALG1_BASEtoOUTml.Text = Format(dblBASE1toOUTml, "# ##0.00")
                ctlALG1_PGtoOUTml.Text = Format(dblPGtoOUTml, "# ##0.00")
                ctlALG1_VGtoOUTml.Text = Format(dblVGtoOUTml, "# ##0.00")
                ctlALG1_ADtoOUTml.Text = Format(dblADtoOUTml, "# ##0.00")
                ctlALG1_ARtoOUTml.Text = Format(dblARtoOUTml, "# ##0.00")
                ctlALG1_BASEtoOUTdr.Text = dblBASE1toOUTdr
                ctlALG1_PGtoOUTdr.Text = dblPGtoOUTdr
                ctlALG1_VGtoOUTdr.Text = dblVGtoOUTdr
                ctlALG1_ADtoOUTdr.Text = dblADtoOUTdr
                ctlALG1_ARtoOUTdr.Text = dblARtoOUTdr
                ctlVOLinOUT.Text = Format(dblVOLinOUT, "# ##0.00")
                ctlNICinOUT.Text = Format(dblNICinOUT, "# ##0.00")
                ctlPGinOUT.Text = Format(dblPGinOUT, "# ##0.00")
                ctlVGinOUT.Text = Format(dblVGinOUT, "# ##0.00")
                ctlADinOUT.Text = Format(dblADinOUT, "# ##0.00")
                ctlARinOUT.Text = Format(dblARinOUT, "# ##0.00")

                ctlALG1_BASE_RUB.Text = Format(dblALG1_BASE_RUB, "# ##0.00")
                ctlALG1_PG_RUB.Text = Format(dblALG1_PG_RUB, "# ##0.00")
                ctlALG1_VG_RUB.Text = Format(dblALG1_VG_RUB, "# ##0.00")
                ctlALG1_AD_RUB.Text = Format(dblALG1_AD_RUB, "# ##0.00")
                ctlALG1_AR_RUB.Text = Format(dblALG1_AR_RUB, "# ##0.00")
                ctlALG1_TOTAL_ML.Text = Format(dblALG1_TOTAL_ML, "# ##0.00")
                ctlALG1_TOTAL_DR.Text = dblALG1_TOTAL_DR
                ctlALG1_TOTAL_RUB.Text = Format(dblALG1_TOTAL_RUB, "# ##0.00")

                'Отрисовываем прямоугольники

                dblWidthDelta = 1
                dblHeightDelta = 1

                ctlRECT_BASE1.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_BASE1.Left = ctlGLASS.Left + dblWidthDelta
                If dblBASE1toOUTml = 0 Then
                    ctlRECT_BASE1.Height = 0
                Else
                    ctlRECT_BASE1.Height = ctlGLASS.Height * (dblBASE1toOUTml / dblVOLinOUT) - dblWidthDelta
                End If
                ctlRECT_BASE1.Top = ctlGLASS.Top + ctlGLASS.Height - ctlRECT_BASE1.Height - dblWidthDelta

                ctlRECT_BASE2.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_BASE2.Left = ctlGLASS.Left + dblWidthDelta
                ctlRECT_BASE2.Height = 0
                ctlRECT_BASE2.Top = ctlGLASS.Top + ctlGLASS.Height - ctlRECT_BASE2.Height - dblWidthDelta

                ctlRECT_PG.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_PG.Left = ctlGLASS.Left + dblWidthDelta
                ctlRECT_PG.Height = ctlGLASS.Height * (dblPGtoOUTml / dblVOLinOUT)
                ctlRECT_PG.Top = ctlRECT_BASE1.Top - ctlRECT_PG.Height

                ctlRECT_VG.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_VG.Left = ctlGLASS.Left + dblWidthDelta
                ctlRECT_VG.Height = ctlGLASS.Height * (dblVGtoOUTml / dblVOLinOUT)
                ctlRECT_VG.Top = ctlRECT_PG.Top - ctlRECT_VG.Height

                ctlRECT_AD.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_AD.Left = ctlGLASS.Left + dblWidthDelta
                ctlRECT_AD.Height = ctlGLASS.Height * (dblADtoOUTml / dblVOLinOUT)
                ctlRECT_AD.Top = ctlRECT_VG.Top - ctlRECT_AD.Height

                ctlRECT_AR.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_AR.Left = ctlGLASS.Left + dblWidthDelta
                ctlRECT_AR.Height = ctlGLASS.Height * (dblARtoOUTml / dblVOLinOUT)
                ctlRECT_AR.Top = ctlRECT_AD.Top - ctlRECT_AR.Height

                Exit Sub

ErrInInput_Alg1:
                'Заполняем поля вывода "---"
                ctlALG1_BASEtoOUTml.Text = "---"
                ctlALG1_PGtoOUTml.Text = "---"
                ctlALG1_VGtoOUTml.Text = "---"
                ctlALG1_ADtoOUTml.Text = "---"
                ctlALG1_ARtoOUTml.Text = "---"
                ctlALG1_BASEtoOUTdr.Text = "---"
                ctlALG1_PGtoOUTdr.Text = "---"
                ctlALG1_VGtoOUTdr.Text = "---"
                ctlALG1_ADtoOUTdr.Text = "---"
                ctlALG1_ARtoOUTdr.Text = "---"
                ctlVOLinOUT.Text = "---"
                ctlNICinOUT.Text = "---"
                ctlPGinOUT.Text = "---"
                ctlVGinOUT.Text = "---"
                ctlADinOUT.Text = "---"
                ctlARinOUT.Text = "---"
                ctlALG1_BASE_RUB.Text = "---"
                ctlALG1_PG_RUB.Text = "---"
                ctlALG1_VG_RUB.Text = "---"
                ctlALG1_AD_RUB.Text = "---"
                ctlALG1_AR_RUB.Text = "---"
                ctlALG1_TOTAL_ML.Text = "---"
                ctlALG1_TOTAL_DR.Text = "---"
                ctlALG1_TOTAL_RUB.Text = "---"

                Exit Sub

            Case 1

                'Если один из введенных параметров не цифровой - на выход
                If (Not IsNumeric(ctlALG2_NICinBASE1.Text)) Or (Not IsNumeric(ctlALG2_PGinBASE1.Text)) Or (Not IsNumeric(ctlALG2_VGinBASE1.Text)) Or (Not IsNumeric(ctlALG2_ADinBASE1.Text)) _
                     Or (Not IsNumeric(ctlALG2_NICinBASE2.Text)) Or (Not IsNumeric(ctlALG2_PGinBASE2.Text)) Or (Not IsNumeric(ctlALG2_VGinBASE2.Text)) Or (Not IsNumeric(ctlALG2_ADinBASE2.Text)) _
                     Or (Not IsNumeric(ctlALG2_NICinNEED.Text)) _
                     Or (Not IsNumeric(ctlALG2_ARinNEED.Text)) _
                     Or (Not IsNumeric(ctlALG2_VOLinNEED.Text)) Then
                    GoTo ErrInInput_Alg2
                End If

                Call InitValues()

                'Присваиваем переменным входные значения
                dblNICinBASE1 = CDbl(ctlALG2_NICinBASE1.Text)
                dblPGinBASE1 = CDbl(ctlALG2_PGinBASE1.Text)
                dblVGinBASE1 = CDbl(ctlALG2_VGinBASE1.Text)
                dblADinBASE1 = CDbl(ctlALG2_ADinBASE1.Text)
                dblNICinBASE2 = CDbl(ctlALG2_NICinBASE2.Text)
                dblPGinBASE2 = CDbl(ctlALG2_PGinBASE2.Text)
                dblVGinBASE2 = CDbl(ctlALG2_VGinBASE2.Text)
                dblADinBASE2 = CDbl(ctlALG2_ADinBASE2.Text)
                dblDROPSinML2 = CDbl(ctlALG2_DROPSinML.Text)
                dblNICinNEED = CDbl(ctlALG2_NICinNEED.Text)
                dblARinNEED = CDbl(ctlALG2_ARinNEED.Text)
                dblVOLinNEED = CDbl(ctlALG2_VOLinNEED.Text)
                dblALG2_BASE1_VOL = CDbl(ctlALG2_BASE1_VOL.Text)
                dblALG2_BASE2_VOL = CDbl(ctlALG2_BASE2_VOL.Text)
                dblALG2_AR_VOL = CDbl(ctlALG2_AR_VOL.Text)
                dblALG2_BASE1_PRICE = CDbl(ctlALG2_BASE1_PRICE.Text)
                dblALG2_BASE2_PRICE = CDbl(ctlALG2_BASE2_PRICE.Text)
                dblALG2_AR_PRICE = CDbl(ctlALG2_AR_PRICE.Text)


                'Если содержание никотина в базовой жидкости меньше необходимого или общий объем меньше 0 - на выход
                If dblVOLinNEED <= 0 Or (dblNICinBASE1 = dblNICinBASE2) Or _
                    (dblNICinBASE1 > dblNICinBASE2 And (dblNICinNEED > dblNICinBASE1 Or dblNICinNEED < dblNICinBASE2)) Or _
                    (dblNICinBASE2 > dblNICinBASE1 And (dblNICinNEED > dblNICinBASE2 Or dblNICinNEED < dblNICinBASE1)) Or _
                    (dblNICinNEED = dblNICinBASE1) Or (dblNICinNEED = dblNICinBASE2) Then GoTo ErrInInput_Alg2

                'Расчитываем количество ароматизатора
                If dblARinNEED > 0 Then
                    dblARtoOUTml = CDbl(dblARinNEED * dblVOLinNEED / 100)
                    dblARinADDml = dblARtoOUTml
                End If

                'Определяем доли базовых жидкостей

                dblNICinNEED = dblNICinNEED * dblVOLinNEED / (dblVOLinNEED - dblARtoOUTml)

                dblPartBase1InOUT = 1
                dblPartBase2InOUT = (dblNICinBASE1 - dblNICinNEED) / (dblNICinNEED - dblNICinBASE2)

                dblBASE1toOUTml = dblPartBase1InOUT * (dblVOLinNEED - dblARtoOUTml) / (dblPartBase1InOUT + dblPartBase2InOUT)
                dblBASE2toOUTml = dblPartBase2InOUT * (dblVOLinNEED - dblARtoOUTml) / (dblPartBase1InOUT + dblPartBase2InOUT)

                dblPGinADDml = dblBASE1toOUTml * dblPGinBASE1 / 100 + dblBASE2toOUTml * dblPGinBASE2 / 100
                dblVGinADDml = dblBASE1toOUTml * dblVGinBASE1 / 100 + dblBASE2toOUTml * dblVGinBASE2 / 100
                dblADinADDml = dblBASE1toOUTml * dblADinBASE1 / 100 + dblBASE2toOUTml * dblADinBASE2 / 100

                dblVOLinOUT = dblPGinADDml + dblVGinADDml + dblADinADDml + dblARinADDml
                dblNICinOUT = (dblNICinBASE1 * dblBASE1toOUTml + dblNICinBASE2 * dblBASE2toOUTml) / dblVOLinOUT

                dblPGinOUT = (dblPGinADDml / dblVOLinOUT) * 100
                dblVGinOUT = (dblVGinADDml / dblVOLinOUT) * 100
                dblADinOUT = (dblADinADDml / dblVOLinOUT) * 100
                dblARinOUT = (dblARinADDml / dblVOLinOUT) * 100

                'Пересчитываем миллилитры в капли
                If dblDROPSinML2 <= 0 Then
                    GoTo ErrInInput_Alg2
                Else
                    dblBASE1toOUTdr = Int(dblDROPSinML2 * dblBASE1toOUTml)
                    dblBASE2toOUTdr = Int(dblDROPSinML2 * dblBASE2toOUTml)
                    dblARtoOUTdr = Int(dblDROPSinML2 * dblARtoOUTml)
                End If

                dblALG2_BASE1_RUB = dblBASE1toOUTml * IIf(dblALG2_BASE1_VOL = 0, 0, dblALG2_BASE1_PRICE / dblALG2_BASE1_VOL)
                dblALG2_BASE2_RUB = dblBASE2toOUTml * IIf(dblALG2_BASE2_VOL = 0, 0, dblALG2_BASE2_PRICE / dblALG2_BASE2_VOL)
                dblALG2_AR_RUB = dblARtoOUTml * IIf(dblALG2_AR_VOL = 0, 0, dblALG2_AR_PRICE / dblALG2_AR_VOL)

                dblALG2_TOTAL_ML = dblBASE1toOUTml + dblBASE2toOUTml + dblARtoOUTml
                dblALG2_TOTAL_DR = dblBASE1toOUTdr + dblBASE2toOUTdr + dblARtoOUTdr
                dblALG2_TOTAL_RUB = dblALG2_BASE1_RUB + dblALG2_BASE2_RUB + dblALG2_AR_RUB


                'Заполняем поля вывода
                ctlALG2_BASE1toOUTml.Text = Format(dblBASE1toOUTml, "# ##0.00")
                ctlALG2_BASE2toOUTml.Text = Format(dblBASE2toOUTml, "# ##0.00")
                ctlALG2_ARtoOUTml.Text = Format(dblARtoOUTml, "# ##0.00")
                ctlALG2_BASE1toOUTdr.Text = dblBASE1toOUTdr
                ctlALG2_BASE2toOUTdr.Text = dblBASE2toOUTdr
                ctlALG2_ARtoOUTdr.Text = dblARtoOUTdr
                ctlVOLinOUT.Text = Format(dblVOLinOUT, "# ##0.00")
                ctlNICinOUT.Text = Format(dblNICinOUT, "# ##0.00")
                ctlPGinOUT.Text = Format(dblPGinOUT, "# ##0.00")
                ctlVGinOUT.Text = Format(dblVGinOUT, "# ##0.00")
                ctlADinOUT.Text = Format(dblADinOUT, "# ##0.00")
                ctlARinOUT.Text = Format(dblARinOUT, "# ##0.00")

                ctlALG2_BASE1_RUB.Text = Format(dblALG2_BASE1_RUB, "# ##0.00")
                ctlALG2_BASE2_RUB.Text = Format(dblALG2_BASE2_RUB, "# ##0.00")
                ctlALG2_AR_RUB.Text = Format(dblALG2_AR_RUB, "# ##0.00")
                ctlALG2_TOTAL_ML.Text = Format(dblALG2_TOTAL_ML, "# ##0.00")
                ctlALG2_TOTAL_DR.Text = dblALG2_TOTAL_DR
                ctlALG2_TOTAL_RUB.Text = Format(dblALG2_TOTAL_RUB, "# ##0.00")

                'Отрисовываем прямоугольники

                dblWidthDelta = 1
                dblHeightDelta = 1

                ctlRECT_BASE1.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_BASE1.Left = ctlGLASS.Left + dblWidthDelta
                If dblBASE1toOUTml = 0 Then
                    ctlRECT_BASE1.Height = 0
                Else
                    ctlRECT_BASE1.Height = ctlGLASS.Height * (dblBASE1toOUTml / dblVOLinOUT) - dblWidthDelta
                End If
                ctlRECT_BASE1.Top = ctlGLASS.Top + ctlGLASS.Height - ctlRECT_BASE1.Height - dblWidthDelta

                ctlRECT_BASE2.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_BASE2.Left = ctlGLASS.Left + dblWidthDelta
                If dblBASE2toOUTml = 0 Then
                    ctlRECT_BASE2.Height = 0
                Else
                    ctlRECT_BASE2.Height = ctlGLASS.Height * (dblBASE2toOUTml / dblVOLinOUT)
                End If
                ctlRECT_BASE2.Top = ctlRECT_BASE1.Top - ctlRECT_BASE2.Height

                ctlRECT_PG.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_PG.Left = ctlGLASS.Left + dblWidthDelta
                ctlRECT_PG.Height = 0
                ctlRECT_PG.Top = ctlRECT_BASE2.Top - ctlRECT_PG.Height

                ctlRECT_VG.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_VG.Left = ctlGLASS.Left + dblWidthDelta
                ctlRECT_VG.Height = 0
                ctlRECT_VG.Top = ctlRECT_PG.Top - ctlRECT_VG.Height

                ctlRECT_AD.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_AD.Left = ctlGLASS.Left + dblWidthDelta
                ctlRECT_AD.Height = 0
                ctlRECT_AD.Top = ctlRECT_VG.Top - ctlRECT_AD.Height

                ctlRECT_AR.Width = ctlGLASS.Width - 2 * dblWidthDelta
                ctlRECT_AR.Left = ctlGLASS.Left + dblWidthDelta
                ctlRECT_AR.Height = ctlGLASS.Height * (dblARtoOUTml / dblVOLinOUT)
                ctlRECT_AR.Top = ctlRECT_AD.Top - ctlRECT_AR.Height

                Exit Sub

ErrInInput_Alg2:
                'Заполняем поля вывода "---"
                ctlALG2_BASE1toOUTml.Text = "---"
                ctlALG2_BASE2toOUTml.Text = "---"
                ctlALG2_ARtoOUTml.Text = "---"
                ctlALG2_BASE1toOUTdr.Text = "---"
                ctlALG2_BASE2toOUTdr.Text = "---"
                ctlALG2_ARtoOUTdr.Text = "---"
                ctlVOLinOUT.Text = "---"
                ctlNICinOUT.Text = "---"
                ctlPGinOUT.Text = "---"
                ctlVGinOUT.Text = "---"
                ctlADinOUT.Text = "---"
                ctlARinOUT.Text = "---"
                ctlALG2_BASE1_RUB.Text = "---"
                ctlALG2_BASE2_RUB.Text = "---"
                ctlALG2_AR_RUB.Text = "---"
                ctlALG2_TOTAL_ML.Text = "---"
                ctlALG2_TOTAL_DR.Text = "---"
                ctlALG2_TOTAL_RUB.Text = "---"

                Exit Sub


        End Select

    End Sub

Тема: Написал eJuiceCalculator для Мака

Опции темы

Поиск по теме

Отображение

Древовидный режим

Похожие темы

написал на VB eJuiceMixtureCalculator

Прошу помощи для покупки электронной сигареты для кальянщика!

Зарядка для LiPo или альтернатива для родных зарядок

eGo. Для вас - снова, для меня - впервой. :-)

Метки этой темы

Ваши права