Tweet
#INCLUDE FILE
DEMO PROGRAM
------------------
Michael Mattias
Tal Systems Inc.
Racine WI USA
[email protected]
www.talsystems.com
[This message has been edited by Michael Mattias (edited October 25, 2002).]
Code:
' file: eeprogress.bas
' #INCLUDE file to add Progress Bar Dialog to PB/CC or PB/Win Program
' Courtesy Michael Mattias Racine WI. Placed in the Public Domain
' by the author October 23, 2002
' utility function
SUB CenterWindow (BYVAL hAnyWnd AS LONG)
DIM WndRect AS RECT
DIM x AS LONG
DIM y AS LONG
GetWindowRect hAnyWnd, WndRect
x = (GetSystemMetrics(%SM_CXSCREEN)-(WndRect.nRight-WndRect.nLeft))\2
y = (GetSystemMetrics(%SM_CYSCREEN)-(WndRect.nBottom-WndRect.nTop+GetSystemMetrics(%SM_CYCAPTION)))\2
SetWindowPos hAnyWnd, %NULL, x, y, 0, 0, %SWP_NOSIZE OR %SWP_NOZORDER
END SUB
'===========================================================
' equates and window procedure for the progress bar dialog
' ==========================================================
$PROGRESS_WINDOW_CLASS = "PB_CC_progress_class"
%ID_PROGRESS_BAR = 101&
%ID_PROGRESS_LABEL = 102&
%PROGRESS_WINDOW_STYLE = %WS_BORDER OR %WS_DLGFRAME
' WS_VISIBLE OMITTED ON PURPOSE!
%PROGRESS_WINDOW_EXSTYLE = %WS_EX_CLIENTEDGE OR %WS_EX_TOOLWINDOW OR %WS_EX_APPWINDOW
' APPWINDOW insures an entry on the task bar so you can click on the task bar
' to see how far you are if the dialog becomes hidden. (You could also make
' the window WS_EX_TOPMOST, but that leaves window on top even when not active
' and frankly I find that ugly as sin).
' equate missing from PB-supplied WIN32API.INC file
#IF NOT %DEF(%SWP_NOSENDCHANGING)
%SWP_NOSENDCHANGING = &h0400& ' /* Don't send WM_WINDOWPOSCHANGING */
#ENDIF
' parameter block. All members are filled when dialog is created. This allows
' great flexibility, although only the hEvent member is needed
TYPE ProgressParmsType
hWnd AS LONG ' hWnd of created window
hWndProgress AS LONG ' of progressbar
hWndLabel AS LONG ' of label
lThreadId AS LONG ' of created thread
hEvent AS LONG ' used only by the thread function to communicate
END TYPE
' ===============================================================
' Function to register the class for the Progress Dialog Window
' ===============================================================
FUNCTION RegisterProgressWindowClass () AS LONG
LOCAL szClassName AS ASCIIZ * %MAX_PATH, wcEx AS WndClassEx
szClassName = $PROGRESS_WINDOW_CLASS
wcex.cbSize = SIZEOF(Wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW
wcex.lpfnWndProc = CODEPTR(WndProcProgress)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = GetModuleHandle(BYVAL %NULL)
wcex.hIcon = %NULL
wcex.hCursor = LoadCursor( %NULL, BYVAL %IDC_WAIT )
wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIconSm = %NULL ' LoadIcon(hInstance, "PROGRAM")
FUNCTION = RegisterClassEx(wcex)
END FUNCTION
' FUNCTION RETURNS: hWnd of main window
' to terminate the thread and destroy dialog, Post/SendMessage ThisHwnd, %WM_CLOSE, 0,0
FUNCTION CreateProgressWindowThread () AS LONG
LOCAL bManualReset AS LONG, bInitialState AS LONG, szEventName AS ASCIIZ * 32
LOCAL hThread AS LONG, J AS LONG, result AS LONG
LOCAL P AS PROGRESSParmsType
STATIC BeenHere AS LONG
LOCAL iccex AS Init_Common_ControlsEx
IF ISFALSE BeenHere THEN ' first time called in program
RegisterProgressWindowClass
iccex.dwSize = SIZEOF(iccex) ' make sure Common Controls available
iccex.dwICC = %ICC_PROGRESS_CLASS
InitCommonControlsEx iccex
BeenHere = %TRUE
END IF
' set up event used to commumicate with the thread..
bManualReset = %TRUE
bInitialState = %FALSE ' FALSE = Unsignalled
szEventName = "PB_CC_PROGRESS_EVENT_NAME"
' A named event is not required, but it's cheap.
P.hEvent = CreateEvent (BYVAL %NULL, bManualReset, bInitialState, szEventName)
' Create the thread; then wait until thread signals it has created the dialog
THREAD CREATE ProgressWindowFunction (BYVAL VARPTR(P)) TO hThread
Result = WaitForSingleObject (p.hEvent, 30000&) ' thirty seconds >enough for this demo
IF Result = %WAIT_OBJECT_0 THEN ' wait succeeded normally
' nothing, this is good
' MSGBOX "Event sent me back!" OK
FUNCTION = 0
ELSE
#IF %DEF(%PB_CC32)
PRINT "Unexpected Return from WaitForSingleObject=" & STR$(Result)
#ELSE
MSGBOX "Unexpected Return from WaitForSingleObject=" & STR$(Result)
#ENDIF
FUNCTION = &hFFFFFFFF
END IF
THREAD CLOSE hThread TO J ' clean up
CloseHandle P.hEvent
FUNCTION = P.Hwnd ' Could return any member..
END FUNCTION
'=====================================================================
' THIS IS THE THREAD FUNCTION WHICH EXITS LATER WHEN IT GETS WM_CLOSE
' ====================================================================
FUNCTION ProgressWindowFunction (BYVAL parm AS LONG ) AS LONG
LOCAL hWnd AS LONG, szText AS ASCIIZ * 128
LOCAL pP AS ProgressParmsType PTR
pP = Parm
szText = "Default Text you should have set in main program"
' create the window
Hwnd = CreateWindowEx( %PROGRESS_WINDOW_EXSTYLE, _
$PROGRESS_WINDOW_CLASS,_
szText , _
%PROGRESS_WINDOW_STYLE, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
GetDeskTopWindow(), _
BYVAL %NULL, _
GetModuleHandle(BYVAL %NULL), _
BYVAL pP)
' when this returns, the controls are created and P. is updated for control IDs
' save the needed member
@pP.hWnd = hWnd
@pP.lThreadId = GetCurrentThreadId()
' trigger the event so our calling function can return
setEvent @pP.hEvent
' enter a message loop
LOCAL msg AS tagMsg
WHILE GetMessage(Msg, %NULL, 0, 0)
TranslateMessage msg
DispatchMessage Msg
WEND
END FUNCTION
' ===========================================
' WINDOW PROCEDURE FOR PROGRESS BAR DIALOG
' ===========================================
FUNCTION WndProcProgress (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
LOCAL hWndLabel AS LONG, hWndProgress AS LONG
LOCAL cx AS LONG, cy AS LONG, x AS LONG, y AS LONG
LOCAL CtrlStyle AS DWORD, CtrlExStyle AS DWORD, szCtrlClass AS ASCIIZ * 64
LOCAL ctrliD AS LONG
LOCAL szText AS ASCIIZ * %MAX_PATH
LOCAL hDC AS LONG, tm AS textMetric, cxchar AS LONG, cychar AS LONG, cxcaps AS LONG
LOCAL E AS LONG
LOCAL pCS AS CreateStruct PTR
LOCAL pP AS ProgressParmsType PTR
SELECT CASE wMsg
CASE %WM_CREATE
pCS = lparam
pP = @pCS.lpCreateParams ' get pointer to our parameters
hDC = GetDC(Hwnd) ' to get info about this window
GetTextMetrics BYVAL hDC, tm
CxChar = tm.tmAveCharWidth
CyChar = tm.tmHeight + tm.tmExternalLeading
WhatMikeForgot:
ReleaseDc hWnd, hDc
EndWhatMikeForgot
' low bit of tm.tmpitchandfamily: 0=fixed pitch, 1=variable pitch
' set caps = cxchar if fixed, 150% if variable
CxCaps = CxChar + ((CxChar * .50) * BIT(tm.tmpitchandfamily, 0))
' add a text label control
ctrlId = %ID_PROGRESS_LABEL
szCtrlClass = "Static"
Ctrlstyle = %WS_VISIBLE OR %WS_CHILD OR %SS_CENTER OR %WS_BORDER OR %SS_SUNKEN
CtrlExStyle = %NULL
x = 1 * cxchar ' one character from left edge
y = 1 * cychar
cx = 40 * cxchar ' 40 characters wide
cy = 4 * cychar ' four lines high
szText = "Label" ' should be changed by calling function
hWndLabel = CreateWindowEx( CtrlExStyle, _
szCtrlClass,_
szText, _
CtrlStyle, _
X, _
Y, _
cx, _
cy, _
hWnd, _
ctrlId, _
GetWindowLong (hWnd, %GWL_HINSTANCE), _
BYVAL %NULL)
@pP.hWndLabel = hWndLabel
IF ISFALSE hWndLabel THEN
E = GetLastError
#IF %DEF(%PB_CC32)
PRINT "Create Window for Label Failed, Error=" & STR$(E)
#ELSE
MSGBOX "Create Window for Label Failed, Error=" & STR$(E)
#ENDIF
END IF
' add the progressbar control
ctrlId = %ID_PROGRESS_BAR
szCtrlClass = $PROGRESS_CLASS
Ctrlstyle = %WS_CHILD OR %PBS_SMOOTH OR %WS_BORDER OR %WS_VISIBLE
CtrlExStyle = %WS_EX_STATICEDGE
x = 1 * cxchar ' 1 chars from left
y = 6 * cychar ' 6 lines down
cx = 40 * cxchar
cy = 3 * cychar
szText = "Progbarl" ' immaterial, ignored by control
hWndProgress = CreateWindowEx( CtrlExStyle, _
szCtrlClass,_
szText, _
CtrlStyle, _
X, _
Y, _
cx, _
cy, _
hWnd, _
ctrlId, _
GetWindowLong (hWnd, %GWL_HINSTANCE), _
BYVAL %NULL)
@pP.hWndProgress = hWndProgress
IF ISFALSE hWndProgress THEN
E = GetLastError
#IF %DEF(%PB_CC32)
PRINT "Create Window for Progress Bar Failed, Error=" & STR$(E)
#ELSE
MSGBOX "Create Window for Progress Bar Failed, Error=" & STR$(E)
#ENDIF
END IF
' set the progress bar's range 0-100
SendMessage hWndProgress, %PBM_SETRANGE, 0, MAKLNG(0, 100)
' set bar to position zero to start
SendMessage hWndProgress, %PBM_SETPOS, 0, 0
' set the number of units per step to 1
SendMessage hWndProgress, %PBM_SETSTEP, 1, 0&
' set the bar color and background colors
SendMessage hWndProgress, %PBM_SETBKCOLOR, 0, %WHITE
SendMessage hWndProgress, %PBM_SETBARCOLOR, 0, %RED
' adjust the size and position of our own window
SetWindowPos hWnd, %HWND_TOP, 50, 50, 44*cxChar, 11*cychar, %SWP_NOSENDCHANGING OR %SWP_NOMOVE
CenterWindow hWnd ' center on desktop
FUNCTION = 0: EXIT FUNCTION ' return 0 to continue creation of window
' END OF WM_CREATE PROCESSING
CASE %WM_CTLCOLORSTATIC ' wparam = hDC, lparam = hWnd of control
SetBkMode wParam, %TRANSPARENT
FUNCTION = GetStockObject (%WHITE_BRUSH)
EXIT FUNCTION
CASE %WM_CLOSE
PostQuitMessage 0 ' will terminate THIS THREAD ONLY
' DO NOT EXIT FUNCTION DefWindowProc will
' call DestroyWindow by default
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
' end of #INCLUDE file EEPROGRESS.BAS
Code:
#IF 0
****************************************************************************************
CC_Progress.bas
Author: Michael Mattias Racine WI
October, 2002
Compiler: PB/CC 3.0
Demo of easy way to add a progress bar to a PB/CC program
Placed in the public domain by author
To use this progress bar dialog in a PB/CC program:
- Include WIN32API.INC in program
- Add the %NOxxx Commmon Controls equates and #INCLUDE of COMMCTRLS.INC to program
I did not try to put this in the #INCLUDE file as others may be using more controls.
I could have put all the Windows header materials in the #INCLUDE file if PB Supported %DEF(procedurename) but it doesn't
I left the Common Controls stuff in the main program because others may be already
using some Common Controls in their program. No reason you can't move that
to EEPROGRESS.BAS if you otherwise are not using the Common Controls
- #INCLUDE "eeprogress.bas"
- Create the Progress Dialog using CreateProgressWindowThread (pre-set for range 0-100, red color)
- SHOW the window (it is created invisible on purpose)
- Step up the bar by POSTing PBM_STEPIT message directly to the progress bar control
- To close Progress Dialog, Post or Send WM_CLOSE to HDlgProgress. I chose to SEND
so the CC program will not resume until the Dialog is destroyed. (Looks kind of
ugly if the dialog is being destroyed whilst other processing occurs in the
main thread).
NOTES: Lots of room for easy modification in the INCLUDE file EEPROGRESS.BAS
It would also be easy to write some 'macro/wrapper' functions like
'CloseProgressDialog' or "StepProgressBar' and put those right in the #INCLUDE
'file, which would make adding progress bar support even easier.
****************************************************************************************
#ENDIF
#COMPILE EXE
#REGISTER NONE
'#DEBUG ERROR ON
'#TOOLS ON <<< need for TRACE, CALLSTK etc
#INCLUDE "Win32API.INC"
' =============================================================
' COMMON CONTROLS EQUATES USED FOR PROGRESS BAR INSERTION
' (comment out the '%NOxxxx to add additional Common Controls to program)
%NOANIMATE = 1 ' Animate control
%NOBUTTON = 1 ' Button
%NOCOMBO = 1 ' Combo box
%NOCOMBOEX = 1 ' ComboBoxEx
%NODATETIMEPICK = 1 ' Date/time picker
%NODRAGLIST = 1 ' Drag list control
%NOEDIT = 1 ' Edit control
%NOFLATSBAPIS = 1 ' Flat scroll bar
%NOHEADER = 1 ' Header control
%NOHOTKEY = 1 ' HotKey control
%NOIMAGELIST = 1 ' Image APIs
%NOIPADDRESS = 1 ' IP Address edit control
%NOLIST = 1 ' List box control
%NOLISTVIEW = 1 ' ListView control
%NOMENUHELP = 1 ' Menu help
%NOMONTHCAL = 1 ' MonthCal
%NOMUI = 1 ' MUI
%NONATIVEFONTCTL = 1 ' Native Font control
%NOPAGESCROLLER = 1 ' Pager
' %NOPROGRESS = 1 ' Progress control
%NOREBAR = 1 ' Rebar control
%NOSTATUSBAR = 1 ' Status bar
%NOTABCONTROL = 1 ' Tab control
%NOTOOLBAR = 1 ' Tool bar
%NOTOOLTIPS = 1 ' Tool tips
%NOTRACKBAR = 1 ' Track bar
%NOTRACKMOUSEEVENT = 1 ' Track Mouse Event
%NOTREEVIEW = 1 ' TreeView
%NOUPDOWN = 1 ' Up Down arrow control
#INCLUDE "CommCtrl.INC"
#INCLUDE "eeprogress.bas" 'Progress bar #INCLUDE file
' ================================================
' ================================================
' MAIN PROGRAM STARTS HERE
' ================================================
FUNCTION WINMAIN( BYVAL hInstance AS LONG , _
BYVAL hPrevInst AS LONG , _
BYVAL lpszCmdLine AS ASCIIZ PTR, _
BYVAL nCmdShow AS LONG ) AS LONG
CALL DemoProgress
PRINT "Any Key to exit"
WAITKEY$
END FUNCTION
FUNCTION DemoProgress() AS LONG
LOCAL hDlgProgress AS LONG, szText AS ASCIIZ * %MAX_PATH, I AS LONG
' create the Progress Dialog
hDlgProgress = CreateProgressWindowThread
' ================================================================
' here is where you would change the colors, range or step value
' of the progress bar control using...
' Send (or Post)Message GetDlgItem(hDlgProgress, %ID_PROGRESS_BAR), %PBM_whatever, wparam, lparam
' .. if you don't like the default values.
' ================================================================
' set the dialog text
szText = "PB/CC Progress Bar Demo Courtesy Michael Mattias"
SetWindowText hDlgProgress, szText
' set the text of the label in the dialog
szText = "Processing Important Job"
SetWindowText GetDlgItem(hDlgProgress, %ID_PROGRESS_LABEL), szText
' Now that all the controls are set up,
' show the dialog (remember, it is created invisible!)
ShowWindow hDlgProgress, %SW_SHOW
' ==================================================
' HEAVY DUTY PROCESSING OCCURS IN THIS LOOP
' ==================================================
FOR I = 1 TO 100
PRINT ".";
PostMessage GetDlgItem(hDlgProgress, %ID_PROGRESS_BAR), %PBM_STEPIT, 0&, 0&
SLEEP 100
NEXT
' close the progress dialog
SendMessage hDlgProgress, %WM_CLOSE, 0&, 0&
' Reset the keyboard focus to our console window. I think there is an undocumented
' PB function to get the window? GetConsoleWindow API not supported on Win 9x.
' Hmm, can't figure out how to do this..oh, this seems to work...
I = INSTAT
END FUNCTION
' *** END OF FILE ***
Michael Mattias
Tal Systems Inc.
Racine WI USA
[email protected]
www.talsystems.com
[This message has been edited by Michael Mattias (edited October 25, 2002).]
Comment