' ' pb_prog.bas ' ' DESCRIPTION ' Progress screen encapsulation ' Routines within show a Non-Modal window with a progress ' Bar And a Cancel button. It stays On the screen until ' progress_shutdown is called. If the user clicks the ' cancel button, the screen stays up until the programmer ' calls progress_shutdown. In order for the program to know ' if the cancel button has been pressed, they must call ' progress_is_cancelled. This function will return %True ' any time after the cancel button has been pressed. To ' change the position of the progress Bar call the ' progress_set function. This function must be passed a ' progress value between 1 and 100. ' ' AUTHOR ' Copyright 2000-2001 ' Don Dickinson ' All rights reserved ' ddickinson@usinternet.com ' dickinson.basicguru.com ' ' LICENSE and DISCLAIMER ' This code is free for all to use without acknowledging the author. ' Use this code as you see fit. By using or compiling this code or derivative ' thereof, you are consenting to the hold the author, Don Dickinson, harmless ' for all effects or side-effects its use. This code works great for me, ' but you are using it at your own risk. ' ' DEPENDENCIES ' WIN32API.INC - not included within ' COMMCTRL.INC - not included within ' ' FUNCTIONS ' Function pbProgressInit(ByVal hParent As Long, sCaption As String) Export As Long ' Sub pbProgressSet(ByVal hProgWindow As Long, ByVal iProgress As Long, sStatus As String) Export ' Sub pbProgressShutdown(ByVal hProg as Long) export ' Function pbProgressIsCancelled(ByVal hProg as Long) export as Long ' ' ' HOW IT WORKS ' ' > Call pbProgressInit to show the window and save the ' returned value (window handle) ' > In your code sprinkle Dialog Doevents to allow the window to be ' moved, redrawn, etc. pbProgressSet does this, so if it is called ' often, you won't need these calls. ' > Call pbProgressSet anytime you need to change the status bar or ' status text ' > Call pbProgressPos anytime to change the position of the ' dialog from it's default centered position. ' > Also call pbProgressIsCancelled throughout. This will return ' non-zero if the user clicked the cancel button. ' > When you're through, call pbProgressShutdown ' #If Not %Def(%PB_PROG_BAS) %PB_PROG_BAS = 1 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Compiling as a DLL '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '- un-rem this line and you can compile this ' module as a DLL called pb_prog.dll ' '%COMPILE_PB_PROG_BAS_ASDLL = 1 #if %COMPILE_PB_PROG_BAS_ASDLL #compile dll #dim all #include "WIN32API.INC" #include "COMMCTRL.INC" #endif '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Control handles '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ %pb_prog_progressbar = 300 %pb_prog_statuslabel = 301 %pb_prog_invisible = 302 $PROGRESS_CANCEL_MESSAGE = "cancel" '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' pb_prog_procCancelButton '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CallBack Function pb_prog_procCancelButton Control Set Text CbHndl, %pb_prog_invisible, $PROGRESS_CANCEL_MESSAGE End Function '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' pbProgressInit '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Function pbProgressInit Alias "pbProgressInit" _ (ByVal hParent As Long, ByVal sCaption As String) Export As Long Dim hWindow As Long Dim hProg As Long InitCommonControls Dialog New hParent, sCaption, 1, 1, 300, 85, %DS_CENTER Or %DS_MODALFRAME, %WS_EX_TOPMOST To hWindow Control Add Label, hWindow, %pb_prog_statuslabel, "", 25, 7, 250, 12, %WS_CHILD Or %WS_VISIBLE, 0 Control Add Label, hWindow, %pb_prog_invisible, "", 0, 0, 1, 1, %WS_CHILD, 0 Control Add "msctls_progress32", hWindow, %pb_prog_progressbar, "", 25, 20, 250, 15, _ %WS_CHILD Or %WS_VISIBLE Or %WS_BORDER, 0 Control Handle hWindow, %pb_prog_progressbar To hProg SendMessage hProg, %PBM_SETRANGE, 0, MakLng(0,100) SendMessage hProg, %PBM_SETPOS, 0, 0 Control Add Button, hWindow, %IDCANCEL, "&Cancel", 130, 50, 40, 14, _ %WS_VISIBLE Or %WS_CHILD Or %BS_PUSHBUTTON Or %WS_TABSTOP, _ Call pb_prog_procCancelButton Dialog Show Modeless hWindow Dialog DoEvents Function = hWindow End Function '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' pbProgressSet '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub pbProgressSet Alias "pbProgressSet" _ ( ByVal hProgWindow As Long, ByVal iProgress As Long, _ ByVal sStatus As String) Export Dim iPos As Long Dim hProg As Long '- Must be between 0 and 100 Control Handle hProgWindow, %pb_prog_progressbar To hProg iPos = Max(0, Min(iProgress, 100)) SendMessage hProg, %PBM_SETPOS, iPos, 0 Control Set Text hProgWindow, %pb_prog_statuslabel, sStatus Dialog DoEvents End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' pbProgressPos '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub pbProgressPos Alias "pbProgressPos" _ ( ByVal hProgWindow as Long, _ ByVal x as Long, ByVal y as Long ) Export Dialog Set Loc hProgWindow, x, y End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' pbProgressShutdown '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub pbProgressShutdown Alias "pbProgressShutdown" _ (ByVal hProgWindow As Long) Export Dialog End hProgWindow End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' pbProgressIsCancelled '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Function pbProgressIsCancelled Alias "pbProgressIsCancelled" _ (ByVal hProgWindow As Long) Export As Long Dim sOk As String Dialog DoEvents If IsWindow(hProgWindow) = %False Then Function = %True ' ElseIf IsWindowVisible(hProgWindow) = %False Then ' Function = %True Else Control Get Text hProgWindow, %pb_prog_invisible To sOk If sOk = $PROGRESS_CANCEL_MESSAGE Then Function = %True Else Function = %False End If End If End Function '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Exported functions with ASCIIZ parameters for use by Delphi and other ' languages that would rather have Asciiz parameters instead of pb strings. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' pbProgressInitZ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Function pbProgressInitZ Alias "pbProgressInitZ" _ (ByVal hParent As Long, zCaption As Asciiz) Export As Long Function = pbProgressInit(hParent, (zCaption)) End Function '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' pbSetProgressZ '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub pbProgressSetZ Alias "pbProgressSetZ" _ ( ByVal hProgWindow As Long, ByVal iProgress As Long, _ zStatus as Asciiz) Export pbProgressSet hProgWindow, iProgress, (zStatus) End Sub #EndIf