guochengji2.bas

用于公路、轻轨及铁路双线线间距工程计算的源程序。

Attribute VB_Name = "guochengji2"
Option Explicit

Public Sub MHpage(number As Integer, Line1 As Integer, Line2 As Integer, page As Integer, mm() As Integer, nn() As Integer)
 Dim i As Integer
 Dim shang As Integer
 Dim yushu As Integer


 If number <= Line1 Then
    page = 1
    mm(1) = 1
    nn(1) = number
 Else
    shang = (number - Line1) \ Line2
    yushu = (number - Line1) Mod Line2
 
    If yushu = 0 Then
      page = shang + 1
    Else
      page = shang + 2
    End If
    
    For i = 1 To page
     Select Case i
      Case 1
         mm(i) = 1
         nn(i) = Line1
      Case page
         mm(i) = Line1 + (i - 2) * Line2 + 1
       If yushu = 0 Then
         nn(i) = Line1 + (i - 1) * Line2
       Else
         nn(i) = Line1 + (i - 2) * Line2 + yushu
       End If
      Case Else
         mm(i) = Line1 + (i - 2) * Line2 + 1
         nn(i) = Line1 + (i - 1) * Line2
     End Select
    Next i
 End If





End Sub

Public Sub ExcelOpen(ExcelObj As Object)
    '以下连接 Excel
    On Error Resume Next
    Set ExcelObj = GetObject(, "Excel.Application")
    If Err Then
      Err.Clear
      Set ExcelObj = CreateObject("Excel.Application")
      If Err Then
       MsgBox ("不能运行Excel，请检查是否安装了Excel")
       Exit Sub
      End If
    End If
      ExcelObj.Visible = True  '显示已经生成或访问的Excel对象
      ExcelObj.WindowState = acMax
    End Sub
'把一行文本分成单词

Public Sub SplitStringintoWords(msg As String, vWords() As String)
  
   Dim mg() As String
   Dim i As Integer, j As Integer
   
   msg = Replace(Trim(msg), " ", ",")
   
   For j = 1 To 10
    msg = Replace(msg, ",,", ",")
   Next j
   
    mg = Split(msg, ",")
    
    
 For i = 0 To UBound(mg)
 
  '由于母过程中已定义了（该子过程中vWords()对应的）一维数组变量，
  '所以下句不需要
   'ReDim Preserve vWords(i)
   
   vWords(i) = Format$(mg(i))
 Next i
    
    
  '首先你必须先读入一行文本 (msg$)，然后使用以上这个过程。
  '在数组vWords中就是文本文件中的所有单词
    

End Sub

'把一行文本分成单词

Public Sub SplitStringintoWords1(bron As String, vWords() As String)
Dim c As Integer, p As Integer
Dim TempBron$, tmp$


    i = 0
    TempBron$ = bron$
    For c = 1 To Len(bron$)
        p = InStr(TempBron$, Chr(32))
        If p <> 0 Then
        ReDim Preserve vWords(i)
            tmp$ = Left$(TempBron$, p - 1)
            vWords(i) = StripString(tmp$)
            TempBron$ = Right$(TempBron$, Len(TempBron$) - p)
            i = i + 1
            c = c + p
        End If
    Next c
   '由于母过程中已定义了（该子过程中vWords()对应的）一维数组变量，
   '所以下句不需要
   'ReDim Preserve vWords(i)
   
    vWords(i) = StripString(TempBron$)
    
'首先你必须先读入一行文本，然后使用以上这个过程。
'在数组vWords中就是文本文件中的所有单词

End Sub





Public Sub color(TheObject As Object, Redval&, Greenval&, Blueval&, TopToBottom As Boolean)

    'TheObject can be any object that supports the Line method (like forms and pictures).
    'Redval, Greenval, and Blueval are the Red, Green, and Blue starting values from 0 to 255.
    'TopToBottom determines whether the gradient will draw down or up.
    
    Dim Step%, Reps%, FillTop%, FillLeft%, FillRight%, FillBottom%, HColor$
    
    'This will create 63 steps in the gradient. This looks smooth on 16-bit and 24-bit color.
    'You can change this, but be careful. You can do some strange-looking stuff with it...
    
    Step = (TheObject.Height / 63)
    
    'This tells it whether to start on the top or the bottom and adjusts variables accordingly.
    
    If TopToBottom = True Then FillTop = 0 Else FillTop = TheObject.Height - Step
    FillLeft = 0
    FillRight = TheObject.Width
    FillBottom = FillTop + Step
    
    'If you changed the number of steps, change the number of reps to match it.
    'If you don't, the gradient will look all funny.
    
    For Reps = 1 To 63
    
        'This draws the colored bar.
        
        TheObject.Line (FillLeft, FillTop)-(FillRight, FillBottom), RGB(Redval, Greenval, Blueval), BF
        
        'This decreases the RGB values to darken the color.
        'Lower the value for "squished" gradients. Raise it for incomplete gradients.
        'Also, if you change the number of steps, you will need to change this number.
        
        Redval = Redval - 4
        Greenval = Greenval - 4
        Blueval = Blueval - 4
        
        'This prevents the RGB values from becoming negative, which causes a runtime error.
        
        If Redval <= 0 Then Redval = 0
        If Greenval <= 0 Then Greenval = 0
        If Blueval <= 0 Then Blueval = 0
        
        'More top or bottom stuff; Moves to next bar.
        
        If TopToBottom = True Then FillTop = FillBottom Else FillTop = FillTop - Step
        FillBottom = FillTop + Step
    Next
End Sub