Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/sgwnd10/test.frm

Visual Basic Form | 1998-08-12 | 5.5 KB | 162 lines

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Object = "{D488E33C-3223-11D2-987F-204C4F4F5020}#1.0#0"; "COMBOE~1.OCX"
Begin VB.Form frmTest
   Caption         =   "SG Window - ComboBoxEx Sample"
   ClientHeight    =   3540
   ClientLeft      =   2640
   ClientTop       =   1740
   ClientWidth     =   7656
   Icon            =   "Test.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   3540
   ScaleWidth      =   7656
   Begin ComboExControl.ComboEx ComboEx1
      Height          =   0
      Left            =   108
      Top             =   144
      Width           =   7392
      _ExtentX        =   13039
      _ExtentY        =   0
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Style           =   0
   End
   Begin ComctlLib.ImageList imlWindows
      Left            =   6960
      Top             =   2700
      _ExtentX        =   804
      _ExtentY        =   804
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   327682
   End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type PictDesc
  cbSizeofStruct As Long
  picType As Long
  hImage As Long
  xExt As Long
  yExt As Long
End Type
Private Type Guid
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type
Private Const SRCCOPY = &HCC0020
Private Type RECT
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
   (lpPictDesc As PictDesc, riid As Guid, ByVal fPictureOwnsHandle As Long, _
   ipic As IPicture) As Long
Private Declare Function BitBlt Lib "gdi32" _
   (ByVal hDestDC 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 dwRop As Long) As Long
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 GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
 Function ConvertIcon(hIcon&) As Picture
   Dim lOk&
    If hIcon = 0 Then Exit Function
    Dim NewPic As Picture, PicConv As PictDesc, IGuid As Guid
    PicConv.cbSizeofStruct = Len(PicConv)
    PicConv.picType = vbPicTypeIcon
    PicConv.hImage = hIcon
    IGuid.Data1 = &H20400
    IGuid.Data4(0) = &HC0
    IGuid.Data4(7) = &H46
    lOk = OleCreatePictureIndirect(PicConv, IGuid, False, NewPic)
   If lOk = 0 Then
      Set ConvertIcon = NewPic
   Else
      Set ConvertIcon = imlWindows.ListImages(1).Picture
   End If
End Function
Private Sub FillCombo(clsWindow As Window, Optional iIndent As Integer = 0)
   Dim clsChild As Window, iIcon%, lWinIcon&
   Dim sText$, pic As StdPicture
   ' Get window icon
   Set pic = clsWindow.Icon(sgSmall_16x16)
   If pic Is Nothing Then
      Set pic = clsWindow.Icon(sgBig_32x32)
      If pic Is Nothing Then iIcon = 1
   End If
   If Not pic Is Nothing Then
      imlWindows.ListImages.Add , , pic
      iIcon = imlWindows.ListImages.Count
   End If
   ' Get window text and insert new item into the combo
   sText = clsWindow.Class & " - '" & clsWindow.Text & "'"
   ComboEx1.AddItem sText, iIcon, iIndent
   ComboEx1.ItemData(ComboEx1.NewIndex) = clsWindow.hWnd
   ' Add children to the combo
   For Each clsChild In clsWindow.Children
      FillCombo clsChild, iIndent + 1
   Next
End Sub
Private Sub ShowWindow()
   Dim rc As RECT
   Me.Cls
   GetWindowRect ComboEx1.ItemData(ComboEx1.ListIndex), rc
   Call StretchBlt(Me.hdc, 10, 35, rc.Right - rc.Left, rc.Bottom - rc.Top _
      , GetDC(ComboEx1.ItemData(ComboEx1.ListIndex)), _
      0, 0, rc.Right - rc.Left, rc.Bottom - rc.Top, SRCCOPY)
End Sub
Private Sub ComboEx1_Click()
   ShowWindow
End Sub
Private Sub ComboEx1_KeyDown(KeyCode As Integer, Shift As Integer)
   Me.Cls
Me.CurrentX = 7000
Me.CurrentY = 120
   Print KeyCode & " is pressed"
End Sub
Private Sub Form_Click()
   ComboEx1.SetFocus
End Sub
Private Sub Form_DblClick()
   Dim i%
   For i = 0 To ComboEx1.ListCount - 1
      ComboEx1.ListIndex = i
      DoEvents
   Next
   ComboEx1.ListIndex = 0
End Sub
Private Sub Form_Load()
   Dim clsDesktop As New sgWindow.Window
   clsDesktop.AttachDesktop
   ComboEx1.ImageList = imlWindows
   FillCombo clsDesktop
   ComboEx1.ListIndex = 0
End Sub
Private Sub Form_Resize()
   On Error Resume Next
   ComboEx1.Width = Me.ScaleWidth - ComboEx1.Left * 2
End Sub
Private Sub imlWindows_Click()
End Sub