In-Memory Dialogs

Windows specific questions.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

Code: Select all

'====================================================================
'' Owner-draw menu with icons demo, fully programmed
'' (no menu resource), modal dialog as main.
'====================================================================

#include "dialogs.bas"
#include once "win/shellapi.bi"

#define MENU_ITEM_ID1 1000
#define MENU_ITEM_ID2 1001
#define MENU_ITEM_ID3 1002

'====================================================================

function InitMenu() as HMENU

  dim as HMENU hMenu, hFileMenu

  hMenu = CreateMenu
  hFileMenu = CreateMenu

  AppendMenu( hMenu, MF_POPUP, cast(UINT_PTR,hFileMenu), "&Menu" )
  AppendMenu( hFileMenu, MF_STRING, MENU_ITEM_ID1, "Item&1" )
  AppendMenu( hFileMenu, MF_STRING, MENU_ITEM_ID2, "Item&2" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, MENU_ITEM_ID3, "Item&3" )

  return hMenu

end function

'====================================================================

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  static as HMENU hMenu
  static as HICON hIcon

  dim as RECT rc
  dim as MENUITEMINFO mii
  dim as MEASUREITEMSTRUCT ptr pmis
  dim as DRAWITEMSTRUCT ptr pdis

  select case uMsg

    case WM_INITDIALOG

      hMenu = InitMenu()
      SetMenu( hDlg, hMenu )

      mii.cbSize = sizeof(MENUITEMINFO)
      mii.fMask = MIIM_FTYPE
      mii.fType = MFT_OWNERDRAW

      SetMenuItemInfo( hMenu, MENU_ITEM_ID1, 0, @mii )
      SetMenuItemInfo( hMenu, MENU_ITEM_ID2, 0, @mii )
      SetMenuItemInfo( hMenu, MENU_ITEM_ID3, 0, @mii )

      '--------------------------------------------------
      '' Fblogo.ico is actually 32x32, but since even a
      '' 16x16 icon displayed too large it was necessary
      '' to scale it with DrawIconEx anyway.
      '--------------------------------------------------

      hIcon = ExtractIcon( GetModuleHandle(null), "fblogo.ico", 0 )

      return true

    case WM_MEASUREITEM

      '-------------------------------------------------
      '' wParam = 0 if this message was sent by a menu.
      '-------------------------------------------------

      if wParam = 0 then

        pmis = cast(MEASUREITEMSTRUCT ptr,lParam)

        '-----------------------------------------------------
        '' Use an arbitrary value for the width of the menu
        '' items and the system-defined value for the height.
        '-----------------------------------------------------

        pmis->itemWidth = 60
        pmis->itemHeight = GetSystemMetrics(SM_CYMENU)

      end if

    case WM_DRAWITEM

      '-------------------------------------------------
      '' wParam = 0 if this message was sent by a menu.
      '-------------------------------------------------

      if wParam = 0 then

        pdis = cast(DRAWITEMSTRUCT ptr,lParam)
        if pdis->CtlType = ODT_MENU then

          '--------------------------------------
          '' Position everything relative to the
          '' DRAWITEMSTRUCT rcItem member.
          '--------------------------------------

          select case pdis->itemID

            case MENU_ITEM_ID1

              DrawIconEx( pdis->hDC, pdis->rcItem.left+4, _
                          pdis->rcItem.top+2, hIcon, _
                          16, 16, 0, 0, DI_NORMAL )

              pdis->rcItem.left += 30
              pdis->rcItem.right += 30

              DrawText( pdis->hDC, "Item&1", -1, @pdis->rcItem, _
                        DT_LEFT or DT_VCENTER or DT_SINGLELINE )

            case MENU_ITEM_ID2

              DrawIconEx( pdis->hDC, pdis->rcItem.left+4, _
                          pdis->rcItem.top+2, hIcon, _
                          16, 16, 0, 0, DI_NORMAL )

              pdis->rcItem.left += 30
              pdis->rcItem.right += 30

              DrawText( pdis->hDC, "Item&2", -1, @pdis->rcItem, _
                        DT_LEFT or DT_VCENTER or DT_SINGLELINE )

            case MENU_ITEM_ID3

              DrawIconEx( pdis->hDC, pdis->rcItem.left+4, _
                          pdis->rcItem.top+2, hIcon, _
                          16, 16, 0, 0, DI_NORMAL )

              pdis->rcItem.left += 30
              pdis->rcItem.right += 30

              DrawText( pdis->hDC, "Item&3", -1, @pdis->rcItem, _
                        DT_LEFT or DT_VCENTER or DT_SINGLELINE )

          end select
        end if
      end if

    case WM_COMMAND

      select case loword(wParam)
        case MENU_ITEM_ID1
          MessageBox( hDlg, "Item 1", "", 0 )
        case MENU_ITEM_ID2
          MessageBox( hDlg, "Item 2", "", 0 )
        case MENU_ITEM_ID3
          MessageBox( hDlg, "Item 3", "", 0 )
        case IDCANCEL
          EndDialog( hDlg, null )
      end select

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

'====================================================================

dim as LPDLGTEMPLATE lpdt

Dialog( 1, 0, 0, 100, 75, "Menu Demo", lpdt, _
        WS_OVERLAPPEDWINDOW or DS_CENTER or WS_VISIBLE )

'--------------------------------------------------------
'' The dialog must have at least one control or the menu
'' will not activate correctly with Alt + access key.
'--------------------------------------------------------

LText( 100, 0, 0, 0, 0, "" )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

'====================================================================
Cherry
Posts: 358
Joined: Oct 23, 2007 12:06
Location: Austria
Contact:

Post by Cherry »

Sorry, but this looks not so good, because neither menu items are highlighted at mouse-over, nor the vista stlye is applied.
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Post by phishguy »

I'm trying to figure out how to change a push button to a dimmed or grayed out display to indicate that the button is disabled. How is this done?
dkl
Site Admin
Posts: 3235
Joined: Jul 28, 2005 14:45
Location: Germany

Post by dkl »

WS_DISABLED style should do it, or EnableWindow(hwnd, FALSE) (might need a repaint there)
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Post by phishguy »

Thanks a bunch! The enablewindow was the ticket.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

hello MichaelW

i included all source codes, bitmaps, icons and resource files with a build batch script in one zip file.

you can edit your first post and add the download link.

http://jafile.com/uploads/freebasic/dialogs.zip

add more control examples ProgressBar, TreeView etc. if you like

from my point of view this thread is very helpfull and should be made sticky

Joshy
Last edited by D.J.Peters on Mar 08, 2011 23:45, edited 2 times in total.
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Post by phishguy »

from my point of view this thread is very helpfull and should be made sticky
I agree. This thread has been very helpful for me to figure out Windows API functions. I have it bookmarked for quick reference.
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Post by phishguy »

I'm not sure if this can be done. If so, I would like an example of a listbox with different colors for text and background for items in the list. Would this need to be a custom drawn list box?
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

D.J.Peters wrote:hello MichaelW
i included all source codes, bitmaps, icons and resource files with a build batch script in one zip file.
Thank you. I will find the time to do something with it soon.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

Another demo:

Code: Select all

'==============================================================================
' Notify Icon demo, modeless dialog as main.
'==============================================================================

#include "dialogs.bas"
#include once "win/shellapi.bi"

'==============================================================================

#define WM_CALLBACK     WM_USER+100
#define IDI_TASKBARICON 0
#define IDM_EXIT        1000
#define ID_TIMER        1

'==============================================================================

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  static as NOTIFYICONDATA nid
  static as HMENU hPop
  static as HICON hIcon
  static as integer percent
  dim as POINT pt

  select case uMsg

    case WM_INITDIALOG

      hIcon = LoadImage( 0, _
                "C:\Program Files\FreeBASIC\bin\win32\res\fblogo.ico", _
                IMAGE_ICON, 0, 0, LR_LOADFROMFILE )

      '--------------------------------------------------
      '' Create a popup menu and append an Exit command.
      '--------------------------------------------------

      hPop = CreatePopupMenu
      AppendMenu( hPop, MF_STRING, IDM_EXIT, "Exit" )

      '---------------------------------------------------------------
      '' Fill in the members of the NOTIFYICONDATA structure and send
      '' it in an NIM_ADD message to the taskbar's status area.
      '---------------------------------------------------------------

      nid.cbSize = sizeof( NOTIFYICONDATA )
      nid.hwnd = hDlg
      nid.uID = IDI_TASKBARICON
      nid.uFlags = NIF_ICON or NIF_MESSAGE or NIF_TIP
      nid.uCallbackMessage = WM_CALLBACK
      nid.hIcon = hIcon
      nid.szTip = "0%"
      Shell_NotifyIcon( NIM_ADD, @nid )

      '--------------------------------------------
      '' Create a timer that will fire every 200ms
      '' and send us a WM_TIMER message.
      '--------------------------------------------

      SetTimer( hDlg, ID_TIMER, 200, null )

    case WM_CALLBACK

      '---------------------------------------------------------------
      '' The WM_CALLBACK message is sent in response to a mouse event
      '' in our taskbar notification area icon, with the identifier of
      '' icon in wParam and the mouse or keyboard message in lParam.
      '---------------------------------------------------------------

      if wParam = IDI_TASKBARICON then
        if lParam = WM_RBUTTONDOWN then

          '----------------------------------------------------
          '' To avoid a problem with the menu not closing when
          '' the user clicks somewhere outside the menu, our
          '' (invisible) window must be the foreground window.
          '----------------------------------------------------

          SetForegroundWindow( hDlg )

          '------------------------------------------------------------
          '' Display our popup menu at the current cursor location and
          '' wait for the user to close the menu by making a selection
          '' or by clicking somewhere outside the menu. If the user
          '' made a selection then we will get a WM_COMMAND message
          '' with the identifier of the menu item in wParam and zero
          '' in lParam.
          '------------------------------------------------------------

          GetCursorPos( @pt )
          TrackPopupMenu( hPop, TPM_RIGHTALIGN, _
                          pt.x, pt.y, null, hDlg, null )

        end if
      end if

    case WM_COMMAND

      if lParam = 0 then
        if wParam = IDM_EXIT then
          Shell_NotifyIcon( NIM_DELETE, @nid )
          KillTimer( hDlg, ID_TIMER )
          DestroyWindow( hDlg )
        end if
      end if

    case WM_TIMER

      '------------------------------------------------------------------
      '' Update the percent value, convert it to a string and store the
      '' string in the szTip member of the NOTIFYICONDATA structure, and
      '' send the structure in an NIM_MODIFY message to the taskbar's
      '' status area. This will update the tooltip text and leave
      '' everything else as is.
      '------------------------------------------------------------------

      percent = iif( percent < 100, percent+1, 0 )
      nid.szTip = str(percent) & "%"
      Shell_NotifyIcon( NIM_MODIFY, @nid )

    case WM_DESTROY

      PostQuitMessage( null )

  end select

  return 0

end function

'==============================================================================

dim as LPDLGTEMPLATE lpdt
dim as HWND hDlg
dim as MSG wMsg

'-----------------------------------------------------------
'' To make the dialog window invisible (and also not appear
'' in the task bar), leave off the WS_VISIBLE style.
'-----------------------------------------------------------

Dialog( 0, 0, 0, 0, 0, "", lpdt, WS_OVERLAPPED or WS_SYSMENU )

hDlg = CreateModelessDialog( 0, @DialogProc, 0, lpdt )

do while GetMessage( @wMsg, null, 0, 0 ) <> 0
  if IsDialogMessage( hDlg,  @wMsg ) = 0 then
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
  end if
loop

'==============================================================================
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

Another demo. Crosshair0.bas is from the window-capture demo post in this thread.

Code: Select all

'=========================================================================
'' Color capture demo, modal dialog as main.
''
'' With the mouse cursor over the client area, outside the edit control,
'' press and hold the left mouse button, drag the cursor to the target
'' location, then release the button.
'=========================================================================
#define IDC_EDIT 1000
'=========================================================================

#include "dialogs.bas"
#include "crosshair0.bas"

'=========================================================================

function DialogProc( byval hDlg as  HWND, _
                     byval uMsg as UINT, _
                     byval wParam as WPARAM, _
                     byval lParam as LPARAM ) as integer

  dim as HDC hdcScreen
  dim as COLORREF clr
  dim as POINT pt
  static as HWND hwndEdit
  static as HCURSOR hCursor

  select case uMsg

    case WM_INITDIALOG

      '----------------------------------------------
      '' Get the window handle for the edit control.
      '----------------------------------------------

      hwndEdit = GetDlgItem( hDlg, IDC_EDIT )

      '------------------------------------------------------
      '' If the system cursor size is 32x32 (likely), create
      '' our crosshair custom cursor and save the handle.
      '------------------------------------------------------

      if GetSystemMetrics( SM_CXCURSOR ) = 32 and _
         GetSystemMetrics( SM_CYCURSOR ) = 32 then
         hCursor = CreateCursor( GetModuleHandle( null ), _
                                 15, 15, 32, 32, _
                                 @cursorAndMask(0), _
                                 @cursorXorMask(0) )
      end if

    case WM_LBUTTONDOWN

      '----------------------------------------------------------
      '' If we have a custom cursor, make it the current cursor.
      '----------------------------------------------------------

      if hCursor then
        SetCursor( hCursor )
      end if

      '---------------------
      '' Capture the mouse.
      '---------------------

      SetCapture( hDlg )

    case WM_LBUTTONUP

      '---------------------------------------------------------------
      '' Get the client coordinates of the mouse cursor and save them
      '' in our POINT structure. The 16-bit coordinate values are
      '' sign-extended to 32 bits because client coordinates to the
      '' left of and/or above the client area are negative.
      '---------------------------------------------------------------

      asm
        mov eax, [lParam]
        movsx eax, ax
        mov [pt], eax
        mov eax, [lParam]
        shr eax, 16
        movsx eax, ax
        mov [pt+4], eax
      end asm

      '--------------------------------------------------------
      '' Convert the client coordinates to screen coordinates.
      '--------------------------------------------------------

      ClientToScreen( hDlg, @pt )

      '----------------------------------
      '' Get a DC for the entire screen.
      '----------------------------------

      hdcScreen = GetDC( null )

      '------------------------------------------------------
      '' Get the (Windows GDI) RGB color values of the pixel
      '' at the screen coordinates of the mouse cursor, and
      '' display the value in hex.
      '------------------------------------------------------

      clr = GetPixel( hdcScreen, pt.x, pt.y )
      SetWindowText( hwndEdit, " " & hex(clr,8) )

      '--------------------------------------------
      '' Remove our custom cursor from the screen.
      '--------------------------------------------

      SetCursor( null )

      '-----------------------------
      '' Release the mouse capture.
      '-----------------------------

      ReleaseCapture()

      '------------
      '' Clean up.
      '------------

      ReleaseDC( null, hdcScreen )

    case WM_COMMAND

      if loword(wParam) = IDCANCEL then

        DestroyCursor( hCursor )
        EndDialog( hDlg, null )

      end if

    case WM_CLOSE

        DestroyCursor( hCursor )
        EndDialog( hDlg, null )

  end select

  return 0

end function

'====================================================================

dim as LPDLGTEMPLATE lpdt

Dialog( 1, 0, 0, 90, 50, "Color Capture Demo", lpdt, _
        WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )

EditText( IDC_EDIT,25,0,38,10,"",WS_BORDER)

CreateModalDialog( 0, @DialogProc, 0, lpdt )

'====================================================================
Kwabbernoot
Posts: 79
Joined: Apr 19, 2010 18:23
Location: NL

Post by Kwabbernoot »

Hi Michael,
I appreciate these examples very much, but the last example doesn't work. I get lots of errors: “duplicate definition” in module Dialogs.bas on the following lines:

line 88 Duplicated definition, g_dialog_width in 'Dim Shared As Integer g_dialog_width'
line 98 Duplicated definition, g_lpw in 'Dim Shared As LPWORD g_lpw'
line 111 Duplicated definition in 'Sub GenUstring( Byref asciiString As String )'
line 151 Duplicated definition in 'Byval lpdt As LPDLGTEMPLATE ) As Integer'
line 190 Duplicated definition in 'Byval lpdt As LPDLGTEMPLATE ) As HWND'
line 245 Duplicated definition in 'Byref typeFace As String = "" )'
line 333 Duplicated definition in 'Byval style As DWORD = 0 )'
line 400 Duplicated definition in 'Byval style As DWORD = 0 )'
line 414 Duplicated definition in 'Byval style As DWORD = 0 )'
line 428 Duplicated definition in 'Byval style As DWORD = 0 )'
line 428 Too many errors, exiting

Maybe there are different versions around of Dialogs.bas or Crosshair0.bas. I've used the versions from the zipped file (see posting D.J.Peters Posted: Dec 17, 2009 20:02).

The example of Jun 23, 2010 5:20 only shows the FreeBasic icon on the windows taskbar. Is that what it should be doing?
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

The dialogs.bas in zip archive is OK, but there is a problem with crosshair0.bas and crosshair2.bas. The original crosshair0.bas and crosshair1.bas are in the November 10, 2008 post. The crosshair0.bas in the zip archive is actually the mouse draw demo with the contents of the original crosshair0.bas inserted. The problem you are having is due to the duplicated:

#include "dialogs.bas"

And the crosshair2.bas in the zip archive is actually the window capture demo with the original crosshair1.bas inserted. I see now that I probably should have used a .bi extension on the files with the cursor definitions.

So to correct your problem you need to get the original crosshair0.bas from the November 10, 2008 post.

The notify icon demo is supposed to display a FreeBASIC icon in the notification area of the task bar, display a ToolTip with a rolling percent count when you hover the mouse cursor over the icon, and display a popup menu containing an “Exit” command when you right-click the icon.
Kwabbernoot
Posts: 79
Joined: Apr 19, 2010 18:23
Location: NL

Post by Kwabbernoot »

Ok. Thanks. I've taken your Crosshair0.bas of November 10, 2008 and called it “CrossHairDef.bi” and changed the #include accordingly. And now it's working.
Jack Jackson
Posts: 9
Joined: Mar 08, 2011 20:40

Post by Jack Jackson »

What a terrific read and a lot of effort and work taken, top!.

the download link reports:
Forbidden
You don't have permission to access /uploads/freebasic/dialogs.zip on this server.

Additionally, a 404 Not Found error was encountered while trying to use an ErrorDocument to handle the request.
Post Reply