exhfun.bas

《管状换热器计算机辅助设计系统ExhCAD绘图系统(版本:1.01a Final)》为自由软件

      frm.ExhCADTreeView.Nodes.Add 1, tvwChild, "assistance", RecordInit(94)
      frm.ExhCADTreeView.Nodes.Add 1, tvwChild, "other", RecordInit(95)
    
End Sub
Public Sub ExhCAD_Compute()
   Dim weight As Double
  
   If (Not SearchWeight(RecordCompute.Pipe(0), RecordCompute.Pipe(1), _
                RecordSetup.Material, weight)) Then
      ExhCADAcs.Speak RecordInit(200 + RecordSetup.Material) + RecordInit(203)
      ExhCADDesign = -1
      Exit Sub
    Else
      RecordSetup.UnitWeight = weight
      
      ComputeFun RecordSetup, RecordCompute, RecordDraw, RecordData
      RecordDraw.Other(3) = RecordDraw.Heater(0) * RecordDraw.Heater(1) * RecordDraw.Heater(2) * RecordSetup.UnitWeight / 1000
      
      ExhCADAcs.Speak RecordInit(173)
    End If
    
    
End Sub
Public Sub ExhCAD_Draw()
   Dim HeaterDraw As New DrawHeater.Draw
   CopyrxFileToAutoCADR14
   If (Not IsAutoCADR14()) Then
       MsgBox RecordInit(170), vbOKOnly, RecordInit(8)
       Exit Sub
  Else
      ExhCADAcs.Speak RecordInit(215)
      MsgBox RecordInit(192), vbOKOnly, RecordInit(8)
      sndPlaySound App.Path + ExhCADWavFile, SND_ASYNC
      DrawDataInit
      HeaterDraw.Draw m_RecordSetup, m_RecordCompute, m_RecordDraw
      SetWindowPos ExhFrm.hwnd, HWND_TOPMOST, _
                       0, 0, 0, 0, FLAGE
      MsgBox RecordInit(172), vbOKOnly, RecordInit(8)
      ExhCAD_Exit
  End If
End Sub
Public Sub HandleClick(menuName As String, itemNum As Integer, strItemText As String)
   Dim sfilename As String
   Select Case itemNum
          Case 1:
            ExhCADDesign = 1
            ExhCADSetup_Init ExhFrm
          Case 2:
            ExhCADDesign = 2
            ExhCADCompute_Init ExhFrm
          Case 3:
             ExhCADDesign = 3
             ExhCADDraw_Init ExhFrm
          Case 5:
             If ExhCADDesign = 1 Then
                 ExhFrm.FileDialog.DialogTitle = RecordInit(61)
                 ExhFrm.FileDialog.DefaultExt = "hp"
                 ExhFrm.FileDialog.Filter = RecordInit(63)
                 ExhFrm.FileDialog.ShowOpen
                 sfilename = ExhFrm.FileDialog.FileName
                 If sfilename = "" Then Exit Sub
                 ExhCADSetup_Read sfilename
              ElseIf ExhCADDesign = 2 Then
                 ExhFrm.FileDialog.DialogTitle = RecordInit(61)
                 ExhFrm.FileDialog.DefaultExt = "hi"
                 ExhFrm.FileDialog.Filter = RecordInit(64)
                 ExhFrm.FileDialog.ShowOpen
                 sfilename = ExhFrm.FileDialog.FileName
                 If sfilename = "" Then Exit Sub
                 ExhCADCompute_Read sfilename
               ElseIf ExhCADDesign = 3 Then
                 ExhFrm.FileDialog.DialogTitle = RecordInit(61)
                 ExhFrm.FileDialog.DefaultExt = "ho"
                 ExhFrm.FileDialog.Filter = RecordInit(65)
                 ExhFrm.FileDialog.ShowOpen
                 sfilename = ExhFrm.FileDialog.FileName
                 If sfilename = "" Then Exit Sub
                 ExhCADDraw_Read sfilename
              End If
              WritePrivateProfileString "Recent Files", CStr(ExhCADDesign), sfilename, App.Path + ExhCADIniFile
          Case 6:
               If ExhCADDesign = 1 Then
                 ExhFrm.FileDialog.DialogTitle = RecordInit(62)
                 ExhFrm.FileDialog.DefaultExt = "hp"
                 ExhFrm.FileDialog.Filter = RecordInit(63)
                 ExhFrm.FileDialog.ShowSave
                 sfilename = ExhFrm.FileDialog.FileName
                 If sfilename = "" Then Exit Sub
                 ExhCADSetup_Write sfilename
                ElseIf ExhCADDesign = 2 Then
                 ExhFrm.FileDialog.DialogTitle = RecordInit(62)
                 ExhFrm.FileDialog.DefaultExt = "hi"
                 ExhFrm.FileDialog.Filter = RecordInit(64)
                 ExhFrm.FileDialog.ShowSave
                 sfilename = ExhFrm.FileDialog.FileName
                 If sfilename = "" Then Exit Sub
                 ExhCADCompute_Write sfilename
               ElseIf ExhCADDesign = 3 Then
                 ExhFrm.FileDialog.DialogTitle = RecordInit(62)
                 ExhFrm.FileDialog.DefaultExt = "ho"
                 ExhFrm.FileDialog.Filter = RecordInit(65)
                 ExhFrm.FileDialog.ShowSave
                 sfilename = ExhFrm.FileDialog.FileName
                 If sfilename = "" Then Exit Sub
                 ExhCADDraw_Write sfilename
              End If
              WritePrivateProfileString "Recent Files", CStr(ExhCADDesign), sfilename, App.Path + ExhCADIniFile
          Case 7:
                 ExhFrm.FileDialog.DialogTitle = RecordInit(168)
                 ExhFrm.FileDialog.DefaultExt = "xls"
                 ExhFrm.FileDialog.Filter = RecordInit(169)
                 ExhFrm.FileDialog.ShowSave
                 sfilename = ExhFrm.FileDialog.FileName
                 If sfilename = "" Then Exit Sub
                 ExcelData_Init
                
                 If StrComp(UCase(Right(sfilename, 3)), "XLS") = 0 Then
                        MakeExcelFile (sfilename)
                 Else
                        MakeCsvTxtFile (sfilename)
                
                 End If
                 
                 
          Case 9:
              'SendKeys "{F1}"
              Shell "notepad.exe " + App.Path + ExhCADTxtFile, vbNormalFocus
          Case 10:
             ShellAbout ExhFrm.hwnd, RecordInit(8), RecordInit(9) + vbCrLf + RecordInit(10), ExhFrm.Icon
          Case 11:
            ExhCAD_Exit
   End Select
End Sub
Public Function RegFileType(ExName As String, KeyName As String, keyValue As String, IconName As String) As Boolean

On Error GoTo RelatedFail
    
    Dim sKeyName As String, sKeyValue As String, sKeyValueIcon As String
    Dim Ret As Integer, lphKey As Long

    sKeyName = KeyName
    sKeyValue = keyValue
    Ret = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey)
    Ret = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)

    sKeyName = ExName
    sKeyValue = keyValue
    Ret = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey)
    Ret = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
  
    sKeyName = KeyName
    sKeyValue = """" & App.Path & "\" & App.EXEName & ".exe" & """" & " %1"
    sKeyValueIcon = IconName


    Ret = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey)
    Ret = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, sKeyValueIcon, MAX_PATH)
    Ret = RegSetValue&(lphKey&, "Shell\Open\Command", REG_SZ, sKeyValue, MAX_PATH)
    
    RegFileType = True
    Exit Function
RelatedFail:
       RegFileType = False
End Function

Public Sub MakeExcelFile(szfilename As String)

    Dim PrintToExcel  As New MakeExcelFile.ExcelFile
   
    If (IsExcel9) Then
       PrintToExcel.MakeExcelFile ExhCADTitles(), ExhCADFields(), _
                               SetupValues(), ComputeValues(), DrawValues(), _
                               szfilename
       MsgBox RecordInit(174), vbOKOnly, RecordInit(8)
    Else
       MsgBox RecordInit(175), vbOKOnly, RecordInit(8)
    End If
                               
                               
    Set PrintToExcel = Nothing
   
End Sub

Public Function IsAutoCADR14() As Boolean

  Dim lngHandle As Long, lngcbData As Long
  Dim strRet As String
  Dim Ret
  
  IsAutoCADR14 = True
  Ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
               "Software\Autodesk\AutoCAD", _
                0&, _
                KEY_READ, _
                lngHandle)
                
 If (Ret <> ERROR_SUCCESS) Then
    IsAutoCADR14 = False
    Exit Function
 End If
                
  RegQueryValueEx lngHandle, _
                  "CurVer", _
                   0&, _
                    REG_SZ, _
                    ByVal strRet, _
                   lngcbData
                   
  strRet = Space(lngcbData)
  RegQueryValueEx lngHandle, _
                  "CurVer", _
                  0&, _
                  REG_SZ, _
                  ByVal strRet, _
                  lngcbData
  RegCloseKey (lngHandle)
  If Len(strRet) <> 0 Then
        strRet = Left(strRet, Len(Trim(strRet)) - 1)
        If StrComp(strRet, RecordInit(171)) <> 0 Then IsAutoCADR14 = False
  Else
       IsAutoCADR14 = False
  End If

End Function

Public Function AutoCADR14InstallPath() As String

  Dim lngHandle As Long, lngcbData As Long
  Dim strRet As String, InstallPath As String
  AutoCADR14InstallPath = ""
If IsAutoCADR14() Then
  RegOpenKeyEx HKEY_LOCAL_MACHINE, _
               "Software\Autodesk\AutoCAD\R14.0", _
                0&, _
                KEY_READ, _
                lngHandle
    RegQueryValueEx lngHandle, _
                  "CurVer", _
                   0&, _
                    REG_SZ, _
                     ByVal strRet, _
                   lngcbData
    strRet = Space(lngcbData)
     RegQueryValueEx lngHandle, _
                  "CurVer", _
                  0&, _
                  REG_SZ, _
                  ByVal strRet, _
                  lngcbData
    strRet = Left(strRet, Len(Trim(strRet)) - 1)
    RegCloseKey (lngHandle)
    
     RegOpenKeyEx HKEY_LOCAL_MACHINE, _
               "Software\Autodesk\AutoCAD\R14.0\" + strRet, _
                0&, _
                KEY_READ, _
                lngHandle
     RegQueryValueEx lngHandle, _
                  "AcadLocation", _
                   0&, _
                    REG_SZ, _
                    ByVal InstallPath, _
                   lngcbData
    InstallPath = Space(lngcbData)
    RegQueryValueEx lngHandle, _
                  "AcadLocation", _
                   0&, _
                    REG_SZ, _
                     ByVal InstallPath, _
                   lngcbData
  
   If Len(Trim(InstallPath)) = 0 Then
     InstallPath = ""
  Else
   InstallPath = Left(InstallPath, Len(Trim(InstallPath)) - 1)
    RegCloseKey (lngHandle)
    End If
   AutoCADR14InstallPath = InstallPath
  
     
End If
   
End Function
Public Function IsExcel9() As Boolean
  Dim lngResult As Long
  Dim lngHandle As Long, lngcbData As Long
  Dim Ret
  IsExcel9 = False
  Ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
               "Software\Microsoft\Office\9.0\Excel", _
                0&, _
                KEY_READ, _
                lngHandle)
  If (Ret = ERROR_SUCCESS) Then IsExcel9 = True
 End Function
Public Sub DrawDataInit()
      Dim I As Integer
       
      m_RecordSetup(0) = RecordSetup.CannulationArrange
      
      For I = 0 To 4
      m_RecordCompute(I) = RecordCompute.Pipe(I)
      Next I