Bay Six Software - Demos - More / Less dialog

Bay Six Software
Beyond the Basics

Profile

Bay Six Software Forum Index

Demos - More / Less dialog

More / Less dialog

Less	More

Code:

'**********************************************************************
' More/Less Demo
' By Brent D. Thorn, 7/2006
' PUBLIC DOMAIN
'**********************************************************************

' NoMainWin

If Val(Version$) < 4 Then
Notice "Code requires LB 4.0 or later."
End
End If

Global g.hInst

CallDLL #kernel32, "GetModuleHandleA", _
_NULL As Long, _
g.hInst As ULong

Call MLDemo.Open

Call DoEvents

Sub DoEvents
[localLoop]
Scan
CallDLL #kernel32, "Sleep", _
50 As Long, _
ret As Void
GoTo [localLoop]
End Sub

Sub MLDemo.Open
' Create dialog fully expanded.
WindowWidth = 276
WindowHeight = 158

' The "Less" controls.
' stcIcon will display an icon.
StaticText #MLDemo.stcIcon, "", 10, 10, 32, 32
StyleBits #MLDemo.stcIcon, _SS_ICON, 0, 0, 0
StaticText #MLDemo.stcLess, "Something happened!", 48, 10, 144, 32
Button #MLDemo.default, "OK", MLDemo.btnOK.Click, UL, 200, 10, 60, 25
' btnMorL is the toggle button.
Button #MLDemo.btnMorL, "Mor&e >>", MLDemo.btnMorL.Click, UL, 200, 40, 60, 25

' The "More" controls.
' Positions must be relative to the container created after opening window.
CheckBox #MLDemo.chkLock, "&Lock", MLDemo.chkLock.Set, MLDemo.chkLock.Reset, 200, 5, 60, 20
' txtMore needs to have a vert. scroll bar and be read-only.
TextBox #MLDemo.txtMore, 10, 5, 180, 48
StyleBits #MLDemo.txtMore, _ES_READONLY Or _WS_VSCROLL, _ES_AUTOHSCROLL, 0, 0

' Center the dialog and open it hidden.
StyleBits #MLDemo, _DS_CENTER, _WS_VISIBLE, 0, 0

Open "More/Less Demo" For Dialog As #MLDemo

' Set LB event handlers.
#MLDemo "TrapClose MLDemo.Close"

' Set controls' initial text or setting.
#MLDemo.txtMore "What that something is I do not know."

' Get "warning" icon and show it in stcIcon.
ret = SendMessageLong(HWnd(#MLDemo.stcIcon), _STM_SETICON, _
GetOEMIcon(_IDI_EXCLAMATION), 0)

' Set up More/Less controls and display contracted view.
Call CreateMoreOrLess "#MLDemo", "txtMore chkLock", "Less", 0, 65, 276, 53
End Sub

Sub MLDemo.Close wnd$
Close #wnd$

End
End Sub

Sub MLDemo.btnMorL.Click btn$
' Get handle of parent window.
wnd$ = Word$(btn$, 1, ".")

' Toggle More/Less state vertically.
If ShowMoreOrLessV$(wnd$) = "More" Then
#btn$ "Mor&e >>"
Else
#btn$ "L&ess <<"
End If
End Sub

Sub MLDemo.btnOK.Click btn$
' Get handle of parent window.
wnd$ = Word$(btn$, 1, ".")
' Explicitly call the "Close" event handler.
Call MLDemo.Close wnd$
End Sub

Sub MLDemo.chkLock.Set chk$
' Get handle of parent window.
wnd$ = Word$(chk$, 1, ".")
' Get handle of btnMorL button and disable it.
btnMorL$ = wnd$ + ".btnMorL"
#btnMorL$ "!Disable"
End Sub

Sub MLDemo.chkLock.Reset chk$
' Get handle of parent window.
wnd$ = Word$(chk$, 1, ".")
' Get handle of btnMorL button and enable it.
btnMorL$ = wnd$ + ".btnMorL"
#btnMorL$ "!Enable"
End Sub

'**********************************************************************
' More/Less Management
'**********************************************************************

Sub CreateMoreOrLess Window$, CtlExts$, MoreOrLess$, X, Y, Width, Height
'-- Purpose: Helps easily implement a "More/Less" style of window. Creates a
' container control, sets some special attributes, moves controls into con-
' tainer, and adjusts the window's dimensions.
'-- Parameters:
' - Window$: a handle to the parent window
' - CtlExts$: a space-separated list of control extensions without leading
' dots (e.g. control #wnd.ext would be listed as "ext")
' - MoreOrLess$: a string, either "More" or "Less" to indicate the desired
' initial state, expanded or collapsed, respectively.
' - X, Y: the position where the container is created. If X is less than or
' equal to Y, the window will expand vertically. If Y is less than X, then
' the window will expand horizontally.
' - Width, Height: the size of the container
'-- Dependencies:
' - Subs: GetClientSize, GetWindowRect, SetControlsParent, SetWindowPos,
' ShowWindow
'-- Note #1: The parent window must be opened with its WindowWidth and Window-
' Height the same as its fully expanded view.
'-- Note #2: The parent window should be hidden before opening by removing the
' _WS_VISIBLE style bit.

hWindow = HWnd(#Window$)

' Create the "More" container hidden.
hCon = CreateContainer(0, 0, X, Y, Width, Height, hWindow, g.hInst, 0)

' Set container's text so it can be found easily. This text will not show
' on-screen.
CallDLL #user32, "SetWindowTextA", hCon As ULong, "MoreContainer" As Ptr, _
ret As Long

' Have container "adopt" controls.
Call SetControlsParent Window$, CtlExts$, hCon

' Set up the desire initial view.
If Lower$(MoreOrLess$) = "less" Then
' Get outside dimensions.
Call GetWindowRect hWindow

If X <= Y Then
' Expands/contracts vertically. Save width.
cx = WindowRect.right.struct - WindowRect.left.struct + 1

' Compute new height minus container.
Call GetClientSize hCon, 0, cy
cy = WindowRect.bottom.struct - WindowRect.top.struct - cy
Else
' Expands/contracts horizontally. Save height.
cy = WindowRect.bottom.struct - WindowRect.top.struct + 1

' Compute new width minus container.
Call GetClientSize hCon, cx, 0
cx = WindowRect.right.struct - WindowRect.left.struct - cx
End If

' Adjust outside dimensions and show the window.
Call SetWindowPos hWindow, _NULL, 0, 0, cx, cy, _
_SWP_SHOWWINDOW Or _SWP_NOZORDER Or _SWP_NOMOVE
Else
' If it isn't "less," assume it's "more." Just show container & window.
Call ShowWindow hCon, _SW_SHOW
Call ShowWindow hWindow, _SW_SHOW
End If
End Sub

Function ShowMoreOrLessV$( Window$ )
'-- Purpose: Toggles a More/Less window between expanded or contracted views
' in the VERTICAL orientation.
'-- Returns: Usually a suggestion for the text for the toggle control (usually
' a button).
' - "More": Window is contracted.
' - "Less": Window is expanded.
' - "Error": An error occurred. Usually happens when CreateMoreOrLess has not
' been previously called.
'-- Dependencies:
' - Subs: CreateMoreOrLess, GetClientSize, GetWindowRect, ShowWindow

hWindow = HWnd(#Window$)

' Find the "More" container.
hCon = FindWindowEx(hWindow, _NULL, "#32770", "MoreContainer")

If hCon = 0 Then
ShowMoreOrLess$ = "Error"
Exit Function
End If

' Get outside dimensions of parent window.
Call GetWindowRect HWnd(#Window$)
cx = WindowRect.right.struct - WindowRect.left.struct + 1

' Get client height of container.
Call GetClientSize hCon, 0, cy

CallDLL #user32, "IsWindowVisible", hCon As ULong, tis As Long

If tis Then
' Container if showing, prepare to hide it.
showCmd = _SW_HIDE

' Compute new outside height minus container.
cy = WindowRect.bottom.struct - WindowRect.top.struct - cy

' Return suggested text for button.
ShowMoreOrLessV$ = "More"
Else
' Container is hidden, prepare to show it.
showCmd = _SW_SHOW

' Compute new outside height plus container.
cy = WindowRect.bottom.struct - WindowRect.top.struct + cy

' Return suggested text for button.
ShowMoreOrLessV$ = "Less"
End If

' Adjust outside height.
Call SetWindowPos hWindow, _NULL, 0, 0, cx, cy, _
_SWP_NOZORDER Or _SWP_NOMOVE

' Finally show or hide container. Doing so here eliminates flicker.
Call ShowWindow hCon, showCmd
End Function

Function ShowMoreOrLessH$( Window$ )
'-- Purpose: Toggles a More/Less window between expanded or contracted views
' in the HORIZONTAL orientation.
'-- Returns: Usually a suggestion for the text for the toggle control (usually
' a button).
' - "More": Window is contracted.
' - "Less": Window is expanded.
' - "Error": An error occurred. Usually happens when CreateMoreOrLess has not
' been previously called.
'-- Dependencies:
' - Subs: CreateMoreOrLess, GetClientSize, GetWindowRect, ShowWindow

hWindow = HWnd(#Window$)

' Find the "More" container.
hCon = FindWindowEx(hWindow, _NULL, "#32770", "MoreContainer")

If hCon = 0 Then
Print "ERROR! ShowMoreOrLessH$ cannot find container control."
Exit Function
End If

' Get outside dimensions of parent window.
Call GetWindowRect hWindow
cy = WindowRect.bottom.struct - WindowRect.top.struct + 1

' Get client width of container.
Call GetClientSize hCon, cx, 0

CallDLL #user32, "IsWindowVisible", hCon As ULong, tis As Long

If tis Then
' Container if showing, prepare to hide it.
showCmd = _SW_HIDE

' Compute new outside width minus container.
cx = WindowRect.right.struct - WindowRect.left.struct - cx

' Return suggested text for button.
ShowMoreOrLessH$ = "More"
Else
' Container is hidden, prepare to show it.
showCmd = _SW_SHOW

' Compute new outside width plus container.
cx = WindowRect.right.struct - WindowRect.left.struct + cx

' Return suggested text for button.
ShowMoreOrLessH$ = "Less"
End If

' Adjust outside width.
Call SetWindowPos hWindow, _NULL, 0, 0, cx, cy, _
_SWP_NOZORDER Or _SWP_NOMOVE

' Finally show or hide container. Doing so here eliminates flicker.
Call ShowWindow hCon, showCmd
End Function

'**********************************************************************
' Container Management
'**********************************************************************

Function CreateContainer( ExStyle, Style, X, Y, Width, Height, hParent, hInstance, lParam )
'-- Purpose: Creates a child dialog box for use as a container object for con-
' trols. Controls must be "adopted" by the container using the SetParent API.
'-- Returns: Window handle (HWND) of the newly created container.
'-- Dependencies:
' - Functions: ContainerProc, GetClassName$, HIWORD, LOWORD, MulDiv

If Left$(GetClassName$(hParent), 1) <> "#" Then
' Get dialog base units.
' They're used to convert pixels to dialog units.
CallDLL #user32, "GetDialogBaseUnits", _
base As ULong
baseX = LOWORD(base)
baseY = HIWORD(base)
Else
baseX = 4
baseY = 8
End If

' Initialize dialog template struct.
Struct DLGTEMPLATE, _
style As ULong, _
dwExtendedStyle As ULong, _
cdit As Word, _
x As Short, _
y As Short, _
cx As Short, _
cy As Short, _
menus As Word, _ 'pseudo element
class As Word, _ 'pseudo element
title As Word 'pseudo element

DLGTEMPLATE.style.struct = Style Or _WS_CHILDWINDOW Or _DS_CONTROL
DLGTEMPLATE.dwExtendedStyle.struct = ExStyle Or _WS_EX_CONTROLPARENT
DLGTEMPLATE.cdit.struct = 0
DLGTEMPLATE.x.struct = MulDiv(X, 4, baseX)
DLGTEMPLATE.y.struct = MulDiv(Y, 4, baseY)
DLGTEMPLATE.cx.struct = MulDiv(Width, 4, baseX)
DLGTEMPLATE.cy.struct = MulDiv(Height, 4, baseY)
DLGTEMPLATE.menus.struct = 0
DLGTEMPLATE.class.struct = 0
DLGTEMPLATE.title.struct = 0

' Template must be in global memory space.
cbDT = Len(DLGTEMPLATE.struct)
CallDLL #kernel32, "GlobalAlloc", _
_GMEM_MOVEABLE As ULong, _
cbDT As ULong, _
hDT As ULong
CallDLL #kernel32, "GlobalLock", _
hDT As ULong, _
pDT As ULong

' Copy struct to global memory.
CallDLL #kernel32, "RtlMoveMemory", _
pDT As ULong, _
DLGTEMPLATE As Struct, _
cbDT As Long, _
ret As Void

' Get pointer to ContainerProc().
Callback lpDlgProc, ContainerProc( ULong, ULong, ULong, ULong ), ULong

' Create the modeless, child dialog box.
CallDLL #user32, "CreateDialogIndirectParamA", _
hInstance As Long, _
pDT As ULong, _
hParent As ULong, _
lpDlgProc As ULong, _
lParam As Long, _
hDlg As ULong

' Memory is no longer needed. Let's clean up.
CallDLL #kernel32, "GlobalUnlock", _
hDT As ULong, _
ret As Long
CallDLL #kernel32, "GlobalFree", _
hDT As ULong, _
ret As ULong

' Return dialog's window handle.
CreateContainer = hDlg
End Function

Function ContainerProc( hDlg, uMsg, wParam, lParam )
'-- Purpose: Acts as container dialog box's dialog procedure. Forwards WM_COM-
' MAND and WM_NOTIFY messages to the container's parent window.

Select Case uMsg
Case _WM_COMMAND, _WM_NOTIFY
print "ContainerProc"
CallDLL #user32, "GetParent", hDlg As ULong, hParent As Ulong
CallDLL #user32, "SendMessageA", hParent As ULong,_
uMsg As ULong, wParam As ULong, lParam As ULong, r As Long
End Select
End Function

'***********************************************
' Support Procedures
'***********************************************

Sub SetControlsParent OldParent$, CtlExts$, hWndNewParent
'-- Dependencies:
' - Functions: GetParent
' - Subs: SetParent

On Error GoTo [Bad_Handle_Error]

c = 0
GoSub [Get_Next_Ctl]

Do While Len(ext$)
Call SetParent HWnd(#ctl$), hWndNewParent
GoSub [Get_Next_Ctl]
Loop

Exit Sub
[Get_Next_Ctl]
c = c + 1
ext$ = Word$(CtlExts$, c)
ctl$ = OldParent$ + "." + ext$
Return
[Bad_Handle_Error]
hWnd = Int(Val(ext$))
CallDLL #user32, "IsWindow", hWnd As ULong, tis As Long
If tis Then
If GetParent(hWnd) = HWnd(#OldParent$) Then
Call SetParent hWnd, hWndNewParent
End If
End If
GoSub [Get_Next_Ctl]
Resume
End Sub

Function HIWORD( dw )
HIWORD = (dw And 4294901760) / 65536
End Function

Function LOWORD( dw )
LOWORD = (dw And 65535)
End Function

Function MulDiv( Factor, Numer, Denom )
CallDLL #kernel32, "MulDiv", Factor As Long, Numer As Long, Denom As Long, _
MulDiv As Long
End Function

Sub SetWindowPos hWnd, hWndAfter, X, Y, Width, Height, Flags
CallDLL #user32, "SetWindowPos", hWnd As ULong, hWndAfter As ULong, _
X As Long, Y As Long, Width As Long, Height As Long, Flags As ULong, _
ret As Long
End Sub

Sub SetParent hWnd, hWndNewParent
CallDLL #user32, "SetParent", hWnd As ULong, hWndNewParent As ULong, _
ret As ULong
End Sub

Function GetOEMIcon( IDI )
CallDLL #user32, "LoadIconA", _NULL As Long, IDI As ULong, _
GetOEMIcon As ULong
End Function

Function SendMessageLong( hWnd, uMsg, wParam, lParam )
CallDLL #user32, "SendMessageA", hWnd As ULong, uMsg As ULong, _
wParam As ULong, lParam As Long, SendMessageLong As Long
End Function

Sub GetClientSize hWnd, ByRef Width, ByRef Height
Struct ClientSize, left As Long, top As Long, width As Long, height As Long
CallDLL #user32, "GetClientRect", hWnd As ULong, ClientSize As Struct, _
ret As Long
Width = ClientSize.width.struct
Height = ClientSize.height.struct
End Sub

Sub GetWindowRect hWnd
Struct WindowRect, left As Long, top As Long, right As Long, bottom As Long
CallDLL #user32, "GetWindowRect", hWnd As ULong, WindowRect As Struct, _
ret As Long
End Sub

Function FindWindowEx( hWndParent, hWndFirstChild, Class$, Text$ )
CallDLL #user32, "FindWindowExA", hWndParent As ULong, _
hWndFirstChild As ULong, Class$ As Ptr, Text$ As Ptr, _
FindWindowEx As ULong
End Function

Function GetParent( hWnd )
CallDLL #user32, "GetParent", hWnd As ULong, GetParent As ULong
End Function

Function GetClassName$( hWnd )
buf$ = Space$(256)
CallDLL #user32, "GetClassNameA", hWnd As ULong, buf$ As Ptr, 255 As Long, _
cch As Long
GetClassName$ = Left$(buf$, cch)
End Function

Sub ShowWindow hWnd, nCmdShow
CallDLL #user32, "ShowWindow", hWnd As ULong, nCmdShow As Long, ret As Long
End Sub