frmshowimg.frm

用vb编了一个数据库程序

VERSION 5.00
Object = "{6D940288-9F11-11CE-83FD-02608C3EC08A}#2.2#0"; "imgedit.ocx"
Begin VB.Form frmShowImg 
   Caption         =   "显示图片"
   ClientHeight    =   6675
   ClientLeft      =   2220
   ClientTop       =   1440
   ClientWidth     =   8130
   LinkTopic       =   "Form1"
   ScaleHeight     =   6675
   ScaleWidth      =   8130
   StartUpPosition =   2  '屏幕中心
   Begin ImgeditLibCtl.ImgEdit ImgEdit 
      Height          =   5505
      Left            =   90
      TabIndex        =   7
      Top             =   60
      Width           =   7995
      _Version        =   131074
      _ExtentX        =   14102
      _ExtentY        =   9710
      _StockProps     =   96
      BorderStyle     =   1
      ImageControl    =   "ImgEdit3"
      BeginProperty AnnotationFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Times New Roman"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      UndoBufferSize  =   121388800
      OcrZoneVisibility=   -3612
      AnnotationOcrType=   25649
      ForceFileLinking1x=   -1  'True
      MagnifierZoom   =   25649
      sReserved1      =   -3612
      sReserved2      =   -3612
      bReserved1      =   -1  'True
      bReserved2      =   -1  'True
   End
   Begin VB.Frame Frame1 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1065
      Left            =   60
      TabIndex        =   5
      Top             =   5580
      Width           =   8025
      Begin VB.CommandButton CmdZoomIn 
         Caption         =   "缩小"
         Height          =   550
         Left            =   6060
         TabIndex        =   2
         Top             =   300
         Width           =   600
      End
      Begin VB.CommandButton CmdZoomOut 
         Caption         =   "放大"
         Height          =   550
         Left            =   6660
         Style           =   1  'Graphical
         TabIndex        =   3
         Top             =   300
         Width           =   600
      End
      Begin VB.CommandButton CmdSure 
         Caption         =   "确定"
         Height          =   550
         Left            =   7260
         TabIndex        =   4
         Top             =   300
         Width           =   600
      End
      Begin VB.CommandButton CmdPrevious 
         Height          =   550
         Left            =   4680
         Picture         =   "frmShowImg.frx":0000
         Style           =   1  'Graphical
         TabIndex        =   0
         Top             =   300
         Width           =   700
      End
      Begin VB.CommandButton CmdNext 
         Height          =   550
         Left            =   5370
         Picture         =   "frmShowImg.frx":0442
         Style           =   1  'Graphical
         TabIndex        =   1
         Top             =   300
         Width           =   700
      End
      Begin VB.Label lblCaption 
         BorderStyle     =   1  'Fixed Single
         Height          =   705
         Left            =   150
         TabIndex        =   6
         Top             =   240
         Width           =   4395
      End
   End
End
Attribute VB_Name = "frmShowImg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public ImgExist As Boolean
Public QuryStr As String
Public rstImage As ADODB.Recordset

Dim StopZoom As Boolean     'MouseUp时该值为真
Dim ZoomBefore As Integer   '图像缩放前的zoom值
Dim StartX As Single        '鼠标在图像中单击的x坐标
Dim StartY As Single        '鼠标在图像中单击的y坐标
Dim ZoomX As Single         'ImgEdit控件宽度与显示图像宽度的比值
Dim ZoomY As Single         'ImgEdit控件高度与显示图像高度的比值

Private Sub CmdNext_Click()

On Error GoTo ErrorHandler

If rstImage.EOF Then
    rstImage.MoveLast
Else
    rstImage.MoveNext
End If
If Not rstImage.EOF Then
    ImgEdit.ClearDisplay
    
    If ImageFileExisted(rstImage!Img_Path & rstImage!Img_Name) = False Then
        MsgBox "文件未找到!!" & vbCrLf & "文件名称: " & rstImage!Img_Name & vbCrLf & "路径: " & rstImage!Img_Path, vbCritical
        Unload Me
    End If

    ImgEdit.Image = rstImage!Img_Path & rstImage!Img_Name
    ZoomX = (ImgEdit.Width / 16) / ImgEdit.ImageWidth
    ZoomY = (ImgEdit.Height / 16) / ImgEdit.ImageHeight
    If ZoomX > ZoomY Then
        ImgEdit.Zoom = ZoomY * 100
    Else
        ImgEdit.Zoom = ZoomX * 100
    End If
    ImgEdit.Display
    lblCaption.Caption = rstImage!Nsrmc & "的" & vbCrLf & rstImage!Img_Case_Name & "的第 " & rstImage!Img_Page & " 页" & vbCrLf & "所属时期：" & rstImage!Img_SSSQ
End If

Exit Sub

ErrorHandler:
    If Err Then
        MsgBox Err.Description, vbCritical
        Err.Clear
    End If
End Sub

Private Sub CmdNext_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then
    Unload Me
End If

End Sub

Private Sub CmdPrevious_Click()

On Error GoTo ErrorHandler

If rstImage.BOF Then
    rstImage.MoveFirst
Else
    rstImage.MovePrevious
End If
If Not rstImage.BOF Then
    ImgEdit.ClearDisplay
    
    If ImageFileExisted(rstImage!Img_Path & rstImage!Img_Name) = False Then
        MsgBox "文件未找到!!" & vbCrLf & "文件名称: " & rstImage!Img_Name & vbCrLf & "路径: " & rstImage!Img_Path, vbCritical
        Unload Me
    End If
    
    ImgEdit.Image = rstImage!Img_Path & rstImage!Img_Name
    ZoomX = (ImgEdit.Width / 16) / ImgEdit.ImageWidth
    ZoomY = (ImgEdit.Height / 16) / ImgEdit.ImageHeight
    If ZoomX > ZoomY Then
        ImgEdit.Zoom = ZoomY * 100
    Else
        ImgEdit.Zoom = ZoomX * 100
    End If
    ImgEdit.Display
    lblCaption.Caption = rstImage!Nsrmc & "的" & vbCrLf & rstImage!Img_Case_Name & "的第 " & rstImage!Img_Page & " 页" & vbCrLf & "所属时期：" & rstImage!Img_SSSQ
End If

Exit Sub

ErrorHandler:
    If Err Then
        MsgBox Err.Description, vbCritical
        Err.Clear
    End If
End Sub

Private Sub CmdPrevious_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then
    Unload Me
End If
End Sub

Private Sub cmdSure_Click()
Unload Me
End Sub

Private Sub CmdSure_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then
    Unload Me
End If
End Sub

Private Sub CmdZoomIn_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then
    Unload Me
End If

End Sub

Private Sub CmdZoomIn_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
StopZoom = False
Do Until ImgEdit.Zoom <= 4
    ImgEdit.Zoom = ImgEdit.Zoom - 2
    ImgEdit.Refresh
    DoEvents
    If StopZoom = True Then
        StopZoom = False
        Exit Sub
    End If
Loop
End Sub

Private Sub CmdZoomIn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
StopZoom = True
End Sub

Private Sub CmdZoomOut_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then
    Unload Me
End If

End Sub

Private Sub CmdZoomOut_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
StopZoom = False
Do Until ImgEdit.Zoom >= 400
    ImgEdit.Zoom = ImgEdit.Zoom + 2
    ImgEdit.Refresh
    DoEvents
    If StopZoom = True Then
        StopZoom = False
        Exit Sub
    End If
Loop
End Sub

Private Sub CmdZoomOut_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
StopZoom = True
End Sub

Private Sub Form_Activate()
On Error GoTo ErrorHandler

    If Not rstImage.BOF Then rstImage.MoveFirst
    
    If ImageFileExisted(rstImage!Img_Path & rstImage!Img_Name) = False Then
        MsgBox "文件未找到!!" & vbCrLf & "文件名称: " & rstImage!Img_Name & vbCrLf & "路径: " & rstImage!Img_Path, vbCritical
        Unload Me
    Else
        '如果该文书只有一页,则向前和向后按钮置灰
        If rstImage.RecordCount = 1 Then
            cmdPrevious.Enabled = False
            cmdNext.Enabled = False
        End If
        ImgEdit.Image = rstImage!Img_Path & rstImage!Img_Name
        ZoomX = (ImgEdit.Width / 16) / ImgEdit.ImageWidth
        ZoomY = (ImgEdit.Height / 16) / ImgEdit.ImageHeight
        If ZoomX > ZoomY Then
            ImgEdit.Zoom = ZoomY * 100
        Else
            ImgEdit.Zoom = ZoomX * 100
        End If
        ImgEdit.Display
        If rstImage.RecordCount > 1 Then
            lblCaption.Caption = rstImage!Nsrmc & "的" & vbCrLf & rstImage!Img_Case_Name & "的第 " & rstImage!Img_Page & " 页" & vbCrLf & "所属时期：" & rstImage!Img_SSSQ
        Else
            lblCaption.Caption = rstImage!Nsrmc & "的" & vbCrLf & rstImage!Img_Case_Name & vbCrLf & "所属时期：" & rstImage!Img_SSSQ
        End If
    End If

Exit Sub

ErrorHandler:
    If Err Then
        MsgBox Err.Description, vbCritical
        Err.Clear
    End If
End Sub

Private Sub Form_Load()
Me.Left = fMainForm.Left + (fMainForm.Width - Me.Width) / 2
Me.Top = fMainForm.Top + (fMainForm.Height - Me.Height) / 2
End Sub

Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then
    Exit Sub
End If
ImgEdit.Visible = False
If Me.Width < 7300 Then
    Me.Width = 7300
End If
If Me.Height < 2500 Then
    Me.Height = 2500
End If
ImgEdit.Width = Me.Width - 250
Frame1.Width = Me.Width - 250
ImgEdit.Height = Me.Height - Frame1.Height - 520
Frame1.Top = Me.Height - Frame1.Height - 450
ImgEdit.Visible = True
If ImgEdit.ImageDisplayed Then
    ImgEdit.ClearDisplay
    ZoomX = (ImgEdit.Width / 16) / ImgEdit.ImageWidth
    ZoomY = (ImgEdit.Height / 16) / ImgEdit.ImageHeight
    If ZoomX > ZoomY Then
        ImgEdit.Zoom = ZoomY * 100
    Else
        ImgEdit.Zoom = ZoomX * 100
    End If
    ImgEdit.Display
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    rstImage.Close
End Sub

Private Sub ImgEdit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
StartX = X
StartY = Y
End Sub

Private Sub ImgEdit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

On Error GoTo ErrorHandler

If StartX = X And StartY = Y And ZoomBefore <> 0 Then
    ImgEdit.Display
    ImgEdit.Zoom = ZoomBefore
    ImgEdit.Refresh
End If
If (StartX / 20) < ImgEdit.ImageScaleWidth And (StartY / 20) < ImgEdit.ImageScaleHeight Then
    If StartX <> X And StartY <> Y Then
        If ((Abs((StartX - X)) / 20) * 25) > ImgEdit.ImageScaleWidth And _
           ((Abs((StartY - Y)) / 20) * 25) > ImgEdit.ImageScaleHeight Then
            ZoomBefore = ImgEdit.Zoom
            ImgEdit.ZoomToSelection
        End If
    End If
End If

Exit Sub
ErrorHandler:
    If Err Then
        MsgBox Err.Description, vbCritical
        Err.Clear
    End If
End Sub

Private Function ImageFileExisted(ImageFile As String) As Boolean
    If Dir(ImageFile) <> vbNullString Then
        ImageFileExisted = True
    Else
        ImageFileExisted = False
    End If
End Function