demo LionBasic Warp

[Frank Brübach]

hello.

to improve my knowledge about powerbasic I have made some experiments with the "PBNote2" (pb9\samples\sdk\PBnote2) example and improved it with some more functions. "lionbasic_warp vol 0.1ax" it's just a demo (I hope a good one!) what I can show, but perhaps some day there will be more. I need for eg half a day to solve the problem to include the combobox correctly in toolbar and much more little details where the little nice devil lives.

test and enjoy the demo. I say not much more. explore the feature. it's a lot of more than an editor. I like more and more powerbasic: it's full of feature, goes deep and detailed in coding structure to handle nearly everything. It's hard stuff for me to understand all new things around this great software, but every day I see more light at the powerbasic horizont

take a little time and use this demo with patience. if you like this demo, test it, make some critics. would be very nice. thanks.

info about lionbasic_warp demo: you have only the possibility to use the editor as it is made for. other feature shows graphic elements and some calculations.

best way to start: "file new open" so you can write something and save your text or not. or use File/Lionbasic_Warp to see the first graphic or Examples/graphics ...

I add here only the *.exe file. all work in progress. pictures too. thanks to help mainly from josé until today here at the board! you find the zip file below.

'-------------------------------------------------------------------------------------------------
=> info: the current version of LionBasic Warp Demo you can find every time  here:
   (last update, "lionBasic Warp 0.1bx", tuesday, 20.10.2009)
'-------------------------------------------------------------------------------------------------

good night, frank

[José Roca]

 

I like more and more powerbasic: it's full of feature, goes deep and detailed in coding structure to handle nearly everything. It's hard stuff for me to understand all new things around this great software, but every day I see more light at the powerbasic horizont

I'm glad you have chosen the SDK style of programming. It takes more time to master but has not limitations. And if you want a simplified way of using it, see my posts and examples related to my CWindow class here: http://www.jose.it-berater.org/smfforum/index.php?topic=3130.0

[Frank Brübach]

hi josé, hi all.

yes, it will takes all a little bit longer to fetch a good image or feature, but I will do this hard way of creating new gui's and pb features. I have not very much time at the moment, but this few time I check and explore always new possibilities for sdk windows and its handling.

I'm glad you have chosen the SDK style of programming. It takes more time to master but has not limitations. And if you want a simplified way of using it, see my posts and examples related to my CWindow class here: http://www.jose.it-berater.org/smfforum/index.php?topic=3130.0

thanks for the link, I didn't know these examples. thanks.

I have done a simple FreeImage example. Download all the stuff and the freeimage.inc file.
it's a big size of FreeImage.dll (nearly 2.4 mb size!), but I will use it for some tests for my lionBasic_warp project. one little example I add here as picture. my "load DIBs + BMPs" example some posts (another thread) before didn't need FreeImage.dll so I am happy. I am thinking there are a lot of power in this FreeImage.dll, but if this one is often used by pb users ? don't know.

question: Would be nice to get some infos about the lionBasic_Warp feature "find_execute": you find it here: (menu/ compile?/ find_execute) what result you'll get

thanks, nice day, best regards frank
ps: lionbasic_warp: one little effect I have also included a new sample with "colBoxes", this will follow next week as new update.

[Frank Brübach]

I have updated LionBasic Warp.

next issue and a general question to "winmain" !

1) I wish to include a callback function for opening a new sdk_window. I have managed this one for 90 per cents, BUT I cannot close the new, second sdk_window by "closing" ("x") ... I must go a tricky way

a) minimize the new window ("sdk_window")
b) go to main, first window and close this one ("LionBasic Warp")
c) now it's possible to close the second window or use it.

if somebody has an idea would be very nice.

the problem: If I use "function winmain() as long" to create a new window I cannot use it for callback functions again. I have made a help function called

Code Select Expand

function abc2() as long
...
'but here it's not allowed to use

function winmain() as long

end function

I open this new sdk_window only by

Code Select Expand


...
CASE %IDM_SDKWIN
         MSGBOX "test for open new sdk_win", %MB_ICONINFORMATION, "~lionBasic Warp"
         IF %IDM_SDKWIN THEN
         abc2(1,2,1,2)
         END IF
...

codepart of sdk_window (winmain)

Code Select Expand

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 * 256   ' class name
   LOCAL wcex           AS WNDCLASSEX     ' class information
   LOCAL uMsg           AS tagMsg         ' message information
   LOCAL szCaption      AS ASCIIZ * 256   ' window caption
   LOCAL hWndMain       AS DWORD          ' handle of main window
   LOCAL rc             AS RECT           ' window coordinates
   LOCAL nLeft          AS LONG           ' x-coordinate of the upper-left corner of the rectangle
   LOCAL nTop           AS LONG           ' y-coordinate of the upper-left corner of the rectangle
   LOCAL nWidth         AS LONG           ' x-coordinate of the lower-right corner of the rectangle
   LOCAL nHeight        AS LONG           ' y-coordinate of the lower-right corner of the rectangle

   szClassName        = "my helloWinProgramm_Long"
   wcex.cbSize        = SIZEOF(wcex)                              ' size of WNDCLASSEX structure
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW                ' class styles
   wcex.lpfnWndProc   = CODEPTR(WndProc)                          ' address of window procedure used by class
   wcex.cbClsExtra    = 0                                         ' extra class bytes
   wcex.cbWndExtra    = 0                                         ' extra window bytes
   wcex.hInstance     = hInstance                                 ' instance of the process that is registering the window
   wcex.hIcon         = LoadIcon(hInstance, "Lion.ICO")          ' handle of class icon
   wcex.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)       ' handle of class cursor
   wcex.hbrBackground = GetStockObject(%White_Brush) 'White_Brush              ' brush used to fill background of window's client area
   wcex.hbrBackground = GetStockObject(%BLACK)
   wcex.lpszMenuName  = %NULL                                     ' resource identifier of the class menu
   wcex.lpszClassName = VARPTR(szClassName)                       ' class name
   wcex.hIconSm       = LoadIcon(hInstance, "Lion.ICO")          ' handle of small icon shown in caption/system Taskbar

   IF ISFALSE RegisterClassEx(wcex) THEN EXIT FUNCTION

   ' Retrieve the size of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and size of the window (just a way of doing it, use
   ' wathever method better suits you or fixed values)
   nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.75   ' 75% of the client screen width
   nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.70   ' 70% of the client screen height
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Window caption
   szCaption = "Lions HelloWindowProgramm :)"

   ' Create the window
   hWndMain = CreateWindowEx (0, _                     ' extended style
                              szClassName, _           ' window class name
                              szCaption, _             ' window caption
                              %WS_OVERLAPPEDWINDOW, _  ' window style
                              nLeft, _                 ' initial x position
                              nTop, _                  ' initial y position
                              nWidth, _                ' initial x size
                              nHeight, _               ' initial y size
                              %NULL, _                 ' parent window handle
                              %NULL, _                 ' window menu handle
                              hInstance, _             ' program instance handle
                              BYVAL %NULL)             ' creation parameters

   ' -------------------------------------------------------------------------------------
   ' The ShowWindow function sets the specified window's show state.
   ' -------------------------------------------------------------------------------------

   ShowWindow hWndMain, nCmdShow

   UpdateWindow hWndMain

   
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndMain, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION

anybody can give a good hint ?

- you find "sdk_window menu" here: men\utilities\sdk_window


2) new features: 1x graphic ("colBox") and 1x "input" test dialog, 1x print3DText ("Lionbasic") example
 

please take attention to use this example.

best regards, frank
new demo of "lionbasic_warp 012bx" exe I add here.

[José Roca]

 
You can't reuse the class for the main window to create a popup window. You have to register another class and provide to it its own message pump and callback function. Here is an example:

Code Select Expand


#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL hWndMain    AS DWORD
   LOCAL hCtl        AS DWORD
   LOCAL hFont       AS DWORD
   LOCAL wcex        AS WNDCLASSEX
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL rc          AS RECT
   LOCAL szCaption   AS ASCIIZ * 255
   LOCAL nLeft       AS LONG
   LOCAL nTop        AS LONG
   LOCAL nWidth      AS LONG
   LOCAL nHeight     AS LONG

   hFont = GetStockObject(%ANSI_VAR_FONT)

   ' Register the window class
   szClassName        = "MyClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = %COLOR_3DFACE + 1
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

   ' Window caption
   szCaption = "SDK Main Window"

   ' Retrieve the size of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and size of the window
   nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.75   ' 75% of the client screen width
   nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.70   ' 70% of the client screen height
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_OVERLAPPEDWINDOW OR _
                             %WS_CLIPCHILDREN, _               ' window styles
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x size
                             nHeight, _                        ' initial y size
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   hCtl = CreateWindowEx(0, "BUTTON", "&Popup", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          0, 0, 0, 0, hWndMain, %IDOK, hInstance, BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   hCtl = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          0, 0, 0, 0, hWndMain, %IDCANCEL, hInstance, BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   ' Show the window
   ShowWindow hWndMain, nCmdShow
   UpdateWindow hWndMain

   ' Message handler loop
   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndMain, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL rc AS RECT

   SELECT CASE wMsg

      CASE %WM_CREATE
         ' -------------------------------------------------------
         ' A good place to initiate things, declare variables,
         ' create controls and read/set settings from a file, etc.
         ' -------------------------------------------------------

      CASE %WM_SIZE
         ' ----------------------------------------------------------------------
         ' If you have a Toolbar and/or a Statusbar, send the following messages:
         ' SendMessage hStatusbar, wMsg, wParam, lParam
         ' SendMessage hToolbar, wMsg, wParam, lParam
         ' ----------------------------------------------------------------------

         ' Resize the two sample buttons of the dialog
         IF wParam <> %SIZE_MINIMIZED THEN
            GetClientRect hWnd, rc
            MoveWindow GetDlgItem(hWnd, %IDOK), (rc.nRight - rc.nLeft) - 185, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
            MoveWindow GetDlgItem(hWnd, %IDCANCEL), (rc.nRight - rc.nLeft) - 95, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
         END IF

      CASE %WM_COMMAND
         ' -------------------------------------------------------
         ' Messages from controls and menu items are handled here.
         ' -------------------------------------------------------
         SELECT CASE LO(WORD, wParam)

            CASE %IDOK
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ShowPopupDialog hwnd
               END IF

            CASE %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

         END SELECT

      CASE %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT, %WM_CTLCOLORLISTBOX, %WM_CTLCOLORSTATIC
         ' --------------------------------------------------------
         ' wParam is the handle of the control's display context (hDC)
         ' lParam is the handle of the control
         ' Example of how to set the colors of an specific control:
         ' --------------------------------------------------------
         ' IF lParam = GetDlgItem(hWnd, CtlId) THEN
         '    SetBkColor wParam, GetSysColor(%COLOR_INFOBK)
         '    SetTextColor wParam, GetSysColor(%COLOR_INFOTEXT)
         '    FUNCTION = GetSysColorBrush(%COLOR_INFOBK)
         '    EXIT FUNCTION
         ' END IF
         ' --------------------------------------------------------

      CASE %WM_SYSCOMMAND
         ' Capture this message and send a WM_CLOSE message
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hWnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_CLOSE
         ' --------------------------------------------------------
         ' The WM_CLOSE message is processed BEFORE the WM_DESTROY
         ' message and it can be used to confirm program exit or
         ' tasks like deallocating memory or similar tasks.
         ' --------------------------------------------------------

      CASE %WM_DESTROY
         ' ---------------------------------------------------------------------------
         ' Is sent when program ends - a good place to delete any created objects and
         ' store settings in file for next run, etc. Must send PostQuitMessage to end
         ' properly in SDK-style dialogs. The PostQuitMessage function sends a WM_QUIT
         ' message to the program's (thread's) message queue, and then WM_QUIT causes
         ' the GetMessage function to return zero in WINMAIN's message loop.
         ' ---------------------------------------------------------------------------
         PostQuitMessage 0    ' This function closes the main window
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Popup dialog - Calling example: ShowPopupDialog hWnd
' ========================================================================================
FUNCTION ShowPopupDialog (BYVAL hParent AS LONG) AS LONG

   LOCAL hWndPopup   AS LONG
   LOCAL hCtl        AS LONG
   LOCAL hFont       AS LONG
   LOCAL rc          AS RECT
   LOCAL wcex        AS WNDCLASSEX
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL szCaption   AS ASCIIZ * 255

   hFont = GetStockObject(%ANSI_VAR_FONT)

   szClassName        = "MyPopupClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(PopupDlgProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = GetModuleHandle("")
   wcex.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = %COLOR_3DFACE + 1
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = 0
   wcex.hIconSm       = 0
   RegisterClassEx wcex

   GetWindowRect hParent, rc          ' For centering child in parent
   rc.nRight = rc.nRight - rc.nLeft   ' Parent's width
   rc.nBottom = rc.nBottom - rc.nTop  ' Parent's height

   szCaption = "Popup dialog"
   hWndPopup = CreateWindowEx(%WS_EX_DLGMODALFRAME OR %WS_EX_CONTROLPARENT, _
               szClassName, szCaption, %WS_CAPTION OR %WS_POPUPWINDOW OR %WS_VISIBLE, _
               rc.nLeft + (rc.nRight - 290) / 2, _
               rc.nTop + (rc.nBottom - 180) / 2, _
               290, 180, hParent, 0, GetModuleHandle(""), BYVAL %NULL)

   hCtl = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
               200, 118, 75, 23, hWndPopup, %IDCANCEL, GetModuleHandle(""), BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   ShowWindow hWndPopup, %SW_SHOW
   UpdateWindow hWndPopup
   ' Message handler loop
   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndPopup, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Popup dialog procedure
' ========================================================================================
FUNCTION PopupDlgProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   SELECT CASE wMsg
      CASE %WM_CREATE
         EnableWindow GetWindow(hWnd, %GW_OWNER), %FALSE   ' To make the popup dialog modal

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_CLOSE
         EnableWindow GetWindow(hWnd, %GW_OWNER), %TRUE  ' Maintains parent's zorder

      CASE %WM_DESTROY
         PostQuitMessage 0                ' This function closes the main window
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


[Frank Brübach]

ok thanks for this example. something like that I was looking for it! good.

here my current problem, I have reduce this code as a simple "menu+popup" example.

a) I have a casual menu. b) then I build in this "popup" window. everything seems ok.
c) but if I close the popup window I get always a gpf. so I think I have forgotten a little important thing, isn't it ? same problem I have noticed for my lionbasic example. I am searching for solution since over half an hour ;(

Code Select Expand

'==============================================================================
'
'  Progress.bas example for PowerBASIC for Windows
'  Copyright (c) 2003-2008 PowerBASIC, Inc.
'  All Rights Reserved.
'
'  Simple example of an application that has a menu. No API calls required.
'
'==============================================================================

#COMPILER PBWIN 9
#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"

%IDOK       = 1
%IDCANCEL   = 2
%IDTEXT     = 100
%BS_DEFAULT = 1
%MF_ENABLED = 0

%ID_OPEN    = 401
%ID_EXIT    = 402
%ID_OPTION1 = 403
%ID_OPTION2 = 404
%ID_HELP    = 405
%ID_ABOUT   = 406
%IDPOPUP = 407

' Global variable to receive the user name
GLOBAL UserName AS STRING


CALLBACK FUNCTION OkButton () AS LONG

   IF CB.MSG = %WM_COMMAND AND CB.CTLMSG = %BN_CLICKED THEN
       CONTROL GET TEXT CB.HNDL, %IDTEXT TO UserName
       DIALOG END CB.HNDL, 1
       FUNCTION = 1
   END IF

END FUNCTION


CALLBACK FUNCTION CancelButton () AS LONG

   IF CB.MSG = %WM_COMMAND AND CB.CTLMSG = %BN_CLICKED THEN
       DIALOG END CB.HNDL, 0
       FUNCTION = 1
   END IF

END FUNCTION


CALLBACK FUNCTION DlgProc () AS LONG

   IF CB.MSG = %WM_COMMAND THEN
       IF CB.CTL => %ID_OPEN AND CB.CTL <= %ID_ABOUT THEN
           MSGBOX "WM_COMMAND received from a menu item!"
           FUNCTION = 1
       END IF
   END IF

END FUNCTION


FUNCTION PBMAIN () AS LONG

   LOCAL hDlg    AS DWORD
   LOCAL Result  AS LONG
   LOCAL hMenu   AS DWORD
   LOCAL hPopup1 AS DWORD
   LOCAL hPopup2 AS DWORD

   '----------------------------------------------------------------
   ' Create a new dialog template
   DIALOG NEW 0, "What is your name?", _
   %WS_CAPTION OR %WS_POPUPWINDOW OR %WS_VISIBLE OR %WS_SYSMENU OR %WS_EX_WINDOWEDGE,, 190, 60, 0, 0 TO hDlg

   '----------------------------------------------------------------
   ' Add controls to it
   CONTROL ADD TEXTBOX, hDlg, %IDTEXT, "", 14,  12, 134, 12, 0
   CONTROL ADD BUTTON, hDlg, %IDOK, "OK", 34, 32, 40, 14, %BS_DEFAULT CALL OkButton
   CONTROL ADD BUTTON, hDlg, %IDCANCEL, "Cancel", 84, 32, 40, 14, 0 CALL CancelButton
   CONTROL ADD BUTTON, hDlg, %IDPOPUP, "Popup", 130, 32, 40, 14, _
       %BS_DEFAULT OR %WS_TABSTOP CALL ShowPopupDialog

   '----------------------------------------------------------------
   ' Create a top-level menu:
   MENU NEW BAR TO hMenu

   ' Add a top-level menu item with a popup menu:
   MENU NEW POPUP TO hPopup1
   MENU ADD POPUP, hMenu, "&File", hPopup1, %MF_ENABLED
   MENU ADD STRING, hPopup1, "&Open", %ID_OPEN, %MF_ENABLED
   MENU ADD STRING, hPopup1, "&Exit", %ID_EXIT, %MF_ENABLED
   MENU ADD STRING, hPopup1, "-",      0, 0

   ' Now we can add another item to the menu that will bring up a sub-menu.
   ' First we obtain a new popup menu handle to distinuish it from the first popup menu:
   MENU NEW POPUP TO hPopup2

   ' Now add a new menu item to the first menu.
   ' This item will bring up the sub-menu when selected:
   MENU ADD POPUP, hPopup1, "&More Options", hPopup2, %MF_ENABLED

   ' Now we will define the sub menu:
   MENU ADD STRING, hPopup2, "Option &1", %ID_OPTION1, %MF_ENABLED
   MENU ADD STRING, hPopup2, "Option &2", %ID_OPTION2, %MF_ENABLED

   ' Finally, we'll add a second top-level menu and popup.
   ' For this popup, we can reuse the first popup variable:
   MENU NEW POPUP TO hPopup1
   MENU ADD POPUP,  hMenu, "&Help", hPopup1, %MF_ENABLED
   MENU ADD STRING, hPopup1, "&Help", %ID_HELP, %MF_ENABLED
   MENU ADD STRING, hPopup1, "-",      0, 0
   MENU ADD STRING, hPopup1, "&About", %ID_ABOUT, %MF_ENABLED

   MENU ATTACH hMenu, hDlg

   '----------------------------------------------------------------
   ' Display the dialog
   DIALOG SHOW MODAL hDlg, CALL DlgProc TO Result

   '----------------------------------------------------------------
   ' Check the result at exit
   IF Result THEN
       MSGBOX "Hello " + UserName
   END IF

END FUNCTION


' ========================================================================================
' Popup dialog - Calling example: ShowPopupDialog hWnd
' ========================================================================================
FUNCTION ShowPopupDialog (BYVAL hParent AS LONG) AS LONG

  LOCAL hWndPopup   AS LONG
  LOCAL hCtl        AS LONG
  LOCAL hFont       AS LONG
  LOCAL rc          AS RECT
  LOCAL wcex        AS WNDCLASSEX
  LOCAL szClassName AS ASCIIZ * 80
  LOCAL szCaption   AS ASCIIZ * 255
  LOCAL hInstance   AS DWORD
  LOCAL hdlg AS LONG

  hFont = GetStockObject(%ANSI_VAR_FONT)

  szClassName        = "MyPopupClassName"
  wcex.cbSize        = SIZEOF(wcex)
  wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
  wcex.lpfnWndProc   = CODEPTR(PopupDlgProc)
  wcex.cbClsExtra    = 0
  wcex.cbWndExtra    = 0
  wcex.hInstance     = hInstance'GetModuleHandle("")
  wcex.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
  wcex.hbrBackground = %COLOR_3DFACE + 1
  wcex.lpszMenuName  = %NULL
  wcex.lpszClassName = VARPTR(szClassName)
  wcex.hIcon         = 0
  wcex.hIconSm       = 0
  RegisterClassEx wcex

  GetWindowRect hParent, rc          ' For centering child in parent
  rc.nRight = rc.nRight - rc.nLeft   ' Parent's width
  rc.nBottom = rc.nBottom - rc.nTop  ' Parent's height

  szCaption = "Popup dialog"
  hWndPopup = CreateWindowEx(%WS_EX_DLGMODALFRAME OR %WS_EX_CONTROLPARENT, _
              szClassName, szCaption, %WS_CAPTION OR %WS_POPUPWINDOW OR %WS_VISIBLE OR %WS_SYSMENU OR %WS_EX_WINDOWEDGE, _
              rc.nLeft + (rc.nRight - 290) / 2, _
              rc.nTop + (rc.nBottom - 180) / 2, _
              290, 180, hParent, 0, hInstance, BYVAL %NULL )
               
  hCtl = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
              200, 118, 75, 23, hWndPopup, %IDCANCEL, hInstance, BYVAL %NULL)
             
  IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

  ShowWindow hWndPopup, %SW_SHOW
  UpdateWindow hWndPopup
  ' Message handler loop
  LOCAL uMsg AS tagMsg
  WHILE GetMessage(uMsg, %NULL, 0, 0)
     IF ISFALSE IsDialogMessage(hWndPopup, uMsg) THEN
        TranslateMessage uMsg
        DispatchMessage uMsg
     END IF
  WEND

  FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Popup dialog procedure
' ========================================================================================
FUNCTION PopupDlgProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

  SELECT CASE wMsg
     CASE %WM_CREATE
        EnableWindow GetWindow(hWnd, %GW_OWNER), %FALSE   ' To make the popup dialog modal

     CASE %WM_COMMAND
        SELECT CASE LO(WORD, wParam)
           CASE %IDCANCEL
              IF HI(WORD, wParam) = %BN_CLICKED THEN
                 SendMessage hWnd, %WM_CLOSE, 0, 0
                 EXIT FUNCTION
              END IF
        END SELECT

     CASE %WM_CLOSE
        EnableWindow GetWindow(hWnd, %GW_OWNER), %TRUE  ' Maintains parent's zorder

     CASE %WM_DESTROY
        PostQuitMessage 0                ' This function closes the main window
        EXIT FUNCTION

  END SELECT

  FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================



would be nice to get fixed this problem. I am blind
thanks.

frank

[José Roca]

 

so I think I have forgotten a little important thing, isn't it ?

Yes, not to mix DDT with SDK unless you know what you're doing. ShowPopupDialog is not a callback function, and is not suitable to be used calling it with:

Code Select Expand


    CONTROL ADD BUTTON, hDlg, %IDPOPUP, "Popup", 130, 32, 40, 14, _
        %BS_DEFAULT OR %WS_TABSTOP CALL ShowPopupDialog


You have to remove this call, process the WM_COMMAND message and call the function there:

Code Select Expand


        IF CB.CTL = %IDPOPUP THEN
           ShowPopupDialog CB.HNDL
        END IF


This is the full code:

Code Select Expand


'==============================================================================
'
'  Progress.bas example for PowerBASIC for Windows
'  Copyright (c) 2003-2008 PowerBASIC, Inc.
'  All Rights Reserved.
'
'  Simple example of an application that has a menu. No API calls required.
'
'==============================================================================

#COMPILER PBWIN 9
#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"

%IDOK       = 1
%IDCANCEL   = 2
%IDTEXT     = 100
%BS_DEFAULT = 1
%MF_ENABLED = 0

%ID_OPEN    = 401
%ID_EXIT    = 402
%ID_OPTION1 = 403
%ID_OPTION2 = 404
%ID_HELP    = 405
%ID_ABOUT   = 406
%IDPOPUP = 407

' Global variable to receive the user name
GLOBAL UserName AS STRING


CALLBACK FUNCTION OkButton () AS LONG

    IF CB.MSG = %WM_COMMAND AND CB.CTLMSG = %BN_CLICKED THEN
        CONTROL GET TEXT CB.HNDL, %IDTEXT TO UserName
        DIALOG END CB.HNDL, 1
        FUNCTION = 1
    END IF

END FUNCTION


CALLBACK FUNCTION CancelButton () AS LONG

    IF CB.MSG = %WM_COMMAND AND CB.CTLMSG = %BN_CLICKED THEN
        DIALOG END CB.HNDL, 0
        FUNCTION = 1
    END IF

END FUNCTION


CALLBACK FUNCTION DlgProc () AS LONG

    IF CB.MSG = %WM_COMMAND THEN
        IF CB.CTL = %IDPOPUP THEN
           ShowPopupDialog CB.HNDL
        END IF
        IF CB.CTL => %ID_OPEN AND CB.CTL <= %ID_ABOUT THEN
            MSGBOX "WM_COMMAND received from a menu item!"
            FUNCTION = 1
        END IF
    END IF

END FUNCTION


FUNCTION PBMAIN () AS LONG

    LOCAL hDlg    AS DWORD
    LOCAL Result  AS LONG
    LOCAL hMenu   AS DWORD
    LOCAL hPopup1 AS DWORD
    LOCAL hPopup2 AS DWORD

    '----------------------------------------------------------------
    ' Create a new dialog template
    DIALOG NEW 0, "What is your name?", _
    %WS_CAPTION OR %WS_POPUPWINDOW OR %WS_VISIBLE OR %WS_SYSMENU OR %WS_EX_WINDOWEDGE,, 190, 60, 0, 0 TO hDlg

    '----------------------------------------------------------------
    ' Add controls to it
    CONTROL ADD TEXTBOX, hDlg, %IDTEXT, "", 14,  12, 134, 12, 0
    CONTROL ADD BUTTON, hDlg, %IDOK, "OK", 34, 32, 40, 14, %BS_DEFAULT CALL OkButton
    CONTROL ADD BUTTON, hDlg, %IDCANCEL, "Cancel", 84, 32, 40, 14, 0 CALL CancelButton
    CONTROL ADD BUTTON, hDlg, %IDPOPUP, "Popup", 130, 32, 40, 14, _
        %BS_DEFAULT OR %WS_TABSTOP

    '----------------------------------------------------------------
    ' Create a top-level menu:
    MENU NEW BAR TO hMenu

    ' Add a top-level menu item with a popup menu:
    MENU NEW POPUP TO hPopup1
    MENU ADD POPUP, hMenu, "&File", hPopup1, %MF_ENABLED
    MENU ADD STRING, hPopup1, "&Open", %ID_OPEN, %MF_ENABLED
    MENU ADD STRING, hPopup1, "&Exit", %ID_EXIT, %MF_ENABLED
    MENU ADD STRING, hPopup1, "-",      0, 0

    ' Now we can add another item to the menu that will bring up a sub-menu.
    ' First we obtain a new popup menu handle to distinuish it from the first popup menu:
    MENU NEW POPUP TO hPopup2

    ' Now add a new menu item to the first menu.
    ' This item will bring up the sub-menu when selected:
    MENU ADD POPUP, hPopup1, "&More Options", hPopup2, %MF_ENABLED

    ' Now we will define the sub menu:
    MENU ADD STRING, hPopup2, "Option &1", %ID_OPTION1, %MF_ENABLED
    MENU ADD STRING, hPopup2, "Option &2", %ID_OPTION2, %MF_ENABLED

    ' Finally, we'll add a second top-level menu and popup.
    ' For this popup, we can reuse the first popup variable:
    MENU NEW POPUP TO hPopup1
    MENU ADD POPUP,  hMenu, "&Help", hPopup1, %MF_ENABLED
    MENU ADD STRING, hPopup1, "&Help", %ID_HELP, %MF_ENABLED
    MENU ADD STRING, hPopup1, "-",      0, 0
    MENU ADD STRING, hPopup1, "&About", %ID_ABOUT, %MF_ENABLED

    MENU ATTACH hMenu, hDlg

    '----------------------------------------------------------------
    ' Display the dialog
    DIALOG SHOW MODAL hDlg, CALL DlgProc TO Result

    '----------------------------------------------------------------
    ' Check the result at exit
    IF Result THEN
        MSGBOX "Hello " + UserName
    END IF

END FUNCTION


' ========================================================================================
' Popup dialog - Calling example: ShowPopupDialog hWnd
' ========================================================================================
FUNCTION ShowPopupDialog (BYVAL hParent AS LONG) AS LONG

   LOCAL hWndPopup   AS LONG
   LOCAL hCtl        AS LONG
   LOCAL hFont       AS LONG
   LOCAL rc          AS RECT
   LOCAL wcex        AS WNDCLASSEX
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL szCaption   AS ASCIIZ * 255
   LOCAL hInstance   AS DWORD
   LOCAL hdlg AS LONG

   hFont = GetStockObject(%ANSI_VAR_FONT)

   szClassName        = "MyPopupClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(PopupDlgProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance'GetModuleHandle("")
   wcex.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = %COLOR_3DFACE + 1
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = 0
   wcex.hIconSm       = 0
   RegisterClassEx wcex

   GetWindowRect hParent, rc          ' For centering child in parent
   rc.nRight = rc.nRight - rc.nLeft   ' Parent's width
   rc.nBottom = rc.nBottom - rc.nTop  ' Parent's height

   szCaption = "Popup dialog"
   hWndPopup = CreateWindowEx(%WS_EX_DLGMODALFRAME OR %WS_EX_CONTROLPARENT, _
               szClassName, szCaption, %WS_CAPTION OR %WS_POPUPWINDOW OR %WS_VISIBLE OR %WS_SYSMENU OR %WS_EX_WINDOWEDGE, _
               rc.nLeft + (rc.nRight - 290) / 2, _
               rc.nTop + (rc.nBottom - 180) / 2, _
               290, 180, hParent, 0, hInstance, BYVAL %NULL )
                 
   hCtl = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
               200, 118, 75, 23, hWndPopup, %IDCANCEL, hInstance, BYVAL %NULL)
               
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   ShowWindow hWndPopup, %SW_SHOW
   UpdateWindow hWndPopup
   ' Message handler loop
   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndPopup, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Popup dialog procedure
' ========================================================================================
FUNCTION PopupDlgProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   SELECT CASE wMsg
      CASE %WM_CREATE
         EnableWindow GetWindow(hWnd, %GW_OWNER), %FALSE   ' To make the popup dialog modal

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_CLOSE
         EnableWindow GetWindow(hWnd, %GW_OWNER), %TRUE  ' Maintains parent's zorder

      CASE %WM_DESTROY
         PostQuitMessage 0                ' This function closes the main window
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


[Frank Brübach]

oh yes, I see thank you !

Yes, not to mix DDT with SDK unless you know what you're doing. ShowPopupDialog is not a callback function, and is not suitable to be used calling it with:

I have solved my two little problems.

1) "input box" can open a) a new "popup dialogue" without having
    problems after b) closing the dialogue was fixed

2) my second sdk window runs (you can open a quite new sdk window!) !

   => you will find this popup sdk window: menu "utilities"\sdk_window.
        perhaps you like it ?

   => open new "sdk window" you will find plus a "close" and a "popup" button with callbacks

   - still little problem: colour blur effect of SDK window, if you click first the main window and then some  
     colours are changing, but I know where this little evil friend lives ! I erase this effect with next
     release.

pictures and exe file as attachment.

that was a very good feeling, to solve this sdk window problem and see everything is running again as I liked it. it's really a big different to use ddt functions or sdk window features! I have to take care for it for the future. thanks for the good script two post before, josé ! I like powerbasic like a beautiful vamp

3) new update of "Lionbasic Warp Demo" you will find everytime in my first post too.

feel free to test this demo to make it better! I would be very thankful !

good night, thanks, best regards, frank

[Frank Brübach]

good evening.

I am looking for an alternative example how to create an inputbox$ calculation for numbers (add, minus, multiply, divide), but not with this kind of antique inputbox$ example I am sending here

Code Select Expand

#DIM ALL
#COMPILE EXE
%USEMACROS = 1
#INCLUDE "Win32API.inc"


FUNCTION PBMAIN() AS LONG
    LOCAL Number$
    LOCAL E AS LONG
    LOCAL F AS LONG
    LOCAL G AS LONG

   Number$ = INPUTBOX$("multiply some values..","Simple Inputbox_Test","5.86") : E = VAL(Number$)

   MSGBOX "number$= "+Number$+" val(number$)= " +STR$(VAL(Number$))+ " E = " +STR$(E),%MB_OK, "one.."

   Number$ = INPUTBOX$("enter second value: ","LionBasic Inputbox_Test","16.49") : F = VAL(Number$)

   MSGBOX "E ="+STR$(E)+" number$ = " + Number$ +" val(number$) = "+STR$(VAL(Number$))+" F = "+STR$(F), %MB_OK, "two.."

   MSGBOX "value E = " + STR$(E)+ " value F = " + STR$(F) + " multiply: E * F = " + STR$(E*F), %MB_OK, "three.."
   G = E * F

   MSGBOX "result [e+f] : G = " + STR$(G), %MB_OK, "final result"


END FUNCTION


perhaps somebody can help. I want to include this feature in my lionbasic demo. best way would be to have an inputbox field or inputmask where the user can type in values and get by button-click (result) the answer. I have tried this one with a DLL but haven't yet grasp it. sorry.

best regards, Frank

[José Roca]

 
See the HexCalc example: http://www.jose.it-berater.org/smfforum/index.php?topic=1702.0

[Frank Brübach]

thanks josé !

but some values or hex numbers doesn't work at petzold's example correct type in: 8*6 = 30 (), not a joke!

but here I have a nearly complete calculator example with callbacks:

there are only these code lines wrong ("val" needs a "string", I know, but this doesn't work at all):

for example:

Code Select Expand

tmpStr = VAL(FORMAT$(CBWPARAM - %CtrlN00) )
...

%pct or pct = 1/100 ' does it mean: percent as long
...

tmpStr = VAL(VAL(tmpStr) & "." & FORMAT$(CBWPARAM - %CtrlN00))


perhaps you or anybody else can fix it, so this calculator works perfect

Code Select Expand


       
... I have deleted this code. I will try to fix whole calculator code and publish again, sorry...  




best regards, frank

[José Roca]

 

but some values or hex numbers doesn't work at petzold's example correct type in: 8*6 = 30 (), not a joke!

It is an hexadecimal calculator, not a decimal one. In hexadecimal, 8*6 = 30.

[José Roca]

 

tmpStr = VAL(FORMAT$(CBWPARAM - %CtrlN00) )
...
tmpStr = VAL(VAL(tmpStr) & "." & FORMAT$(CBWPARAM - %CtrlN00))

I'm afraid you must re-read the topics for VAL and FORMAT$ in the help file. VAL returns a numeric value, therefore you are using it improperly.

Code Select Expand


tmpStr = VAL(FORMAT$(CBWPARAM - %CtrlN00) )


must be:

Code Select Expand


tmpStr = FORMAT$(CBWPARAM - %CtrlN00)


Code Select Expand


tmpStr = VAL(VAL(tmpStr) & "." & FORMAT$(CBWPARAM - %CtrlN00))


must be:

Code Select Expand


tmpStr = tmpStr & "." & FORMAT$(CBWPARAM - %CtrlN00)


[José Roca]

 

%pct or pct = 1/100 ' does it mean: percent as long

No, it does not. Equates in PB are integer values and %pct = 1/100 will be 0.

Later you're using it as if it was a function:

Code Select Expand


%Pct(VAL(PrevVal), VAL(tmpStr) )


Equates are constant values, not functions or macros.

Code Select Expand


perhaps you or anybody else can fix it, so this calculator works perfect


Impossible to fix it easily. You have switched again to DDT and you won't be able to detect the keystrokes. If you want to use DDT, the PB Forum has recently opened a dedicated forum: http://www.powerbasic.com/support/pbforums/forumdisplay.php?f=33

[Frank Brübach]

short: hello josé

1) first: yes you are right, I have read something wrong, sorry... "VAL" turns a string argument into a number, I had read it too fast, sorry. here a correct example for it.

Code Select Expand

#COMPILE EXE
#DIM ALL

FUNCTION PBMAIN () AS LONG

DIM i AS LONG
DIM j AS LONG
DIM x AS LONG
DIM y AS LONG

i& = VAL("&HF5F3")       ' Hex, returns -2573 (signed)
MSGBOX "hex: " + STR$(i&)

j& = VAL("&H0F5F3")      ' Hex, returns 62963 (unsigned)
MSGBOX "hex: " + STR$(j&)


x& = VAL("&B0100101101") ' Binary, returns 301 (unsigned)
MSGBOX "binary: " + STR$(x&)

y& = VAL("&O4574514")    ' Octal, returns 1243468 (signed)
MSGBOX "octal: " + STR$(y&)


END FUNCTION


2) thank you for your prompted help, I will check the code of the calculator again to fix it.

3) yes, petzold has done really a hexadecimal calculator, I see it! uargh!

4) thank you, may be the right one: I have found this example I needed for input test and get feedback, great!

If you want to use DDT, the PB Forum has recently opened a dedicated forum: http://www.powerbasic.com/support/pbforums/forumdisplay.php?f=33

5) better to learn with existing examples, so I can see how does it work. I have found this ddt example (calculator) to understand these things with callbacks, I didn't want really to switch to ddt   more to come, you will see.

best regards, nice evening, frank