www.pudn.com > BMP2JPG.rar > Form1.frm
VERSION 5.00
Object = "{5D1AF2B8-A669-11D3-8E15-C42627F9362B}#6.0#0"; "JPGMaker.ocx"
Begin VB.Form Form1
Caption = "*.BMP to *.JPG图片转换工具 Written by ZHB - http://yxbasic.51.net"
ClientHeight = 4800
ClientLeft = 45
ClientTop = 615
ClientWidth = 7680
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4800
ScaleWidth = 7680
StartUpPosition = 2 '屏幕中心
Begin JPGMaker.JPGMake JPGMake1
Left = 2640
Top = 575
_ExtentX = 661
_ExtentY = 661
End
Begin VB.HScrollBar HScroll1
Height = 252
LargeChange = 5
Left = 120
Max = 100
Min = 1
TabIndex = 1
Top = 925
Value = 50
Width = 3012
End
Begin VB.CommandButton Command2
Caption = "转成 *.JPG图片"
Enabled = 0 'False
Height = 372
Left = 120
TabIndex = 2
Top = 1575
Width = 3012
End
Begin VB.CommandButton Command1
Caption = "选择 *.BMP图片"
Height = 372
Left = 120
TabIndex = 0
Top = 120
Width = 3012
End
Begin VB.Label Node
BackColor = &H00800000&
ForeColor = &H00C00000&
Height = 75
Index = 0
Left = 2880
TabIndex = 10
Top = 2040
Visible = 0 'False
Width = 75
End
Begin VB.Label LblQualityDes
AutoSize = -1 'True
Height = 180
Left = 1560
TabIndex = 9
ToolTipText = "选择 *.JPG图片品质"
Top = 1320
Width = 90
End
Begin VB.Image Image1
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
Height = 4580
Left = 3360
ToolTipText = "图片预览区"
Top = 120
Width = 4215
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "50 %"
Height = 195
Left = 1560
TabIndex = 8
Top = 600
Width = 345
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "-> 高"
Height = 180
Left = 2640
TabIndex = 7
Top = 1320
Width = 450
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "低 <-"
Height = 180
Left = 175
TabIndex = 6
Top = 1320
Width = 450
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "*.JPG图片品质:"
Height = 180
Left = 120
TabIndex = 5
Top = 600
Width = 1260
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "转换信息:"
Height = 180
Left = 120
TabIndex = 4
Top = 2040
Width = 810
End
Begin VB.Label Label1
BorderStyle = 1 'Fixed Single
Height = 2410
Left = 120
TabIndex = 3
Top = 2280
Width = 3015
End
Begin VB.Menu meuFile
Caption = "文件(&F)"
Begin VB.Menu meuOpenBMPFile
Caption = "选择 *.BMP图片"
End
Begin VB.Menu meuConvert
Caption = "转成 *.JGP图片"
Enabled = 0 'False
End
Begin VB.Menu bar
Caption = "-"
End
Begin VB.Menu meuExit
Caption = "退出"
End
End
Begin VB.Menu meuSelectQuality
Caption = "品质(Q)"
Begin VB.Menu meuLow
Caption = "可接受品质"
End
Begin VB.Menu meuMid
Caption = "中品质"
End
Begin VB.Menu meuWinDef
Caption = "Windows默认品质"
Checked = -1 'True
End
Begin VB.Menu meuHigh
Caption = "高品质"
End
Begin VB.Menu meuGood
Caption = "最佳品质"
End
End
Begin VB.Menu meuHelp
Caption = "帮助(&H)"
Begin VB.Menu meuHelpFile
Caption = "帮助文件"
End
Begin VB.Menu bar1
Caption = "-"
End
Begin VB.Menu meuVisitMyWeb
Caption = "访问我的个人主页"
End
Begin VB.Menu meuMailto
Caption = "发送邮件给我..."
End
Begin VB.Menu bar2
Caption = "-"
End
Begin VB.Menu meuAbout
Caption = "关于本软件"
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
'实现发送MAIL功能
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 Const SW_SHOW = 5
Dim sFileName As String
Dim jpgFilename As String
Dim Label4Right As Integer
Dim bmpsize As Single
Dim jpgsize As Single
Dim bShow As Boolean
Dim bMove As Boolean
Dim oldX As Single
Dim oldY As Single
Private Sub Command1_Click() '选择文件
Call ShowOpenFile("打开一个.BMP图片", "*.BMP", "Bitmaps图片", sFileName)
If sFileName = "" Then Exit Sub
JPGMake1.FileName = sFileName
jpgFilename = Mid$(sFileName, 1, Len(sFileName) - 4) & ".jpg"
SaveSetting App.EXEName, "Setting", "Init_Dir", jpgFilename
Image1.Picture = LoadPicture(sFileName) '显示原始图片
Command2.Enabled = True
meuConvert.Enabled = True
Call Form_Resize
End Sub
Private Sub Command2_Click() '转换文件
Label1.Caption = ""
JPGMake1.Go
DoEvents
If Dir$(jpgFilename) <> "" Then '判断文件是否转换成功
bmpsize = Int(FileLen(sFileName) / 1024) '计算文件大小，并显示压缩比
jpgsize = Int(FileLen(jpgFilename) / 1024)
Label1.Caption = "BMP 文件大小:" & CStr(bmpsize) & " KB" & vbCrLf & _
"JPG 文件大小:" & CStr(jpgsize) & " KB" & vbCrLf & _
"文件压缩比率:" & Format(jpgsize / bmpsize * 100, "0.0") & "%"
Image1.Picture = LoadPicture(jpgFilename) '显示转换后的图片
Else
Label1.Caption = "未知错误" & vbCrLf & "-文件转换失败!"
End If
Call Form_Resize
End Sub
Private Sub Form_Resize() '自动窗体变化
On Error Resume Next
Label1.Height = Me.Height - 3080
Image1.Height = Me.Height - 905
Image1.Width = Me.Width - 3585
End Sub
Private Sub HScroll1_Change() '选择品质
JPGMake1.Quality = HScroll1.Value
Label6.Caption = CStr(HScroll1.Value) & " %" '显示品质
Select Case HScroll1.Value
Case 1 To 49
LblQualityDes.Caption = "低品质"
meuLow.Checked = False
Case 50
LblQualityDes.Caption = "可接受品质"
Call meuLow_Click
Case 62.5
LblQualityDes.Caption = "中品质"
Call meuMid_Click
Case 75
LblQualityDes.Caption = "Windows默认品质"
Call meuWinDef_Click
Case 87.5
LblQualityDes.Caption = "高品质"
Call meuHigh_Click
Case 100
LblQualityDes.Caption = "最佳品质"
Call meuGood_Click
End Select
Label4Right = (Label4.Left + Label4.Width) '品质标签居中显示
LblQualityDes.Left = (Label5.Left - Label4Right) / 2 - LblQualityDes.Width / 2 + Label4Right
End Sub
Private Sub HScroll1_Scroll()
Call HScroll1_Change
End Sub
Private Sub LblQualityDes_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
PopupMenu meuSelectQuality
End Sub
Private Sub meuAbout_Click()
MsgBox Me.Caption
End Sub
Private Sub meuConvert_Click()
Call Command2_Click
End Sub
Private Sub meuExit_Click()
End
End Sub
Private Sub meuGood_Click() '最佳品质
HScroll1.Value = 100
meuGood.Checked = True
meuLow.Checked = False
meuMid.Checked = False
meuWinDef.Checked = False
meuHigh.Checked = False
End Sub
Private Sub meuHelpFile_Click()
If Dir$(App.Path & "\readme.txt") <> "" Then
Shell "notepad.exe " & App.Path & "\readme.txt", vbNormalFocus '用记事本打开 readme.txt
Else
MsgBox "帮助文件readme.txt未找到！", 64, "提示"
End If
End Sub
Private Sub meuHigh_Click() '高品质
HScroll1.Value = 87.5
meuHigh.Checked = True
meuLow.Checked = False
meuMid.Checked = False
meuWinDef.Checked = False
meuGood.Checked = False
End Sub
Private Sub meuLow_Click() '低品质
HScroll1.Value = 50
meuLow.Checked = True
meuMid.Checked = False
meuWinDef.Checked = False
meuHigh.Checked = False
meuGood.Checked = False
End Sub
Private Sub meuMid_Click() '中品质
HScroll1.Value = 62.5
meuMid.Checked = True
meuLow.Checked = False
meuWinDef.Checked = False
meuHigh.Checked = False
meuGood.Checked = False
End Sub
Private Sub meuOpenBMPFile_Click()
Call Command1_Click
End Sub
Private Sub meuWinDef_Click() '默认的品质
HScroll1.Value = 75
meuWinDef.Checked = True
meuLow.Checked = False
meuMid.Checked = False
meuHigh.Checked = False
meuGood.Checked = False
End Sub
Private Sub Form_Load()
HScroll1.Value = 75 '默认的品质
If Node.Count = 1 Then
Dim i As Integer
For i = 1 To 7
Load Node(i) '载入Node(在Node的Count为1时，表示开始未载入Node)
Next
End If
bShow = False
If Dir$(App.Path & "\sample.bmp") <> "" Then
Image1.Picture = LoadPicture(App.Path & "\sample.bmp")
End If
End Sub
Private Sub Form_Click() '点击窗体时，取消选中
If bShow Then
bShow = False
HideNodes
End If
End Sub
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
SetNodes Image1
End Sub
Private Sub Form_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
SizeObject Source.Index, X, Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.MousePointer = vbDefault
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
bMove = True
oldX = X: oldY = Y
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
If bMove Then
Image1.Left = X - oldX + Image1.Left
Image1.Top = Y - oldY + Image1.Top
For i = 0 To 7
Node(i).Visible = False
Next
End If
End Sub
Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
bMove = False
For i = 0 To 7
Node(i).Visible = True
Next
End Sub
Private Sub Node_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
HideNodes
Node(Index).Drag
End Sub
Private Sub Image1_Click()
Dim i As Integer
If Node.Count = 1 Then
For i = 1 To 7
Load Node(i)
Next
End If
bShow = True
SetNodes Image1
End Sub
Private Sub Image1_DragDrop(Source As Control, X As Single, Y As Single)
SetNodes Image1
End Sub
Private Sub Image1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
With Image1
Select Case Source.Index
Case 0
.Top = .Top + Y
.Left = .Left + X
.Width = .Width - X
.Height = .Height - Y
Case 1
.Left = .Left + X
.Width = .Width - X
Case 2
.Width = .Width - X
.Height = Y
.Left = .Left + X
Case 3
.Height = .Height - Y
.Top = .Top + Y
Case 4
.Height = Y
Case 5
.Width = X
.Height = .Height - Y
.Top = .Top + Y
Case 6
.Width = X
Case 7
.Width = X
.Height = Y
End Select
End With
End Sub
Private Sub Node_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
Case 0, 7
Node(Index).MousePointer = 8
Case 1, 6
Node(Index).MousePointer = 9
Case 2, 5
Node(Index).MousePointer = 6
Case 3, 4
Node(Index).MousePointer = 7
End Select
End Sub
Private Sub SetNodes(SelectedControl As Control)
Dim i As Integer
With SelectedControl
For i = 0 To 7
Select Case i
'Left Top
Case 0
Node(i).Left = .Left - Node(i).Width
Node(i).Top = .Top - Node(i).Height
'Left center
Case 1
Node(i).Left = .Left - Node(i).Width
Node(i).Top = .Top + ((.Height - Node(i).Height) / 2)
'Left bottom
Case 2
Node(i).Left = .Left - Node(i).Width
Node(i).Top = .Top + .Height
'Center Top
Case 3
Node(i).Left = .Left + ((.Width + Node(i).Width) / 2)
Node(i).Top = .Top - Node(i).Height
'Center Bottom
Case 4
Node(i).Left = .Left + ((.Width + Node(i).Width) / 2)
Node(i).Top = .Top + .Height
'Right Top
Case 5
Node(i).Left = .Left + .Width
Node(i).Top = .Top - Node(i).Height
'Right Center
Case 6
Node(i).Left = .Left + .Width
Node(i).Top = .Top + ((.Height - Node(i).Height) / 2)
'Right Bottom
Case 7
Node(i).Left = .Left + .Width
Node(i).Top = .Top + .Height
End Select
Node(i).Visible = True
Next
End With
End Sub
Private Sub SizeObject(NodeIndex As Integer, X As Single, Y As Single)
On Error Resume Next
With Image1
Select Case NodeIndex
Case 0
.Width = .Width + (.Left - X)
.Height = .Height + (.Top - Y)
.Left = X
.Top = Y
Case 1
.Width = .Width + (.Left - X)
.Left = X
Case 2
.Width = (.Left - X) + .Width
.Height = Y - .Top
.Left = X
Case 3
.Height = .Height + .Top - Y
.Top = Y
Case 4
.Height = Y - .Top
Case 5
.Width = X - .Left
.Height = .Height + .Top - Y
.Top = Y
Case 6
.Width = X - .Left
Case 7
.Width = X - .Left
.Height = Y - .Top
End Select
End With
End Sub
Private Sub HideNodes()
Dim i As Integer
For i = 0 To 7
Node(i).Visible = False
Next
End Sub
Private Sub meuVisitMyWeb_Click() '浏览我的个人主页
Call shellexecute(Me.hwnd, "open", "http://yxbasic.51.net", "", "", SW_SHOW)
End Sub
Private Sub meuMailto_Click() '联系作者
Call shellexecute(Me.hwnd, "open", "mailto:happybasic@163.com", "", "", SW_SHOW)
End Sub