':::.IDE Template
'Compilable Example:
#Compile Exe
#Dim All
#Include "Win32API.inc"
Global hDlg as Dword
Function PBMain() As Long
   Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Push", 50,10,100,20
   Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
   If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then

   End If
End Function
'end:::****************************************

':::Compiler Directives
'#Debug Error On     'catch array/pointer errors - OFF in production
'#Debug Display On   'display untrapped errors   - OFF in production
'#Tools On          'use ON only when needed for Trace/Profile/CallStk
#Include "Win32api.inc"
#Resource "gbsnippets.pbr"
'end:::****************************************

':::Elapsed Time
   'GetTickCount - milliseconds since Windows started. accurate to about 15ms
   Dim iStart As Long, iEnd As Long, Result As String
   iStart = GetTickCount
   ... statements to time
   iEnd = GetTickCount
   Result = Format$((iEnd - iStart)/1000,3) & " seconds"
'end:::****************************************

':::CPrint
Sub CPrint (SOut As String)
'    put these lines elsewhere:
'    Declare Function WinMsg LIB "WINMSG.DLL" ALIAS "WindowMessageA" (BYVAL MsgNum AS LONG) AS String
'    Static iMsgCount As Long
'    CPrint Str$(iMsgCount&)+ " " + WinMsg(CB.Msg)  'Console message code
'    Incr iMsgCount&
    Static hConsole As Long, cWritten As Long
    If hConsole = 0 Then AllocConsole: hConsole = GetStdHandle(-11&)
    WriteConsole hConsole, ByCopy sOut + $CrLf, Len(sOut) + 2, cWritten, ByVal 0&
End Sub
'end:::****************************************

':::Clear Console
Sub ClearConsole
   Local hWrittenChars As Long
   Local tConsoleInfo As CONSOLE_SCREEN_BUFFER_INFO
   GetConsoleScreenBufferInfo(hConsole, tConsoleInfo)
   FillConsoleOutputCharacter(hConsole, 32, tConsoleInfo.dwSize.x * tConsoleInfo.dwSize.y, Mak(DWord,0,0), hWrittenChars)
   SetConsoleCursorPosition(hConsole, Mak(DWord,0,0))
End Sub
'end:::****************************************

':::TextBox Style
Local style&
style& = %ws_tabstop Or %ws_border Or  %es_left Or %es_autohscroll _
         Or %es_multiline Or %es_nohidesel Or %es_wantreturn
'end:::****************************************

':::Open Help-Email-URL
Local tempFile As %Max_Path, iResult&
tempFile = Exe.Path$ + "gbsnippets.chm"   'also works on .hlp filenames
iResult& = ShellExecute(hDlg, "Open", tempFile, $Nul, $Nul, %SW_ShowNormal)

Local EMessage as AscIIZ*%Max_Path
EMessage$ = "mailto:gbeene@airmail.net?subject=gbSnippets&body=Comments:"
iReturn& = ShellExecute(hDlg, "Open", EMessage$ , $Nul, $Nul, %SW_ShowNormal)

'To insert an email address as a variable, use something like this:
temp$ = "gbeene@airmail.net"
EMessage$ = "mailto:" + temp$ + "?subject=gbSnippets&body=Comments:"

Local iReturn As Long, URL As Asciiz * %Max_Path
URL = "http://www.garybeene.com"
iReturn = ShellExecute(hDlg, "Open", URL, $Nul, $Nul, %SW_ShowNormal)
'end:::****************************************

':::Callback Template
CallBack Function DlgProc() As Long
   Select Case CB.Msg
      Case %WM_Activate         'setn to the window being activated and window being deactivated
      Case %WM_ActivateApp      'focus returns to app from another app
      Case %WM_Char             'when keyboard is pressed
      Case %WM_Close            'sent to window that is about to close
      Case %WM_Command          'control notifications
      Case %WM_ContextMenu      'user clicked the right mouse button (right-clicked) in a window.
      Case %WM_Create           'when the dialog is first created, before it becomes visible
      Case %WM_Destroy          'window is being destroyed. after window is removed from screen (children still exist)
      Case %WM_DropFiles        'when a file is dropped on a drop-activated control/dialog 
      Case %WM_EraseBkgnd       'indicates that a window needs to be erased
      Case %WM_GetDlgCode       'give all keyboard events
      Case %WM_GetMinMaxInfo    'whenever dialog dimension is about to change
      Case %WM_Help             'when F1 is pressed
      Case %WM_HotKey           'when user presses a registered hotkey
      Case %WM_InitDialog       'immediately before a dialog box is displayed
      Case %WM_InitMenuPopup    'sent before a popup menu is displayed
      Case %WM_MenuSelect       'when a user selects a menu item
      Case %WM_MouseMove        'when cursor moves
      Case %WM_Notify           'control notifications
      Case %WM_Paint            'client area need redrawn
      Case %WM_SetCursor        'sent if mouse causes cursor to move
      Case %WM_Size             'size has changed
      Case %WM_SysCommand       'command chosen from Window menu or upper right buttons
      Case %WM_Timer            'timer event
   End Select
End Function
'end:::****************************************

':::SubClass a Control
OrigProc& = SetWindowLong(hControl, %GWL_WndProc, CodePTR(NewProc))   'subclass a control
SetWindowLong hControl, %GWL_WNDPROC, OldProc&   'un-subclass, restore original window procedure
'end:::****************************************

':::SubClass Window Procedure
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   'Then you must provide a new window procedure for that control. It MUST be declared like this:
   'include normal callback function processing ...
   Select Case Msg
      Case X
         ... custom processing...
         Function = 0 : Exit Function    'use if no further message processing is required
      Case Y
         ... custom processing...
         Function = 0 : Exit Function    'use if no further message processing is required
   End Select
   Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)   'send unprocessed messages to the original procedure
End Function
'end:::****************************************

':::Browse for Folder
Sub BrowseForFolder
   Local title$, start$, flags&, folder$
   title$ = "Select Folder"    'if "" then "Open" is used
   start$ = Exe.path$
   flags& = %BIF_ReturnOnlyFSDirs Or %BIF_DontGoBelowDomain Or %BIF_NoNewFolderButton
   Display Browse  hDlg, 100, 100, title$, start$, flags& To folder$
   'folder$ is set to "" if Cancel/Escape is pressed
   If Len(folder$) Then
      MsgBox folder$
   Else
      MsgBox "No folder selected!"   'ESC or Cancel
   End If
End Sub
'end:::****************************************

':::Browse for Color
Sub BrowserForColor
   Type CustomColors
      c(15) As Long
   End Type
   Global CustomColorList as CustomColors  'stores 16 user-defined colors

   Static LastSelectedColor&
   Local ColorResult&, Flags&
   Flags& = 0   'enables button to define customized colors, but does not force it open
   Display Color hDlg, 100, 100, LastSelectedColor&, CustomColorList ,Flags& To ColorResult&
   If ColorResult& = -1 Then
      MsgBox "No color selected!"     'ColorResult$ is set to "" if Cancel/Escape is pressed
   Else
      LastSelectedColor& = ColorResult&    'used SelectedColor& as firstcolor the next time the dialog is displayed
      MsgBox Str$(ColorResult&)
   End If
End Sub
'end:::****************************************

':::Browse for File
Sub BrowseForFile
   Local hParent as DWord, title$, folder$, filter$, start$, defaultext$, flags&, filevar$, countvar&
   hParent = hDlg          'if not parent, use 0 or %hWnd_Desktop
   title$ = "Open File"     'if "", then "Open" is used
   folder$ = "c:\"          'if "", then current directory is used
   filter$ = Chr$("PowerBASIC", 0, "*.bas", 0)    'same as:  "BASIC" + $Nul + "*.bas" + $Nul
      'filter$ consists of pairs of $Nul terminated description/pattern values
      'filter$ example:    Chr$("All Files", 0, "*.*", 0)
      'filter$ example:    Chr$("BASIC", 0, "*.bas;*.inc;*.bak", 0)
      'filter$ example:    Chr$("Bitmap Files", 0, "*.bmp", 0, "All Files", 0, "*.*", 0)
   start$ = ""               'starting filename
   defaultext$ = "bas"
   flags& = %OFN_Explorer Or %OFN_FileMustExist Or %OFN_HideReadOnly
   Display OpenFile hParent, 100, 100, title$, folder$, filter$, start$, _
                     defaultext$, flags& To filevar$, countvar&
   'filevar$ contains returned name of file selected, "" if no file is selected
   'countvar$ contains number of files selected
   If Len(filevar$) Then
      MsgBox filevar$
   Else
      MsgBox "No file selected!"    'ESC or Cancel
   End If
End Sub
'end:::****************************************

':::Confirm Overwrite
Function ConfirmOverWrite (sFileName$) as Long  '-1 approval, 0 not approved
   If IsFile(sFileName$) Then
      'file exists. ask user for permission to overwrite
      Select Case MsgBox ("File exists. Overwrite?", %MB_okcancel Or %MB_IconQuestion, "Save")
         Case %IDOK
            Function = %True
         Case %IDCancel
            Function = %False
      End Select
   Else
      Function = %True   'if file does not exist, permission is granted to create it
   End If
End Function
'end:::****************************************

':::File Changed on Exit
        Case %WM_SYSCOMMAND
                If (Cb.WParam And &HFFF0) = %SC_Close Then          'trap Alt-F4 and X Button
                   If FileChanged And AutoSaveOnExit& Then
                      TreeSaveData          'save without asking
                      Function = 0          'then destroy
                   ElseIf FileChanged Then
                      Style& = %MB_YesNoCancel Or %MB_IconQuestion ' Or %MB_TaskModal
                      Select Case MsgBox("The file has been changed. Save the changes?", Style&, "Close gbSnippets?")
                         Case %IdYes
                            TreeSaveData
                            Function = 0    'Save, then destroy
                         Case %IdNo
                            Function = 0    'Not Save, then destroy
                         Case %IdCancel
                            Function = 1   'True - abort the close - no further processing needed
                      End Select
                   End If
                End If
'end:::****************************************

':::Open in DOS/Window/Explorer
Local TargetPath as Asciiz * %Max_Path
TargetPath = "c:\windows"
ShellExecute(hDlg, "Open", TargetPath, $Nul, $Nul, %SW_Restore)   'window

Local TargetPath as Asciiz * %Max_Path
TargetPath = "c:\windows"
ShellExecute(hDlg, "Explore", TargetPath, $Nul, $Nul, %SW_Restore)  'explorer

Local TargetPath$
TargetPath$ = "c:\Windows"
Shell "cmd /K chdir /D " & TargetPath$        'WinNT, 2000, XP, Vista   DOS
Shell "command /K chdir /D " & TargetPath$   'Win95/98/ME               DOS
'end:::****************************************

':::Text File to Array
Dim count&
Open "myfile.txt" For Input As #1
FileScan #1, RECORDS TO count&        'get count of lines of text in the file
Dim MyArray(count&-1) As String       'Dim 0 to count-1
Line Input #1, MyArray() TO count&    'Get entire array in one gulp, count& gives # lines read
Close #1
'end:::****************************************

':::Text File to String
Dim filedata$
Open "myfile.txt" For Binary As #1
Get$ #1, Lof(1), filedata$    'filedata$ will contain $crlf's from the file
Close #1                      'LOF() returns number of bytes in an Open file

'Note: The string can be loaded into an array using the ParseCount/Parse
'functions as given in these next two statements.
Dim MyArray(ParseCount(filedata$))
Parse filedata$, MyArray(), $crlf
'end:::****************************************

':::Text File 1 Line at a Time
Open "myfile.txt" For Input AS #1
While IsFalse Eof(1)    'Note:  NOT Eof(1) will not work
   Line Input #1, x$
   '...do something with the line read
Wend
Close #1
'end:::****************************************

':::MouseWheel
      Case %WM_MouseWheel
         Select Case Hi(Integer,wParam)    'note the use of Integer
           Case > 0
               Dialog Set Text hDlg, "up  " + Str$(Hi(Integer,wParam))
           Case < 0
               Dialog Set Text hDlg, "down  " + Str$(Hi(Integer,wParam))
         End Select
'end:::****************************************

':::Speech Synthesis (Read Text)
Sub ReadText (sText)
    Local vRes, vTxt, vTime As Variant, oSp as Dispatch
    Set oSp = New Dispatch In "SAPI.SpVoice"
    If IsFalse IsObject(oSp) Then Exit Sub
    vTxt = sText
    Object Call oSp.Speak(vTxt) To vRes
    vTime = -1 As Long
    Object Call oSp.WaitUntilDone(vTime) To vRes
End Sub
'end:::****************************************

':::Remove Double Spaces
While Instr(temp$, "  ")
   Replace "  " With " " In temp$
Wend
'end:::****************************************

':::Special Folders
      Local sPath As Asciiz * %MAX_PATH, temp$
      SHGetFolderPath(0, %CSIDL_DeskTopDirectory, 0, 0, sPath) : temp$ = temp$ + sPath + $crlf
      SHGetFolderPath(0, %CSIDL_Program_Files, 0, 0, sPath) : temp$ = temp$ + sPath + $crlf
      SHGetFolderPath(0, %CSIDL_System, 0, 0, sPath) : temp$ = temp$ + sPath + $crlf
      SHGetFolderPath(0, %CSIDL_Windows, 0, 0, sPath) : temp$ = temp$ + sPath + $crlf
      SHGetFolderPath(0, %CSIDL_DeskTop, 0, 0, sPath) : temp$ = temp$ + sPath + $crlf
      SHGetFolderPath(0, %CSIDL_Programs, 0, 0, sPath) : temp$ = temp$ + sPath + $crlf
      SHGetFolderPath(0, %CSIDL_Personal, 0, 0, sPath) : temp$ = temp$ + sPath + $crlf
      SHGetFolderPath(0, %CSIDL_Startup, 0, 0, sPath) : temp$ = temp$ + sPath + $crlf
      SHGetFolderPath(0, %CSIDL_Startup, 0, 0, sPath) : temp$ = temp$ + sPath + $crlf
      MsgBox temp$
'end:::****************************************


':::sample
'This snippet shows how to compile and run a *.bas file using the PowerBASIC
'compiler (PBWin)

'Compilable Example:
'end:::****************************************