home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sgwnd10 / form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-08-09  |  10.5 KB  |  301 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "SGWindow Test"
  5.    ClientHeight    =   5160
  6.    ClientLeft      =   120
  7.    ClientTop       =   576
  8.    ClientWidth     =   7896
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   5160
  13.    ScaleWidth      =   7896
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin VB.Frame Frame1 
  16.       Height          =   1044
  17.       Left            =   108
  18.       TabIndex        =   4
  19.       Top             =   3996
  20.       Width           =   2532
  21.       Begin VB.Label lblDescr 
  22.          Height          =   792
  23.          Left            =   72
  24.          TabIndex        =   5
  25.          Top             =   180
  26.          Width           =   2352
  27.          WordWrap        =   -1  'True
  28.       End
  29.    End
  30.    Begin VB.CommandButton cmdExit 
  31.       Caption         =   "E&xit"
  32.       Height          =   408
  33.       Left            =   6516
  34.       TabIndex        =   1
  35.       Top             =   3540
  36.       Width           =   1236
  37.    End
  38.    Begin VB.ListBox lstTests 
  39.       Height          =   3528
  40.       IntegralHeight  =   0   'False
  41.       ItemData        =   "Form1.frx":0000
  42.       Left            =   120
  43.       List            =   "Form1.frx":0002
  44.       TabIndex        =   0
  45.       Top             =   432
  46.       Width           =   2532
  47.    End
  48.    Begin VB.Frame frm1 
  49.       Height          =   1044
  50.       Left            =   2772
  51.       TabIndex        =   2
  52.       Top             =   3996
  53.       Width           =   5016
  54.       Begin VB.Label lblMessage 
  55.          BeginProperty Font 
  56.             Name            =   "Courier"
  57.             Size            =   9.6
  58.             Charset         =   0
  59.             Weight          =   400
  60.             Underline       =   0   'False
  61.             Italic          =   0   'False
  62.             Strikethrough   =   0   'False
  63.          EndProperty
  64.          Height          =   744
  65.          Left            =   108
  66.          TabIndex        =   3
  67.          Top             =   180
  68.          Width           =   4800
  69.       End
  70.    End
  71.    Begin VB.Frame frameTest 
  72.       Height          =   3648
  73.       Left            =   2772
  74.       TabIndex        =   6
  75.       Top             =   324
  76.       Width           =   3612
  77.    End
  78.    Begin VB.Label lblTest 
  79.       Alignment       =   1  'Right Justify
  80.       Height          =   252
  81.       Left            =   4260
  82.       TabIndex        =   9
  83.       Top             =   60
  84.       Width           =   2112
  85.    End
  86.    Begin VB.Label lblAttachedWnd 
  87.       Height          =   252
  88.       Left            =   1320
  89.       TabIndex        =   8
  90.       Top             =   60
  91.       Width           =   3132
  92.    End
  93.    Begin VB.Label Label1 
  94.       Caption         =   "Attached Wnd:"
  95.       Height          =   252
  96.       Left            =   120
  97.       TabIndex        =   7
  98.       Top             =   60
  99.       Width           =   1092
  100.    End
  101.    Begin VB.Menu mnuFile 
  102.       Caption         =   "File"
  103.       Begin VB.Menu mnuFileExit 
  104.          Caption         =   "E&xit"
  105.       End
  106.    End
  107. Attribute VB_Name = "frmMain"
  108. Attribute VB_GlobalNameSpace = False
  109. Attribute VB_Creatable = False
  110. Attribute VB_PredeclaredId = True
  111. Attribute VB_Exposed = False
  112. Option Explicit
  113. ' --- SG Window objects
  114. Public WithEvents g_wndTest As sgWindow.Window
  115. Attribute g_wndTest.VB_VarHelpID = -1
  116. Public WithEvents g_wndForm As sgWindow.Window
  117. Attribute g_wndForm.VB_VarHelpID = -1
  118. ' Tests structures
  119. Private Type TestType
  120.    nID As Integer       ' Test code
  121.    sName As String      ' User readable test name
  122.    sDescr As String     ' Test description
  123.    frm As Form
  124. End Type
  125. Private Type Tests
  126.    nTests As Integer          ' Total number of tests
  127.    nCurrTest  As Integer      ' Active test
  128.    arrTests() As TestType     ' Array of test structures
  129. End Type
  130. Private g_Tests As Tests
  131. ' Misc constants
  132. Const g_TestFormLeft% = 40
  133. Const g_TestFormTop% = 160
  134. Public Function GetWindowDescription(wnd As sgWindow.Window) As String
  135.    If Len(wnd.Text) <> 0 Then
  136.       GetWindowDescription = wnd.Class & " - " & wnd.Text
  137.    Else
  138.       GetWindowDescription = wnd.Class & " ID: " & CStr(wnd.id)
  139.    End If
  140. End Function
  141. Private Sub ShowTest(nTest%)
  142.    If (nTest < -1) Or (nTest > g_Tests.nTests - 1) Then Exit Sub
  143.    ' Hide current test
  144.    Dim w As New sgWindow.Window
  145.    If (g_Tests.nCurrTest >= 0) Then
  146.       w.HWND = g_Tests.arrTests(g_Tests.nCurrTest).frm.HWND
  147.       w.Visible = False
  148.       lblTest.Caption = "TEST:"
  149.    End If
  150.    ' Show test
  151.    If (nTest > -1) Then
  152.       Dim frm As Form
  153.       Set frm = g_Tests.arrTests(nTest).frm
  154.       
  155.       ' Attach form to the SGWindow object
  156.       w.HWND = frm.HWND
  157.       
  158.       ' Main form should be parent of the form containing test.
  159.       If w.Parent.HWND <> Me.HWND Then
  160.          w.Parent = g_wndForm
  161.       End If
  162.       
  163.       ' Position and show test form
  164.       PositionTestFrame frm
  165.       w.Visible = True
  166.       lblTest.Caption = "TEST: " & frm.Caption
  167.    End If
  168.    g_Tests.nCurrTest = nTest
  169.    If Me.Visible Then Me.SetFocus
  170.    InitializeTest nTest
  171. End Sub
  172. Private Sub InitializeTest(nTest%)
  173.    Select Case nTest + 1
  174.       Case 1:  frmTest1.RefeshWindows
  175.       Case 2:  frmTest2.txtClass = g_wndTest.Class
  176.       Case 3:  frmTest3.txtText = g_wndTest.Text
  177.       Case 4:  frmTest4.RefreshStyles
  178.       Case 5:  frmTest5.RefreshStyles
  179.       Case 6:  frmTest6.RefreshPosition
  180.       Case 7:
  181.       Case 8:  frmTest8.RefreshState
  182.       Case 11: frmTest11.RefreshState
  183.       Case 19: frmTest18.RefreshState
  184.       
  185.       Case Else
  186.    End Select
  187. End Sub
  188. Private Sub PositionTestFrame(frm As Object)
  189.    frm.left = frameTest.left + g_TestFormLeft - Me.left
  190.    frm.top = frameTest.top + g_TestFormTop
  191. End Sub
  192. Private Sub AddTest(id%, name$, descr$, frm As Form)
  193.    Dim test As TestType
  194.    test.nID = id
  195.    test.sName = name
  196.    test.sDescr = descr
  197.    Set test.frm = frm
  198.    g_Tests.arrTests(g_Tests.nTests) = test
  199.    g_Tests.nTests = g_Tests.nTests + 1
  200.    Load frm
  201.    frm.Caption = test.sName
  202.    If Not g_wndForm Is Nothing Then
  203.       Dim w As New sgWindow.Window
  204.       w.HWND = frm.HWND
  205.       w.Parent = g_wndForm
  206.    End If
  207. End Sub
  208. Private Sub OnLoad()
  209.    ' Initialize tests array
  210.    ReDim g_Tests.arrTests(32)
  211.    g_Tests.nTests = 0
  212.    AddTest 1, "Attach", "Demonstrates how to attach window handle (HWND) to the SGWindow object and how to enumerate windows", frmTest1
  213.    AddTest 2, "Class", "Retrieve window class name", frmTest2
  214.    AddTest 3, "Text", "Retrieve or set window text (caption)", frmTest3
  215.    AddTest 4, "Style", "Retrive or set window style", frmTest4
  216.    AddTest 5, "Extended style", "Retrive or set window extended style", frmTest5
  217.    AddTest 6, "Position", "Retrieve or set window position", frmTest6
  218.    AddTest 7, "Visible", "Retrieve or set window visibility state", frmTest7
  219.    AddTest 8, "Destroy", "Destroy window attached window", frmTest8
  220.    AddTest 9, "SendMessage", "Send message to the attached window", frmTest9
  221.    AddTest 10, "Freeze events", "Freeze SG Window events", frmTest10
  222.    AddTest 11, "Hooked", "Enables or disables window message subclassing", frmTest11
  223.    AddTest 12, "Enable message", "Adds or removes message from the collection of messages that fires events", frmTest12
  224.    AddTest 13, "Find window", "Finds specified window", frmTest13
  225.    AddTest 14, "Insert into system menu", "Insert menu item into the system menu", frmTest14
  226.    AddTest 15, "Create window", "Demonstrates how to create and manage window using Win32 API", frmTest15
  227.    AddTest 16, "Client paint", "Demonstrates painting on the window client area", frmTest16
  228.    AddTest 17, "Frame paint", "Demonstrates painting on the window frame area", frmTest22
  229.    AddTest 18, "Print", "Print a window to the supplied device context", frmTest17
  230.    AddTest 19, "Redraw", "Redraw window", frmTest18
  231.    AddTest 20, "Top level parent", "Retrieve top level parent of the attached window", frmTest19
  232.    AddTest 21, "Icon", "Retrieve icon from the attache window", frmTest20
  233.    AddTest 22, "Send keys", "Send keybord messages to the attached window", frmTest21
  234.    AddTest 23, "Simple frame paint", "Demonstrates painting on the window frame area. This sample paints over the default caption.", frmTest23
  235.    AddTest 24, "Append Menu", "Demonstrates how to update forms menu at runtime.", frmTest24
  236.    ' Load tests listbox
  237.    Dim i%
  238.    For i = 0 To g_Tests.nTests - 1
  239.      lstTests.AddItem g_Tests.arrTests(i).sName
  240.    Next
  241.    ShowTest 0
  242.    frmTest1.RefeshWindows
  243. End Sub
  244. Private Sub GetSelectedTest(ByRef tst As TestType)
  245.    tst.nID = 0
  246.    If lstTests.ListIndex = -1 Then Exit Sub
  247.    Dim sSel$, i%
  248.    sSel = lstTests.List(lstTests.ListIndex)
  249.    For i = 0 To g_Tests.nTests - 1
  250.       If sSel = g_Tests.arrTests(i).sName Then
  251.          tst.nID = g_Tests.arrTests(i).nID
  252.          tst.sDescr = g_Tests.arrTests(i).sDescr
  253.          tst.sName = g_Tests.arrTests(i).sName
  254.       End If
  255.    Next
  256. End Sub
  257. Private Function FormatMessage(msg As Long, wParam As Long, lParam As Long)
  258.    Dim sMsg$
  259.    sMsg = "Message: " & GetMessageName(msg) & " - " & CStr(msg) & vbCrLf & _
  260.           "wParam:  " & CStr(wParam) & ", Lo=" & CStr(sgWindow.LowWord(wParam)) & ", Hi=" & CStr(sgWindow.HighWord(wParam)) & vbCrLf & _
  261.           "lParam:  " & CStr(lParam) & ", Lo=" & CStr(sgWindow.LowWord(lParam)) & ", Hi=" & CStr(sgWindow.HighWord(lParam))
  262.    FormatMessage = sMsg
  263. End Function
  264. Private Sub OnClose()
  265.    Dim i%
  266.    For i = 0 To g_Tests.nTests - 1
  267.      Unload g_Tests.arrTests(i).frm
  268.    Next
  269. End Sub
  270. Private Sub cmdExit_Click()
  271.     Unload Me
  272. End Sub
  273. Private Sub Form_Load()
  274.    ' Initialize Window object
  275.    Set g_wndForm = New sgWindow.Window
  276.    g_wndForm.HWND = Me.HWND
  277.    g_wndForm.Hooked = True
  278.    Set g_wndTest = New sgWindow.Window
  279.    g_wndTest.HWND = Me.HWND
  280.    g_wndTest.Hooked = True
  281.    g_wndTest.EnableMessage wm_MOUSEMOVE
  282.    OnLoad
  283. End Sub
  284. Private Sub Form_Unload(Cancel As Integer)
  285.    OnClose
  286. End Sub
  287. Private Sub lstTests_Click()
  288.    Dim tst As TestType
  289.    GetSelectedTest tst
  290.    lblDescr.Caption = tst.sDescr
  291.    ShowTest tst.nID - 1
  292. End Sub
  293. Private Sub mnuFileExit_Click()
  294.     OnClose
  295.     Unload Me
  296. End Sub
  297. Private Sub g_wndTest_Message(ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef result As Long)
  298.    Me.lblMessage = FormatMessage(msg, wParam, lParam)
  299.    result = g_wndTest.CallWindowProc(msg, wParam, lParam)
  300. End Sub
  301.