frmimgpreview.frm

用vb编了一个数据库程序

VERSION 5.00
Object = "{6D940288-9F11-11CE-83FD-02608C3EC08A}#2.2#0"; "imgedit.ocx"
Begin VB.Form frmImgPreview 
   Caption         =   "图像预览"
   ClientHeight    =   6555
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7875
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   6555
   ScaleWidth      =   7875
   StartUpPosition =   2  '屏幕中心
   Begin ImgeditLibCtl.ImgEdit ImgEdit 
      Height          =   5745
      Left            =   60
      TabIndex        =   5
      Top             =   60
      Width           =   7755
      _Version        =   131074
      _ExtentX        =   13679
      _ExtentY        =   10134
      _StockProps     =   96
      BorderStyle     =   1
      ImageControl    =   "ImgEdit2"
      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  =   121389568
      OcrZoneVisibility=   -3612
      AnnotationOcrType=   25649
      ForceFileLinking1x=   -1  'True
      MagnifierZoom   =   25649
      sReserved1      =   -3612
      sReserved2      =   -3612
      bReserved1      =   -1  'True
      bReserved2      =   -1  'True
   End
   Begin VB.Frame Frame 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   60
      TabIndex        =   0
      Top             =   5790
      Width           =   7755
      Begin VB.TextBox txtSSSQ 
         Height          =   350
         Left            =   1560
         MaxLength       =   6
         TabIndex        =   3
         Text            =   "199901"
         Top             =   240
         Width           =   1600
      End
      Begin VB.CommandButton cmdCancel 
         Caption         =   " 放弃(&C)"
         Height          =   375
         Left            =   6120
         TabIndex        =   2
         Top             =   240
         Width           =   1500
      End
      Begin VB.CommandButton cmdSave 
         Caption         =   " 保存(&S)"
         Height          =   375
         Left            =   4620
         TabIndex        =   1
         Top             =   240
         Width           =   1500
      End
      Begin VB.Label lblSSSQ 
         AutoSize        =   -1  'True
         Caption         =   "该文书所属时期"
         Height          =   180
         Left            =   150
         TabIndex        =   4
         Top             =   330
         Width           =   1260
      End
   End
End
Attribute VB_Name = "frmImgPreview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public IsSave As Boolean
Public Img_SSSQ As String

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控件高度与显示图像高度的比值

Const SizeLimit As Integer = 7350

Private Sub cmdCancel_Click()
    IsSave = False
    Unload Me
End Sub

Private Sub cmdSave_Click()
    IsSave = True
    
    If txtSSSQ.Enabled = True Then
    
        '所属时期无效,退出
        If Not IsDate(Left(txtSSSQ.Text, 4) & "/" & Right(txtSSSQ.Text, 2) & "/01") Then
            MsgBox "所属时期无效,请重新输入!", vbCritical
            Exit Sub
        End If
        
        Img_SSSQ = txtSSSQ.Text
    End If
    Unload Me
End Sub

Private Sub Form_Load()

'控制[所属时期]按钮的可见性
If CompanyCaseType(CompNum, CaseNum).Img_IsRegister Then
    txtSSSQ.Enabled = False
    txtSSSQ.BackColor = &H8000000F
    txtSSSQ.Text = Year(Date) & Format(DatePart("M", Date), "0#")
End If

'设置图片源
ImgEdit.Image = CompanyCaseType(CompNum, CaseNum).Img_Path & CompanyCaseType(CompNum, CaseNum).Img_Name

'显示扫描所得图片
If ImgEdit.Image <> vbNullString Then

    '将显示的图片缩放到到适合ImgEdit控件的高度和宽度
    ZoomX = (ImgEdit.Width / 15.5) / ImgEdit.ImageWidth
    ZoomY = (ImgEdit.Height / 15.5) / ImgEdit.ImageHeight
    If ZoomX > ZoomY Then
        ImgEdit.Zoom = ZoomY * 100
    Else
        ImgEdit.Zoom = ZoomX * 100
    End If
    
    ImgEdit.Display
End If

txtSSSQ.Text = GetSetting(App.Title, "Settings", "txtSSSQ", txtSSSQ.Text)

End Sub

Private Sub Form_Resize()

If Me.WindowState = vbMinimized Then
    Exit Sub
End If
If Me.Width < SizeLimit Then
    Me.Width = SizeLimit
End If
If Me.Height < SizeLimit * 0.8 Then
    Me.Height = SizeLimit * 0.8
End If

ImgEdit.Width = Me.Width - 220
ImgEdit.Height = Me.Height - Frame.Height - 420

Frame.Width = Me.Width - 220
Frame.Top = ImgEdit.Height

cmdCancel.Left = Frame.Width - cmdCancel.Width - 200
cmdSave.Left = cmdCancel.Left - cmdCancel.Width

If ImgEdit.ImageDisplayed Then
    ImgEdit.ClearDisplay
    
    '将显示的图片缩放到到适合ImgEdit控件的高度和宽度
    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)
    SaveSetting App.Title, "Settings", "txtSSSQ", txtSSSQ.Text
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)
'******************************
'功能: 缩放鼠标选取范围内的图像
'******************************
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
End Sub