Powerbasic Museum 2020-B

General Category => General Discussion => Topic started by: Frank Brübach on October 17, 2009, 12:48:23 AM

Title: demo LionBasic Warp
Post by: Frank Brübach on October 17, 2009, 12:48:23 AM
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
Title: Re: demo LionBasic Warp
Post by: José Roca on October 17, 2009, 03:42:04 AM
 
Quote
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
Title: Re: demo LionBasic Warp
Post by: Frank Brübach on October 17, 2009, 04:49:03 PM
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.

QuoteI'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.
Title: Re: demo LionBasic Warp
Post by: Frank Brübach on October 19, 2009, 03:57:23 PM
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

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


...
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)

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.
Title: Re: demo LionBasic Warp
Post by: José Roca on October 19, 2009, 05:26:08 PM
 
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:


#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
' ========================================================================================

Title: Re: demo LionBasic Warp
Post by: Frank Brübach on October 19, 2009, 09:51:13 PM
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 ;(

'==============================================================================
'
'  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
Title: Re: demo LionBasic Warp
Post by: José Roca on October 19, 2009, 10:28:41 PM
 
Quote
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:


    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:


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


This is the full code:


'==============================================================================
'
'  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
' ========================================================================================

Title: Re: demo LionBasic Warp
Post by: Frank Brübach on October 20, 2009, 01:30:18 AM
oh yes, I see :) thank you !

QuoteYes, 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!)  ! :D

   => 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
Title: Re: demo LionBasic Warp + Inputbox$
Post by: Frank Brübach on October 21, 2009, 08:19:31 PM
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 ;)

#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
Title: Re: demo LionBasic Warp
Post by: José Roca on October 21, 2009, 08:33:30 PM
 
See the HexCalc example: http://www.jose.it-berater.org/smfforum/index.php?topic=1702.0
Title: Re: demo LionBasic Warp + calculator
Post by: Frank Brübach on October 21, 2009, 09:45:55 PM
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:
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 :)


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




best regards, frank
Title: Re: demo LionBasic Warp
Post by: José Roca on October 21, 2009, 10:06:49 PM
 
Quote
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.
Title: Re: demo LionBasic Warp
Post by: José Roca on October 21, 2009, 10:19:58 PM
 
Quote
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.


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


must be:


tmpStr = FORMAT$(CBWPARAM - %CtrlN00)



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


must be:


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

Title: Re: demo LionBasic Warp
Post by: José Roca on October 21, 2009, 10:30:48 PM
 
Quote
%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:


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


Equates are constant values, not functions or macros.


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
Title: Re: demo LionBasic Warp
Post by: Frank Brübach on October 21, 2009, 10:40:34 PM
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.

#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!

QuoteIf 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
Title: Re: demo LionBasic Warp
Post by: Frank Brübach on October 22, 2009, 10:06:05 AM
good morning,

here first of all the "decimal Calculator" from petzold's "hexCalculator" I have changed correctly :)

I will check other possibilities to make an own sdk window for InputBoxes and Calculations. not doing this one with ddt, so it's boring enough. I was very tired last night. Better to sleep if you are tired to prevent mistakes. I must grinning.

' ========================================================================================
' HEXCALC.BAS
' This program is a translation of HEXCALC.C -- Hexadecimal Calculator
' © Charles Petzold, 1998, described and analysed in Chapter 11 of the book Programming
' Windows, 5th Edition.
' Perhaps the epitome of lazy programming is the HEXCALC program. This program doesn't
' call CreateWindow at all, never processes WM_PAINT messages, never obtains a device
' context, and never processes mouse messages. Yet it manages to incorporate a 10-function
' hexadecimal calculator with a full keyboard and mouse interface in fewer than 150 lines
' of source code.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"
#RESOURCE "hexcalc.pbr"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
                 BYVAL pszCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG

  LOCAL szAppName AS ASCIIZ * 256
  LOCAL msg       AS tagMsg
  LOCAL hWnd      AS DWORD
  LOCAL wc        AS WNDCLASS

  szAppName        = "HexCalc"
  wc.style         = %CS_HREDRAW OR %CS_VREDRAW
  wc.lpfnWndProc   = CODEPTR(WndProc)
  wc.cbClsExtra    = 0
  wc.cbWndExtra    = %DLGWINDOWEXTRA    ' // Note!
  wc.hInstance     = hInstance
  wc.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION) '%NULL
  wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
  wc.hbrBackground = %COLOR_BTNFACE + 1
  wc.lpszMenuName  = %NULL
  wc.lpszClassName = VARPTR(szAppName)

  IF ISFALSE RegisterClass(wc) THEN EXIT FUNCTION

  hWnd = CreateDialog (hInstance, szAppName, 0, %NULL)

  ShowWindow hWnd, iCmdShow

  WHILE GetMessage(msg, %NULL, 0, 0)
     TranslateMessage msg
     DispatchMessage msg
  WEND

  FUNCTION = Msg.wParam

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

' ========================================================================================
SUB ShowNumber (BYVAL hWnd AS DWORD, BYVAL iNumber AS DWORD)
  LOCAL szBuffer AS ASCIIZ * 20
  wsprintf szBuffer, "%X", BYVAL iNumber
  SetDlgItemText hWnd, %VK_ESCAPE, szBuffer
  SetDlgItemText hWnd, %VK_ESCAPE, FORMAT$(iNumber) '- HEX$(iNumber)
END SUB
' ========================================================================================

' ========================================================================================
FUNCTION CalcIt (BYVAL iFirstNum AS DWORD, BYVAL iOperation AS LONG, BYVAL iNum AS DWORD) AS DWORD

  SELECT CASE CHR$(iOperation)
    CASE "=": FUNCTION = iNum
    CASE "+": FUNCTION = iFirstNum +  iNum
    CASE "-": FUNCTION = iFirstNum -  iNum
    CASE "*": FUNCTION = iFirstNum *  iNum
    CASE "&": FUNCTION = iFirstNum AND  iNum
    CASE "|": FUNCTION = iFirstNum OR  iNum
    CASE "^": FUNCTION = iFirstNum ^  iNum
    CASE "<": SHIFT LEFT iFirstNum, iNum : FUNCTION = iFirstNum
    CASE ">": SHIFT RIGHT iFirstNum, iNum : FUNCTION = iFirstNum
    CASE "/": FUNCTION = IIF&(iNum = 0, %MAXDWORD, iFirstNum \ iNum)
    CASE "%": FUNCTION = IIF&(iNum = 0, %MAXDWORD, iFirstNum MOD iNum)
    CASE ELSE : FUNCTION = 0
  END SELECT

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

' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL message AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

  STATIC bNewNumber AS LONG
  STATIC iOperation AS LONG
  STATIC iNumber    AS DWORD
  STATIC iFirstNum  AS DWORD
  LOCAL  hButton    AS DWORD
  LOCAL  dwTemp     AS DWORD

  SELECT CASE message

     CASE %WM_CREATE
        bNewNumber = %TRUE
        iOperation = ASC("=")
        FUNCTION = 0
        EXIT FUNCTION

     CASE %WM_KEYDOWN                ' left arrow --> backspace
        IF wParam <> %VK_LEFT THEN EXIT FUNCTION
        SendMessage hWnd, %WM_CHAR, %VK_BACK, 0

     CASE %WM_CHAR
        wParam = ASC(UCASE$(CHR$(wParam)))
        IF wParam = %VK_RETURN THEN wParam = ASC("=")
        hButton = GetDlgItem(hWnd, wParam)
        IF hButton THEN
           SendMessage hButton, %BM_SETSTATE, 1, 0
           ApiSleep 100
           SendMessage hButton, %BM_SETSTATE, 0, 0
        ELSE
           MessageBeep 0
        END IF
        SendMessage hWnd, %WM_COMMAND, wParam, 0

     CASE %WM_COMMAND
        SetFocus hWnd
        IF LOWRD(wParam) = %VK_BACK THEN          ' backspace
           iNumber = iNumber \ 16
           ShowNumber hWnd, iNumber
        ELSEIF LOWRD(wParam) = %VK_ESCAPE THEN    ' escape
           iNumber = 0
           ShowNumber hWnd, iNumber
        ELSEIF isxdigit(LOWRD(wParam)) THEN       ' hex digit
           IF bNewNumber THEN
              iFirstNum = iNumber
              iNumber = 0
           END IF
           bNewNumber = %FALSE
           dwTemp = %MAXDWORD
           SHIFT RIGHT dwTemp, 4
           IF iNumber <= dwTemp THEN
              iNumber = 16 * iNumber + wParam - IIF&(isdigit(wParam), ASC("0"), ASC("A") - 10)
              ShowNumber hWnd, iNumber
           ELSE
              MessageBeep 0
           END IF
        ELSE                                      ' operation
           IF ISFALSE bNewNumber THEN
              iNumber = CalcIt (iFirstNum, iOperation, iNumber)
              ShowNumber hWnd, iNumber
           END IF
           bNewNumber = %TRUE
           iOperation = LOWRD(wParam)
        END IF

     CASE %WM_DESTROY
        PostQuitMessage 0
        FUNCTION = 0
        EXIT FUNCTION

  END SELECT

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

END FUNCTION
'



zip file and picture below. more to come. I will show new way to include calculations with inputmask for lionBasic Warp next time. I try to open by sdk_window (second picture) a new calculator with inputs and feedback results. - by the way: the big "ddt calculator" is on the road again to work fine as soon as possible. thanks.


frank
Title: Re: demo LionBasic Warp
Post by: Frank Brübach on October 23, 2009, 03:46:41 PM
more than one question ;)

I am trying to make an "cWindow" sdk with popup menu. I have managed this part. but with a normal sdk feature, because I don't know how to use "cWindow" features for popup menus or handling for new properties and buttons or changing values in combo boxes and much more. does anybody has an existing cWindow example they are using this features ?

my "cWindow-popup" example:

' ########################################################################################
' SDK window with gradient.
' ########################################################################################

#DIM ALL
#COMPILE EXE

%USEMACROS = 1                  ' // Use macros
%USERICHEDIT = 1              ' // Use RichEdit
#INCLUDE ONCE "CWindow.inc"     ' // CWindow class
#INCLUDE ONCE "CommCtrl.inc"     ' // CWindow class
#INCLUDE ONCE "winctrl.inc"   ' // Window wrapper functions
#INCLUDE ONCE "richedit.inc"
%IDMonster = 2
%IDCombo = 3
%IDText = 4
%IDScroll = 5
%IDTool = 6
%IDRich = 7
%IDCombobox = 8
'%IDTEXT = 9

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

  ' // Create an instance of the class
  LOCAL pWindow AS IWindow
  pWindow = CLASS "CWindow"
  IF ISNOTHING(pWindow) THEN EXIT FUNCTION

  ' // Create the main window
  LOCAL hwnd AS DWORD
  hwnd = pWindow.CreateWindow(%NULL, "SDK Window with gradient Effect", %CW_USEDEFAULT, %CW_USEDEFAULT, _
         %CW_USEDEFAULT, %CW_USEDEFAULT, -1, -1, CODEPTR(WindowProc))

  ' // Change the style of the main window class
  SetClassLong hwnd, %GCL_STYLE, %CS_DBLCLKS OR %CS_HREDRAW OR %CS_VREDRAW

  ' // Add two buttons without position or size (they will be resized
  ' // in the WM_SIZE message).
  pWindow.AddButton(hwnd, %IDOK,     "&Ok_Open",   0, 0, 0, 0, -1, -1)
  pWindow.AddButton(hwnd, %IDCANCEL, "&Quit", 0, 0, 0, 0, -1, -1)
  pWindow.AddButton(hwnd, %IDMONSTER, "&Monster", 10, 36, 50, 50, -1, -1)
  pWindow.AddCombobox(hwnd, %IDCombo, "&Combo", 10, 100, 60, 60, -1, -1)
  pWindow.AddToolbar(hwnd, %IDTool, "&Combo", 10, 100, 60, 60, -1, -1)
  pWindow.AddRichEdit(hwnd,%IDRich, "&Write something! RichEdit, pherhaps here could read some day the whole story of the 'Lords of the Rings' adventures!", 340,410,120,80,-1,-1)
  pWindow.AddTextbox(hwnd, %IDText, "&Info:Text", 10, 140, 40, 40, -1, -1)
  pWindow.AddVScrollBar(hwnd, %IDScroll, "&ToolBar", 20, 400, 40, 120, -1, -1)
  pWindow.AddVScrollBar(hwnd, %IDScroll, "&ToolBar", 70, 400, 40, 120, -1, -1)

  ' // Force the resizing of the buttons by sending a WM_SIZE message
  SendMessage hwnd, %WM_SIZE, 0, 0

  ' // Default message pump (you can replace it with your own)
  pWindow.DoEvents

END FUNCTION
' ########################################################################################

' ========================================================================================
' Gradient fill procedure
' ========================================================================================
SUB DrawGradient (BYVAL hDC AS DWORD)

  LOCAL rectFill   AS RECT
  LOCAL rectClient AS RECT
  LOCAL fStep      AS SINGLE
  LOCAL hBrush     AS DWORD
  LOCAL lOnBand    AS LONG

  GetClientRect WindowFromDC(hDC), rectClient
  fStep = rectClient.nbottom / 200

  FOR lOnBand = 0 TO 199
     SetRect rectFill, 0, lOnBand * fStep, rectClient.nright + 1, (lOnBand + 1) * fStep
     hBrush = CreateSolidBrush(RGB(100, 0, (255 - lOnBand)))
     FillRect hDC, rectFill, hBrush
     DeleteObject hBrush
  NEXT

END SUB
' ========================================================================================

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

  LOCAL hDC AS DWORD
  LOCAL pPaint AS PAINTSTRUCT
  LOCAL rc AS RECT

  SELECT CASE uMsg

     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

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

        END SELECT



     CASE %WM_PAINT
        hDC = BeginPaint(hwnd, pPaint)
        GetClientRect hwnd, rc
        SetBkMode hDC, %TRANSPARENT
        SetTextColor hDC, %WHITE
        DrawText hDC, "Hello, my funny and exciting cWindows!", -1, rc, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
        EndPaint hwnd, pPaint
        FUNCTION = %TRUE
        EXIT FUNCTION

     CASE %IDMonster
         MSGBOX "more to come as soon as possible", %MB_ICONINFORMATION, "Info: Cwindow says Yep!"

     CASE %WM_ERASEBKGND
        hDC = wParam
        DrawGradient hDC
        FUNCTION = %TRUE
        EXIT FUNCTION

     CASE %WM_SIZE
        IF wParam <> %SIZE_MINIMIZED THEN
           GetClientRect hwnd, rc
           MoveWindow GetDlgItem(hwnd, %IDMonster), (rc.nRight - rc.nLeft) - 425, (rc.nBottom - rc.nTop) - 55, 55, 55, %TRUE '35, 75, 23, %TRUE
           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_DESTROY
        PostQuitMessage 0
        EXIT FUNCTION

  END SELECT

  FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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
' ========================================================================================

' ========================================================================================
' 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

  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 with SDK"
  hWndPopup = CreateWindowEx(%WS_EX_DLGMODALFRAME OR %WS_EX_CONTROLPARENT, _
              szClassName, szCaption, %WS_CAPTION OR %WS_POPUPWINDOW OR %WS_VISIBLE OR %WS_OVERLAPPEDWINDOW OR %WS_CLIPCHILDREN, _
              rc.nLeft + (rc.nRight - 290) / 2, _
              rc.nTop + (rc.nBottom - 180) / 2, _
              340, 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, hInstance, BYVAL %NULL)
  hCtl = CreateWindowEx(0, "BUTTON", "&Monster", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
              60, 118, 75, 23, hWndPopup, %IDOK, hInstance, BYVAL %NULL)
  hCtl = CreateWindowEx(0, "Combobox", "&TEXT", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
              80, 80, 125, 25, hWndPopup, %IDCombobox, hInstance, BYVAL %NULL)
  hCtl = CreateWindowEx(0, "Combobox", "&type in", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
              80, 40, 100, 25, hWndPopup, %IDTEXT, 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
' =================================


my idea was to make some new feature for LionBasic Warp (via Menus) to open new sdk windows or cWindows with more functions and possibilities for sdk handling. the popup window in this example should be help to make some day "user inputs" for values and calculate something. !? ;)

nice day, frank
Title: Re: demo LionBasic Warp
Post by: José Roca on October 23, 2009, 05:50:29 PM
 
Do not use low numbers for the identifiers, such %IDMonster = 2, %IDCombo = 3 because these numbers are used by Windows for its own identifiers, and if you click the monster button having assigned to it a value of 2 you will receive an %IDCANCEL message.

Do not use the same identifier for different controls or you will be unable to ascertain which one has been clicked.

Do not try to process control messages putting the CASE xxx anywhere. Control and menu items must be processed under the %WM_COMMAND message. CASE %IDMonster is misplaced.

Adding scrollbars isn't going to make your dialog scrollable. Size the dialog according your needs.

The CWindow class has been designed to just make easier to create dialogs and add controls with less verbosity, i.e. without having to create a class first, and with a simplified syntax. But it has not properties for each control ala Visual Basic because this will require a very big amount of code and will bloat the size of the program.

My headers contain wrapper functions to handle all the messages of all the common controls.

AnimateCtrl.inc (Animation control)
ButtonCtrl.inc (Button control)
ComboBoxCtrl.inc (ComboBox control)
ComboBoxExCtrl.inc (ComboBoxEx control)
DateTimeCtrl.inc (Date Time control)
EditCtrl.inc (Edit control)
HeaderCtrl.inc (Header control)
HotKeyCtrl.inc (Hot Key control)
IPAddressCtrl.inc (IP Address control)
ListBoxCtrl.inc (ListBox control)
ListViewCtrl.inc (ListView control)
MonthCalCtrl.inc (Month Calendar control)
PagerCtrl.inc (Pager control)
ProgressBarCtrl.inc (Progress Bar control)
RebarCtrl.inc (Rebar control)
RichEditCtrl.inc (Rich Edit control)
ScrollBarCtrl.inc (Scroll Bar control)
StaticCtrl.inc (Static control)
StatusbarCtrl.inc (Status Bar control)
SysLinkCtrl.inc (SysLink control)
TabCtrl.inc (Tab control)
TaskDialogCtrl.inc (Task Dialog control)
ToolbarCtrl.inc (Toolbar control)
TrackbarCtrl.inc (Track Bar control)
TreeViewCtrl.inc (TreeView control)
UpDownCtrl.inc (UpDown control)

They are documented in my reference guides for them:

http://www.jose.it-berater.org/comctrl/iframe/index1.htm
http://www.jose.it-berater.org/comctrl/iframe/index2.htm

Finally, there is a modified version of your test program:


' ########################################################################################
' SDK window with gradient.
' ########################################################################################

#DIM ALL
#COMPILE EXE

%USEMACROS = 1                  ' // Use macros
%USERICHEDIT = 1              ' // Use RichEdit
#INCLUDE ONCE "CWindow.inc"     ' // CWindow class
#INCLUDE ONCE "CommCtrl.inc"     ' // Common controls
#INCLUDE ONCE "winctrl.inc"   ' // Window wrapper functions
#INCLUDE ONCE "richedit.inc"
%IDMonster = 1001
%IDCombo = 1002
%IDText = 1003
%IDScroll = 1004
%IDTool = 1005
%IDRich = 1006
%IDCombobox = 1007
'%IDTEXT = 1008

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

  ' // Create an instance of the class
  LOCAL pWindow AS IWindow
  pWindow = CLASS "CWindow"
  IF ISNOTHING(pWindow) THEN EXIT FUNCTION

  ' // Create the main window
  LOCAL hwnd AS DWORD
  hwnd = pWindow.CreateWindow(%NULL, "SDK Window with gradient Effect", 0, 0, _
         500, 400, -1, -1, CODEPTR(WindowProc))

  ' // Change the style of the main window class
  SetClassLong hwnd, %GCL_STYLE, %CS_DBLCLKS OR %CS_HREDRAW OR %CS_VREDRAW

  ' // Add two buttons without position or size (they will be resized
  ' // in the WM_SIZE message).
  pWindow.AddButton(hwnd, %IDOK,     "&Ok_Open",   0, 0, 0, 0, -1, -1)
  pWindow.AddButton(hwnd, %IDCANCEL, "&Quit", 0, 0, 0, 0, -1, -1)
  pWindow.AddButton(hwnd, %IDMONSTER, "&Monster", 10, 36, 50, 50, -1, -1)
  pWindow.AddCombobox(hwnd, %IDCombo, "&Combo", 10, 100, 60, 60, -1, -1)
  pWindow.AddToolbar(hwnd, %IDTool, "", 10, 100, 60, 60, -1, -1)
  pWindow.AddRichEdit(hwnd,%IDRich, "Write something! RichEdit, pherhaps here could read some day the whole story of the 'Lords of the Rings' adventures!", 10,250,120,80,-1,-1)
  pWindow.AddTextbox(hwnd, %IDText, "", 10, 140, 40, 40, -1, -1)

  ' // Force the resizing of the buttons by sending a WM_SIZE message
  SendMessage hwnd, %WM_SIZE, 0, 0

  ' // Default message pump (you can replace it with your own)
  pWindow.DoEvents

END FUNCTION
' ########################################################################################

' ========================================================================================
' Gradient fill procedure
' ========================================================================================
SUB DrawGradient (BYVAL hDC AS DWORD)

  LOCAL rectFill   AS RECT
  LOCAL rectClient AS RECT
  LOCAL fStep      AS SINGLE
  LOCAL hBrush     AS DWORD
  LOCAL lOnBand    AS LONG

  GetClientRect WindowFromDC(hDC), rectClient
  fStep = rectClient.nbottom / 200

  FOR lOnBand = 0 TO 199
     SetRect rectFill, 0, lOnBand * fStep, rectClient.nright + 1, (lOnBand + 1) * fStep
     hBrush = CreateSolidBrush(RGB(100, 0, (255 - lOnBand)))
     FillRect hDC, rectFill, hBrush
     DeleteObject hBrush
  NEXT

END SUB
' ========================================================================================

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

  LOCAL hDC AS DWORD
  LOCAL pPaint AS PAINTSTRUCT
  LOCAL rc AS RECT

  SELECT CASE uMsg

     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

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

           CASE %IDMonster
              MSGBOX "more to come as soon as possible", %MB_ICONINFORMATION, "Info: Cwindow says Yep!"

        END SELECT

     CASE %WM_PAINT
        hDC = BeginPaint(hwnd, pPaint)
        GetClientRect hwnd, rc
        SetBkMode hDC, %TRANSPARENT
        SetTextColor hDC, %WHITE
        DrawText hDC, "Hello, my funny and exciting cWindows!", -1, rc, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
        EndPaint hwnd, pPaint
        FUNCTION = %TRUE
        EXIT FUNCTION

     CASE %WM_ERASEBKGND
        hDC = wParam
        DrawGradient hDC
        FUNCTION = %TRUE
        EXIT FUNCTION

     CASE %WM_SIZE

        ' Resize the toolbar
        SendMessage GetDlgItem(hwnd, %IDTool), uMsg, wParam, lParam

        IF wParam <> %SIZE_MINIMIZED THEN
           GetClientRect hwnd, rc
           MoveWindow GetDlgItem(hwnd, %IDMonster), 10, 40, 55, 55, %TRUE
           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_DESTROY
        PostQuitMessage 0
        EXIT FUNCTION

  END SELECT

  FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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
' ========================================================================================

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

  ' // Create an instance of the class
  LOCAL pPopup AS IWindow
  pPopup = CLASS "CWindow"
  IF ISNOTHING(pPopup) THEN EXIT SUB

  ' // Create the main window
  LOCAL hwnd AS DWORD
  hwnd = pPopup.CreateWindow(hParent, "Popup dialog with CWindow", 0, 0, 320, 200, -1, -1, CODEPTR(PopupDlgProc))


  ' // Add a close button
  pPopup.AddButton(hwnd, %IDCANCEL, "&Close", 200, 118, 75, 23, -1, -1)
  pPopup.AddButton(hwnd, %IDOK, "&Monster", 60, 118, 75, 23, -1, -1)
  pPopup.AddCombobox(hwnd, %IDCombobox, "", 80, 80, 125, 25, -1, -1)
  pPopup.AddCombobox(hwnd, %IDTEXT, "", 80, 40, 100, 25, -1, -1)

  ' // Default message pump (you can replace it with your own)
  pPopup.DoEvents

  ' // Enable the parent window
  EnableWindow hParent, %TRUE

END SUB
' ========================================================================================