frmmain.frm

把文本信息加密到图片

   
  Me.Show 'Shows the form
  If chkFade.Value = vbChecked Then FormFadeIn Me 'Fades if enabled
  
  'Auto-pastes the text of the clipboard to the textbox if enabled
  If chkAutoPaste.Value = vbChecked Then rtxtEncrypt.Text = Clipboard.GetText
End Sub

Private Sub bxfOptions_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  'Removes underline from each of the labels
  Dim ix As Integer
  For ix = lblChooseOption.LBound To lblChooseOption.uBound
    If lblChooseOption(ix).FontUnderline <> 0 Then lblChooseOption(ix).FontUnderline = 0
  Next ix
End Sub

Private Sub chkLimitPicWidth_Click()
  'Enables/disabels the controls linked to chkLimitPicWidth
  txtPicWidth.Enabled = chkLimitPicWidth.Value
  lblPixels.Enabled = chkLimitPicWidth.Value
  cmdOptions(13).Enabled = chkLimitPicWidth.Value
  
  'User un-checked the checkbox:
  If chkLimitPicWidth.Value = vbUnchecked Then
    'Apply default width
    SetPicWidth picWidth
  Else
    'Calls the "OK"-button
    cmdOptions_Click 13
    If txtPicWidth.Visible = True Then txtPicWidth.SetFocus
  End If
End Sub

Private Sub chkOptionsInfo_Click()
  'Shows/hides the infomation-label
  lblOptionsInfo.Visible = chkOptionsInfo.Value
End Sub

Private Sub chkPictureInfo_Click()
  'Shows/hides the infomation-label
  lblPictureInfo.Visible = chkPictureInfo.Value
End Sub

Private Sub chkTextInfo_Click()
  'Shows/hides the infomation-label
  lblTextInfo.Visible = chkTextInfo.Value
End Sub

'---------------------------------------------------------------------------------------
' Procedure : cmdOptions_Click
' DateTime  : 03-04-2003 16:53 CET
' Author    : Anders Nissen, IcySoft
' Purpose   : This sub handles all the events of the commandboxes in the option-pages
'---------------------------------------------------------------------------------------
Private Sub cmdOptions_Click(Index As Integer)
  On Error GoTo cmdOptions_Click_Error

  Select Case Index
    
    '//   TEXT   \\
    Case 0
      lblPictureInfo.Caption = "加密中..."
      lblPictureInfo.Refresh
      'Encrypts the text!
      If isTrueColor Then lblPictureInfo.Caption = Encrypt(rtxtEncrypt.Text, picEncrypted)
      'Scrambles the picture if enabled
      If chkAutoScramble.Value = vbChecked Then Scramble picEncrypted, 2
      
    Case 1
      Dim TextSourceToLoad As String
      TextSourceToLoad = LoadPath("文本文件|*.txt")
      'Loads the chosen file
      If TextSourceToLoad <> "" Then rtxtEncrypt.LoadFile TextSourceToLoad
    
    Case 2
      Dim TextDestToSave As String
      TextDestToSave = SavePath("文本文件|*.txt")
      'Saves the text to the chosen destination
      If TextDestToSave <> "" Then rtxtEncrypt.SaveFile TextDestToSave
      
    Case 3
      'Copies the text of the textbox to the clipboard
      Clipboard.SetText rtxtEncrypt.Text
      
    Case 4
      'Pastes the text from the clipboard after the text in the textbox
      rtxtEncrypt.Text = rtxtEncrypt.Text & Clipboard.GetText
    
    '// PICTURE  \\
    Case 5
      lblTextInfo.Caption = "解码中...": lblTextInfo.Refresh
      'Decrypts the picture!
      If isTrueColor Then rtxtEncrypt.Text = Decrypt(picEncrypted)
      lblTextInfo.Caption = "解密完毕!"
    
    Case 6
      Dim PicSourceToLoad As String
      PicSourceToLoad = LoadPath("位图文件|*.bmp")
      'Loads the chosen file
      If PicSourceToLoad <> "" Then picEncrypted.Picture = LoadPicture(PicSourceToLoad)
        
    Case 7
      Dim PicDestToSave As String
      PicDestToSave = SavePath("位图文件|*.bmp")
      'Saves the picture to the chosen destination
      If PicDestToSave <> "" Then SavePicture picEncrypted.Image, PicDestToSave
    
    Case 8
      'Copies the content of the picturebox to the clipboard
      Clipboard.SetData picEncrypted.Image
    
    Case 9
      'Pastes the picture, if any, from the clipboard to the picturebox
      picEncrypted.Picture = Clipboard.GetData
    
    Case 10
      'Scrambles the picturebox making the picture un-readable (by this app anyway ;) )
      Scramble picEncrypted, 2 'InputBox("Enter a scramblecode between 1-10", , 5)
    
    Case 11
      'Un-scrambles a scrambled picture to make it readable
      Scramble picEncrypted, 2, True 'InputBox("Enter a scramblecode between 1-10", , 5), True
    
    '// SETTINGS \\
    
    Case 12
      'Sets the default values of the controls in the "Settings"-page
      chkAniMenus.Value = vbChecked
      chkFade.Value = vbChecked
      chkAutoScramble.Value = vbUnchecked
      chkAutoPaste.Value = vbUnchecked
      chkLimitPicWidth.Value = vbUnchecked
      chkLimitPicWidth.Caption = "Limit picturewidth"
      picEncrypted.Width = picWidth
      chkOptionsInfo.Value = vbChecked
      chkTextInfo.Value = vbChecked
      chkPictureInfo.Value = vbChecked
    
    Case 13
      Dim WidthLimit As Integer
      'Making sure the text is numeric and in twips
      WidthLimit = Val(txtPicWidth.Text) * Screen.TwipsPerPixelX 'In twips
    
      'Width is too small, too large or mistyped:
      If WidthLimit < 75 Or WidthLimit > picWidth Then 'All in twips
        MsgBox "Width outside limit or mistyped statement." & vbNewLine & _
          "Enter a value between 5-" & picWidth / Screen.TwipsPerPixelX, vbExclamation
        'Sets the text to the starting width of the picturebox
        txtPicWidth.Text = picWidth / Screen.TwipsPerPixelX
        'Sets the picturebox's width to the starting width of the picturebox
        SetPicWidth picWidth 'In twips
      Else
        'Given value is OK - applies the value to picturebox
        SetPicWidth WidthLimit 'In twips
      End If
      
      'Set focus if visible
      If txtPicWidth.Visible = True Then txtPicWidth.SetFocus
    
    Case Else
    '...hmmm, just has to be here!
    
  End Select

  'Error - ie. wrong datatype pasted into the picturebox ect.
  On Error GoTo 0
  Exit Sub
cmdOptions_Click_Error:
  MsgBox "发生错误!" & vbNewLine & _
    "错误 " & Err.Number & " (" & Err.Description & ")", vbCritical
End Sub

Private Sub Form_Unload(Cancel As Integer)
  'Fades the form if Fading is enabled
  If chkFade.Value = vbChecked Then FormFadeOut Me
  SaveOptions 'Saves the options in the registry
  End 'Closes the program
End Sub

Private Sub imgFormTop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  'Moves the form
  MoveForm Me
End Sub

Private Sub imgMinimize_Click()
  'Minimizing the form
  Me.WindowState = 1
End Sub

Private Sub imgUnload_Click()
  'Referers to the "Form_Unload"-sub
  Unload Me
End Sub

Private Sub lblChooseOption_Click(Index As Integer)
  'If the page is already active don't do anything
  If lblChooseOption(Index).ForeColor = vbBlack Then Exit Sub
  
  'Applying black forecolor to the current label and light-gray to the others
  Dim ix As Integer
  For ix = lblChooseOption.LBound To lblChooseOption.uBound
     lblChooseOption(ix).ForeColor = &HC0C0C0
     picOptions(ix).Visible = False
  Next ix
  lblChooseOption(Index).ForeColor = vbBlack
  lblChooseOption(Index).Refresh
  picOptions(Index).Visible = True 'Showing the selected option-page
  
  'Slides the picturebox if Animation of Optiontabs is enabled
  If chkAniMenus.Value = vbChecked Then
    For ix = 0 To picOptions(Index).Height Step picOptions(Index).Height / 35
      picOptions(Index).Height = ix
      picOptions(Index).Refresh
    Next ix
  End If
End Sub

Private Sub lblChooseOption_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  'Applying underline to the current label and removing it from the others
  Dim ix As Integer
  For ix = lblChooseOption.LBound To lblChooseOption.uBound
    If lblChooseOption(ix).FontUnderline <> 0 Then lblChooseOption(ix).FontUnderline = 0
  Next ix
  If lblChooseOption(Index).FontUnderline <> 1 Then lblChooseOption(Index).FontUnderline = 1
  'Writing the tag-info to lblOptionsInfo
  lblOptionsInfo.Caption = lblChooseOption(Index).Tag
End Sub

Private Sub lblTitel_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  'Selfexplaining - moves the form using API (see the function under "modAPI")
  MoveForm Me
End Sub

Private Sub rtxtEncrypt_Change()
  'Info about the text in the textbox
  lblTextInfo.Caption = "字符: " & Len(rtxtEncrypt.Text) & " 像素: " & _
    Round((Len(rtxtEncrypt.Text) / 3) + 1.5) 'Length of text in pixels
End Sub

Private Sub txtPicWidth_GotFocus()
  'Selects the text, if any, in the textbox when got focus
  txtPicWidth.SelStart = 0
  txtPicWidth.SelLength = Len(txtPicWidth.Text)
  lblOptionsInfo.Caption = txtPicWidth.Tag
End Sub

Private Sub picEncrypted_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  'Extracts the color- and char-values from the current (x,y) of the picture
  Dim PixelFarve As OLE_COLOR, Tegn1, Tegn2, Tegn3, Colors
  PixelFarve = picEncrypted.Point(X, Y)
  Tegn1 = Chr(RedFromRGB(PixelFarve))
  Tegn2 = Chr(GreenFromRGB(PixelFarve))
  Tegn3 = Chr(BlueFromRGB(PixelFarve))
  Colors = RedFromRGB(PixelFarve) & "," & GreenFromRGB(PixelFarve) & "," & BlueFromRGB(PixelFarve)
  'Shows the info in the label below the picture
  lblPictureInfo.Caption = "(" & X & "," & Y & ") RGB: " & Colors & " 字符: " & Tegn1 & Tegn2 & Tegn3
End Sub

Private Sub chkFade_KeyDown(KeyCode As Integer, Shift As Integer)
  'If the function is grayed (but not "enabled" to still allow the info the by shown)
  If chkFade.Value = vbGrayed Then
    'Explain why the function is unusable
    MsgBox "This function is not functional in your Operation System", vbInformation
    'Make sure the checkbox isn't changed
    chkFade.Value = vbGrayed
  End If
End Sub

Private Sub chkFade_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  'Refers to the chkFade_keyDown-sub
  chkFade_KeyDown 0, 0
End Sub

'---------------------------------------------------------------------------------------
' Procedure : cmdOptions_MouseMove
' DateTime  : 03-04-2003 16:32 CET
' Author    : Anders Nissen, IcySoft
' Purpose   : The following sub's are just for applying info about the controls to lblOptionsInfo
'---------------------------------------------------------------------------------------
Private Sub cmdOptions_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  lblOptionsInfo.Caption = cmdOptions(Index).Tag
End Sub

Private Sub chkAniMenus_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  lblOptionsInfo.Caption = chkAniMenus.Tag
End Sub

Private Sub txtPicWidth_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  lblOptionsInfo.Caption = txtPicWidth.Tag
End Sub

Private Sub chkTextInfo_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  lblOptionsInfo.Caption = chkTextInfo.Tag
End Sub

Private Sub chkAutoPaste_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  lblOptionsInfo.Caption = chkAutoPaste.Tag
End Sub

Private Sub chkPictureInfo_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  lblOptionsInfo.Caption = chkPictureInfo.Tag
End Sub

Private Sub chkAutoScramble_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  lblOptionsInfo.Caption = chkAutoScramble.Tag
End Sub

Private Sub chkFade_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  lblOptionsInfo.Caption = chkFade.Tag
End Sub

Private Sub chkLimitPicWidth_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  lblOptionsInfo.Caption = chkLimitPicWidth.Tag
End Sub

Private Sub chkOptionsInfo_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  lblOptionsInfo.Caption = chkOptionsInfo.Tag
End Sub