ficons.frm

一款漂亮的控件。 快

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmDrawState 
   Caption         =   "图标显示的不同方式"
   ClientHeight    =   5145
   ClientLeft      =   3870
   ClientTop       =   1980
   ClientWidth     =   5445
   Icon            =   "ficons.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5145
   ScaleWidth      =   5445
   Begin VB.PictureBox picCut 
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      Height          =   4710
      Left            =   4125
      ScaleHeight     =   4710
      ScaleWidth      =   855
      TabIndex        =   0
      Top             =   360
      Width           =   855
   End
   Begin ComctlLib.ImageList ilsIcons 
      Left            =   2640
      Top             =   360
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
         NumListImages   =   16
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":014A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":0464
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":077E
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":0A98
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":0DB2
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":10CC
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":13E6
            Key             =   ""
         EndProperty
         BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":1700
            Key             =   ""
         EndProperty
         BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":1A1A
            Key             =   ""
         EndProperty
         BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":1D34
            Key             =   ""
         EndProperty
         BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":204E
            Key             =   ""
         EndProperty
         BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":2368
            Key             =   ""
         EndProperty
         BeginProperty ListImage13 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":2682
            Key             =   ""
         EndProperty
         BeginProperty ListImage14 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":299C
            Key             =   ""
         EndProperty
         BeginProperty ListImage15 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":2CB6
            Key             =   ""
         EndProperty
         BeginProperty ListImage16 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "ficons.frx":2FD0
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmDrawState"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' Corrected Draw State function declarations:
Private Declare Function DrawState Lib "user32" Alias "DrawStateA" _
   (ByVal hdc As Long, _
   ByVal hBrush As Long, _
   ByVal lpDrawStateProc As Long, _
   ByVal lParam As Long, _
   ByVal wParam As Long, _
   ByVal X As Long, _
   ByVal Y As Long, _
   ByVal cX As Long, _
   ByVal cY As Long, _
   ByVal fuFlags As Long) As Long
Private Declare Function DrawStateString Lib "user32" Alias "DrawStateA" _
   (ByVal hdc As Long, _
   ByVal hBrush As Long, _
   ByVal lpDrawStateProc As Long, _
   ByVal lpString As String, _
   ByVal cbStringLen As Long, _
   ByVal X As Long, _
   ByVal Y As Long, _
   ByVal cX As Long, _
   ByVal cY As Long, _
   ByVal fuFlags As Long) As Long

' Missing Draw State constants declarations:
'/* Image type */
Private Const DST_COMPLEX = &H0
Private Const DST_TEXT = &H1
Private Const DST_PREFIXTEXT = &H2
Private Const DST_ICON = &H3
Private Const DST_BITMAP = &H4

' /* State type */
Private Const DSS_NORMAL = &H0
Private Const DSS_UNION = &H10
Private Const DSS_DISABLED = &H20
Private Const DSS_MONO = &H80
Private Const DSS_RIGHT = &H8000

' Create a new icon based on an image list icon:
Private Declare Function ImageList_GetIcon Lib "COMCTL32.DLL" ( _
        ByVal himl As Long, _
        ByVal i As Long, _
        ByVal diIgnore As Long _
    ) As Long
' Draw an item in an ImageList:
Private Declare Function ImageList_Draw Lib "COMCTL32.DLL" ( _
        ByVal himl As Long, _
        ByVal i As Long, _
        ByVal hdcDst As Long, _
        ByVal X As Long, _
        ByVal Y As Long, _
        ByVal fStyle As Long _
    ) As Long
' Draw an item in an ImageList with more control over positioning
' and colour:
Private Declare Function ImageList_DrawEx Lib "COMCTL32.DLL" ( _
      ByVal himl As Long, _
      ByVal i As Long, _
      ByVal hdcDst As Long, _
      ByVal X As Long, _
      ByVal Y As Long, _
      ByVal dx As Long, _
      ByVal dy As Long, _
      ByVal rgbBk As Long, _
      ByVal rgbFg As Long, _
      ByVal fStyle As Long _
   ) As Long
' Built in ImageList drawing methods:
Private Const ILD_NORMAL = 0
Private Const ILD_TRANSPARENT = 1
Private Const ILD_BLEND25 = 2
Private Const ILD_SELECTED = 4
Private Const ILD_FOCUS = 4
Private Const ILD_OVERLAYMASK = 3840
' Use default rgb colour:
Private Const CLR_NONE = -1

' Standard GDI draw icon function:
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Const DI_MASK = &H1
Private Const DI_IMAGE = &H2
Private Const DI_NORMAL = &H3
Private Const DI_COMPAT = &H4
Private Const DI_DEFAULTSIZE = &H8

' Clear up GDI object:
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
' Create a GDI brush:
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
' Get a System Colour (can use OLETranslateColor instead for this):
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Const COLOR_WINDOW = 5

Private Sub Draw()
Dim himl As Long
Dim hIcon As Long
Dim i As Long
Dim lR As Long
Dim hBr As Long
Dim lFlags As Long

    ' Create a green brush to colourise items in DrawText
   hBr = CreateSolidBrush(&HFF00&)
   
   ' Draw the headers using the DrawState function:
   DrawStateString Me.hdc, 0, 0, "正常", Len("Normal"), 25, 4, 50, 13, DST_TEXT Or DSS_NORMAL
   DrawStateString Me.hdc, 0, 0, "不可用", Len("Disabled"), 75, 4, 50, 13, DST_TEXT Or DSS_DISABLED
   DrawStateString Me.hdc, hBr, 0, "色彩", Len("Coloured"), 125, 4, 50, 13, DST_TEXT Or DSS_MONO
   DrawStateString Me.hdc, 0, 0, "Dithered", Len("Dithered"), 175, 4, 50, 13, DST_TEXT Or DSS_UNION

   DrawStateString Me.hdc, 0, 0, "被选择", Len("Selected"), 225, 4, 50, 13, DST_TEXT Or DSS_NORMAL
   DrawStateString Me.hdc, 0, 0, "剪切", Len("'Cut'"), 275, 4, 50, 13, DST_TEXT Or DSS_NORMAL

    ' Get the image list handle (note we do draw an item first to ensure it
    ' has been initialised, otherwise the code can error):
   ilsIcons.ListImages(1).Draw 0, 0, 0
   himl = ilsIcons.hImageList
   For i = 1 To ilsIcons.ListImages.Count
      ' Get an icon from the image list:
      hIcon = ImageList_GetIcon(himl, i - 1, 0)
      ' Draw it in standard state:
      DrawIconEx Me.hdc, 25, i * 20, hIcon, 16, 16, 0, 0, DI_NORMAL
      ' Now demonstrate the DrawState effects:
      lR = DrawState(Me.hdc, 0, 0, hIcon, 0, 75, i * 20, 16, 16, DST_ICON Or DSS_DISABLED)
      lR = DrawState(Me.hdc, hBr, 0, hIcon, 0, 125, i * 20, 16, 16, DST_ICON Or DSS_MONO)
      ' Note DSS_UNION (dithering) only seems to work in NT:
      lR = DrawState(Me.hdc, 0, 0, hIcon, 0, 175, i * 20, 16, 16, DST_ICON Or DSS_UNION)
      ' Clear up the Icon object:
      DeleteObject hIcon
      ' Image list drawing commands:
      lFlags = ILD_TRANSPARENT Or ILD_SELECTED
      ' Draw the icon in the selected state:
      lR = ImageList_Draw(himl, i - 1, Me.hdc, 225, i * 20, lFlags)
      ' Draw the icon in the selected state, but set the dithering colour to
      ' the Window background colour rather than the highlight colour to
      ' give the effect seen when you Cut a file in Explorer:
      lR = ImageList_DrawEx(himl, i - 1, picCut.hdc, 0, (i - 1) * 20, 0, 0, CLR_NONE, GetSysColor(COLOR_WINDOW), lFlags)

   Next i
   
   ' Clear up the Brush used to colourise the icon:
   DeleteObject hBr
   
   ' Show the cut icons (these are only drawn on a picture box so the
   ' background is the correct colour here):
   picCut.Refresh
   
End Sub

Private Sub Form_Paint()
    ' Refresh the form:
   Draw
End Sub