frmmain.frm

人事,工资,考勤系统把数据导入Excel要用到Excel.dll,Office.d

    lblInfo = "Process cancelled!"
    Exit Sub
  End If
  strSession = Trim(strSession)
  
  cDialog.CancelError = True
  cDialog.DialogTitle = "Save ASP Picture Proxy..."
  cDialog.Filename = ""
  cDialog.Filter = "Active Server Page(*.asp)|*.asp"
  cDialog.FilterIndex = 1
  cDialog.Flags = cdlOFNOverwritePrompt

  cDialog.ShowSave
  If Err = cdlCancel Or Trim(cDialog.Filename) = "" Then
    lblInfo = "Process cancelled!"
    Exit Sub
  End If
  
  MousePointer = vbHourglass
  xImage.MakeASPProxy Trim(cDialog.Filename), strSession
  MousePointer = vbNormal
  
  If xImage.ErrNumber <> 0 Then
    lblInfo = xImage.ErrDesc
  Else
    lblInfo = "ASP file created successful!"
  End If
End Sub

Private Sub cmdSaveImage_Click()
On Error Resume Next

  Dim blnUseImage As Boolean
  Dim strPath As String
  
  If mnuUseImage.Checked = True And imgGet.Picture <> 0 Then
    blnUseImage = True
    strPath = App.Path & "\dbtmpfl1.bmp"
    SavePicture imgGet.Picture, strPath
    If Err.Number <> 0 Then
      blnUseImage = False
      Err.Clear
    End If
  End If
      
  If Not blnUseImage Then
    cDialog.CancelError = True
    cDialog.DialogTitle = "Select Image..."
    cDialog.Filename = ""
    cDialog.Filter = "Pictures(*.jpg;*.gif;*.bmp)|*.jpg;*.gif;*.bmp"
    cDialog.FilterIndex = 1
    cDialog.Flags = cdlOFNOverwritePrompt

    cDialog.ShowOpen
    If Err = cdlCancel Then
      strPath = ""
    Else
      strPath = Trim(cDialog.Filename)
    End If
  End If
  
  If strPath = "" Then
    lblInfo = "Operation cancelled!"
    Exit Sub
  Else
    If Not blnUseImage Then
      imgGet.Visible = False
      imgGet.Picture = LoadPicture()
    End If
    MousePointer = vbHourglass
    xImage.SaveImage strTable, strColumn, strWhere, Trim(strPath)
    If blnUseImage = True Then Kill strPath
    
    If xImage.ErrNumber <> 0 Then
      lblInfo = xImage.ErrDesc
    Else
      lblInfo = "Picture save to DB successful!"
      If Not blnUseImage Then
        imgGet.Picture = LoadPicture(Trim(strPath))
        CreateThumb picHolder, imgGet, mnuCenterPic.Checked, mnuAutosize.Checked
        imgGet.Visible = True
        imgGet.Refresh
      End If
    End If
    MousePointer = vbNormal
  End If
End Sub

Private Sub cmdShow_Click()
On Error Resume Next
  frmAllRows.Show vbModal, Me
End Sub

Private Sub cmdSchema_Click()
On Error Resume Next
  frmTables.Show vbModal, Me
End Sub

Private Sub cmdGet_Click()
On Error Resume Next
  
  Dim Filename As String
  If mnuSaveOnGet.Checked = True Then
    cDialog.CancelError = True
    cDialog.DialogTitle = "Save DB Image..."
    cDialog.Filename = ""
    cDialog.Filter = "Pictures(*.jpg;*.gif;*.bmp)|*.jpg;*.gif;*.bmp"
    cDialog.FilterIndex = 1
    cDialog.Flags = cdlOFNOverwritePrompt
  
    cDialog.ShowSave
    If Err = cdlCancel Then
      Filename = ""
    Else
      Filename = Trim(cDialog.Filename)
    End If
  End If
  
  imgGet.Visible = False
  imgGet.Picture = LoadPicture()
  lblInfo = "Attempting to retrieve picture..."
  MousePointer = vbHourglass
  Set imgGet.Picture = xImage.GetImage(strTable, strColumn, strWhere, Filename)
  
  If xImage.ErrNumber <> 0 Then
    lblInfo = xImage.ErrDesc
  Else
    lblInfo = "Picture received successfully!"
    CreateThumb picHolder, imgGet, mnuCenterPic.Checked, mnuAutosize.Checked
    imgGet.Visible = True
    imgGet.Refresh
  End If
  MousePointer = vbNormal
End Sub

Public Sub CreateThumb(picTarget As PictureBox, imgActual As Image, Center As Boolean, Autosize As Boolean)
On Error Resume Next

  imgActual.Stretch = False
  If Autosize = True Then
    If picTarget.ScaleHeight < imgActual.Height _
      Or picTarget.ScaleWidth < imgActual.Width Then
        
        Dim intHeight As Integer, intWidth As Integer, dblMultiplyer As Double
        intHeight = imgActual.Height - picTarget.ScaleHeight
        intWidth = imgActual.Width - picTarget.ScaleWidth
        
        If intHeight >= intWidth Then
          dblMultiplyer = (imgActual.Height - intHeight) / imgActual.Height
        Else
          dblMultiplyer = picTarget.ScaleWidth / imgActual.Width
        End If
        
        imgActual.Height = imgActual.Height * dblMultiplyer
        imgActual.Width = imgActual.Width * dblMultiplyer
        imgActual.Stretch = True
        imgActual.Refresh
    Else
      imgActual.Stretch = False
    End If
  Else
    imgActual.Stretch = False
  End If
  
  If Center Then
    imgActual.Left = picTarget.ScaleWidth / 2 - imgActual.Width / 2
    imgActual.Top = picTarget.ScaleHeight / 2 - imgActual.Height / 2
  Else
    imgActual.Top = 0
    imgActual.Left = 0
  End If
End Sub

Private Sub imgGet_DblClick()
  frmView.Show vbModal, Me
End Sub

Private Sub mnuAbout_Click()
  MsgBox "SQL DBImage Tools by Shannon Harmon" & vbCrLf & "Copyright 2000 - All rights reserved!", vbInformation, "About"
End Sub

Private Sub mnuAutosize_Click()
  mnuAutosize.Checked = Not (mnuAutosize.Checked)
  CreateThumb picHolder, imgGet, mnuCenterPic.Checked, mnuAutosize.Checked
End Sub

Private Sub mnuCenterPic_Click()
  mnuCenterPic.Checked = Not (mnuCenterPic.Checked)
  CreateThumb picHolder, imgGet, mnuCenterPic.Checked, mnuAutosize.Checked
End Sub

Private Sub mnuExit_Click()
  Unload Me
End Sub

Private Sub mnuOpen_Click()
On Error Resume Next
  
  cDialog.CancelError = True
  cDialog.DialogTitle = "Open Image..."
  cDialog.Filename = ""
  cDialog.Filter = "Pictures(*.jpg;*.gif;*.bmp;*.ico;*.wmf;*.cur)|*.jpg;*.gif;*.bmp;*.ico;*.wmf;*.cur"
  cDialog.FilterIndex = 1
  
  cDialog.ShowOpen
  If Err = cdlCancel Or Trim(cDialog.Filename) = "" Then Exit Sub
  
  imgGet.Visible = False
  imgGet.Stretch = False
  imgGet.Picture = LoadPicture(Trim(cDialog.Filename))
  lblInfo = imgGet.Width & "x" & imgGet.Height
  CreateThumb picHolder, imgGet, mnuCenterPic.Checked, mnuAutosize.Checked
    
  If Err.Number <> 0 Then
    lblInfo = "Error opening picture file..."
  Else
    imgGet.Visible = True
    imgGet.Refresh
  End If
End Sub

Private Sub mnuSaveOnGet_Click()
  mnuSaveOnGet.Checked = Not (mnuSaveOnGet.Checked)
End Sub

Private Sub mnuSavePixel_Click()
On Error Resume Next
  
  Dim strColor As String, blnTransparent As Boolean, msgReturn As VbMsgBoxResult
  strColor = InputBox("Enter the web color to create (ie: #003366)...", "Save Pixel")
  strColor = Trim(strColor)
  strColor = Replace(strColor, "#", "")
  
  If strColor = "" Then
    lblInfo = "Operation cancelled!"
    Exit Sub
  ElseIf Len(strColor) <> 6 Then
    lblInfo = "Invalid web color!"
    Exit Sub
  End If
  
  msgReturn = MsgBox("Would you like this pixel to be transparent?", vbYesNo, "Save Pixel")
  If msgReturn = vbYes Then
    blnTransparent = True
  Else
    blnTransparent = False
  End If
  
  cDialog.CancelError = True
  cDialog.DialogTitle = "Save Gif 1x1 Pixel..."
  cDialog.Filename = ""
  cDialog.Filter = "Gif 89a(*.gif)|*.gif"
  cDialog.FilterIndex = 1
  cDialog.Flags = cdlOFNOverwritePrompt

  cDialog.ShowSave
  If Err = cdlCancel Then
    lblInfo = "Operation cancelled!"
    Exit Sub
  End If
  
  MousePointer = vbHourglass
  xImage.MakePixel Trim(cDialog.Filename), strColor, blnTransparent
  MousePointer = vbNormal
      
  If xImage.ErrNumber <> 0 Then
    lblInfo = xImage.ErrDesc
  Else
    lblInfo = "Pixel save successful!"
  End If
End Sub

Private Sub mnuUseImage_Click()
  mnuUseImage.Checked = Not (mnuUseImage.Checked)
End Sub

Private Sub picHolder_DblClick()
  frmView.Show vbModal, Me
End Sub

Private Sub txtConnectionString_Change()
  xImage.ConnectionString = Trim(txtConnectionString)
End Sub

Private Sub txtConnectionString_GotFocus()
  SendKeys "{Home}+{End}"
End Sub

Private Sub txtDBColumn_Change()
  strColumn = Trim(txtDBColumn)
End Sub

Private Sub txtDBColumn_GotFocus()
  SendKeys "{Home}+{End}"
End Sub

Private Sub txtDBTable_Change()
  strTable = Trim(txtDBTable)
End Sub

Private Sub txtDBTable_GotFocus()
  SendKeys "{Home}+{End}"
End Sub

Private Sub txtPassword_Change()
  xImage.Password = Trim(txtPassword)
End Sub

Private Sub txtPassword_GotFocus()
  SendKeys "{Home}+{End}"
End Sub

Private Sub txtUID_Change()
  xImage.UID = Trim(txtUID)
End Sub

Private Sub txtUID_GotFocus()
  SendKeys "{Home}+{End}"
End Sub

Private Sub txtWhere_GotFocus()
  SendKeys "{Home}+{End}"
End Sub

Private Sub txtWhere_Change()
  strWhere = Trim(txtWhere)
End Sub

Private Sub mnuEdit_Click()
On Error Resume Next
  If Clipboard.GetFormat(2) Then
    mnuPaste.Enabled = True
  Else
    mnuPaste.Enabled = False
  End If
  
  If imgGet.Picture <> 0 Then
    mnuCopy.Enabled = True
  Else
    mnuCopy.Enabled = False
  End If
End Sub

Private Sub mnuCopy_Click()
On Error Resume Next
  Clipboard.Clear
  Clipboard.SetData imgGet.Picture
End Sub

Private Sub mnuPaste_Click()
On Error Resume Next
  imgGet.Visible = False
  imgGet.Stretch = False
  imgGet.Picture = Clipboard.GetData()
  lblInfo = imgGet.Width & "x" & imgGet.Height
  CreateThumb picHolder, imgGet, mnuCenterPic.Checked, mnuAutosize.Checked
  If Err.Number <> 0 Then
    lblInfo = Err.Description
  Else
    imgGet.Visible = True
    imgGet.Refresh
  End If
End Sub