?? savemap.frm
字號:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form SaveMap
BorderStyle = 3 'Fixed Dialog
Caption = "保存圖象"
ClientHeight = 3336
ClientLeft = 48
ClientTop = 336
ClientWidth = 6204
BeginProperty Font
Name = "宋體"
Size = 11.4
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "SaveMap.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3336
ScaleWidth = 6204
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox Picture1
BackColor = &H80000001&
Height = 3132
Left = 120
ScaleHeight = 3084
ScaleWidth = 5964
TabIndex = 0
Top = 120
Width = 6012
Begin VB.TextBox TextHeightT
Height = 372
Left = 3600
MaxLength = 4
TabIndex = 15
Text = "Text1"
Top = 1080
Width = 2292
End
Begin VB.TextBox TextWidthT
Height = 372
Left = 1320
MaxLength = 4
TabIndex = 14
Text = "Text1"
Top = 1080
Width = 2292
End
Begin VB.CommandButton CommandSaveFile
Caption = "..."
BeginProperty Font
Name = "宋體"
Size = 10.8
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 5280
TabIndex = 12
Top = 120
Width = 612
End
Begin VB.CommandButton SaveBMPCancel
Caption = "放棄"
BeginProperty Font
Name = "宋體"
Size = 11.4
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4680
TabIndex = 11
Top = 2280
Width = 1215
End
Begin VB.CommandButton SaveBMPOK
Caption = "確定"
BeginProperty Font
Name = "宋體"
Size = 11.4
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 10
Top = 2280
Width = 1215
End
Begin VB.OptionButton OptionType
Caption = "WMF"
Height = 375
Index = 3
Left = 5040
TabIndex = 9
Top = 1560
Width = 855
End
Begin VB.OptionButton OptionType
Caption = "TIF"
Height = 375
Index = 2
Left = 3840
TabIndex = 8
Top = 1560
Width = 855
End
Begin VB.OptionButton OptionType
Caption = "JPG"
Height = 375
Index = 1
Left = 2640
TabIndex = 7
Top = 1560
Value = -1 'True
Width = 855
End
Begin VB.OptionButton OptionType
Caption = "BMP"
Height = 375
Index = 0
Left = 1440
TabIndex = 5
Top = 1560
Width = 855
End
Begin VB.ComboBox PaperNo
Height = 324
ItemData = "SaveMap.frx":0442
Left = 1320
List = "SaveMap.frx":046D
TabIndex = 4
Top = 600
Width = 4572
End
Begin VB.TextBox FileNameBMP
Height = 375
Left = 1320
TabIndex = 2
Top = 120
Width = 3855
End
Begin VB.Label LabelWidthHeight
Alignment = 2 'Center
Caption = "圖紙寬、高"
Height = 372
Left = 120
TabIndex = 13
Top = 1080
Width = 1212
End
Begin VB.Label Label10
Alignment = 2 'Center
Caption = "圖形格式"
Height = 372
Index = 1
Left = 120
TabIndex = 6
Top = 1560
Width = 1212
End
Begin VB.Label Label10
Alignment = 2 'Center
Caption = "選擇圖紙號"
Height = 375
Index = 0
Left = 120
TabIndex = 3
Top = 600
Width = 1215
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000000&
Caption = "文件名"
Height = 375
Index = 7
Left = 120
TabIndex = 1
Top = 120
Width = 1215
End
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 0
Top = 0
_ExtentX = 677
_ExtentY = 677
_Version = 393216
End
End
Attribute VB_Name = "SaveMap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandSaveFile_Click()
Dim I As Integer, TheOutPath As String, TheOutFile As String
On Error Resume Next
CommonDialog1.DialogTitle = "存放文件"
CommonDialog1.FileName = FileNameBMP.Text
CommonDialog1.Filter = "*.BMP|*.BMP|*.JPG|*.JPG|*.TIF|*.TIF|*.WMF|*.WMF"
''CommonDialog1.InitDir = TheInPath
CommonDialog1.FilterIndex = 0
CommonDialog1.ShowSave
If (Err = 0) Then '打開文件
I = InStr(CommonDialog1.FileName, CommonDialog1.FileTitle)
TheOutPath = Left(CommonDialog1.FileName, I - 1)
TheOutFile = UCase(CommonDialog1.FileTitle)
I = InStr(TheOutFile, ".")
If (I > 0) Then
TheOutFile = Left(TheOutFile, I)
End If
TheOutFile = TheOutFile + "BMP"
FileNameBMP.Text = TheOutPath + TheOutFile
End If
End Sub
Private Sub Form_Load()
FileNameBMP.Text = TheOutFile
PaperNo.ListIndex = 3
bOKCancel = False
End Sub
Private Sub OptionType_Click(Index As Integer)
Dim StrIndex As String, I As Integer
If (Index = 1) Then
StrIndex = "JPG"
ElseIf (Index = 2) Then
StrIndex = "TIF"
ElseIf (Index = 3) Then
StrIndex = "WMF"
Else
StrIndex = "BMP"
End If
TheOutFile = FileNameBMP.Text
I = InStr(TheOutFile, ".")
If (I > 0) Then
FileNameBMP.Text = Left(TheOutFile, I) + StrIndex
Else
FileNameBMP.Text = TheOutFile + "." + StrIndex
End If
End Sub
Private Sub PaperNo_Click()
LabelWidthHeight.Enabled = False
TextWidthT.Enabled = False
TextHeightT.Enabled = False
If (PaperNo.ListIndex = 0) Then '640*480
PaperHeight = 480
PaperWidth = 640
mmPaperHeight = PaperHeight * Screen.TwipsPerPixelY / 56.7
mmPaperWidth = PaperWidth * Screen.TwipsPerPixelX / 56.7
ElseIf (PaperNo.ListIndex = 1) Then '800*600
PaperHeight = 600
PaperWidth = 800
mmPaperHeight = PaperHeight * Screen.TwipsPerPixelY / 56.7
mmPaperWidth = PaperWidth * Screen.TwipsPerPixelX / 56.7
ElseIf (PaperNo.ListIndex = 2) Then '1024*768
PaperHeight = 768
PaperWidth = 1024
mmPaperHeight = PaperHeight * Screen.TwipsPerPixelY / 56.7
mmPaperWidth = PaperWidth * Screen.TwipsPerPixelX / 56.7
ElseIf (PaperNo.ListIndex = 3) Then
PaperHeight = Screen.Height / Screen.TwipsPerPixelY
PaperWidth = Screen.Width / Screen.TwipsPerPixelX
mmPaperHeight = Screen.Height / 56.7
mmPaperWidth = Screen.Width / 56.7
ElseIf (PaperNo.ListIndex = PaperNo.ListCount - 1) Then '自定義
LabelWidthHeight.Enabled = True
TextWidthT.Enabled = True
TextHeightT.Enabled = True
Else
'圖紙長寬,單位mm
mmPaperWidth = Val(Mid(PaperNo.List(PaperNo.ListIndex), 4, 3))
mmPaperHeight = Val(Mid(PaperNo.List(PaperNo.ListIndex), 8, 3))
'設置圖片框長寬,單位twip,1mm=56.7twip
PaperHeight = mmPaperHeight * 56.7 / Screen.TwipsPerPixelY
PaperWidth = mmPaperWidth * 56.7 / Screen.TwipsPerPixelX
End If
TextWidthT.Text = PaperWidth
TextHeightT.Text = PaperHeight
End Sub
Private Sub SaveBMPCancel_Click()
bOKCancel = False
Unload Me
End Sub
Private Sub SaveBMPOK_Click()
Dim I As Integer, StrIndex As String * 3
If (PaperNo.ListIndex = 0) Then '640*480
PaperHeight = 480
PaperWidth = 640
mmPaperHeight = PaperHeight * Screen.TwipsPerPixelY / 56.7
mmPaperWidth = PaperWidth * Screen.TwipsPerPixelX / 56.7
ElseIf (PaperNo.ListIndex = 1) Then '800*600
PaperHeight = 600
PaperWidth = 800
mmPaperHeight = PaperHeight * Screen.TwipsPerPixelY / 56.7
mmPaperWidth = PaperWidth * Screen.TwipsPerPixelX / 56.7
ElseIf (PaperNo.ListIndex = 2) Then '1024*768
PaperHeight = 768
PaperWidth = 1024
mmPaperHeight = PaperHeight * Screen.TwipsPerPixelY / 56.7
mmPaperWidth = PaperWidth * Screen.TwipsPerPixelX / 56.7
ElseIf (PaperNo.ListIndex = 3) Then
PaperHeight = Screen.Height / Screen.TwipsPerPixelY
PaperWidth = Screen.Width / Screen.TwipsPerPixelX
mmPaperHeight = Screen.Height / 56.7
mmPaperWidth = Screen.Width / 56.7
ElseIf (PaperNo.ListIndex = PaperNo.ListCount - 1) Then '自定義
PaperWidth = TextWidthT.Text
PaperHeight = TextHeightT.Text
mmPaperHeight = PaperHeight * Screen.TwipsPerPixelY / 56.7
mmPaperWidth = PaperWidth * Screen.TwipsPerPixelX / 56.7
Else
'圖紙長寬,單位mm
mmPaperWidth = Val(Mid(PaperNo.List(PaperNo.ListIndex), 4, 3))
mmPaperHeight = Val(Mid(PaperNo.List(PaperNo.ListIndex), 8, 3))
'設置圖片框長寬,單位twip,1mm=56.7twip
PaperHeight = mmPaperHeight * 56.7 / Screen.TwipsPerPixelY
PaperWidth = mmPaperWidth * 56.7 / Screen.TwipsPerPixelX
End If
If (OptionType(1).Value = True) Then
StrIndex = "JPG"
ElseIf (OptionType(2).Value = True) Then
StrIndex = "TIF"
ElseIf (OptionType(3).Value = True) Then
StrIndex = "WMF"
Else
StrIndex = "BMP"
End If
TheOutFile = FileNameBMP.Text
I = InStr(TheOutFile, ".")
If (I > 0) Then
FileNameBMP.Text = Left(TheOutFile, I) + StrIndex
Else
FileNameBMP.Text = TheOutFile + "." + StrIndex
End If
TheOutFile = FileNameBMP.Text
bOKCancel = True
Unload Me
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -