adj1.frm

GDI 图形处理

         Caption         =   "对比度"
         Height          =   300
         Index           =   5
         Left            =   120
         TabIndex        =   28
         Tag             =   "Contrast"
         Top             =   2040
         Width           =   615
      End
      Begin VB.Label Label1 
         Caption         =   "亮度"
         Height          =   300
         Index           =   6
         Left            =   120
         TabIndex        =   27
         Tag             =   "Contrast"
         Top             =   2400
         Width           =   615
      End
      Begin VB.Label Label1 
         Caption         =   "色度"
         Height          =   300
         Index           =   7
         Left            =   120
         TabIndex        =   26
         Tag             =   "Contrast"
         Top             =   2760
         Width           =   615
      End
      Begin VB.Label Label1 
         Caption         =   "RG着色"
         Height          =   300
         Index           =   8
         Left            =   120
         TabIndex        =   25
         Tag             =   "Contrast"
         Top             =   3120
         Width           =   615
      End
   End
End
Attribute VB_Name = "Adj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Const SWP_DRAWFRAME = &H20
Const SWP_FRAMECHANGED = &H20        '  The frame changed: send WM_NCCALCSIZE
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Const ILLUMINANT_A = 1
Private Const ILLUMINANT_B = 2
Private Const ILLUMINANT_C = 3
Private Const ILLUMINANT_D50 = 4
Private Const ILLUMINANT_D55 = 5
Private Const ILLUMINANT_D65 = 6
Private Const ILLUMINANT_D75 = 7
Private Const ILLUMINANT_DAYLIGHT = ILLUMINANT_C
Private Const ILLUMINANT_DEVICE_DEFAULT = 0
Private Const ILLUMINANT_F2 = 8
Private Const ILLUMINANT_FLUORESCENT = ILLUMINANT_F2
Private Const ILLUMINANT_MAX_INDEX = ILLUMINANT_F2
Private Const ILLUMINANT_NTSC = ILLUMINANT_C
Private Const ILLUMINANT_TUNGSTEN = ILLUMINANT_A
Private Const CA_NEGATIVE = &H1
Private Const CA_LOG_FILTER = &H2

Const HALFTONE = 4
Const MF_BYPOSITION = &H400&
Const MF_REMOVE = &H1000&

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function GetColorAdjustment Lib "gdi32" (ByVal hdc As Long, lpca As COLORADJUSTMENT) As Long
Private Declare Function SetColorAdjustment Lib "gdi32" (ByVal hdc As Long, lpca As COLORADJUSTMENT) As Long
Private Declare Function GetStretchBltMode Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRECT As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, _
        ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, _
        ByVal nPosition As Long, ByVal wFlags As Long) As Long

Dim Hscrolinx As Byte, HscrolGotFocus As Boolean
Dim IllumIndex As Long, Flagsval As Byte, OptFlag As Boolean



Private Sub Command4_Click()
CA = dfCA
SetCa
If GetStretchBltMode(PicFrm.hdc) <> HALFTONE Then
    SetStretchBltMode PicFrm.hdc, HALFTONE
End If
SetColorAdjustment m_hDc, CA
StretchBlt m_hDc, 0, 0, BmpWidth, BmpHeight, Capfrm.hdc, 0, 0, BmpWidth, BmpHeight, vbSrcCopy
PicFrm.Refresh
End Sub



Private Sub Form_Initialize()
Dim Rec As RECT, WinWidth As Long, WinHeight As Long
Dim Inx As Byte
On Error GoTo err
m_AdjShow = True
m_Adjhwnd = Me.hwnd
GetWindowRect Me.hwnd, Rec
m_AdjW = Rec.Right - Rec.Left
m_AdjH = Rec.Bottom - Rec.Top
SetWindowPos m_Adjhwnd, HWND_TOPMOST, -m_AdjW, m_DisplayH - m_AdjH, m_AdjW, m_AdjH, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_DRAWFRAME 'Or SWP_NOSIZE Or SWP_NOMOVE
err:

End Sub

Private Sub Form_Load()
Dim hSysMenu As Long, nCnt As Long
Dim Inx As Byte

hSysMenu = GetSystemMenu(Me.hwnd, False)

    If hSysMenu Then
        ' Get System menu's menu count
        nCnt = GetMenuItemCount(hSysMenu)
        If nCnt Then
            ' Menu count is based on 0 (0, 1, 2, 3...)
            RemoveMenu hSysMenu, nCnt - 1, MF_BYPOSITION Or MF_REMOVE
            RemoveMenu hSysMenu, nCnt - 2, MF_BYPOSITION Or MF_REMOVE ' Remove the seperator
            DrawMenuBar Me.hwnd
        End If
    End If
    Combo1.AddItem "Device's default"
Combo1.AddItem "Tungsten lamp"
Combo1.AddItem "Noon sunlight"
Combo1.AddItem "NTSC daylight"
Combo1.AddItem "Normal print"
Combo1.AddItem "Bond paper print"
Combo1.AddItem "Standard daylight"
Combo1.AddItem "Northern daylight"
Combo1.AddItem "Cool white lamp"
Combo1.ListIndex = 0
IllumIndex = Combo1.ListIndex
SetCa
OptFlag = True
End Sub

Private Sub Form_LostFocus()
'WinMov
End Sub

Private Sub Form_Unload(Cancel As Integer)
OptFlag = False
m_AdjShow = False

End Sub

Private Sub HScroll1_Change(Index As Integer)

Dim Inx As Byte
Inx = Index
    If Inx < 3 Then
        Tmp = HScroll1(Inx).Value
        Tmp = Tmp * 100
        Text1(Inx).Text = Tmp
        
    End If
    If Inx = 3 Or Inx = 4 Then
        Text1(Inx).Text = HScroll1(Inx).Value * 10
        
    End If
    If Inx > 4 Then
        Text1(Inx).Text = HScroll1(Inx).Value
        
    End If
If HscrolGotFocus = True And OptFlag = True Then PicRfc

End Sub

Private Sub HScroll1_GotFocus(Index As Integer)
HscrolGotFocus = True
End Sub

Private Sub HScroll1_LostFocus(Index As Integer)
HscrolGotFocus = False

End Sub

Private Sub HScroll1_Scroll(Index As Integer)

Hscrolinx = Index
End Sub

Private Sub Option1_Click(Index As Integer)
Falgsval = Index + 1

End Sub

Private Sub Timer1_Timer()
Dim Tmp As Long
Dim Inx As Byte
For Inx = 0 To 8
    If Inx < 3 Then
        Tmp = HScroll1(Inx).Value
        Tmp = Tmp * 100
        Text1(Inx).Text = Tmp
    End If
    If Inx = 3 Or Inx = 4 Then
        Text1(Inx).Text = HScroll1(Inx).Value * 10
    End If
    If Inx > 4 Then
        Text1(Inx).Text = HScroll1(Inx).Value
    End If
Next Inx
End Sub
Private Sub SetCa()
'Dim CA As COLORADJUSTMENT
'GetColorAdjustment m_hDc, CA
Adj.Combo1.ListIndex = CA.caIlluminantIndex
Adj.HScroll1(0).Value = CA.caRedGamma \ 100
Adj.HScroll1(1).Value = CA.caGreenGamma \ 100
Adj.HScroll1(2).Value = CA.caBlueGamma \ 100
Adj.HScroll1(3).Value = CA.caReferenceBlack \ 10
Adj.HScroll1(4).Value = CA.caReferenceWhite \ 10
Adj.HScroll1(5).Value = CA.caContrast
Adj.HScroll1(6).Value = CA.caBrightness
Adj.HScroll1(7).Value = CA.caColorfulness
Adj.HScroll1(8).Value = CA.caRedGreenTint
If CA.caFlags < 0 Then Exit Sub
Adj.Option1(0).Value = CA.caFlags
End Sub
Private Sub PicRfc()
Dim Tmp As Single
Dim A As Long, B As Long
 DoEvents
    
    'retrieve the current color adjustment
    'GetColorAdjustment Picture2.hdc, CA
    'initialize the type
    CA.caSize = Len(CA)
    'set the brightness to darkest
    'set a new illuminant
    CA.caIlluminantIndex = IllumIndex
    Tmp = Val(Adj.Text1(0).Text)
    CA.caRedGamma = Tmp
    Tmp = Val(Adj.Text1(1).Text)
    CA.caGreenGamma = Tmp
    Tmp = Val(Adj.Text1(2).Text)
    CA.caBlueGamma = Tmp
    Tmp = Val(Adj.Text1(3).Text)
    CA.caReferenceBlack = Tmp
    Tmp = Val(Adj.Text1(4).Text)
    CA.caReferenceWhite = Tmp
    Tmp = Val(Adj.Text1(5).Text)
    CA.caContrast = Tmp
    Tmp = Val(Adj.Text1(6).Text)
    CA.caBrightness = Tmp
    Tmp = Val(Adj.Text1(7).Text)
    CA.caColorfulness = Tmp
    Tmp = Val(Adj.Text1(8).Text)
    CA.caRedGreenTint = Tmp
    CA.caFlags = Flagsval
    'check if the current StretchMode is set to HALFTONE
     If GetStretchBltMode(PicFrm.hdc) <> HALFTONE Then
        'if it's not, set it to HALFTONE
        SetStretchBltMode PicFrm.hdc, HALFTONE
    End If
    A = SetColorAdjustment(PicFrm.hdc, CA)
    'API uses pixels
    'PicFrm.Show
    B = StretchBlt(PicFrm.hdc, 0, 0, BmpWidth, BmpHeight, Capfrm.hdc, 0, 0, BmpWidth, BmpHeight, vbSrcCopy)
    If B = 0 Then
        MsgBox "参数设置错误！"
        Exit Sub
    End If
PicFrm.Refresh

End Sub