imagefrm.frm

电话本信息 基本上实现电话功能 自己下载侃侃吧

VERSION 5.00
Begin VB.Form ImageFrm 
   Caption         =   "Form2"
   ClientHeight    =   7260
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9300
   LinkTopic       =   "Form2"
   MinButton       =   0   'False
   ScaleHeight     =   7260
   ScaleWidth      =   9300
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.VScrollBar VS1 
      Height          =   2175
      Left            =   3600
      TabIndex        =   2
      Top             =   90
      Visible         =   0   'False
      Width           =   285
   End
   Begin VB.HScrollBar HS1 
      Height          =   285
      Left            =   90
      TabIndex        =   1
      Top             =   2340
      Visible         =   0   'False
      Width           =   3795
   End
   Begin VB.PictureBox PBox1 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      Height          =   2175
      Index           =   0
      Left            =   100
      ScaleHeight     =   141
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   225
      TabIndex        =   0
      Top             =   100
      Width           =   3435
      Begin VB.PictureBox PBox1 
         AutoRedraw      =   -1  'True
         BorderStyle     =   0  'None
         FontTransparent =   0   'False
         Height          =   870
         Index           =   1
         Left            =   180
         ScaleHeight     =   58
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   127
         TabIndex        =   3
         Top             =   180
         Width           =   1905
      End
      Begin VB.Label LT1 
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "正在加载图片，请稍候..."
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   240
         Left            =   0
         TabIndex        =   4
         Top             =   1215
         Width           =   2760
      End
   End
   Begin VB.Menu m_Image 
      Caption         =   ""
      Visible         =   0   'False
      Begin VB.Menu m_LS 
         Caption         =   "自适应窗体显示图片"
      End
      Begin VB.Menu m_Line0 
         Caption         =   "-"
      End
      Begin VB.Menu m_ILT 
         Caption         =   "自动调整位置"
         Checked         =   -1  'True
      End
      Begin VB.Menu m_Mid 
         Caption         =   "居中显示图片"
      End
      Begin VB.Menu m_Line1 
         Caption         =   "-"
      End
      Begin VB.Menu m_AutoSize 
         Caption         =   "自动调整尺寸"
      End
      Begin VB.Menu m_ReSize 
         Caption         =   "图片原始尺寸"
      End
      Begin VB.Menu m_MiSize 
         Caption         =   "按比例缩小图片"
      End
      Begin VB.Menu m_MaSize 
         Caption         =   "按比例放大图片"
      End
      Begin VB.Menu m_Line2 
         Caption         =   "-"
      End
      Begin VB.Menu m_Gray 
         Caption         =   "256色灰度显示"
      End
      Begin VB.Menu m_Line3 
         Caption         =   "-"
      End
      Begin VB.Menu m_About 
         Caption         =   "关于..."
      End
   End
End
Attribute VB_Name = "ImageFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Enum MoveFlagE
  NoMove = 0
  MoveInitialize = 1
  MoveWithScale = 2
  MoveWithZoom = 4
End Enum

Dim w As Long, h As Long, NowZOOM As Single
Dim LP As Single, TP As Single, IMG As StdPicture

Private Sub Form_Load()
  Dim I As Long, K As Long
  
  Me.Icon = MainFrm.Icon
  Me.Caption = "相片查看"
  GetImageWH w, h
  m_ILT.Checked = True
  PBox1(1).BackColor = PBox1(0).BackColor
  m_AutoSize.Checked = True
  Exit Sub
End Sub

Private Sub Form_Resize()
  Static Flag As Boolean
  If Me.WindowState <> vbMinimized And (Not Flag) Then
    Flag = True
    If Me.Width < 2000 Then Me.Width = 2000
    If Me.Height < 2000 Then Me.Height = 2000
    PBox1(0).Width = Me.ScaleWidth - PBox1(0).Left * 2
    PBox1(0).Height = Me.ScaleHeight - PBox1(0).Top * 2
    If LT1.Visible Then
        LT1.Width = PBox1(0).ScaleWidth
        LT1.Top = (PBox1(0).ScaleHeight - LT1.Height) \ 2
        DoEvents
    End If
    DisplayPicture NowZOOM, MoveWithScale, m_ILT.Checked, m_AutoSize.Checked, m_LS.Checked, m_Gray.Checked
    LT1.Visible = False
    Flag = False
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  w = 0: h = 0: NowZOOM = 0
  LP = 0: TP = 0
End Sub

Private Sub m_AutoSize_Click()
  If m_AutoSize.Checked Then
    m_AutoSize.Checked = False
  Else
    m_AutoSize.Checked = True
    DisplayPicture 1, MoveWithScale, m_ILT.Checked, True, , m_Gray.Checked
  End If
End Sub

Private Sub m_Gray_Click()
  DisplayPicture NowZOOM, MoveWithScale, m_ILT.Checked, m_AutoSize.Checked, m_LS.Checked, Not m_Gray.Checked
End Sub

Private Sub m_ILT_Click()
  If m_ILT.Checked Then
    m_ILT.Checked = False
  Else
    m_ILT.Checked = True
    DisplayPicture NowZOOM, MoveInitialize, , m_AutoSize.Checked, , m_Gray.Checked
  End If
End Sub

Private Sub m_LS_Click()
  If m_LS.Checked Then
    m_LS.Checked = False
    DisplayPicture NowZOOM, MoveWithScale, m_ILT.Checked, m_AutoSize.Checked, m_LS.Checked, m_Gray.Checked
  Else
    m_LS.Checked = True
    DisplayPicture NowZOOM, MoveWithScale, m_ILT.Checked, m_AutoSize.Checked, m_LS.Checked, m_Gray.Checked
  End If
  m_ILT.Enabled = Not m_LS.Checked
  m_AutoSize.Checked = m_ILT.Enabled
  m_Mid.Enabled = m_ILT.Enabled
  m_MaSize.Enabled = m_ILT.Enabled
  m_MiSize.Enabled = m_ILT.Enabled
  m_AutoSize.Enabled = m_ILT.Enabled
End Sub

Private Sub m_Mid_Click()
  LP = 0.5
  TP = 0.5
  m_ILT.Checked = False
  DisplayPicture NowZOOM, MoveWithScale, m_ILT.Checked, m_AutoSize.Checked, , m_Gray.Checked
End Sub

Private Sub m_MaSize_Click()
  m_AutoSize.Checked = False
  If (NowZOOM * w > &HFFFFFF) Or (NowZOOM * h > &HFFFFFF) Then Exit Sub
  DisplayPicture NowZOOM + 0.1, MoveWithScale, m_ILT.Checked, False, , m_Gray.Checked
End Sub

Private Sub m_MiSize_Click()
  Dim ZOOM As Single
  m_AutoSize.Checked = False
  If (NowZOOM * w < 10) Or (NowZOOM * h < 10) Then Exit Sub
  If NowZOOM > 0.1 Then
    DisplayPicture NowZOOM - 0.1, MoveWithScale, m_ILT.Checked, False, , m_Gray.Checked
  Else
    ZOOM = 0.01
    Do While ZOOM >= NowZOOM
      ZOOM = ZOOM * 0.1
    Loop
    DisplayPicture NowZOOM - ZOOM, MoveWithScale, m_ILT.Checked, False, , m_Gray.Checked
  End If
End Sub

Private Sub m_ReSize_Click()
  m_AutoSize.Checked = False
  m_LS.Checked = False
  m_ILT.Enabled = True
  m_Mid.Enabled = True
  m_MaSize.Enabled = True
  m_MiSize.Enabled = True
  m_AutoSize.Enabled = True
  NowZOOM = 0
  DisplayPicture 1, MoveWithScale, m_ILT.Checked, False, , m_Gray.Checked
End Sub

'Private Sub PBox1_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
'  Debug.Print "X=" & X & " Y=" & Y
'End Sub

Private Sub PBox1_KeyPress(Index As Integer, KeyAscii As Integer)
  If KeyAscii = 27 Then Unload Me
End Sub

Private Sub PBox1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton And Index = 1 And Not (m_LS.Checked) And Not (m_AutoSize.Checked) Then
        SendMoveForm PBox1(1).hwnd
        LP = PBox1(0).ScaleWidth - PBox1(1).ScaleWidth
        If LP <> 0 Then LP = PBox1(1).Left / LP
        TP = PBox1(0).ScaleHeight - PBox1(1).ScaleHeight
        If TP <> 0 Then TP = PBox1(1).Top / TP
    End If
End Sub

Private Sub PBox1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 2 And X > 0 And Y > 0 And X < PBox1(Index).ScaleWidth And Y < PBox1(Index).ScaleHeight Then
    Me.PopupMenu m_Image, , PBox1(0).Left + Me.ScaleX(IIf(Index, X + PBox1(1).Left, X), 3, 1), PBox1(0).Top + Me.ScaleY(IIf(Index, PBox1(1).Top + Y, Y), 3, 1)
  End If
End Sub

Private Sub DisplayPicture(Optional ByVal ZOOM As Single = 1, _
                           Optional ByVal UpNow As MoveFlagE = NoMove, _
                           Optional ByVal AutoScale As Boolean = True, _
                           Optional ByVal AutoSize As Boolean = True, _
                           Optional ByVal AutoLS As Boolean = False, _
                           Optional ByVal GrayMode As Boolean = False)
                           
  Dim I As Long, K As Long, S As Single
  Dim X As Long, Y As Long
  
  If ZOOM < 0 Then
    Exit Sub
  ElseIf NowZOOM = 0 And ZOOM = 0 Then
    ZOOM = 1
  End If
  If AutoSize Then
    If w > PBox1(0).ScaleWidth Or h > PBox1(0).ScaleHeight Then
        If w > h Then
            ZOOM = PBox1(0).ScaleWidth / CSng(w)
        Else
            ZOOM = PBox1(0).ScaleHeight / CSng(h)
        End If
    Else
        ZOOM = 1
    End If
  End If
  If AutoLS Then
'    PBox1(1).Visible = False
    PBox1(1).Cls
    PBox1(1).Width = PBox1(0).ScaleWidth
    PBox1(1).Height = PBox1(0).ScaleHeight
    ShowImage PBox1(1).hdc, PBox1(1).ScaleWidth, PBox1(1).ScaleHeight, , , ZOOM
    If GrayMode Then GrayBmp PBox1(1).hdc, 0, 0, PBox1(1).ScaleWidth, PBox1(1).ScaleHeight
    PBox1(1).Refresh
'    PBox1(1).Visible = True
  ElseIf ZOOM <> NowZOOM Then
'    PBox1(1).Visible = False
    PBox1(1).Width = w * ZOOM
    PBox1(1).Height = h * ZOOM
    If PBox1(1).Width = 0 Then PBox1(1).Width = 1
    If PBox1(1).Height = 0 Then PBox1(1).Height = 1
    PBox1(1).Cls
    '显示缩略图片
    ShowImage PBox1(1).hdc, PBox1(1).ScaleWidth, PBox1(1).ScaleHeight, , , ZOOM, False
    If GrayMode Then GrayBmp PBox1(1).hdc, 0, 0, PBox1(1).ScaleWidth, PBox1(1).ScaleHeight
    PBox1(1).Refresh
    NowZOOM = ZOOM
'    PBox1(1).Visible = True
  ElseIf GrayMode <> m_Gray.Checked Then
    ShowImage PBox1(1).hdc, PBox1(1).ScaleWidth, PBox1(1).ScaleHeight, , , NowZOOM, False
    If GrayMode Then GrayBmp PBox1(1).hdc, 0, 0, PBox1(1).ScaleWidth, PBox1(1).ScaleHeight
    PBox1(1).Refresh
  End If
  
  m_Gray.Checked = GrayMode
  
  If AutoScale Then UpNow = MoveInitialize
  
  Select Case UpNow
    Case MoveInitialize:
        If PBox1(1).ScaleWidth > PBox1(0).ScaleWidth Then
            PBox1(1).Left = 0
            LP = 0
        Else
            PBox1(1).Left = (PBox1(0).ScaleWidth - PBox1(1).ScaleWidth) \ 2
            LP = 0.5
        End If
        If PBox1(1).ScaleHeight > PBox1(0).ScaleHeight Then
            PBox1(1).Top = 0
            TP = 0
        Else
            PBox1(1).Top = (PBox1(0).ScaleHeight - PBox1(1).ScaleHeight) \ 2
            TP = 0.5
        End If
        TP = PBox1(0).ScaleHeight - PBox1(1).ScaleHeight
        If TP <> 0 Then TP = PBox1(1).Top / TP
    Case MoveWithScale:
        PBox1(1).Left = LP * (PBox1(0).ScaleWidth - PBox1(1).ScaleWidth)
        PBox1(1).Top = TP * (PBox1(0).ScaleHeight - PBox1(1).ScaleHeight)
    Case MoveWithZoom:
  End Select
End Sub