mdleffect.bas

VB实现的串口通信操作界面

Attribute VB_Name = "mdlEffect"
'*******************************************************************************
'** File Name  : mdlEffect.bas                                                **
'** Language   : Visual Basic 6.0                                             **
'** References : -                                                            **
'** Components : -                                                            **
'** Modules    : * mdlAPI (GetPixel and SetPixel)                             **
'**              * frmPaint (AdjustPaintResizeBox, DrawSelectionRect,         **
'**                          Form_Resize                                      **
'**              * mdlGeneral (ShowErrMessage)                                **
'** Developer  : Theo Zacharias ([e-mail])                           **
'** Description: A modul to handle image effect operations                    **
'** Last modified on August 15, 2003                                          **
'*******************************************************************************

Option Explicit

Public Enum enmEffect
  conEffFlipHorizontal = 0
  conEffFlipVertical = 1
  conEffResize = 2
  conEffRotate = 3
  conEffInvertColors = 4
End Enum

Public Const conZoomFactor = 1.25
Public Const conMaxImageWidth = 50000
Public Const conMaxImageHeight = 50000

'Properties for resize effect
Public sngResizeWidth As Single                             'resize width factor
Public sngResizeHeight As Single                           'resize height factor

'Properties for rotate effect
Public blnRotateClockWise As Boolean
Public sngRotateAngle As Single

' Purpose    : Apply effect intImageEffect to the selection (if any) or to the
'              paint area
' Assumption : These effect properties have been initiated:
'              - sngResizeWidth, sngResizeHeight (for resize effect)
'              - sngRotateAngle (degree type, for rotate effect)
' Effect     : As specified
' Inputs     : intEffect, pic, picTemp
' Returns    : pic (with effect applied)
Public Sub ApplyEffect(intEffect As enmEffect, _
                       ByRef pic As PictureBox, picTemp As PictureBox)
  Dim blnAutoSize As Boolean                     'to save picTemp.AutoSize value
  
  On Error GoTo ErrorHandler
  
  With pic
    blnAutoSize = picTemp.AutoSize
    picTemp.AutoSize = True
    picTemp.Width = .Width
    picTemp.Height = .Height
    picTemp.Picture = .Image
    .Picture = Nothing
    Select Case intEffect
      Case conEffFlipHorizontal
        .PaintPicture picTemp.Image, .ScaleWidth, 0, _
                      -.ScaleWidth, .ScaleHeight, , , , , vbSrcCopy
      Case conEffFlipVertical
        .PaintPicture picTemp.Image, 0, .ScaleHeight, _
                      .ScaleWidth, -.ScaleHeight, , , , , vbSrcCopy
      Case conEffInvertColors
        .PaintPicture picTemp.Image, 0, 0, _
                      .ScaleWidth, .ScaleHeight, , , , , vbSrcInvert
      Case conEffResize
        frmPaint.DrawSelectionRect
        .Visible = False
        .Width = .Width * sngResizeWidth
        .Height = .Height * sngResizeHeight
        .PaintPicture picTemp.Image, 0, 0, _
                      .ScaleWidth, .ScaleHeight, , , , , vbSrcCopy
        .Visible = True
        frmPaint.DrawSelectionRect
        frmPaint.AdjustPaintResizeBox
        frmPaint.Form_Resize
      Case conEffRotate
        If sngRotateAngle = 180 Then
          .PaintPicture picTemp.Image, .ScaleWidth, .ScaleHeight, _
                        -.ScaleWidth, -.ScaleHeight, , , , , vbSrcCopy
        Else
          ImageRotate picSource:=picTemp, picDestination:=pic, _
                      sngRotateAngle:=sngRotateAngle, _
                      blnClockWise:=blnRotateClockWise
        End If
    End Select
    picTemp.AutoSize = blnAutoSize
  End With
  Exit Sub

ErrorHandler:
  ShowErrMessage intErr:=conErrOthers, strErrMessage:=Err.Description
End Sub

' Purpose    : Rotate image picSource sngRotateAngle degree and save the result
'              in picDestination
' Assumptions: -
' Effect     : As specified
' Inputs     : picSource, picDestination, sngRotateAngle
' Return     : picDestination
Private Sub ImageRotate(picSource As PictureBox, _
                        picDestination As PictureBox, _
                        sngRotateAngle As Single, blnClockWise As Boolean)
  Const conPi = 3.14159265358979
  
  Dim A As Single                                            'angle of R and dXd
  Dim intMaxXY As Single 'maximum width or height of picDestination
  Dim dXs As Long         'relative coordinate where the pixel color information
  Dim dYs As Long         '                     will be retrieved from picSource
  Dim dXd As Long         'relative coordinate where the pixel color information
  Dim dYd As Long         '                    will be written to picDestination
  Dim lngAdjustX As Long                 'to adjust the new pixel coordinates to
  Dim lngAdjustY As Long                 ' make sure the whole part of the image
                                         '  is shown (currently only for 90