www.pudn.com > imagescale---raw.zip > FrmMain.frm
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmMain
Caption = "zyl910图像平滑放大"
ClientHeight = 4395
ClientLeft = 60
ClientTop = 345
ClientWidth = 5880
Icon = "FrmMain.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 293
ScaleMode = 3 'Pixel
ScaleWidth = 392
StartUpPosition = 3 '窗口缺省
Begin MSComDlg.CommonDialog CDlgSave
Left = 900
Top = 300
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin MSComDlg.CommonDialog CDlgOpen
Left = 90
Top = 270
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin VB.CommandButton CmdScale
Caption = "生成(&c)"
Height = 300
Left = 5100
TabIndex = 10
Top = 0
Width = 780
End
Begin VB.ComboBox CboScale
Height = 300
Left = 3810
Style = 2 'Dropdown List
TabIndex = 9
Top = 0
Width = 1260
End
Begin VB.TextBox TxtScale
Alignment = 1 'Right Justify
BackColor = &H8000000F&
Height = 270
Left = 3090
Locked = -1 'True
TabIndex = 8
Text = "100%"
Top = 15
Width = 720
End
Begin VB.HScrollBar SolScale
Height = 240
LargeChange = 10
Left = 1590
Max = 30
Min = -30
TabIndex = 7
Top = 30
Width = 1500
End
Begin VB.CommandButton CmdSave
Caption = "保存(&S)"
Height = 300
Left = 780
TabIndex = 6
Top = 0
Width = 780
End
Begin VB.CommandButton CmdOpen
Caption = "打开(&O)"
Height = 300
Left = 0
TabIndex = 5
Top = 0
Width = 780
End
Begin VB.PictureBox PicRect
Height = 2805
Left = 120
ScaleHeight = 183
ScaleMode = 3 'Pixel
ScaleWidth = 301
TabIndex = 0
Top = 390
Width = 4575
Begin VB.PictureBox PicClip
BackColor = &H8000000C&
BorderStyle = 0 'None
Height = 1605
Left = 450
ScaleHeight = 107
ScaleMode = 3 'Pixel
ScaleWidth = 229
TabIndex = 3
Top = 150
Width = 3435
Begin VB.PictureBox PicData
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 240
Left = 480
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 16
TabIndex = 4
Top = 330
Width = 240
End
End
Begin VB.HScrollBar HSol
Height = 225
Left = 180
TabIndex = 2
Top = 1860
Width = 3495
End
Begin VB.VScrollBar VSol
Height = 1815
Left = 4140
TabIndex = 1
Top = 150
Width = 315
End
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const MyTitle = "zyl910图像平滑放大"
Private DIBData As ClsDIB
Private DIBWork As ClsDIB
Private ScaleNum As Single
Private Sub SolNum()
If PicData.Width > PicClip.Width Then
HSol.Max = PicData.Width - PicClip.Width
HSol.LargeChange = PicClip.Width
If HSol.Value > HSol.Max Then HSol.Value = HSol.Max
HSol.Enabled = True
Else
HSol.Value = 0
HSol.Enabled = False
End If
If PicData.Height > PicClip.Height Then
VSol.Max = PicData.Height - PicClip.Height
VSol.LargeChange = PicClip.Height
If VSol.Value > VSol.Max Then VSol.Value = VSol.Max
VSol.Enabled = True
Else
VSol.Value = 0
VSol.Enabled = False
End If
End Sub
Private Sub CmdOpen_Click()
Static fShow As Boolean
If fShow = False Then
CDlgOpen.InitDir = App.Path
End If
On Error GoTo ErrLoad
CDlgOpen.ShowOpen
On Error GoTo 0
If fShow = False Then
CDlgOpen.InitDir = vbNullString
fShow = True
End If
Dim DIBTemp As New ClsDIB
If BasDIB.DIBLoadMap(DIBTemp, CDlgOpen.FileName, True, 24) Then
Set DIBData = DIBTemp
DIBWork.Free
'Debug.Print DIBData.Width; DIBData.Height
PicData.Width = DIBData.Width
PicData.Height = DIBData.Height
DIBData.PutTo PicData.hDC, 0, 0
HSol.Value = 0
VSol.Value = 0
SolNum
PicData.Refresh
Else
MsgBox "错误的图像文件", vbCritical
End If
Set DIBTemp = Nothing
Exit Sub
ErrLoad:
On Error GoTo 0
End Sub
Private Sub CmdSave_Click()
Dim DIBTemp As ClsDIB
If DIBWork.DataPtr Then
Set DIBTemp = DIBWork
ElseIf DIBData.DataPtr Then
Set DIBTemp = DIBData
Else
MsgBox "没有处理的图片", vbCritical
Exit Sub
End If
Static fSave As Boolean
If fSave = False Then
CDlgOpen.InitDir = App.Path
End If
On Error GoTo ErrSave
CDlgSave.ShowSave
On Error GoTo 0
If fSave = False Then
CDlgSave.InitDir = vbNullString
fSave = True
End If
If DIBTemp.SaveBMP(CDlgSave.FileName) Then
'
Else
MsgBox "保存失败", vbCritical
End If
Set DIBTemp = Nothing
Exit Sub
ErrSave:
On Error GoTo 0
End Sub
Private Sub CmdScale_Click()
If DIBData.DataPtr = 0 Then
MsgBox "请打开图片", vbCritical
Exit Sub
End If
Dim W As Long, H As Long
W = DIBData.Width * ScaleNum
H = DIBData.Height * ScaleNum
If W < 1 Then W = 1
If H < 1 Then H = 1
Dim DIBTemp As New ClsDIB
Dim t As Long
Me.MousePointer = vbHourglass
t = timeGetTime
If DIBScale(CboScale.ListIndex, DIBTemp, DIBData, W, H) = False Then
Set DIBTemp = Nothing
MsgBox "处理失败", vbCritical
Exit Sub
End If
t = timeGetTime - t
Me.MousePointer = vbDefault
Me.Caption = MyTitle & " 处理时间：" & Format(t / 1000, "##,###,##0.000") & "秒"
Set DIBWork = DIBTemp
Set DIBTemp = Nothing
PicData.Width = DIBWork.Width
PicData.Height = DIBWork.Height
DIBWork.PutTo PicData.hDC
SolNum
PicData.Refresh
End Sub
Private Sub Form_Load()
PointInit
SolScale.Value = 10
PicRect.Move 0, CmdOpen.Height
PicClip.Move 0, 0
PicData.Move 0, 0
HSol.Left = 0
VSol.Top = 0
HSol.Height = 16
VSol.Width = 16
Dim I As Long
For I = ScaleModeConst.SMC_Min To ScaleModeConst.SMC_Max
CboScale.AddItem ScaleModeName(I)
Next I
CboScale.ListIndex = ScaleModeConst.SMC_BiliNear
CDlgOpen.Filter = "图像文件(*.bmp;*.jpg;*.gif)|*.bmp;*.jpg;*.gif"
CDlgOpen.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
CDlgSave.Filter = "BMP位图(*.bmp)|*.bmp"
CDlgSave.Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt Or cdlOFNHideReadOnly
Set DIBData = New ClsDIB
Set DIBWork = New ClsDIB
End Sub
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then Exit Sub
On Local Error Resume Next
PicRect.Move PicRect.Left, PicRect.Top, Me.ScaleWidth - PicRect.Left, Me.ScaleHeight - PicRect.Top
PicClip.Move PicClip.Left, PicClip.Top, PicRect.ScaleWidth - VSol.Width, PicRect.ScaleHeight - HSol.Height
HSol.Move HSol.Left, PicClip.Height, PicClip.Width, HSol.Height
VSol.Move PicClip.Width, VSol.Top, VSol.Width, PicClip.Height
SolNum
On Error GoTo 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set DIBData = Nothing
Set DIBWork = Nothing
PointFree
End Sub
Private Sub HSol_Change()
PicData.Left = -HSol.Value
End Sub
Private Sub HSol_Scroll()
PicData.Left = -HSol.Value
End Sub
Private Sub SolScale_Change()
ScaleNum = 2 ^ (SolScale.Value / SolScale.LargeChange)
TxtScale.Text = Format$(ScaleNum * 100, "##0.00") + "%"
End Sub
Private Sub SolScale_Scroll()
SolScale_Change
End Sub
Private Sub VSol_Change()
PicData.Top = -VSol.Value
End Sub
Private Sub VSol_Scroll()
PicData.Top = -VSol.Value
End Sub