In-Memory Dialogs

Windows specific questions.
denise_amiga
Posts: 16
Joined: Jan 18, 2007 9:55

little modification

Postby denise_amiga » Mar 24, 2007 14:55

now the DS_SETFONT style is not necessary to specify it, is put automatic if it is necessary.

Code: Select all

Sub Dialog( Byval cdit As WORD, _
            Byval x As Short, _
            Byval y As Short, _
            Byval cx As Short, _
            Byval cy As Short, _
            Byref title As String, _
            Byref lpdt As LPDLGTEMPLATE, _
            Byval style As DWORD, _
            Byval pointSize As Short = 10, _              ' default size. set to 0 for default system
            Byref typeFace As String = "MS Sans Serif" )  ' default font. set to "" for default system

  g_dialog_width = cx

  lpdt = GlobalAlloc( GMEM_FIXED Or GMEM_ZEROINIT, 1024 * 10 )

  '' Memory allocated by GlobalAlloc is guaranteed to be
  '' aligned on an 8-byte boundary. Initialize the essential
  '' members of the structure.
  ''
  lpdt->cdit = cdit
  lpdt->x  = x
  lpdt->y  = y
  lpdt->cx = cx
  lpdt->cy = cy

  '' Set g_lpw to the menu array that follows the structure.
  ''
  g_lpw = cast(LPWORD,lpdt + 1)

  '' Skip the first element of the menu array, leaving it
  '' set to zero (no menu).
  ''
  g_lpw += 1

  '' Skip the first element of the class array, leaving it
  '' set to zero (no class), so the system will use the
  '' predefined dialog box class.
  ''
  g_lpw += 1

  '' Initialize the title array and set g_lpw to next WORD
  '' following the title array.
  ''
  GenUstring( title )

  '' If the DS_SETFONT style was specified, set the font
  '' point size, initialize the typeface array, and set
  '' g_lpw to next WORD following the typeface array.
  ''
  '' Now DS_SETFONT style is automatic.
  ''
  If pointSize And typeFace<>"" Then
      style Or= DS_SETFONT
    *g_lpw = pointSize
    g_lpw += 1
    GenUstring( typeFace )
  Else
      style And= Not DS_SETFONT
  End If

  lpdt->style = style

End Sub

example with default values ("MS Sans Serif",10)

Code: Select all

...
Dim As LPDLGTEMPLATE lpdt
Dialog( 8, 0, 0, 150, 100, "Group Demo", lpdt, _
        WS_OVERLAPPED Or WS_SYSMENU Or DS_CENTER )
...

example with default system values

Code: Select all

...
Dim As LPDLGTEMPLATE lpdt
Dialog( 8, 0, 0, 150, 100, "Group Demo", lpdt, _
        WS_OVERLAPPED Or WS_SYSMENU Or DS_CENTER, 0 )
...

example with personal settings values (only for fun)

Code: Select all

...
Dim As LPDLGTEMPLATE lpdt
Dialog( 8, 0, 0, 150, 100, "Group Demo", lpdt, _
        WS_OVERLAPPED Or WS_SYSMENU Or DS_CENTER, 30, "Courier" )
...


thx MichaelW for interchange the code.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Re: little modification

Postby MichaelW » Mar 25, 2007 17:10

denise_amiga wrote:now the DS_SETFONT style is not necessary to specify it, is put automatic if it is necessary.

That looks like a better way of handling DS_SETFONT, thank you for posting it.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

WM_COPYDATA

Postby MichaelW » Mar 25, 2007 17:20

Another quick and dirty demo.

Code: Select all

'====================================================================
'' Data copy demo, modal dialog as main.
''
'' This app uses the WM_COPYDATA message to transfer data between
'' two processes (actually two separate instances of the same app).
'' I did not try to determine the maximum number of bytes that can
'' be transferred using this method, but I did determine that under
'' Windows 2000, 100000 bytes can be transferred without problems.
'====================================================================

#include "dialogs.bas"

#define TESTDATA  1
#define BUFFSIZE  100000

dim shared as integer instance2

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

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

  static as HWND hWndOtherInstance, hWndEdit, hWndStatic
  static as COPYDATASTRUCT cds
  static as COPYDATASTRUCT ptr pcds
  static as byte ptr pBuff

  select case uMsg

    case WM_INITDIALOG

      pBuff = allocate( BUFFSIZE )

      hWndEdit = GetDlgItem( hDlg, 101 )
      hWndStatic = GetDlgItem( hDlg, 103 )

      SendMessage( hWndEdit, EM_SETLIMITTEXT, BUFFSIZE, 0 )

    case WM_COMMAND

      if hiword(wParam) = BN_CLICKED and loword(wParam) = 102 then

        '' Get the window handle of the other instance.
        ''
        if instance2 then
          hWndOtherInstance = FindWindow( "#32770", "Data Copy 1" )
        else
          hWndOtherInstance = FindWindow( "#32770", "Data Copy 2" )
        end if

        '' Ensure that the other instance is running.
        ''
        if hWndOtherInstance then

          '' The length must be incremented so the null
          '' terminator will be sent with the data
          '' (necessary only because the WM_COPYDATA
          '' handler expects a null-terminated string).
          ''
          cds.cbData = GetWindowTextLength( hWndEdit ) + 1

          if cds.cbData > 1 and cds.cbData <= BUFFSIZE then

            GetWindowText( hWndEdit, pBuff, BUFFSIZE )

            cds.dwData = TESTDATA
            cds.lpData = pBuff

            SendMessage( hWndOtherInstance, _
                         WM_COPYDATA, _
                         cast(wParam,hDlg), _
                         cast(lParam,@cds) )

            SetWindowText( hWndStatic, ">> " & str(cds.cbData) )

          end if

        else

          SetWindowText( hWndStatic, space(21) )

        end if
      end if

    case WM_COPYDATA

      pcds = cast(COPYDATASTRUCT ptr,lParam)
      if pcds->dwData = TESTDATA then
        SetWindowText( hWndEdit, pcds->lpData )
        SetWindowText( hWndStatic, "<< " & str(pcds->cbData) )
      end if

    case WM_CLOSE

      deallocate( pBuff )

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

'' The first and second instances need to have different names.
'' #32770 is the system-defined class for dialog boxes.

if FindWindow( "#32770", "Data Copy 2" ) = 0 then
  if FindWindow( "#32770", "Data Copy 1" ) then

    instance2 = true

    Dialog( 3, 180, 10, 160, 120, "Data Copy 2", lpdt, _
            WS_OVERLAPPED or WS_SYSMENU )

  else

    Dialog( 3, 10, 10, 160, 120, "Data Copy 1", lpdt, _
            WS_OVERLAPPED or WS_SYSMENU )

  end if

  EditText( 101, 4, 4, 150, 80, "", WS_BORDER or _
            ES_MULTILINE or ES_WANTRETURN or _
            WS_VSCROLL or WS_HSCROLL )

  PushButton( 102, -1, 90, 30, 12, "Send" )

  Ltext( 103, 120, 92, 40, 12, "" )

  CreateModalDialog( 0, @DialogProc, 0, lpdt )

end if

'====================================================================
Last edited by MichaelW on Apr 08, 2013 17:30, edited 1 time in total.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Postby MichaelW » Apr 08, 2007 1:02

This demo uses the HexDump procedure that I posted here:

http://www.freebasic.net/forum/viewtopi ... 7638#67638

Code: Select all

'========================================================================
'' Hex dump demo, modal dialog as main.
''
'' The file to dump must be specified on the command line,
'' or just dropped onto the EXE.
'========================================================================

#include "dialogs.bas"
#include "hexdump.bas"
#include "vbcompat.bi"
#include "win/shlwapi.bi"

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

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

  static as HWND hWndEdit
  dim as byte ptr pBuffer, pDump
  dim as RECT rcDlg

  select case uMsg

    case WM_CTLCOLORSTATIC

      '' Change the background for the read-only edit control,
      '' which by default is too dark for easy reading, to a
      '' more normal white.

      return cast(integer,GetStockObject( WHITE_BRUSH ))

    case WM_INITDIALOG

      hWndEdit = GetDlgItem( hDlg, 101 )
      SendMessage( hWndEdit, EM_SETLIMITTEXT, 1000000, 0 )

      open command for binary as 1

      if lof(1) then

        dim as integer tbbwidth
        dim as string temp

        GetClientRect( hDlg, @rcDlg )

        tbbwidth = GetSystemMetrics( SM_CXSIZE )

        temp = command

        '' Compact the path string if it exceeds the width of
        '' the title bar less 3 title-bar button widths.

        PathCompactPath( GetDC( hDlg ), strptr(temp), _
                         rcDlg.right - 3 * tbbwidth )

        '' Display the path.

        SetWindowText( hDlg, temp )

      end if

      pBuffer = allocate( lof(1) )

      get #1, , *pBuffer, lof(1)

      pDump = HexDump( pBuffer, lof(1), true )

      SendMessage( hWndEdit, WM_SETTEXT, 0, cast(LPARAM,pDump) )

      '' Cannot remove highlight by sending EM_SETSEL directly,
      '' see http://support.microsoft.com/kb/96674 for details.

      SetFocus( hWndEdit )
      PostMessage( hWndEdit, EM_SETSEL ,0 , 0 )

    case WM_COMMAND

      if loword(wParam) = IDCANCEL then

          EndDialog( hDlg, null )

      end if

    case WM_SIZE

      '' This is a one-time sizing of the edit control to
      '' fit the client area of the dialog.

      GetClientRect( hDlg, @rcDlg )

      MoveWindow( hWndEdit, 0, 0, rcDlg.right, rcDlg.bottom, true )

    case WM_CLOSE

      deallocate( pBuffer )
      deallocate( pDump )

      EndDialog( hDlg, null )

  end select

  return 0

end function

'========================================================================
'' Start of implicit main.
'========================================================================

dim as LPDLGTEMPLATE lpdt

'' Specify a fixed-pitch font.

Dialog( 1, 0, 0, 320, 240, "Hex Dump Demo", lpdt, _
        WS_OVERLAPPED or WS_SYSMENU or  DS_CENTER or DS_SETFONT, _
        8, "Courier New" )

EditText( 101, 0, 0, 0, 0, "", _
           WS_VSCROLL or _
           ES_MULTILINE or _
           ES_AUTOVSCROLL or _
           ES_NOHIDESEL or _
           ES_WANTRETURN or _
           ES_READONLY )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

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

Edit:
For a large file there will be a significant delay before the dump appears. Almost all of that delay is in the processing of the WM_SETTEXT message.

Edit2:
New version with a few improvements.
Last edited by MichaelW on Sep 03, 2007 7:18, edited 1 time in total.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Postby MichaelW » Sep 02, 2007 8:55

Another demo.

Code: Select all

'====================================================================
'' OpenGL demo, modeless dialog as main.
''
'' The OpenGL code is mostly from the FBGFX_OpenGL example port of
'' NeHe Lesson 4, with the initialization code mostly from a MASM32
'' example by Franck Charlet. I'm not sure that the OpenGL code is
'' all correct, or that I trapped the most likely errors.
'====================================================================

#include "dialogs.bas"
#include "GL/gl.bi"
#include "GL/glu.bi"

dim shared as HDC dlgHDC

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

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

  select case uMsg

    case WM_INITDIALOG

      dim as PIXELFORMATDESCRIPTOR pfd
      dim as integer pixelFormatIndex
      dim as HGLRC hglrc
      dim as RECT rc

      dlgHDC = GetDC( hDlg )
      pfd.nSize = sizeof(PIXELFORMATDESCRIPTOR)
      pfd.nVersion = 1
      pfd.dwFlags = PFD_DRAW_TO_WINDOW or _
                    PFD_SUPPORT_OPENGL or _
                    PFD_DOUBLEBUFFER
      pfd.dwLayerMask = PFD_MAIN_PLANE
      pfd.iPixelType = PFD_TYPE_RGBA
      pfd.cColorBits = 8
      pfd.cDepthBits = 16

      pixelFormatIndex = ChoosePixelFormat( dlgHDC, @pfd )

      if SetPixelFormat( dlgHDC, pixelFormatIndex, @pfd ) = 0 then
        MessageBox( hDlg, "SetPixelFormat failed", 0, 0 )
        DestroyWindow( hDlg )
      end if

      hglrc = wglCreateContext( dlgHDC )
      if hglrc = 0 then
        MessageBox( hDlg, "wglCreateContext failed", 0, 0 )
        DestroyWindow( hDlg )
      end if

      if wglMakeCurrent( dlgHDC, hglrc ) = 0 then
        MessageBox( hDlg, "wglMakeCurrent failed", 0, 0 )
        DestroyWindow( hDlg )
      end if

      GetClientRect( hDlg, @rc )

      glViewport 0, 0, rc.right, rc.bottom

      glMatrixMode GL_PROJECTION
      glLoadIdentity
      gluPerspective 45.0, rc.right/rc.bottom, 0.1, 100.0
      glMatrixMode GL_MODELVIEW
      glLoadIdentity

      glShadeModel GL_SMOOTH
      glClearColor 0.0, 0.0, 0.0, 1.0
      glClearDepth 1.0
      glEnable GL_DEPTH_TEST
      glDepthFunc GL_LEQUAL
      glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST

    case WM_COMMAND

      if loword(wParam) = IDCANCEL then

        DestroyWindow( hDlg )

      end if

    case WM_CLOSE

      DestroyWindow( hDlg )

    case WM_DESTROY

      PostQuitMessage( null )

  end select

  return 0

end function

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

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

dim rtri as single, rquad as single

Dialog( 0, 0, 0, 160, 120, "OpenGL in Dialog Demo", lpdt, _
        WS_OVERLAPPED or WS_SYSMENU or WS_VISIBLE or DS_CENTER )

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

'' This special message loop is useful when some action needs to
'' be repeated at a very high rate. Where the minimum effective
'' period for a normal timer is about 10ms, the effective period
'' for this message loop running on the typical system is well
'' under one microsecond. PM_REMOVE indicates that we want the
'' messages removed from the message queue as we process them.
''
do
  if PeekMessage( @wMsg, null, 0, 0, PM_REMOVE ) <> 0 then

    '' PeekMessage returned non-zero, indicating that a
    '' message is available. If the message was WM_QUIT,
    '' then it's time to exit.
    ''
    if wMsg.message = WM_QUIT then exit do

    if IsDialogMessage( hDlg,  @wMsg ) = 0 then
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
    end if

  else

    glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
    glLoadIdentity
    glTranslatef -1.5, 0.0, -6.0
    glRotatef rtri, 0, 1, 0
    glBegin GL_TRIANGLES
    glColor3f 1.0, 0.0, 0.0
    glVertex3f 0.0, 1.0, 0.0
    glColor3f 0.0, 1.0, 0.0
    glVertex3f -1.0, -1.0, 0.0
    glColor3f 0.0, 0.0, 1.0
    glVertex3f 1.0, -1.0, 0.0
    glEnd

    glLoadIdentity
    glTranslatef 1.5, 0.0, -6.0
    glColor3f 0.5, 0.5, 1.0
    glRotatef rquad, 1, 0, 0
    glBegin GL_QUADS
    glVertex3f -1.0, 1.0, 0.0
    glVertex3f 1.0, 1.0, 0.0
    glVertex3f 1.0, -1.0, 0.0
    glVertex3f -1.0, -1.0, 0.0
    glEnd
    rtri += 0.2
    rquad += 0.15

    SwapBuffers( dlgHDC )

  end if

loop

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

Postby MichaelW » Sep 06, 2007 6:57

Another demo. AFAIK this covers all the normal system colors through Windows XP.

Code: Select all

'====================================================================
'' System color demo, modal dialog as main.
'====================================================================

#include "dialogs.bas"

'' These currently missing from winuser.bi.

#define COLOR_MENUHILIGHT 29
#define COLOR_MENUBAR     30

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

#define LBADDS(h,s)SendMessage(h,LB_ADDSTRING,0,cast(LPARAM,@s))

'' List boxes use a zero-based index.

dim shared as integer sysColors(0 to 35) = { _
    COLOR_3DDKSHADOW, _
    COLOR_3DFACE, _
    COLOR_3DHIGHLIGHT, _
    COLOR_3DHILIGHT, _
    COLOR_3DLIGHT, _
    COLOR_3DSHADOW, _
    COLOR_ACTIVEBORDER, _
    COLOR_ACTIVECAPTION, _
    COLOR_APPWORKSPACE, _
    COLOR_BACKGROUND, _
    COLOR_BTNFACE, _
    COLOR_BTNHIGHLIGHT, _
    COLOR_BTNHILIGHT, _
    COLOR_BTNSHADOW, _
    COLOR_BTNTEXT, _
    COLOR_CAPTIONTEXT, _
    COLOR_DESKTOP, _
    COLOR_GRADIENTACTIVECAPTION, _
    COLOR_GRADIENTINACTIVECAPTION, _
    COLOR_GRAYTEXT, _
    COLOR_HIGHLIGHT, _
    COLOR_HIGHLIGHTTEXT, _
    COLOR_HOTLIGHT, _
    COLOR_INACTIVEBORDER, _
    COLOR_INACTIVECAPTION, _
    COLOR_INACTIVECAPTIONTEXT, _
    COLOR_INFOBK, _
    COLOR_INFOTEXT, _
    COLOR_MENU, _
    COLOR_MENUBAR, _
    COLOR_MENUHILIGHT, _
    COLOR_MENUTEXT, _
    COLOR_SCROLLBAR, _
    COLOR_WINDOW, _
    COLOR_WINDOWFRAME, _
    COLOR_WINDOWTEXT }

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

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

  static as HWND hWndList, hWndSample
  static as HBRUSH hBrush
  dim as integer i, clr
  dim as string h

  select case uMsg

    case WM_INITDIALOG

      hWndList = GetDlgItem( hDlg, 100 )
      hWndSample = GetDlgItem( hDlg, 101 )

      LBADDS( hWndList, "COLOR_3DDKSHADOW" )
      LBADDS( hWndList, "COLOR_3DFACE" )
      LBADDS( hWndList, "COLOR_3DHIGHLIGHT" )
      LBADDS( hWndList, "COLOR_3DHILIGHT" )
      LBADDS( hWndList, "COLOR_3DLIGHT" )
      LBADDS( hWndList, "COLOR_3DSHADOW" )
      LBADDS( hWndList, "COLOR_ACTIVEBORDER" )
      LBADDS( hWndList, "COLOR_ACTIVECAPTION" )
      LBADDS( hWndList, "COLOR_APPWORKSPACE" )
      LBADDS( hWndList, "COLOR_BACKGROUND" )
      LBADDS( hWndList, "COLOR_BTNFACE" )
      LBADDS( hWndList, "COLOR_BTNHIGHLIGHT" )
      LBADDS( hWndList, "COLOR_BTNHILIGHT" )
      LBADDS( hWndList, "COLOR_BTNSHADOW" )
      LBADDS( hWndList, "COLOR_BTNTEXT" )
      LBADDS( hWndList, "COLOR_CAPTIONTEXT" )
      LBADDS( hWndList, "COLOR_DESKTOP" )
      LBADDS( hWndList, "COLOR_GRADIENTACTIVECAPTION" )
      LBADDS( hWndList, "COLOR_GRADIENTINACTIVECAPTION" )
      LBADDS( hWndList, "COLOR_GRAYTEXT" )
      LBADDS( hWndList, "COLOR_HIGHLIGHT" )
      LBADDS( hWndList, "COLOR_HIGHLIGHTTEXT" )
      LBADDS( hWndList, "COLOR_HOTLIGHT" )
      LBADDS( hWndList, "COLOR_INACTIVEBORDER" )
      LBADDS( hWndList, "COLOR_INACTIVECAPTION" )
      LBADDS( hWndList, "COLOR_INACTIVECAPTIONTEXT" )
      LBADDS( hWndList, "COLOR_INFOBK" )
      LBADDS( hWndList, "COLOR_INFOTEXT" )
      LBADDS( hWndList, "COLOR_MENU" )
      LBADDS( hWndList, "COLOR_MENUBAR" )
      LBADDS( hWndList, "COLOR_MENUHILIGHT" )
      LBADDS( hWndList, "COLOR_MENUTEXT" )
      LBADDS( hWndList, "COLOR_SCROLLBAR" )
      LBADDS( hWndList, "COLOR_WINDOW" )
      LBADDS( hWndList, "COLOR_WINDOWFRAME" )
      LBADDS( hWndList, "COLOR_WINDOWTEXT" )

      '' Set the current selection to the first item
      '' and send a LBN_SELCHANGE notification.

      SendMessage( hWndList, LB_SETCURSEL, 0, 0 )
      SendMessage( hDlg, WM_COMMAND, LBN_SELCHANGE SHL 16 , 0 )

    case WM_COMMAND

      if hiword(wParam) = LBN_SELCHANGE then

        '' Update everything to reflect the selection.

        i = SendMessage( GetDlgItem( hDlg, 100 ), LB_GETCURSEL, 0, 0 )
        hBrush = GetSysColorBrush( sysColors(i) )
        if hBrush then

          clr = GetSysColor( sysColors(i) )
          h = hex(clr)
          h = string(6-len(h),"0") & h & "h"
          SetDlgItemText( hDlg, 102, h )

          '' This will force an update of the sample, causing
          '' the system to send a WM_CTLCOLORSTATIC message to
          '' the dialog before the control is updated.

          SetDlgItemText( hDlg, 101, "" )

        end if

      elseif loword(wParam) = IDCANCEL then

        '' This will allow the user to close the
        '' dialog by pressing the Escape.

        EndDialog( hDlg, null )

      end if

    case WM_CTLCOLORSTATIC

      '' Return the brush that corresponds to the selected
      '' system color only for the sample window.

      if lParam = hWndSample then

        return cast(integer,hBrush)

      end if

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

Dialog( 3, 0, 0, 160, 120, "System Colors", lpdt, _
        WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )

ListBox( 100, 5, 5, 146, 80, _
         WS_TABSTOP or WS_BORDER or WS_VSCROLL or LBS_NOTIFY )

'' This will be used to display a sample of the color.

LText( 101, 20, 86, 60, 15, "", SS_SUNKEN )

'' This will be used to display the color value.

LText( 102, 100, 90, 40, 10, "" )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

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

Postby MichaelW » Oct 12, 2007 9:29

Another demo.

Code: Select all

'====================================================================
'' Owner-draw button demo, modal dialog as main.
''
'' Adapted from an example in the Microsoft PSDK (that does
'' not appear to be available on MSDN) using bitmaps from:
'' examples\GL\NeHe\data\
'====================================================================

#include "dialogs.bas"

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

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

  static as HBITMAP hBmp1, hBmp2
  static as HDC hdcMem
  static as LPDRAWITEMSTRUCT lpdis

  select case uMsg

    case WM_INITDIALOG

      hBmp1 = LoadImage( GetModuleHandle( null ), _
                         "mask1.bmp", _
                         IMAGE_BITMAP , _
                         0, _
                         0, _
                         LR_LOADFROMFILE )

      hBmp2 = LoadImage( GetModuleHandle( null ), _
                         "mask2.bmp", _
                         IMAGE_BITMAP , _
                         0, _
                         0, _
                         LR_LOADFROMFILE )

      return true

    case WM_DRAWITEM

      lpdis = cast(LPDRAWITEMSTRUCT,lParam)

      hdcMem = CreateCompatibleDC( lpdis->hDC )

      if (lpdis->itemState and ODS_SELECTED) then
        SelectObject( hdcMem, hBmp2 )
      else
        SelectObject( hdcMem, hBmp1)
      end if

      StretchBlt( lpdis->hDC, _
                  lpdis->rcItem.left, _
                  lpdis->rcItem.top, _
                  lpdis->rcItem.right - lpdis->rcItem.left, _
                  lpdis->rcItem.bottom - lpdis->rcItem.top, _
                  hdcMem, _
                  0, _
                  0, _
                  128, _
                  128, _
                  SRCCOPY )

      '' Return hDC member of DRAWITEMSTRUCT to default state.
      '' This is ESSENTIAL for proper button operation.

      DeleteDC( hdcMem )

      return true

    case WM_COMMAND

      if loword(wParam) = IDCANCEL then

        '' This will allow the user to close the
        '' dialog by pressing the Escape key.

        EndDialog( hDlg, null )

      end if

      if hiword(wParam) = BN_CLICKED then

        select case loword(wParam)

          case 100

            'MessageBox( hDlg, "Click...", "", 0 )

        end select

        return true

      end if

    case WM_CLOSE

      DeleteObject( hBmp1 )
      DeleteObject( hBmp2 )

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

Dialog( 1, 0, 0, 100, 75, "Owner Draw Button Demo", lpdt, _
        WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )

Control( 100, 35, 20, 20, 20, "", 0, "BUTTON", BS_OWNERDRAW )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

'====================================================================
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain

Postby Antoni » Oct 21, 2007 10:57

Just a suggestion:

The parameter cdit in Dialog could be avoided with a shared variable cdit incremented with every call to Control and written to lpdt before the calls to CreateDialogIndirectParam or DialogBoxIndirectParam.

I took it as an identifier and gave more than a headache...

You could leave it there to not break code but make it unused...
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Postby MichaelW » Oct 21, 2007 13:28

Thanks for the suggestion. It looks like it should work, as long as I reset it to zero when the dialog is created, but I’ll have to think about it more. BTW, cdit is the name of the structure element, derived from Count Dialog ITems I think, and using it for the parameter name made sense at the time, but I should have considered that for anyone not familiar with the DLGTEMPLATE structure it’s just another meaningless name.
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain

Postby Antoni » Oct 22, 2007 7:38

Perhaps all of it could me made into a TYPE structure, so separate variables are kept for each instance...
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain

Postby Antoni » Oct 24, 2007 14:50

MichaelW:
I tried to add this function to the end of the In-mem Dilaog library

Code: Select all

 Sub TabCtrl( Byval cid As WORD, _
              Byval x As Short, _
              Byval y As Short, _
              Byval cx As Short, _
              Byval cy As Short, _
              Byval style As DWORD = 0 )

    Control( cid, x, y, cx, cy, "", 0, "SysTabControl32", _
             style )
End Sub


But I can't manage to have the secondaty dilaogs appear inside the tab in the code below:

Code: Select all


'modified from a fsw example in the FBEdit samples

#Include "dialogs.bas"

#define IDD_DLG0 1000
#define IDC_BTN1 1002
#define IDC_TAB1 1001
#define IDD_TAB1 1100
#define CHK_1 1101
#define EDT_1 1102
#define IDD_TAB2 1200
#define CHK_2 1201
#define CHK_3 1202
#define EDT_2 1001
#define EDT_3 1002
#define EDT_4 1003

declare function DlgProc(byval hWnd as HWND,byval uMsg as UINT,byval wParam as WPARAM,byval lParam as LPARAM) as integer

dim SHARED hInstance as HINSTANCE


function Tab1Proc(byval hDlg as HWND,byval uMsg as UINT,byval wParam as WPARAM,byval lParam as LPARAM) as bool

   return FALSE

end function

function Tab2Proc(byval hDlg as HWND,byval uMsg as UINT,byval wParam as WPARAM,byval lParam as LPARAM) as bool

   return FALSE

end function


function DlgProc(byval hDlg as HWND,byval uMsg as UINT,byval wParam as WPARAM,byval lParam as LPARAM) as bool
   dim as long id, event
   dim ts as TCITEM
   dim lpNMHDR as NMHDR PTR
   dim hTab as HWND

   select case uMsg
      case WM_INITDIALOG
         ' Get handle of tabstrip
         Dim As LPDLGTEMPLATE lpdt1,lpdt2
         hTab=GetDlgItem(hDlg,IDC_TAB1)
         ts.mask=TCIF_TEXT or TCIF_PARAM
         
         'Create Tab1 child dialog
         ts.pszText=StrPtr("Tab1")
         dialog ( 2,6,25,200,103, "Tab1",lpdt1,&h5000000)
         autocheckbox (CHK_1,14,38,172,9,"Checkbox",&h50010003)
         edittext     (EDT_1,14,49,172,13,"Edit",&h50010000)
         ts.lparam=createmodelessdialog(hdlg,@Tab1Proc,0,lpdt1)
      SendMessage(hTab,TCM_INSERTITEM,0,Cast(LPARAM,@ts))
         
         ' Create Tab2 child dialog
         ts.pszText=StrPtr("Tab2")
         dialog ( 3,6,25,200,103, "Tab2",lpdt2,&h5000000)
         edittext     (EDT_2,8,55,174,13,"edit1",&h50010000)
         edittext     (EDT_3,8,73,174,13,"edit2",&h50010000)
         edittext     (EDT_4,8,92,174,13,"edit3",&h50010000)
         ts.lParam= createmodelessdialog(hdlg,@Tab2Proc,0,lpdt2)
         SendMessage(htab,TCM_INSERTITEM,1,Cast(LPARAM,@ts))
   
      case WM_NOTIFY
         lpNMHDR=Cast(NMHDR ptr,lParam)
         if lpNMHDR->code=TCN_SELCHANGING then
            ' Hide the currently selected dialog
            id=SendMessage(lpNMHDR->hwndFrom,TCM_GETCURSEL,0,0)
            ts.mask=TCIF_PARAM
            SendMessage(lpNMHDR->hwndFrom,TCM_GETITEM,id,Cast(LPARAM,@ts))
            ShowWindow(Cast(HWND,ts.lParam),SW_HIDE)
         elseif lpNMHDR->code=TCN_SELCHANGE then
            ' Show the currently selected dialog
            id=SendMessage(lpNMHDR->hwndFrom,TCM_GETCURSEL,0,0)
            ts.mask=TCIF_PARAM
            SendMessage(lpNMHDR->hwndFrom,TCM_GETITEM,id,Cast(LPARAM,@ts))
            ShowWindow(Cast(HWND,ts.lParam),SW_SHOW)
         endif
         '
      case WM_CLOSE
         EndDialog(hDlg, 0)
         '
      case WM_COMMAND
         id=loword(wParam)
         event=hiword(wParam)
         select case id
            case IDC_BTN1
               EndDialog(hDlg, 0)
               '
         end select
         '
      case else
         return FALSE
         '
   end select
   return TRUE

end Function

   InitCommonControls
   hInstance=GetModuleHandle(NULL)
   
   
   Dim As LPDLGTEMPLATE lpdt 
     dialog(2, 6,6,248,188, "Tab Demo", lpdt, _
                     WS_OVERLAPPED Or WS_SYSMENU Or DS_CENTER )
   TabCtrl(IDC_TAB1,2,3,244,157)
   PushButton( IDC_BTN1, 176,160,64,17, "Cancel", WS_TABSTOP )
   CreateModalDialog( 0, @DlgProc, 0,lpdt)   

   ExitProcess(0)



What I'm doing wrong?
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Postby MichaelW » Oct 24, 2007 20:25

This version seems to work, but fixing it was too easy, so I probably missed some things.

Code: Select all

'modified from a fsw example in the FBEdit samples

#Include "dialogs.bas"

#define IDD_DLG0 1000
#define IDC_BTN1 1002
#define IDC_TAB1 1001
#define IDD_TAB1 1100
#define CHK_1 1101
#define EDT_1 1102
#define IDD_TAB2 1200
#define CHK_2 1201
#define CHK_3 1202
#define EDT_2 1001
#define EDT_3 1002
#define EDT_4 1003

Declare Function DlgProc(Byval hWnd As HWND,Byval uMsg As UINT,Byval wParam As WPARAM,Byval lParam As LPARAM) As Integer

Dim Shared hInstance As HINSTANCE


Function Tab1Proc(Byval hDlg As HWND,Byval uMsg As UINT,Byval wParam As WPARAM,Byval lParam As LPARAM) As bool

        Return FALSE

End Function

Function Tab2Proc(Byval hDlg As HWND,Byval uMsg As UINT,Byval wParam As WPARAM,Byval lParam As LPARAM) As bool

        Return FALSE

End Function


Function DlgProc(Byval hDlg As HWND,Byval uMsg As UINT,Byval wParam As WPARAM,Byval lParam As LPARAM) As bool
        Dim As Long id, event
        Dim ts As TCITEM
        Dim lpNMHDR As NMHDR Ptr
        Dim hTab As HWND

        Select Case uMsg
                Case WM_INITDIALOG
                        ' Get handle of tabstrip
                        Dim As LPDLGTEMPLATE lpdt1,lpdt2
                        hTab=GetDlgItem(hDlg,IDC_TAB1)
                        ts.mask=TCIF_TEXT Or TCIF_PARAM

                        'Create Tab1 child dialog
                        ts.pszText=Strptr("Tab1")
                        '' &h5000000 = WS_CLIPSIBLINGS or WS_MAXIMIZE
                        '''dialog ( 2,6,25,200,103, "Tab1",lpdt1,&h5000000)
                        '' WS_CHILD required so dialog will move with tab.
                        '' WS_VISIBLE required here for the dialog to
                        '' be visible initially.
                        '' And I would guess that the parent for the
                        '' dialogs needs to be the tab control instead
                        '' of the parent dialog.
                        dialog ( 2,6,25,200,103, "Tab1",lpdt1, WS_CHILD or WS_VISIBLE)

         autocheckbox (CHK_1,14,38,172,9,"Checkbox",&h50010003)
         edittext     (EDT_1,14,49,172,13,"Edit",&h50010000)
         ts.lparam=createmodelessdialog(hdlg,@Tab1Proc,0,lpdt1)

      SendMessage(hTab,TCM_INSERTITEM,0,Cast(LPARAM,@ts))

                        ' Create Tab2 child dialog
                        ts.pszText=Strptr("Tab2")
                        '''dialog ( 3,6,25,200,103, "Tab2",lpdt2,&h5000000)
                        dialog ( 3,6,25,200,103, "Tab2",lpdt2,WS_CHILD)
                        edittext     (EDT_2,8,55,174,13,"edit1",&h50010000)
                        edittext     (EDT_3,8,73,174,13,"edit2",&h50010000)
                        edittext     (EDT_4,8,92,174,13,"edit3",&h50010000)
                        ts.lParam= createmodelessdialog(hdlg,@Tab2Proc,0,lpdt2)
                        SendMessage(htab,TCM_INSERTITEM,1,Cast(LPARAM,@ts))

                Case WM_NOTIFY
                        lpNMHDR=Cast(NMHDR Ptr,lParam)
                        If lpNMHDR->code=TCN_SELCHANGING Then
                                ' Hide the currently selected dialog
                                id=SendMessage(lpNMHDR->hwndFrom,TCM_GETCURSEL,0,0)
                                ts.mask=TCIF_PARAM
                                SendMessage(lpNMHDR->hwndFrom,TCM_GETITEM,id,Cast(LPARAM,@ts))
                                ShowWindow(Cast(HWND,ts.lParam),SW_HIDE)
                        Elseif lpNMHDR->code=TCN_SELCHANGE Then
                                ' Show the currently selected dialog
                                id=SendMessage(lpNMHDR->hwndFrom,TCM_GETCURSEL,0,0)
                                ts.mask=TCIF_PARAM
                                SendMessage(lpNMHDR->hwndFrom,TCM_GETITEM,id,Cast(LPARAM,@ts))
                                ShowWindow(Cast(HWND,ts.lParam),SW_SHOW)
                        Endif
                        '
                Case WM_CLOSE
                        EndDialog(hDlg, 0)
                        '
                Case WM_COMMAND
                        id=loword(wParam)
                        event=hiword(wParam)
                        Select Case id
                                Case IDC_BTN1
                                        EndDialog(hDlg, 0)
                                        '
                                case IDCANCEL
                                  '' This allows user to close dialog
                                  '' with Escape key;
                                  EndDialog(hDlg, 0)

                        End Select
                        '
                Case Else
                        Return FALSE
                        '
        End Select
        Return TRUE

End Function

   InitCommonControls
        hInstance=GetModuleHandle(NULL)


        Dim As LPDLGTEMPLATE lpdt

   ''WS_CLIPSIBLINGS required for parent window and tab control.

   dialog(2, 6,6,248,188, "Tab Demo", lpdt, _
          WS_OVERLAPPED Or WS_SYSMENU Or DS_CENTER or WS_CLIPSIBLINGS )

   '''TabCtrl(IDC_TAB1,2,3,244,157)

   '' WC_TABCONTROL is defined in commctrl.bi as
   '' #define WC_TABCONTROL   "SysTabControl32"

   '' Base style defined in Control procedure is WS_CHILD or WS_VISIBLE.

   Control( IDC_TAB1, 2, 3, 244, 157, "", 0, WC_TABCONTROL, _
            WS_CLIPSIBLINGS  )

   PushButton( IDC_BTN1, 176,160,64,17, "Cancel", WS_TABSTOP )
   CreateModalDialog( 0, @DlgProc, 0,lpdt)

        ExitProcess(0)
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain

Postby Antoni » Oct 24, 2007 20:40

Thanks, Michael, It works!
If is there something missing I don't know, as it was just a test.
I was very clever copying the numerical styles from a resouce file without checking what they were...
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Postby MichaelW » Nov 14, 2007 0:47

Code: Select all

'====================================================================
'' Popup menu demo, fully programmed (no menu resource), modal
'' dialog as main.
'====================================================================

#include "dialogs.bas"

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

#define TPM_HORPOSANIMATION &h0400
#define TPM_HORNEGANIMATION &h0800
#define TPM_VERPOSANIMATION &h1000
#define TPM_VERNEGANIMATION &h2000
#define TPM_NOANIMATION     &h4000

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

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

  static as HMENU hMenuPop
  dim as RECT rc
  dim as integer i

  select case uMsg

    case WM_INITDIALOG

      hMenuPop = CreatePopupMenu()

      AppendMenu( hMenuPop, MF_STRING, 1001, "Option &1" )
      AppendMenu( hMenuPop, MF_STRING, 1002, "Option &2" )
      AppendMenu( hMenuPop, MF_SEPARATOR, 0, 0 )
      AppendMenu( hMenuPop, MF_STRING, 1003, "Option &3" )
      AppendMenu( hMenuPop, MF_SEPARATOR, 0, 0 )
      AppendMenu( hMenuPop, MF_STRING, 1004, "Option &4" )
      AppendMenu( hMenuPop, MF_STRING, 1005, "Option &5" )

    case WM_COMMAND

      if hiword(wParam) = BN_CLICKED then

        select case loword(wParam)

          case IDCANCEL

            '' This allows the user to close the
            '' dialog by pressing the Escape key.

            EndDialog( hDlg, null )

          case 100

            GetWindowRect( GetDlgItem( hDlg, 100 ), @rc )

            i = TrackPopupMenu( hMenuPop, _
                                TPM_LEFTALIGN or _
                                TPM_RETURNCMD or _
                                TPM_TOPALIGN or _
                                TPM_HORPOSANIMATION, _
                                rc.left, _
                                rc.top, _
                                0, _
                                hDlg, _
                                0 )

            MessageBox( hDlg, "Selected ID = "& str(i), _
                          "From TrackPopupMenu", 0 )

        end select

      end if

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

Dialog( 1, 0, 0, 120, 90, "Popup Menu Demo", lpdt, _
        WS_OVERLAPPEDWINDOW or DS_CENTER )

PushButton( 100, -1, 40, 35, 12, "Pop" )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

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

Postby MichaelW » Dec 20, 2007 2:33

Code: Select all

'====================================================================
'' Full-screen dialog demo with no titlebar and no border,
'' modal dialog as main.
'====================================================================

#include "dialogs.bas"

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

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

  dim as HWND hWndButton
  dim as RECT rcDesktop, rcButton

  select case uMsg

    case WM_INITDIALOG

      '' Size the dialog to fit the desktop window.

      GetWindowRect( GetDesktopwindow(), @rcDesktop )
      MoveWindow( hDlg, 0, 0, rcDesktop.right, _
                  rcDesktop.bottom, true )

      '' Center the button in the dialog.

      hWndButton = GetDlgItem( hDlg, IDCANCEL )
      GetWindowRect( hWndButton, @rcButton )
      MoveWindow( hWndButton, _
                  (rcDesktop.right - rcButton.right) \ 2, _
                  (rcDesktop.bottom - rcButton.bottom) \ 2, _
                  rcButton.right, rcButton.bottom, true )

    case WM_COMMAND

      select case loword(wParam)

        case IDCANCEL

          EndDialog( hDlg, null )

      end select

    case WM_CLOSE

      EndDialog( hDlg, null )

  end select

  return 0

end function

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

dim as LPDLGTEMPLATE lpdt

'' The WS_POPUP style will create a dialog window
'' with no title bar and no border.

Dialog( 1, 0, 0, 0, 0, "", lpdt, WS_POPUP )

PushButton( IDCANCEL, 0, 0, 40, 12, "Close" )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

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

Return to “Windows”

Who is online

Users browsing this forum: MSN [Bot] and 2 guests