'============================================================================== ' ' SKELETON.BAS for PowerBASIC for Windows ' Copyright (c) 1997-2011 PowerBASIC, Inc. ' All Rights Reserved. ' ' A simple program skeleton ' '============================================================================== #COMPILER PBWIN 10 #DIM ALL #COMPILE EXE '------------------------------------------------------------------------------ #RESOURCE RES, "Skeleton.res" '------------------------------------------------------------------------------ #INCLUDE ONCE "Win32API.inc" '------------------------------------------------------------------------------ %ID_TOOLBAR = %WM_USER + 1024 %IDB_BUTTONS = %ID_TOOLBAR + 1 ' FILE %IDM_NEW = %WM_USER + 2048 ' New File %IDM_OPEN = %IDM_NEW + 1 ' Open File %IDM_CLOSE = %IDM_OPEN + 1 ' Close %IDM_SAVE = %IDM_CLOSE + 1 ' Save %IDM_EXIT = %IDM_SAVE + 1 ' Exit ' EDIT %IDM_CUT = %IDM_EXIT + 1 ' Cut %IDM_COPY = %IDM_CUT + 1 ' Copy %IDM_PASTE = %IDM_COPY + 1 ' Paste ' HELP %IDM_HELP = %IDM_PASTE + 1 ' Help %IDM_ABOUT = %IDM_HELP + 1 ' About Program.Exe '------------------------------------------------------------------------------ GLOBAL g_hInst AS DWORD GLOBAL g_hStatus AS DWORD GLOBAL g_hToolbar AS DWORD GLOBAL g_hWndMain AS DWORD '============================================================================== FUNCTION AboutProc (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, _ BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG '------------------------------------------------------------------------------ ' About Dialog procedure '---------------------------------------------------------------------------- STATIC idTimer AS LONG SELECT CASE AS LONG wMsg CASE %WM_INITDIALOG ' Time-out About box after 4 seconds idTimer = SetTimer(hDlg, BYVAL &H0000FEED, 4000, BYVAL %NULL) CASE %WM_TIMER SendMessage hDlg, %WM_COMMAND, %IDOK, %NULL CASE %WM_COMMAND SELECT CASE LOWRD(wParam) CASE %IDCANCEL KillTimer %NULL, idTimer EndDialog hDlg, 0 FUNCTION = 1 CASE %IDOK, 103 KillTimer %NULL, idTimer EndDialog hDlg, 1 FUNCTION = 1 END SELECT END SELECT END FUNCTION ' End AboutProc '============================================================================== FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _ BYVAL wParam AS DWORD, BYVAL lParam AS LONG) Export AS LONG '------------------------------------------------------------------------------ ' Main window procedure '---------------------------------------------------------------------------- LOCAL lpToolTip AS TOOLTIPTEXT PTR STATIC zText AS ASCIIZ * 255 STATIC hBmp AS DWORD SELECT CASE AS LONG wMsg CASE %WM_CREATE '<- sent here at creation of the main window DIM tbb(0 TO 6) AS TBBUTTON 'Must ensure the CommCtrl.dll is loaded InitCommonControls '---------------------------------------------------------------------- ' Fill the TBBUTTON array with button information for the Toolbar '---------------------------------------------------------------------- tbb(0).iBitmap = 0 tbb(0).idCommand = %IDM_NEW tbb(0).fsState = %TBSTATE_ENABLED tbb(0).fsStyle = %TBSTYLE_BUTTON tbb(0).dwData = 0 tbb(0).iString = 0 tbb(1).iBitmap = 1 tbb(1).idCommand = %IDM_OPEN tbb(1).fsState = %TBSTATE_ENABLED tbb(1).fsStyle = %TBSTYLE_BUTTON tbb(1).dwData = 0 tbb(1).iString = 0 tbb(2).iBitmap = 2 tbb(2).idCommand = %IDM_SAVE tbb(2).fsState = %TBSTATE_ENABLED tbb(2).fsStyle = %TBSTYLE_BUTTON tbb(2).dwData = 0 tbb(2).iString = 0 tbb(3).iBitmap = 0 tbb(3).idCommand = 0 tbb(3).fsState = %TBSTATE_ENABLED tbb(3).fsStyle = %TBSTYLE_SEP tbb(3).dwData = 0 tbb(3).iString = 0 tbb(4).iBitmap = 4 tbb(4).idCommand = %IDM_CUT tbb(4).fsState = %TBSTATE_ENABLED tbb(4).fsStyle = %TBSTYLE_BUTTON tbb(4).dwData = 0 tbb(4).iString = 0 tbb(5).iBitmap = 5 tbb(5).idCommand = %IDM_COPY tbb(5).fsState = %TBSTATE_ENABLED tbb(5).fsStyle = %TBSTYLE_BUTTON tbb(5).dwData = 0 tbb(5).iString = 0 tbb(6).iBitmap = 6 tbb(6).idCommand = %IDM_PASTE tbb(6).fsState = %TBSTATE_ENABLED tbb(6).fsStyle = %TBSTYLE_BUTTON tbb(6).dwData = 0 tbb(6).iString = 0 ' Load the toolbar bitmap hBmp = LoadImage(g_hInst, "TOOLBAR", %IMAGE_BITMAP, 0, 0, _ %LR_LOADMAP3DCOLORS OR %LR_DEFAULTSIZE) ' Create the toolbar window g_hToolbar = CreateToolbarEx(hWnd, %WS_CHILD OR %TBSTYLE_TOOLTIPS, _ %ID_TOOLBAR, 21, %NULL, hBmp, _ tbb(0), UBOUND(tbb)+1, 0, 0, 24, 24, LEN(TBBUTTON)) ' Display the toolbar SendMessage g_hToolbar, %TB_AUTOSIZE, 0, 0 ShowWindow g_hToolbar, %SW_SHOW '---------------------------------------------------------------------- ' Create the status bar window '---------------------------------------------------------------------- g_hStatus = CreateStatusWindow(%WS_CHILD OR %WS_BORDER OR _ %WS_VISIBLE OR %SBS_SIZEGRIP, _ "", hWnd, 200) CASE %WM_NOTIFY '<- events/notifications from for example the ToolTip control lpToolTip = lParam IF @lpToolTip.hdr.code = %TTN_NEEDTEXT THEN LoadString g_hInst, @lpToolTip.hdr.idFrom, zText, SIZEOF(zText) @lpToolTip.lpszText = VARPTR(zText) END IF EXIT FUNCTION CASE %WM_MENUSELECT ' sent on selection change in a menu LoadString g_hInst, wParam, zText, SIZEOF(zText) SendMessage g_hStatus, %WM_SETTEXT, 0, VARPTR(zText) EXIT FUNCTION CASE %WM_MOUSEMOVE ' received on mouse move over the main window zText = "Mouse Position:" & STR$(LOWRD(lParam)) & "," & STR$(HIWRD(lParam)) SendMessage g_hStatus, %WM_SETTEXT, 0, VARPTR(zText) EXIT FUNCTION CASE %WM_SIZE ' the window has been resized SendMessage g_hStatus, wMsg, wParam, lParam SendMessage g_hToolbar, wMsg, wParam, lParam CASE %WM_COMMAND ' events/notifications from controls SELECT CASE AS LONG LOWRD(wParam) CASE %IDM_NEW ' The New command was activated from Button/Menu MSGBOX "NEW selected" EXIT FUNCTION CASE %IDM_OPEN MSGBOX "OPEN selected" EXIT FUNCTION CASE %IDM_CLOSE MSGBOX "CLOSE selected" EXIT FUNCTION CASE %IDM_SAVE MSGBOX "SAVE selected" EXIT FUNCTION CASE %IDM_EXIT SendMessage hWnd, %WM_DESTROY, wParam, lParam EXIT FUNCTION CASE %IDM_CUT MSGBOX "CUT selected" EXIT FUNCTION CASE %IDM_COPY MSGBOX "COPY selected" EXIT FUNCTION CASE %IDM_PASTE MSGBOX "PASTE selected" EXIT FUNCTION CASE %IDM_HELP MSGBOX "There is no help, we are all doomed!" EXIT FUNCTION CASE %IDM_ABOUT ' Load and show Dialog Box from resource - see Skeleton.rc DialogBox(g_hInst, "ABOUT", hWnd, CODEPTR(AboutProc)) EXIT FUNCTION END SELECT CASE %WM_DESTROY ' sent at exit - a good point for cleaning up DeleteObject hBmp ' must delete what we have created PostQuitMessage 0 ' break the message loop in WINMAIN EXIT FUNCTION END SELECT ' pass messages on to Window's default window engine FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam) END FUNCTION ' End WndProc '============================================================================== FUNCTION WINMAIN (BYVAL hInstance AS DWORD, _ BYVAL hPrevInstance AS DWORD, _ BYVAL lpCmdLine AS ASCIIZ PTR, _ BYVAL iCmdShow AS LONG) AS LONG '------------------------------------------------------------------------------ ' Program entry point '---------------------------------------------------------------------------- LOCAL Msg AS TAGMSG LOCAL wce AS WNDCLASSEX LOCAL szClassName AS ASCIIZ * 80 LOCAL hMenu AS DWORD LOCAL hAccel AS DWORD g_hInst = hInstance szClassName = "MYPROGRAM32" '-------------------------------------------------------------------------- ' Setup and Register a window class to be used by the main window '-------------------------------------------------------------------------- wce.cbSize = SIZEOF(wce) wce.STYLE = %CS_HREDRAW OR %CS_VREDRAW wce.lpfnWndProc = CODEPTR(WndProc) wce.hInstance = hInstance wce.hIcon = LoadIcon(hInstance, "PROGRAM") wce.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW) wce.hbrBackground = GetStockObject(%WHITE_BRUSH) wce.lpszClassName = VARPTR(szClassName ) wce.hIconSm = LoadIcon(hInstance, BYVAL %IDI_APPLICATION) RegisterClassEx wce '-------------------------------------------------------------------------- ' Load menu from resource - the code for it is in Skeleton.rc '-------------------------------------------------------------------------- hMenu = LoadMenu(hInstance, "MAINMENU") '-------------------------------------------------------------------------- ' Create a window using the registered class '-------------------------------------------------------------------------- g_hWndMain = CreateWindow(szClassName, _ ' window class name "Simple Program Skeleton", _ ' window caption %WS_OVERLAPPEDWINDOW, _ ' window style %CW_USEDEFAULT, _ ' initial x position %CW_USEDEFAULT, _ ' initial y position %CW_USEDEFAULT, _ ' initial x size %CW_USEDEFAULT, _ ' initial y size %HWND_DESKTOP, _ ' parent window handle hMenu, _ ' window menu handle hInstance, _ ' program instance handle BYVAL %NULL) ' creation parameters '-------------------------------------------------------------------------- ' load keyboard accelerators from resource - the code for it is in Skeleton.rc '-------------------------------------------------------------------------- hAccel = LoadAccelerators(hInstance, "SKELETON") '-------------------------------------------------------------------------- ' Tell Windows hor to show the program at start '-------------------------------------------------------------------------- ShowWindow g_hWndMain, iCmdShow UpdateWindow g_hWndMain '-------------------------------------------------------------------------- ' Message handler loop. This one runs until GetMessage returns zero, ' which happens when a PostQuit message is sent from %WM_DESTROY '-------------------------------------------------------------------------- DO WHILE GetMessage(Msg, BYVAL %NULL, 0, 0) IF ISFALSE TranslateAccelerator(g_hWndMain, hAccel, Msg) THEN TranslateMessage Msg DispatchMessage Msg END IF LOOP '-------------------------------------------------------------------------- ' Exit point '-------------------------------------------------------------------------- FUNCTION = msg.wParam END FUNCTION ' End WinMain