Tweet
#DIM ALL
#COMPILE EXE
#INCLUDE "WIN32API.INC"
#INCLUDE "COMMCTRL.INC"
%IDC_STATUSBAR = 101
GLOBAL ghInstance AS DWORD ' handle of the application instance
'-------------------------------------------------------------------------------
'
' PROCEDURE: WinMain
' PURPOSE: Program entry point, calls initialization function, processes
' message loop.
'
'-------------------------------------------------------------------------------
FUNCTION WinMain _
( _
BYVAL hInstance AS DWORD, _ ' handle of current instance
BYVAL hPrevInstance AS DWORD, _ ' handle of previous instance(not used in Win32)
BYVAL pszCmdLine AS ASCIIZ PTR, _ ' address of command line
BYVAL nCmdShow AS LONG _ ' show state of window
) AS LONG
LOCAL szClassName AS ASCIIZ * %MAX_PATH ' class name
LOCAL twcx AS WNDCLASSEX ' class information
LOCAL tmsg AS tagMsg ' message information
LOCAL ticc AS INIT_COMMON_CONTROLSEX ' specifies common control classes to register
LOCAL hWnd AS DWORD ' handle of main window
' Save the handle of the application instance
ghInstance = hInstance
' Register the Form1 window
szClassName = "Form1_Class"
twcx.cbSize = SIZEOF(twcx) ' size of WNDCLASSEX structure
twcx.style = %CS_DBLCLKS ' class styles
twcx.lpfnWndProc = CODEPTR(Form1_WndProc) ' address of window procedure used by class
twcx.cbClsExtra = 0 ' extra class bytes
twcx.cbWndExtra = 0 ' extra window bytes
twcx.hInstance = ghInstance ' instance of the process that is registering the window
twcx.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION) ' handle of class icon
twcx.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW) ' handle of class cursor
twcx.hbrBackground = %COLOR_BTNFACE + 1 ' brush used to fill background of window's client area
twcx.lpszMenuName = %NULL ' resource identifier of the class menu
twcx.lpszClassName = VARPTR(szClassName) ' class name
twcx.hIconSm = %NULL ' handle of small icon shown in caption/system Taskbar
IF ISFALSE RegisterClassEx(twcx) THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
' Load the common controls library and
' specify the classes to register.
ticc.dwSize = SIZEOF(ticc)
ticc.dwICC = %ICC_BAR_CLASSES
InitCommonControlsEx ticc
' Create the Form1 window
hWnd = CreateWindowEx(%WS_EX_WINDOWEDGE, _ ' extended styles
"Form1_Class", _ ' class name
"", _ ' caption
%WS_OVERLAPPEDWINDOW OR %WS_VISIBLE, _ ' window styles
160, 130, _ ' left, top
373, 231, _ ' width, height
%NULL, %NULL, _ ' handle of owner, menu handle
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
' If window could not be created, return "failure"
IF ISFALSE hWnd THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
' Initialize this instance of the window
' Make the window visible; update its client area
ShowWindow hWnd, nCmdShow
UpdateWindow hWnd
' Main message loop of program.
' Acquire and dispatch messages until a WM_QUIT message is received.
WHILE ISTRUE GetMessage(tmsg, BYVAL %NULL, 0, 0)
IF ISFALSE IsDialogMessage(hWnd, tmsg) THEN
TranslateMessage tmsg
DispatchMessage tmsg
END IF
WEND
FUNCTION = tmsg.wParam
END FUNCTION
'-------------------------------------------------------------------------------
'
' PROCEDURE: Form1_WndProc
' PURPOSE: Processes messages for the Form1 window.
'
'-------------------------------------------------------------------------------
FUNCTION Form1_WndProc _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL uMsg AS DWORD, _ ' type of message
BYVAL wParam AS DWORD, _ ' first message parameter
BYVAL lParam AS LONG _ ' second message parameter
) EXPORT AS LONG
LOCAL ptnmhdr AS NMHDR PTR ' information about a notification message
LOCAL plEdge AS LONG PTR ' address of array of right edges
LOCAL hWndChild AS DWORD ' handle of child window
LOCAL hFont AS DWORD ' handle of font used by form
LOCAL lpnm AS NMMOUSE PTR
SELECT CASE uMsg
CASE %WM_NOTIFY
ptnmhdr = lParam
SELECT CASE @ptnmhdr.idFrom
CASE %IDC_STATUSBAR
IF @ptnmhdr.code = %NM_CLICK THEN
lpnm = lParam
' Display the zero-based index of the section that was clicked.
MSGBOX STR$(@lpnm.dwItemSpec)
END IF
END SELECT
CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_CREATE
' Create font used by container
hFont = GetStockObject(%DEFAULT_GUI_FONT)
' Create the Statusbar1 statusbar control
hWndChild = CreateWindowEx(%NULL, _ ' extended styles
"msctls_statusbar32", _ ' class name
"", _ ' caption
%WS_CHILD OR %WS_VISIBLE OR _ ' window styles
%CCS_BOTTOM OR %SBARS_SIZEGRIP, _ ' class styles
0, 177, _ ' left, top
365, 20, _ ' width, height
hWnd, %IDC_STATUSBAR, _ ' handle of parent, control ID
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
' Allocate memory for the coordinate of the right edge of each part
plEdge = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, 4 * 4)
IF ISTRUE plEdge THEN
@plEdge[0] = 96
@plEdge[1] = 194
@plEdge[2] = 292
@plEdge[3] = -1
SendMessage hWndChild, %SB_SETPARTS, 4, BYVAL plEdge
' Free memory that was allocated for the edge info
HeapFree GetProcessHeap(), 0, BYVAL plEdge
END IF
' Update the size of the statusbar
SendMessage hWndChild, %WM_SIZE, 0, 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
END FUNCTION
'=========================================================================================
CASE %WM_NOTIFY
ptnmhdr = lParam
SELECT CASE @ptnmhdr.idFrom
CASE %IDC_STATUSBAR
IF @ptnmhdr.code = %NM_CLICK THEN
lpnm = lParam
' Display the zero-based index of the section that was clicked.
MSGBOX STR$(@lpnm.dwItemSpec)
END IF
END SELECT
Comment