form1.frm

来自「VB编写的施工放样方法研究及其综合程序」· FRM 代码 · 共 452 行

FRM
452
字号
VERSION 5.00
Object = "{06E63450-A5B2-4C92-B142-5227DF06BB12}#1.0#0"; "VerticalMenuVertMenu.ocx"
Object = "{74848F95-A02A-4286-AF0C-A3C755E4A5B3}#1.0#0"; "actskn43.ocx"
Begin VB.Form Form1 
   Caption         =   "工程放样数据计算软件V1.0"
   ClientHeight    =   6420
   ClientLeft      =   1725
   ClientTop       =   2025
   ClientWidth     =   10170
   BeginProperty Font 
      Name            =   "方正姚体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6420
   ScaleWidth      =   10170
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1 
      Height          =   255
      Left            =   6000
      OleObjectBlob   =   "Form1.frx":628A
      TabIndex        =   1
      Top             =   6120
      Width           =   4095
   End
   Begin VB.PictureBox Picture1 
      Height          =   6015
      Left            =   2040
      Picture         =   "Form1.frx":6338
      ScaleHeight     =   397
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   533
      TabIndex        =   2
      Top             =   120
      Width           =   8055
      Begin VB.Timer Timer1 
         Interval        =   2000
         Left            =   480
         Top             =   960
      End
   End
   Begin ACTIVESKINLibCtl.Skin Skin1 
      Left            =   2400
      OleObjectBlob   =   "Form1.frx":1B8E8
      Top             =   1080
   End
   Begin VertMenu.VerticalMenu VerticalMenu1 
      Height          =   6255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1815
      _ExtentX        =   3201
      _ExtentY        =   11033
      MenusMax        =   5
      MenuCur         =   2
      MenuStartup     =   2
      MenuCaption1    =   "更换皮肤"
      MenuItemsMax1   =   4
      MenuItemIcon11  =   "Form1.frx":1BB1C
      MenuItemCaption11=   "颜色"
      MenuItemIcon12  =   "Form1.frx":33856
      MenuItemCaption12=   "经典外观"
      MenuItemIcon13  =   "Form1.frx":4B590
      MenuItemCaption13=   "Web外观"
      MenuItemIcon14  =   "Form1.frx":4F4CA
      MenuItemCaption14=   "B-Studio外观"
      MenuCaption2    =   "放样计算"
      MenuItemsMax2   =   4
      MenuItemIcon21  =   "Form1.frx":67204
      MenuItemCaption21=   "计算器"
      MenuItemIcon22  =   "Form1.frx":67656
      MenuItemCaption22=   "极坐标法"
      MenuItemIcon23  =   "Form1.frx":7F390
      MenuItemCaption23=   "直角坐标法"
      MenuItemIcon24  =   "Form1.frx":970CA
      MenuItemCaption24=   "前方交会法"
      MenuCaption3    =   "圆曲线测设"
      MenuItemsMax3   =   2
      MenuItemIcon31  =   "Form1.frx":AEE04
      MenuItemCaption31=   "主要点测设"
      MenuItemKey31   =   "t-vb"
      MenuItemIcon32  =   "Form1.frx":C6B3E
      MenuItemCaption32=   "详细点测设"
      MenuItemKey32   =   "t-hacker"
      MenuCaption4    =   "缓和曲线测设"
      MenuItemsMax4   =   2
      MenuItemIcon41  =   "Form1.frx":DE878
      MenuItemCaption41=   "主要点测设"
      MenuItemIcon42  =   "Form1.frx":E4B12
      MenuItemCaption42=   "详细点测设"
      MenuCaption5    =   "帮助"
      MenuItemsMax5   =   2
      MenuItemIcon51  =   "Form1.frx":EADAC
      MenuItemCaption51=   "关于"
      MenuItemIcon52  =   "Form1.frx":102AE6
      MenuItemCaption52=   "联机帮助"
   End
   Begin VB.Menu File 
      Caption         =   "文件(&F)"
      Begin VB.Menu Change_skin 
         Caption         =   "更换皮肤"
         Begin VB.Menu chang_color 
            Caption         =   "颜色"
            Shortcut        =   ^B
         End
         Begin VB.Menu chang_appearance 
            Caption         =   "外观"
            Begin VB.Menu classic 
               Caption         =   "经典"
            End
            Begin VB.Menu web 
               Caption         =   "Web"
            End
            Begin VB.Menu B_Studio 
               Caption         =   "B-Studio"
            End
         End
      End
      Begin VB.Menu Calculator 
         Caption         =   "计算器"
         Shortcut        =   ^C
      End
      Begin VB.Menu part 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu Exit 
         Caption         =   "退出"
         Shortcut        =   ^E
      End
   End
   Begin VB.Menu calc 
      Caption         =   "放样计算(&C)"
      Begin VB.Menu Polar 
         Caption         =   "极坐标法"
         Shortcut        =   ^P
      End
      Begin VB.Menu right_angle 
         Caption         =   "直角坐标法"
         Shortcut        =   ^R
      End
      Begin VB.Menu forward 
         Caption         =   "前方交会法"
         Shortcut        =   ^W
      End
   End
   Begin VB.Menu curve 
      Caption         =   "曲线测设(&V)"
      Begin VB.Menu circular 
         Caption         =   "圆曲线"
         Begin VB.Menu circular_main 
            Caption         =   "主要点计算(&I)"
         End
         Begin VB.Menu circular_whole 
            Caption         =   "详细点测设计算(&J)"
         End
      End
      Begin VB.Menu spiral_curve 
         Caption         =   "有缓和曲线的圆曲线"
         Begin VB.Menu spiral_curve_main 
            Caption         =   "主要点计算(&K)"
         End
         Begin VB.Menu spiral_curve_whole 
            Caption         =   "详细点测设计算(&L)"
         End
      End
   End
   Begin VB.Menu Help 
      Caption         =   "帮助(&H)"
      Begin VB.Menu About 
         Caption         =   "关于"
         Shortcut        =   ^A
      End
      Begin VB.Menu part2 
         Caption         =   "-"
         Index           =   2
      End
      Begin VB.Menu online_help 
         Caption         =   "联机帮助(&O)"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim I As Integer

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub About_Click()
MsgBox "工程放样数据计算软件V1.0" & Chr(10) & "版权所有 (C) 2007 武汉大学测绘学院" _
& Chr(10) & "作者:李卫军 王建方 任常青" & Chr(10) & "更新日期:2007/04/20" _
& Chr(10) & "E-mail:liweijun12345@163.com", 0, "关于"
End Sub

Private Sub B_Studio_Click()
Skin1.LoadSkin (".\Skin\B-Studio.skn")
Skin1.ApplySkin (0)
'Form2.Skin1.LoadSkin ("B-Studio.skn")
'Skin1.ApplySkin (0)
'Form3.Skin1.LoadSkin ("B-Studio.skn")
'Skin1.ApplySkin (0)
'Form4.Skin1.LoadSkin ("B-Studio.skn")
'Skin1.ApplySkin (0)
'Form5.Skin1.LoadSkin ("B-Studio.skn")
'Skin1.ApplySkin (0)
'Form6.Skin1.LoadSkin ("B-Studio.skn")
'Skin1.ApplySkin (0)
'Form7.Skin1.LoadSkin ("B-Studio.skn")
'Skin1.ApplySkin (0)
'Form8.Skin1.LoadSkin ("B-Studio.skn")
'Skin1.ApplySkin (0)
End Sub

Private Sub Calculator_Click()
Shell "calc.exe"
End Sub

Private Sub chang_color_Click()
Skin1.GetImages.SetHue Rnd * 360, False
'Form2.Skin1.GetImages.SetHue Rnd * 360, False
'Form3.Skin1.GetImages.SetHue Rnd * 360, False
'Form4.Skin1.GetImages.SetHue Rnd * 360, False
'Form5.Skin1.GetImages.SetHue Rnd * 360, False
'Form6.Skin1.GetImages.SetHue Rnd * 360, False
'Form7.Skin1.GetImages.SetHue Rnd * 360, False
'Form8.Skin1.GetImages.SetHue Rnd * 360, False
End Sub

Private Sub circular_main_Click()
Load Form5
Form5.Skin1.LoadSkin (".\Skin\chizh.skn")
Skin1.ApplySkin (0)
Form5.Show 1
End Sub

Private Sub circular_whole_Click()
Load Form6
Form6.Skin1.LoadSkin (".\Skin\chizh.skn")
Skin1.ApplySkin (0)
Form6.Show 1
End Sub

Private Sub classic_Click()
Skin1.LoadSkin (".\Skin\chizh.skn")
Skin1.ApplySkin (0)
'Form2.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form3.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form4.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form5.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form6.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form7.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form8.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
End Sub

Private Sub Exit_Click()
End
End Sub

Private Sub Form_Load()
Skin1.LoadSkin (".\Skin\chizh.skn")
Skin1.ApplySkin (0)
'Form2.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form3.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form4.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form5.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form6.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form7.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
'Form8.Skin1.LoadSkin ("chizh.skn")
'Skin1.ApplySkin (0)
End Sub

Private Sub forward_Click()
Load Form4
Form4.Skin1.LoadSkin (".\Skin\chizh.skn")
Skin1.ApplySkin (0)
Form4.Show 1
End Sub

Private Sub online_help_Click()
ShellExecute Me.hwnd, "open", ".\Help\施工放样方法.htm", vbNullString, vbNullString, vbNormalFocus
End Sub

Private Sub Polar_Click()
Load Form2
Form2.Skin1.LoadSkin (".\Skin\chizh.skn")
Skin1.ApplySkin (0)
Form2.Show 1
End Sub

Private Sub right_angle_Click()
Load Form3
Form3.Skin1.LoadSkin (".\Skin\chizh.skn")
Skin1.ApplySkin (0)
Form3.Show 1
End Sub

Private Sub spiral_curve_main_Click()
Load Form7
Form7.Skin1.LoadSkin (".\Skin\chizh.skn")
Skin1.ApplySkin (0)
Form7.Show 1
End Sub

Private Sub spiral_curve_whole_Click()
Load Form8
Form8.Skin1.LoadSkin (".\Skin\chizh.skn")
Skin1.ApplySkin (0)
Form8.Show 1
End Sub

Private Sub Timer1_Timer()
I = I + 1
If I = 3 Then Picture1.Picture = LoadPicture(".\Picture\1.jpg")
If I = 6 Then Picture1.Picture = LoadPicture(".\Picture\2.jpg")
If I = 9 Then Picture1.Picture = LoadPicture(".\Picture\3.jpg")
If I = 12 Then Picture1.Picture = LoadPicture(".\Picture\4.jpg")
If I = 15 Then Picture1.Picture = LoadPicture(".\Picture\5.jpg")
If I = 18 Then I = 0
End Sub

Private Sub VerticalMenu1_MenuItemClick(MenuNumber As Long, MenuItem As Long)
If MenuNumber = 1 Then
  If MenuItem = 1 Then
    Skin1.GetImages.SetHue Rnd * 360, False
    'Form2.Skin1.GetImages.SetHue Rnd * 360, False
    'Form3.Skin1.GetImages.SetHue Rnd * 360, False
    'Form4.Skin1.GetImages.SetHue Rnd * 360, False
    'Form5.Skin1.GetImages.SetHue Rnd * 360, False
    'Form6.Skin1.GetImages.SetHue Rnd * 360, False
    'Form7.Skin1.GetImages.SetHue Rnd * 360, False
    'Form8.Skin1.GetImages.SetHue Rnd * 360, False
  End If
  If MenuItem = 2 Then
    Skin1.LoadSkin (".\Skin\chizh.skn")
    Skin1.ApplySkin (0)
  End If
  If MenuItem = 3 Then
    Skin1.LoadSkin (".\Skin\Web-II.skn")
    Skin1.ApplySkin (0)
  End If
  If MenuItem = 4 Then
    Skin1.LoadSkin (".\Skin\B-Studio.skn")
    Skin1.ApplySkin (0)
  End If
End If
If MenuNumber = 2 Then
  If MenuItem = 1 Then Shell "calc.exe"
  If MenuItem = 2 Then
    Load Form2
    Form2.Skin1.LoadSkin (".\Skin\chizh.skn")
    Skin1.ApplySkin (0)
    Form2.Show 1
  End If
  If MenuItem = 3 Then
    Load Form3
    Form3.Skin1.LoadSkin (".\Skin\chizh.skn")
    Skin1.ApplySkin (0)
    Form3.Show 1
  End If
  If MenuItem = 4 Then
    Load Form4
    Form4.Skin1.LoadSkin (".\Skin\chizh.skn")
    Skin1.ApplySkin (0)
    Form4.Show 1
  End If
End If
If MenuNumber = 3 Then
  If MenuItem = 1 Then
    Load Form5
    Form5.Skin1.LoadSkin (".\Skin\chizh.skn")
    Skin1.ApplySkin (0)
    Form5.Show 1
  End If
  If MenuItem = 2 Then
    Load Form6
    Form6.Skin1.LoadSkin (".\Skin\chizh.skn")
    Skin1.ApplySkin (0)
    Form6.Show 1
  End If
End If
If MenuNumber = 4 Then
    If MenuItem = 1 Then
    Load Form7
    Form7.Skin1.LoadSkin (".\Skin\chizh.skn")
    Skin1.ApplySkin (0)
    Form7.Show 1
  End If
  If MenuItem = 2 Then
    Load Form8
    Form8.Skin1.LoadSkin (".\Skin\chizh.skn")
    Skin1.ApplySkin (0)
    Form8.Show 1
  End If
End If
If MenuNumber = 5 Then
    If MenuItem = 1 Then
    MsgBox "工程放样数据计算软件V1.0" & Chr(10) & "版权所有 (C) 2007 武汉大学测绘学院" _
    & Chr(10) & "作者:李卫军 王建方 任常青" & Chr(10) & "更新日期:2007/04/20" _
    & Chr(10) & "E-mail:liweijun12345@163.com", 0, "关于"
    End If
    If MenuItem = 2 Then
    ShellExecute Me.hwnd, "open", ".\Help\施工放样方法.htm", vbNullString, vbNullString, vbNormalFocus
    End If
End If
End Sub

Private Sub web_Click()
Skin1.LoadSkin (".\Skin\Web-II.skn")
Skin1.ApplySkin (0)
'Form2.Skin1.LoadSkin ("Web-II.skn")
'Skin1.ApplySkin (0)
'Form3.Skin1.LoadSkin ("Web-II.skn")
'Skin1.ApplySkin (0)
'Form4.Skin1.LoadSkin ("Web-II.skn")
'Skin1.ApplySkin (0)
'Form5.Skin1.LoadSkin ("Web-II.skn")
'Skin1.ApplySkin (0)
'Form6.Skin1.LoadSkin ("Web-II.skn")
'Skin1.ApplySkin (0)
'Form7.Skin1.LoadSkin ("Web-II.skn")
'Skin1.ApplySkin (0)
'Form8.Skin1.LoadSkin ("Web-II.skn")
'Skin1.ApplySkin (0)
End Sub

          

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?