论坛 › K08：编程语言 › 版主sdh142857，关于您开发的vb有限元软件的几点要求

zeallnln 发表于 2007-8-7 22:58:53

版主sdh142857，关于您开发的vb有限元软件的几点要求

版主sdh142857：

               下载了您的软件，感觉不错。

               缺点就是代码注释比较少。既然您的软件是开源的，那就多给大家注释一下，最好再加个流程图。
否则不方便大家学习交流。


               你的软件按钮不能随着窗口的大小变化来调节位置以及按钮大小。我把这个代码给你。


以下代码写入主窗口
Private Sub Form_Resize()
Dim H, i As Integer
On Error Resume Next
Resize_ALL Me 'Me是窗体名，Form1,Form2等等都可以
End Sub

以下代码写在模块中
Public Type ctrObj
Name As String
Index As Long
Parrent As String
Top As Long
Left As Long
Height As Long
Width As Long
ScaleHeight As Long
ScaleWidth As Long
End Type
Private FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private bRunning As Boolean
Private MaxForm As Long
Private MaxControl As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ReleaseCapture Lib "USER32" () As Long
Function ActualPos(plLeft As Long) As Long
If plLeft < 0 Then
    ActualPos = plLeft + 75000
Else
    ActualPos = plLeft
End If
End Function
Function FindForm(pfrmIn As Form) As Long
Dim i As Long
FindForm = -1
If MaxForm > 0 Then

    For i = 0 To (MaxForm - 1)
      If FormRecord(i).Name = pfrmIn.Name Then
      FindForm = i
      Exit Function
      End If
    Next i
End If
End Function

Function AddForm(pfrmIn As Form) As Long
Dim FormControl As Control
Dim i As Long
ReDim Preserve FormRecord(MaxForm + 1)
FormRecord(MaxForm).Name = pfrmIn.Name
FormRecord(MaxForm).Top = pfrmIn.Top
FormRecord(MaxForm).Left = pfrmIn.Left
FormRecord(MaxForm).Height = pfrmIn.Height
FormRecord(MaxForm).Width = pfrmIn.Width
FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight
FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
AddForm = MaxForm
MaxForm = MaxForm + 1
For Each FormControl In pfrmIn
    i = FindControl(FormControl, pfrmIn.Name)
    If i < 0 Then
      i = AddControl(FormControl, pfrmIn.Name)
    End If
Next FormControl
End Function
Function FindControl(inControl As Control, inName As String) As Long
Dim i As Long
FindControl = -1
For i = 0 To (MaxControl - 1)
    If ControlRecord(i).Parrent = inName Then
      If ControlRecord(i).Name = inControl.Name Then
      On Error Resume Next
      If ControlRecord(i).Index = inControl.Index Then
          FindControl = i
          Exit Function
      End If
      On Error GoTo 0
      End If
    End If
Next i
End Function
Function AddControl(inControl As Control, inName As String) As Long
ReDim Preserve ControlRecord(MaxControl + 1)
On Error Resume Next
ControlRecord(MaxControl).Name = inControl.Name
ControlRecord(MaxControl).Index = inControl.Index
ControlRecord(MaxControl).Parrent = inName
If TypeOf inControl Is Line Then
    ControlRecord(MaxControl).Top = inControl.Y1
    ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
    ControlRecord(MaxControl).Height = inControl.Y2
    ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
Else
    ControlRecord(MaxControl).Top = inControl.Top
    ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
    ControlRecord(MaxControl).Height = inControl.Height
    ControlRecord(MaxControl).Width = inControl.Width
End If
inControl.IntegralHeight = False
On Error GoTo 0
AddControl = MaxControl
MaxControl = MaxControl + 1
End Function
Function PerWidth(pfrmIn As Form) As Long
Dim i As Long
i = FindForm(pfrmIn)
If i < 0 Then
    i = AddForm(pfrmIn)
End If
PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth
End Function
Function PerHeight(pfrmIn As Form) As Double
Dim i As Long
i = FindForm(pfrmIn)
If i < 0 Then
    i = AddForm(pfrmIn)
End If
PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight
End Function
Public Sub ResizeControl(inControl As Control, pfrmIn As Form)
On Error Resume Next
Dim i As Long
Dim widthfactor As Single, heightfactor As Single
Dim minFactor As Single
Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
yRatio = PerHeight(pfrmIn)
xRatio = PerWidth(pfrmIn)
i = FindControl(inControl, pfrmIn.Name)
If inControl.Left < 0 Then
    lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
    lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If
lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)
If TypeOf inControl Is Line Then
    If inControl.X1 < 0 Then
      inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
    Else
      inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
    End If
    inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)
    If inControl.X2 < 0 Then
      inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
    Else
      inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
    End If
    inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
Else
    inControl.Move lLeft, lTop, lWidth, lHeight
    inControl.Move lLeft, lTop, lWidth
    inControl.Move lLeft, lTop
End If
End Sub
Public Sub ResizeForm(pfrmIn As Form)
Dim FormControl As Control
Dim isVisible As Boolean
Dim StartX, StartY, MaxX, MaxY As Long
Dim bNew As Boolean
If Not bRunning Then
    bRunning = True
    If FindForm(pfrmIn) < 0 Then
      bNew = True
    Else
      bNew = False
    End If
    If pfrmIn.Top < 30000 Then
      isVisible = pfrmIn.Visible
      On Error Resume Next
      If Not pfrmIn.MDIChild Then
      On Error GoTo 0
      ' ' pfrmIn.Visible = False
      Else
      If bNew Then
          StartY = pfrmIn.Height
          StartX = pfrmIn.Width
          On Error Resume Next
          For Each FormControl In pfrmIn
            If FormControl.Left + FormControl.Width + 200 > MaxX Then
            MaxX = FormControl.Left + FormControl.Width + 200
            End If
            If FormControl.Top + FormControl.Height + 500 > MaxY Then
            MaxY = FormControl.Top + FormControl.Height + 500
            End If
            If FormControl.X1 + 200 > MaxX Then
            MaxX = FormControl.X1 + 200
            End If
            If FormControl.Y1 + 500 > MaxY Then
            MaxY = FormControl.Y1 + 500
            End If
            If FormControl.X2 + 200 > MaxX Then
            MaxX = FormControl.X2 + 200
            End If
            If FormControl.Y2 + 500 > MaxY Then
            MaxY = FormControl.Y2 + 500
            End If
          Next FormControl
          On Error GoTo 0
          pfrmIn.Height = MaxY
          pfrmIn.Width = MaxX
      End If
      On Error GoTo 0
      End If
      For Each FormControl In pfrmIn
      ResizeControl FormControl, pfrmIn
      Next FormControl
      On Error Resume Next
      If Not pfrmIn.MDIChild Then
      On Error GoTo 0
      pfrmIn.Visible = isVisible
      Else
      If bNew Then
      pfrmIn.Height = StartY
      pfrmIn.Width = StartX
      For Each FormControl In pfrmIn
          ResizeControl FormControl, pfrmIn
      Next FormControl
      End If
    End If
    On Error GoTo 0
End If
bRunning = False
End If
End Sub
Public Sub SaveFormPosition(pfrmIn As Form)
Dim i As Long
If MaxForm > 0 Then
    For i = 0 To (MaxForm - 1)
      If FormRecord(i).Name = pfrmIn.Name Then
      FormRecord(i).Top = pfrmIn.Top
      FormRecord(i).Left = pfrmIn.Left
      FormRecord(i).Height = pfrmIn.Height
      FormRecord(i).Width = pfrmIn.Width
      Exit Sub
      End If
    Next i
    AddForm (pfrmIn)
End If
End Sub
Public Sub RestoreFormPosition(pfrmIn As Form)
Dim i As Long
If MaxForm > 0 Then
    For i = 0 To (MaxForm - 1)
      If FormRecord(i).Name = pfrmIn.Name Then
      If FormRecord(i).Top < 0 Then
          pfrmIn.WindowState = 2
      ElseIf FormRecord(i).Top < 30000 Then
          pfrmIn.WindowState = 0
          pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height
      Else
          pfrmIn.WindowState = 1
      End If
          Exit Sub
      End If
    Next i
End If
End Sub
Public Sub Resize_ALL(Form_Name As Form)
Dim OBJ As Object
For Each OBJ In Form_Name
    ResizeControl OBJ, Form_Name
Next OBJ
End Sub
Public Sub DragForm(frm As Form)
On Local Error Resume Next
Call ReleaseCapture
Call SendMessage(frm.hwnd, WM_NCLBUTTONDOWN, 2, 0)
End Sub

[ 本帖最后由 zeallnln 于 2007-8-7 23:01 编辑 ]

sdh142857 发表于 2007-8-8 17:15:59

回复 #1 zeallnln 的帖子

谢谢楼主的建议,辛苦你了!我一定抽时间再整理一下.:)

我原本也只是在学习有限元法时抱着试一试的想法,用空闲时间随便编写了一个程序,之后也没有再继续扩充和完善了.

我建议各位有兴趣的编程爱好者都来弄一下,把它完善起来.

[ 本帖最后由 sdh142857 于 2007-8-8 17:17 编辑 ]

methane 发表于 2007-8-8 21:35:44

厉害,支持sdh142857 把程序 做下去!

请问 在哪里有下载, 想学习一下!

thanks!

流星雨90 发表于 2008-3-9 10:38:12

支持版主，俺也正在学习中。。。

adolf6269 发表于 2008-5-7 09:54:05

强烈支持 我也来学习学习
我下个学期才学有限元 这个学期才学了结构力学 用VB编了个结构力学的求解器 和楼主的有限元软件比起来真是小巫见大巫啊

sdh142857 发表于 2008-5-8 16:41:48

原帖由 adolf6269 于 2008-5-7 09:54 发表 http://www.simwe.com/forum/images/common/back.gif
强烈支持 我也来学习学习
我下个学期才学有限元 这个学期才学了结构力学 用VB编了个结构力学的求解器 和楼主的有限元软件比起来真是小巫见大巫啊
呵呵!不必谦虚,以后多交流.:handshake

查看完整版本: 版主sdh142857，关于您开发的vb有限元软件的几点要求