View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
RB Smissaert RB Smissaert is offline
external usenet poster
 
Posts: 2,452
Default APIs FindWindow and GetWindowText

Yes, interesting stuff, but didn't mean to cause an obsession ...
Better to put in the main Sub Application.ScreenUpdating = False
Also I get an error at ActiveChart.SeriesCollection.NewSeries
after some 2053 windows, 1004, application defined or object defined error.
Haven't looked yet why this is.

RBS

"Dave D-C" wrote in message
...
D-C wrote:
Insignificant speed issue, ,,


What I meant to say is that there is an insignificant gain in speed
because the same NEXT/CHILD path is followed.

I have been obsessed with these Windows APIs since your (RBS)
"Function FindWindowHwndLike" post of Sep 9.
Here is a pretty program which charts the active Windows structure,
siblings left-to-right, children bottom to top. D-C

Option Explicit
Private Declare Function GetDesktopWindow& Lib "user32" ()
Private Declare Function GetWindow& Lib "user32" ( _
ByVal hWnd As Long, _
ByVal wCmd As Long)
Private Declare Function GetWindowText& Lib "user32" _
Alias "GetWindowTextA" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long)
Private Declare Function GetClassName& Lib "user32" _
Alias "GetClassNameA" ( _
ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long)
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5

Dim gChartName$, gVert%, gRow&

Sub ChartWindowsMain()
ThisWorkbook.Activate
Charts.Add
gChartName = ActiveChart.Name
ActiveChart.ChartType = xlXYScatterLines
ActiveChart.Location Whe=xlLocationAsNewSheet
ActiveChart.HasLegend = False
Sheets("sheet1").Activate
ActiveSheet.Cells.Clear
gVert = 0 ' vertical on chart
gRow = 1 ' row on sheet
Call ChartWindowsSub(0, 1, 1) ' hwnd, row, horiz
Sheets(gChartName).Activate
Beep
End Sub

Sub ChartWindowsSub(hWndStart&, pRow1&, pHoriz%)
' based on FindWindowHwndLike by RB Smissaert
' These const's are to flag certain windows on sheet1
Const ClassName = "Vba", WindowTitle = ""
Dim hWndV&, hWndCh&, sWindowTitle$, sClassName$, r%
Dim Horiz%, Vert%, Children As New Collection, nChildren%, tArray
gVert = gVert + 1 ' each set of children has different vertical
Horiz = pHoriz ' this set starts here
Vert = gVert ' and here
hWndV = hWndStart
' 1st time is 0
If hWndV = 0 Then hWndV = GetDesktopWindow()
Do While hWndV 0 ' first, loop thru siblings and save children
' Get the window text
sWindowTitle = Space$(255)
r = GetWindowText(hWndV, sWindowTitle, 255)
sWindowTitle = Left$(sWindowTitle, r)
' get the class name
sClassName = Space$(255)
r = GetClassName(hWndV, sClassName, 255)
sClassName = Left$(sClassName, r)
Call zChart(Horiz, Vert, hWndV, sClassName, sWindowTitle)
' check for highlighting on sheet1
If sClassName Like ClassName & "*" And _
sWindowTitle Like WindowTitle & "*" Then
Cells(gRow - 1, 3).Interior.ColorIndex = 3 ' red
End If
' check for child and save it
hWndCh = GetWindow(hWndV, GW_CHILD)
If hWndCh < 0 Then
nChildren = nChildren + 1
' using collection because it's easier with unknown dimension?
Children.Add Array(hWndCh, Horiz, Vert), Format(nChildren)
End If
Horiz = Horiz + 1
hWndV = GetWindow(hWndV, GW_HWNDNEXT)
Loop
' This set of siblings finished, addSeries
Call zAddSeries(pRow1, gRow - 1)
' Now go backwards thru children
' Going backwards prevents lines crossing
Do While nChildren 0
' this is the parent node
tArray = Children(nChildren)
hWndV = tArray(0)
Horiz = tArray(1)
Vert = tArray(2)
Call zChart(Horiz, Vert, 0, "", "")
' Recursive call for siblings
Call ChartWindowsSub(hWndV, gRow - 1, Horiz)
nChildren = nChildren - 1
Loop
End Sub

Sub zChart(pHoriz%, pVert%, phWnd&, pC$, pT$)
' Populate sheet1
Cells(gRow, 1) = pHoriz
Cells(gRow, 2) = pVert
If phWnd < 0 Then Cells(gRow, 3) = phWnd
Cells(gRow, 4) = pC
Cells(gRow, 5) = pT
gRow = gRow + 1
End Sub

Sub zAddSeries(pRow1&, pRow9&)
' Add series to chart
Sheets(gChartName).Activate
ActiveChart.SeriesCollection.NewSeries
With
ActiveChart.SeriesCollection(ActiveChart.SeriesCol lection.Count)
.XValues = "=Sheet1!" & zR1R2C(pRow1, pRow9, 1)
.Values = "=Sheet1!" & zR1R2C(pRow1, pRow9, 2)
.MarkerBackgroundColorIndex = 1
.MarkerForegroundColorIndex = 1
.MarkerStyle = xlCircle
.MarkerSize = 4
.Border.ColorIndex = 1
.Border.Weight = xlThin
.Border.LineStyle = xlContinuous
End With
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone,
LegendKey:=False
Sheets("Sheet1").Activate
End Sub

Function zR1R2C$(pRow1&, pRow2&, pCol%)
' make R1C1:R2C1
zR1R2C = "R" & Format(pRow1) & "C" & Format(pCol) & _
":R" & Format(pRow2) & "C" & Format(pCol)
End Function

----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet
News==----
http://www.newsfeeds.com The #1 Newsgroup Service in the World! 120,000+
Newsgroups
----= East and West-Coast Server Farms - Total Privacy via Encryption
=----