exhfun.bas

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

      
      For I = 0 To 2
      m_RecordDraw(I) = RecordDraw.Heater(I)
      Next I
End Sub
Public Sub ExhFrmInit()
  With ExhFrm.AppName
          .Top = Val(RecordInit(4))
          .Left = Val(RecordInit(5))
          .Height = Val(RecordInit(6))
          .Width = Val(RecordInit(7))
          .Caption = RecordInit(8)
          .Visible = True
          .FontSize = 15
          .BackStyle = 0
     End With
        With ExhFrm.ExhCADMenuImg
          .Top = Val(RecordInit(15))
          .Left = Val(RecordInit(16))
          .Height = Val(RecordInit(17))
          .Width = Val(RecordInit(18))
      Set .Picture = PictureFile(0)
          .Visible = True
     End With
     With ExhFrm.OvalCmdLast
            .Top = Val(RecordInit(29))
            .Left = Val(RecordInit(30))
            .Height = Val(RecordInit(31))
            .Width = Val(RecordInit(32))
        Set .Picture = PictureFile(1)
            .m_TipString = RecordInit(34)
     End With
     With ExhFrm.OvalCmdNext
            .Top = Val(RecordInit(35))
            .Left = Val(RecordInit(36))
            .Height = Val(RecordInit(37))
            .Width = Val(RecordInit(38))
        Set .Picture = PictureFile(2)
            .m_TipString = RecordInit(40)
     End With
     With ExhFrm.ExhCADTreeView
          .Top = Val(RecordInit(71))
          .Left = Val(RecordInit(72))
          .Height = Val(RecordInit(73))
          .Width = Val(RecordInit(74))
          .Appearance = Val(RecordInit(75))
     End With
     With ExhFrm.ExhCADListView
          .Top = Val(RecordInit(96))
          .Left = Val(RecordInit(97))
          .Height = Val(RecordInit(98))
          .Width = Val(RecordInit(99))
          .Appearance = Val(RecordInit(100))
          .View = Val(RecordInit(101))
     End With
     With ExhFrm
             .Top = Val(RecordInit(154))
             .Left = Val(RecordInit(155))
             .Height = Val(RecordInit(156))
             .Width = Val(RecordInit(157))
             .BorderStyle = Val(RecordInit(158))
         Set .Picture = PictureFile(3)
     End With
     With ExhFrm.TipFlash
             .Top = Val(RecordInit(149))
             .Left = Val(RecordInit(150))
             .Height = Val(RecordInit(151))
             .Width = Val(RecordInit(152))
     End With
    
    
      ExhFrm.ExhCADAgent.Characters.Load "Birdie", App.Path + AcsFile
      Set ExhCADAcs = ExhFrm.ExhCADAgent.Characters("Birdie")
      ExhCADAcs.Play "Suggest"
      Set ExhCADRequest = ExhCADAcs.MoveTo(Val(RecordInit(206)), Val(RecordInit(207)))
      ExhCADAcs.Height = ExhCADAcs.Height / Val(RecordInit(208))
      ExhCADAcs.Width = ExhCADAcs.Width / Val(RecordInit(208))
     
     ExhFrm.ExhCADImgLst.ListImages.Add , , PictureFile(4)
    
     ExhFrm.ExhCADImgLst.ListImages.Add , , PictureFile(5)

     ExhFrm.ExhCADImgLst.ListImages.Add , , PictureFile(6)
     
     ExhFrm.ExhCADImgLst.ListImages.Add , , PictureFile(7)
    
     ExhFrm.ExhCADImgLst.ListImages.Add , , PictureFile(8)
     ExhFrm.ExhCADListView.ColumnHeaders.Add , , RecordInit(102)
     ExhFrm.ExhCADListView.ColumnHeaders.Add , , RecordInit(103)
     ExhFrm.ExhCADListView.ColumnHeaders.Add , , RecordInit(104)
End Sub
Public Sub InputChange(InputTextString As String, frm As ExhFrm)

Select Case InputTextString
       Case "H2O":
           RecordSetup.FumeElement(0) = Val(frm.InputText.Text)
       Case "CO2":
           RecordSetup.FumeElement(1) = Val(frm.InputText.Text)
       Case "N2":
           RecordSetup.FumeElement(2) = Val(frm.InputText.Text)
       Case "use":
           RecordSetup.ExperienceConstant(0) = Val(frm.InputText.Text)
       Case "lose"
           RecordSetup.ExperienceConstant(1) = Val(frm.InputText.Text)
       Case "protect":
           RecordSetup.ExperienceConstant(2) = Val(frm.InputText.Text)
       Case "InAirT":
           RecordCompute.Air(0) = Val(frm.InputText.Text)
       Case "OutAirT":
           RecordCompute.Air(1) = Val(frm.InputText.Text)
       Case "AirQ":
           RecordCompute.Air(2) = Val(frm.InputText.Text)
       Case "AirV":
           RecordCompute.Air(3) = Val(frm.InputText.Text)
       Case "InFumeT":
           RecordCompute.Fume(0) = Val(frm.InputText.Text)
       Case "FumeQ":
           RecordCompute.Fume(1) = Val(frm.InputText.Text)
       Case "FumeV":
           RecordCompute.Fume(2) = Val(frm.InputText.Text)
       Case "DiameterP":
           RecordCompute.Pipe(0) = Val(frm.InputText.Text)
       Case "ThickP":
           RecordCompute.Pipe(1) = Val(frm.InputText.Text)
       Case "HDistance":
           RecordCompute.Pipe(2) = Val(frm.InputText.Text)
       Case "VDistance":
           RecordCompute.Pipe(3) = Val(frm.InputText.Text)
       Case "NRoute":
           RecordCompute.Pipe(4) = Val(frm.InputText.Text)
       Case "InsertLength"
           RecordSetup.InsertSize(0) = Val(frm.InputText.Text)
       Case "InsertWidth"
           RecordSetup.InsertSize(1) = Val(frm.InputText.Text)
       Case "InsertDiameter"
          RecordSetup.InsertSize(0) = Val(frm.InputText.Text)
          RecordSetup.InsertSize(1) = Val(frm.InputText.Text)
       
End Select

End Sub

Public Sub CopyrxFileToAutoCADR14()
   Dim ExhCADArx As String, TechDemandArx As String, AutoCADR14rxFile As String
    AutoCADR14rxFile = AutoCADR14InstallPath
    ExhCADArx = Space(254)
    TechDemandArx = Space(254)
   If StrComp(AutoCADR14rxFile, "") = 0 Then
      MsgBox RecordInit(190), vbOKOnly, RecordInit(8)
      Exit Sub
   Else
      GetPrivateProfileString "Arx Files", "1", "", ExhCADArx, 254, App.Path + ExhCADIniFile
      GetPrivateProfileString "Arx Files", "2", "", TechDemandArx, 254, App.Path + ExhCADIniFile
      ExhCADArx = Left(ExhCADArx, Len(RTrim(ExhCADArx)) - 1)
      TechDemandArx = Left(TechDemandArx, Len(RTrim(TechDemandArx)) - 1)
      Open App.Path + ExhCADrxFile For Output As #1
      Print #1, ExhCADArx + vbCrLf + TechDemandArx
      Close #1
      
CopyFile App.Path + ExhCADrxFile, AutoCADR14rxFile + AutoCADrxFile, False
CopyFile App.Path + ExhCADmnuFile, AutoCADR14rxFile + AutoCADmnuFile, False
CopyFile App.Path + ExhCADlspFile, AutoCADR14rxFile + AutoCADlspFile, False
CopyFile App.Path + ExhCADmnlFile, AutoCADR14rxFile + AutoCADmnlFile, False
  
MergeFile AutoCADR14rxFile + AcadlspFile, App.Path + ExhCADAcadlspFile
MergeFile AutoCADR14rxFile + AcadmnlFile, App.Path + ExhCADAcadmnlFile
      
   End If
End Sub

Public Sub DeleterxFileToAutoCADR14()
    Dim szfilename As String, AutoCADR14rxFile As String
    AutoCADR14rxFile = AutoCADR14InstallPath
    If StrComp(AutoCADR14rxFile, "") = 0 Then
      MsgBox RecordInit(191), vbOKOnly, RecordInit(8)
      End
   Else
      DeleteFile AutoCADR14rxFile + AutoCADrxFile
      DeleteFile AutoCADR14rxFile + AutoCADmnuFile
      DeleteFile AutoCADR14rxFile + AutoCADmnlFile
      DeleteFile AutoCADR14rxFile + AutoCADlspFile
   End If
End Sub

Public Sub ExhCAD_Exit()
  'DeleterxFileToAutoCADR14
  End
End Sub

Public Sub MergeFile(firstfile As String, secondfile As String)
  Dim one_line As String
  Dim I As Integer
  If (FileContains(firstfile, IsInstallExhCAD)) Then Exit Sub
  
  Open firstfile For Append As #1
 
  Open secondfile For Input As #2
   
  Do While Not EOF(2)
        Line Input #2, one_line
        Print #1, one_line
  Loop
  Close #1
  Close #2
End Sub

Public Function FileContains(FileName As String, SearchText As String) As Long
Dim FileNumber As Integer
Dim FileLength As Long
Dim Chunk As String
Dim ChunkStart As Long
Dim FoundAt As Long
Const MaxChunk = 20000
FileNumber = FreeFile
FileContains = 0
Open FileName For Binary Access Read Shared As FileNumber
FileLength = LOF(FileNumber)
ChunkStart = 0
Do Until ChunkStart = FileLength
    If FileLength - ChunkStart > MaxChunk Then
        Chunk = Input$(MaxChunk, FileNumber)
        ChunkStart = ChunkStart + MaxChunk - Len(SearchText)
     Else
        Chunk = Input$(FileLength - ChunkStart, FileNumber)
        ChunkStart = FileLength
    End If
        FoundAt = InStr(Chunk, SearchText)
    If FoundAt > 0 Then
        FileContains = FoundAt
    Exit Do
    End If
Loop
Close FileNumber
End Function

Public Function SearchWeight(diameter As Double, thick As Double, materialtype As Integer, weight As Double) As Boolean
   
    Dim db As Database
    Dim rs As Recordset
    Dim strSQL As String
   
    Set db = OpenDatabase(App.Path + PipeMdbFile)
  
    SearchWeight = False
    Select Case materialtype
           Case Common
              strSQL = "SELECT * FROM COMMON "
              
           Case LowPress
              strSQL = "SELECT * FROM LowPress "
              
           Case StainlessSteel
              strSQL = "SELECT * FROM StainlessSteel "
           Case HighPress
               strSQL = "SELECT * FROM HighPress "
              
    End Select
    strSQL = strSQL & " WHERE Diameter="
    strSQL = strSQL & Str(diameter) & " AND  Thick= " & Str(thick)
 
     Set rs = db.OpenRecordset(strSQL)
        If Not (rs.BOF And rs.EOF) Then
             Do While Not rs.EOF
                weight = rs.Fields(2).Value
                SearchWeight = True
                Exit Do
                rs.MoveNext
              Loop
           End If
         rs.Close
         db.Close

End Function

Public Sub MakeCsvTxtFile(szfilename As String)
   Dim I As Integer
   
   Open szfilename For Output As #1
   
       Write #1, "", ExhCADTitles(0), ""
   For I = 0 To 10
        Write #1, SetupValues(I, 0), SetupValues(I, 1), SetupValues(I, 2)
   Next I
   
       Write #1, "", ExhCADTitles(1), ""
   For I = 0 To 11
      Write #1, ComputeValues(I, 0), ComputeValues(I, 1), ComputeValues(I, 2)
   Next I
   
      Write #1, "", ExhCADTitles(2), ""
   For I = 0 To 11
      Write #1, DrawValues(I, 0), DrawValues(I, 1), DrawValues(I, 2)
   Next I
   
   
 
   Close #1
                     
   
End Sub