frmscan.frm

金算盘软件代码

Private Sub cmbChange_Validate(Index As Integer, Cancel As Boolean)
    If Index = 0 Then
        If cmbChange(0).Text <> "" Then
            If cmbChange(0).ListIndex = -1 Then
                If Not IsNumeric(cmbChange(0).Text) Then
                    EMsgBox "请输入缩放比例（2至6554）！"
                    Cancel = True
                ElseIf CDbl(cmbChange(0).Text) < 2 Or CDbl(cmbChange(0).Text) > 6554 Then
                    EMsgBox "请输入缩放比例（2至6554）！"
                    Cancel = True
                Else
                    IEdit.Zoom = CDbl(cmbChange(Index).Text)
                    IEdit.Refresh
                End If
            Else
                cmbChange(Index).Text = IEdit.Zoom
            End If
        End If
    Else
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        'SendKeys "{TAB}"
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_Load()
    Utility.LoadFormResPicture Me
    If IScan.ScannerAvailable Then
        m_blnScannerOK = True
    Else
        IMsgBox "没有发现 TWAIN 扫描仪，不能扫描！"
        cmdScan(4).Enabled = False
        cmdScan(5).Enabled = False
    End If
    
    lblTitle(0).Caption = "单位:"
    lblTitle(1).Caption = "工程:"
    lblTitle(2).Caption = "日期:"
    lblTitle(3).Caption = "合同:"
    lblTitle(5).Caption = "共 0 张"
    ClearImg
    m_TempPath = Environ("Temp")
    If Trim(m_TempPath) = "" Then
        m_TempPath = Environ("Tmp")
        If Trim(m_TempPath) = "" Then
            m_TempPath = "C:\"
        End If
    End If
    cmbChange(0).AddItem "最佳匹配"
    cmbChange(0).AddItem "宽度充满"
    cmbChange(0).AddItem "高度充满"
    cmbChange(0).AddItem "实际大小"
    cmbChange(0).AddItem "原始大小"
    cmbChange(0).Text = "100"

    cmbChange(1).AddItem "左转90度"
    cmbChange(1).AddItem "右转90度"
    cmbChange(1).AddItem "倒转"
    
    m_ImgPath = GetAccountlistFilePathName & gclsBase.UID & "\"
        
    If m_lngOrderID <> 0 Then
        If GetOrderInfo() = False Then
            Unload Me
            Exit Sub
        End If
    ElseIf m_lngImgID <> 0 Then
        ShowAoldImg m_lngImgID
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If ChangeSaveNote = False Then
        Cancel = -1
        Exit Sub
    End If
    Utility.UnLoadFormResPicture Me
End Sub
Private Function ChangeSaveNote() As Boolean
    Dim lngResult As Long
    
    If m_blnChanged Then
        lngResult = ShowMsg(Me.hwnd, "第" & m_strCodeBak & "号图像已经改变，您需要存盘吗？", MB_YESNOCANCEL + MB_ICONQUESTION + MB_SYSTEMMODAL, "保存图像")
        If lngResult = vbNo Then
            ChangeSaveNote = True
            m_strCodeBak = lstHead.Text
        ElseIf lngResult = vbYes Then
            If SaveImgToBase() = True Then
                ChangeSaveNote = True
            End If
        Else
            ChangeSaveNote = False
            lstHead.Text = m_strCodeBak
        End If
    Else
        ChangeSaveNote = True
    End If
End Function
Private Sub ClearImg()
    IEdit.iMage = ""
    IEdit.DisplayBlankImage 1200, 1000
End Sub
Private Sub cmdScan_Click(Index As Integer)
    On Error GoTo ErrHandle
    Select Case Index
    Case 0
        If SaveImgToBase() = False Then
            Exit Sub
        End If
        If FindOtherImg() = False Then
            If m_lngImgID <> 0 Then
                ClearImg
                lstHead.Text = Card.GetNextCode(lstHead.Text)
                m_strCodeBak = lstHead.Text
                m_lngImgID = 0
                m_blnChanged = False
            End If
        End If
    Case 1
        If ChangeSaveNote = False Then
            Exit Sub
        End If
        If FindOtherImg(False) Then
            m_blnChanged = False
        End If
    Case 2
        If SaveImgToBase() = False Then
            Exit Sub
        End If
        Unload Me
    Case 3
        Unload Me
    Case 4
        If IScan.ShowSelectScanner() <> 0 Then Exit Sub
        IScan.ShowSetupBeforeScan = True
        IScan.ResetScanner
        If m_blnScannerOK Then
            If IScan.OpenScanner = 0 Then
                IScan.StartScan
                IScan.CloseScanner
            End If
        End If
    Case 5
        IScan.ShowSetupBeforeScan = False
        If m_blnScannerOK Then
            IScan.OpenScanner
            If IScan.OpenScanner = 0 Then
                IScan.StartScan
                IScan.CloseScanner
            End If
        End If
    Case 6
        OpenFile
'        RefreshImg
    Case 7
        DeleteFile
        'SaveAsFile
    Case 8
        If IEdit.ImageDisplayed Then
            On Error Resume Next
            If IEdit.ShowPageProperties(False) = 1 Then
                m_blnChanged = True
            End If
        End If
    Case 9
        PrintImg
    End Select
    Exit Sub
ErrHandle:
    EMsgBox Err.Description
End Sub

Private Sub IEdit_DragOver(Source As Control, x As Single, y As Single, State As Integer)
'    Static xbak As Single, ybak As Single
'
'    If (x - xbak) > 0 Then
'        IEdit.ScrollImage 2, (x - xbak) \ 2
'    ElseIf (x - xbak) < 0 Then
'        IEdit.ScrollImage 3, -(x - xbak) \ 2
'    End If
'    If (y - ybak) > 0 Then
'        IEdit.ScrollImage 0, (y - ybak) \ 2
'    ElseIf (y - ybak) < 0 Then
'        IEdit.ScrollImage 1, -(y - ybak) \ 2
'    End If
'    xbak = x
'    ybak = y
End Sub

Private Sub IEdit_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Static xbak As Single, ybak As Single
    
    If xbak = 0 Then
        xbak = x
        ybak = y
    End If
    If Button = vbRightButton Then
        If (x - xbak) > 10 Then
            IEdit.ScrollImage 2, (x - xbak) \ 2
            xbak = x
        ElseIf (x - xbak) < -10 Then
            IEdit.ScrollImage 3, -(x - xbak) \ 2
            xbak = x
        End If
        If (y - ybak) > 10 Then
            IEdit.ScrollImage 0, (y - ybak) \ 2
            ybak = y
        ElseIf (y - ybak) < -10 Then
            IEdit.ScrollImage 1, -(y - ybak) \ 2
            ybak = y
        End If
    End If
End Sub

Private Sub IScan_ScanDone()
    cmbChange(1).ListIndex = -1
    IEdit.Zoom = 100
    cmbChange(0).Text = "100"
    m_blnChanged = True
End Sub

Private Function SaveFile(ByVal StrFileName As String) As Boolean
    On Error GoTo ErrHandle
    
    If Trim(StrFileName) = "" Then Exit Function
    If UCase(Trim(IEdit.iMage)) <> UCase(Trim(StrFileName)) Then
        If Dir(StrFileName, 15) <> "" Then
            If QMsgBox("文件已经存在，您要覆盖吗？") = vbNo Then
                Exit Function
            End If
            Kill StrFileName
        End If
    End If
    If chkZoom.Value Then
        IEdit.SaveAS StrFileName, 1, , , , True
    Else
        IEdit.SaveAS StrFileName, 1
    End If
    SaveFile = True
    Exit Function
ErrHandle:
    EMsgBox Err.Description
End Function
Private Function SaveAsFile(Optional ByVal StrFileName As String) As Boolean
    Dim strFilter As String
    
    If StrFileName = "" Then
        strFilter = "GAF文件(*.GAF)|*.GAF"
'        strFilter = strFilter & IIf(OptFormat(0).Value <> 0, "|TIFF文件(*.TIF)|*.TIF", _
'            IIf(OptFormat(1).Value <> 0, "|AWD文件(*.AWD)|*.AWD", "|BMP文件(*.BMP)|*.BMP"))
        strFilter = strFilter & "|所有文件(*.*)|*.*"

        comDlg.Filter = strFilter
        comDlg.CancelError = True
        On Error Resume Next
        comDlg.ShowOpen
        If Err Then Exit Function
        StrFileName = comDlg.FileName
    End If
    On Error GoTo ErrHandle
    SaveAsFile = SaveFile(StrFileName)
    Exit Function
ErrHandle:
    EMsgBox Err.Description
End Function
Private Function OpenFile(Optional ByVal StrFileName As String = "") As Boolean
    
    If StrFileName = "" Then
        comDlg.Filter = "GAF文件(*.GAF)|*.GAF" _
                     & "|BMP文件(*.BMP)|*.BMP" _
                     & "|TIFF文件(*.TIF)|*.TIF" _
                     & "|AWD文件(*.AWD)|*.AWD" _
                     & "|PCX文件(*.PCX)|*.PCX" _
                     & "|DCX文件(*.DCX)|*.DCX" _
                     & "|JPG文件(*.JPG)|*.JPG" _
                     & "|XIF文件(*.XIF)|*.XIF" _
                     & "|GIF文件(*.GIF)|*.GIF" _
                     & "|所有文件(*.*)|*.*"
        comDlg.CancelError = True
        On Error Resume Next
        comDlg.ShowOpen
        If Err Then Exit Function
        StrFileName = comDlg.FileName
    End If
    On Error GoTo ErrHandle
    IEdit.iMage = StrFileName
    cmbChange(0).Text = "100"
    IEdit.Zoom = 100
    IEdit.Display
    OpenFile = True
    cmbChange(1).ListIndex = -1
    Exit Function
ErrHandle:
    EMsgBox Err.Description
    ClearImg
    m_blnChanged = True
End Function

Private Function PrintImg() As Boolean
    On Error GoTo ErrHandle
    
    If m_lngImgID <> 0 Or m_blnChanged Then
        IEdit.PrintImage
    End If
    PrintImg = True
    Exit Function
ErrHandle:
    EMsgBox Err.Description
End Function

Private Function SaveImgToBase() As Boolean
    Dim strSql As String
    Dim StrFileName As String
    Dim strToFileName As String
    Dim lngTmp As Long
    
    On Error GoTo ErrHandle
    
    If m_blnChanged = False Then
        SaveImgToBase = True
        Exit Function
    End If
    If Dir(m_ImgPath, vbDirectory) = "" Then
        If QMsgBox("文件夹“" & m_ImgPath & "”不存在，您是否需要新增？") = vbNo Then
            Exit Function
        End If
        MkDir m_ImgPath
    End If
    If DataValid() = False Then
        Exit Function
    End If
    If m_lngImgID = 0 Then
        lngTmp = GetNewID("OrderImage")
        strSql = "INSERT INTO OrderImage (lngImageID,lngOrderID,strImageCode) VALUES (" & _
            lngTmp & "," & m_lngOrderID & ",'" & m_strCodeBak & "')"
        If gclsBase.ExecSQL(strSql) = False Then
            Exit Function
        End If
        m_lngImgID = lngTmp
    End If
    
    strToFileName = m_ImgPath & m_lngImgID & ".GAF"
'    If Dir(strToFileName, 15) <> "" Then
'        If QMsgBox("文件已经存在，您需要覆盖吗？") = vbNo Then
'            GoTo EndProc
'        End If
''        Kill strToFileName
'    End If

'    StrFileName = Trim(IEdit.iMage)
'    If StrFileName <> "" Then
'        If Dir(StrFileName, 15) = "" Then
'            StrFileName = ""
'        End If
'    End If
'    If StrFileName = "" Or IEdit.ImageModified Then
        If SaveFile(strToFileName) = False Then
            strSql = "DELETE OrderImage WHERE lngImageID=" & lngTmp
            gclsBase.ExecSQL strSql
            m_lngImgID = 0