frmcloudmodel.frm

用VB实现的一维正向正态云模型发生器。网上有一个用VC写的

VERSION 5.00
Begin VB.Form FrmCloudModel 
   Caption         =   "一维正态云模型"
   ClientHeight    =   7995
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10155
   LinkTopic       =   "Form1"
   ScaleHeight     =   7995
   ScaleWidth      =   10155
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox picDrawCloud 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Height          =   6975
      Left            =   120
      ScaleHeight     =   6915
      ScaleWidth      =   9915
      TabIndex        =   1
      Top             =   0
      Width           =   9975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   615
      Left            =   720
      TabIndex        =   0
      Top             =   7200
      Width           =   1455
   End
End
Attribute VB_Name = "FrmCloudModel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private FormOldWidth As Long
''保存窗体的原始宽度
Private FormOldHeight As Long
''保存窗体的原始高度

'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)

    Dim Obj As Control
    FormOldWidth = FormName.ScaleWidth
    FormOldHeight = FormName.ScaleHeight
    On Error Resume Next
    For Each Obj In FormName
        Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
    Next Obj
    On Error GoTo 0

End Sub

''按比例改变表单内各元件的大小，在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm(FormName As Form)
    Dim Pos(4) As Double
    Dim i As Long, TempPos As Long, StartPos As Long
    Dim Obj As Control
    Dim ScaleX As Double, ScaleY As Double

    ScaleX = FormName.ScaleWidth / FormOldWidth
    ''保存窗体宽度缩放比例
    ScaleY = FormName.ScaleHeight / FormOldHeight
    ''保存窗体高度缩放比例
    On Error Resume Next
    For Each Obj In FormName
        StartPos = 1
        For i = 0 To 4
            ''读取控件的原始位置与大小
            TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
            If TempPos > 0 Then
                Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
                StartPos = TempPos + 1
            Else
                Pos(i) = 0
            End If
            ''根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
            Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
        Next i
    Next Obj
    On Error GoTo 0
End Sub

Private Sub Form_Resize()

    Call ResizeForm(Me) ''确保窗体改变时控件随之改变
    picDrawCloud.Cls
    FrmParameterSet.DrawCoordinate
    FrmParameterSet.FCloudGeneratorTool m_dEx, m_dHe, m_dEn, m_iN
    
End Sub

Private Sub Command1_Click()
   
    FrmParameterSet.Show 1

End Sub

Private Sub Form_Load()
     
    Call ResizeInit(Me)

End Sub