
'=========================================================================
'' Simple editor demo, fully-programmed menu and keyboard accelerators
'' (no MENU or ACCELERATORS resource), modeless dialog as main.
''
'' Keyboard accelerators are easier to implement in a modeless dialog
'' because you have direct access to the message loop.
'=========================================================================

#include "dialogs.bas"

'---------------------------------------------------------------
'' Dialogs.bas includes windows.bi, but to support the Open and
'' Save As dialogs from the Common Dialog Box Library, we need
'' to also include commdlg.bi.
'---------------------------------------------------------------

#include once "win\commdlg.bi"

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

#define IDC_EDIT    100

#define IDM_NEW     1000
#define IDM_OPEN    1001
#define IDM_SAVE    1002
#define IDM_SAVEAS  1003
#define IDM_EXIT    1004

#define TABWIDTH 4

Dim Shared As HACCEL g_hAccel
Dim Shared As HWND g_hwndEdit
Dim Shared As Zstring * MAX_PATH g_szFile = "Untitled"

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

''------------------------------------------------------------------
'' Note that for the following two functions the string pointed to
'' by pszFile must be large enough to receive the drive designator,
'' path, file name, and extension of the specified file, and that
'' the size must be specified in nMaxFile. The size is typically
'' specified as the MAX_PATH constant.
''------------------------------------------------------------------

'--------------------------------------------------------------------
'' This function sets up and opens the Open dialog box and returns
'' whatever the GetOpenFileName function returned. The return value
'' will be zero if the user canceled the dialog or an error occurred,
'' or non-zero if the user specified a file and clicked OK, in which
'' case the string pointed to by pszFile will contain the full path
'' and filename of the file specified by the user.
'--------------------------------------------------------------------

Function GetOFN( Byval hwndOwner As HWND, _
                 Byval pszFile As Zstring Ptr, _
                 Byval nMaxFile As Integer) As Integer

    Dim As OPENFILENAME ofn

    ofn.lStructSize = sizeof(OPENFILENAME)
    ofn.hWndOwner = hwndOwner
    ofn.lpstrFilter = Strptr(!"All Files (*.*)\0*.*\0\0")
    ofn.lpstrFile = pszFile
    ofn.nMaxFile = nMaxFile
    ofn.Flags = OFN_FILEMUSTEXIST Or OFN_LONGNAMES

    Return GetOpenFileName( @ofn )

End Function

'---------------------------------------------------------------------
'' This function sets up and opens the Save As dialog box and returns
'' whatever the GetSaveFileName function returned. The return value
'' will be zero if the user canceled the dialog or an error occurred,
'' or non-zero if the user specified a file name and clicked OK, in
'' which case the string pointed to by pszFile will contain the full
'' path and filename specified by the user.
'---------------------------------------------------------------------

Function GetSFN( Byval hwndOwner As HWND, _
                 Byval pszFile As Zstring Ptr, _
                 Byval nMaxFile As Integer) As Integer

    Dim As OPENFILENAME ofn

    ofn.lStructSize = sizeof(OPENFILENAME)
    ofn.hWndOwner = hwndOwner
    ofn.lpstrFile = pszFile
    ofn.nMaxFile = nMaxFile
    ofn.Flags = OFN_LONGNAMES

    Return GetSaveFileName( @ofn )

End Function

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

Function LoadTextFromFile( Byval pszFile As Zstring Ptr ) As Integer

  Dim As Ubyte Ptr p
  Dim As Integer i, res

  Open *pszFile For Binary As 1

  i = Lof(1)

  '-----------------------------------------------------------
  '' The edit control expects a null-terminated string, so we
  '' need to allocate a zero-filled buffer and allow room
  '' for the terminating null.
  '-----------------------------------------------------------

  p = callocate(i+1)

  Get #1,,*p,i

  '----------------------------------------------------------
  '' The WM_SETTEXT message returns true if the text is set.
  '----------------------------------------------------------

  If SendMessage( g_hwndEdit, WM_SETTEXT, 0, cast(LPARAM,p) ) Then
    res = i
  End If

  deallocate p

  Close

  Return res

End Function

Function SaveTextToFile( Byval pszFile As Zstring Ptr ) As Integer

  Dim As Ubyte Ptr p
  Dim As Integer i

  i = SendMessage( g_hwndEdit, WM_GETTEXTLENGTH , 0, 0 )

  '--------------------------------------------------------------
  '' Double the size of the buffer to prevent Windows NT/2000/XP
  '' from potentially reducing the length of the string in the
  '' conversion from ANSI to Unicode.
  '--------------------------------------------------------------

  p = allocate(i*2)

  SendMessage( g_hwndEdit, WM_GETTEXT , i*2, cast(LPARAM,p) )

  Kill *pszFile
  Open *pszFile For Binary As 1
  Put #1,,*p,i
  Close

  Return i

End Function

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

Function InitMenu() As HMENU

  Dim As HMENU hMenu, hFileMenu
  Dim As ACCEL accl( 0 To 2)

  hMenu = CreateMenu
  hFileMenu = CreateMenu

  AppendMenu( hMenu, MF_POPUP, cast(UINT_PTR,hFileMenu), "&File" )
  AppendMenu( hFileMenu, MF_STRING, IDM_NEW, !"&New\tCtrl+N" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, IDM_OPEN, !"&Open\tCtrl+O" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, IDM_SAVE, !"&Save\tCtrl+S" )
  AppendMenu( hFileMenu, MF_STRING, IDM_SAVEAS, !"Save &As" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, IDM_EXIT, !"E&xit\tAlt+F4" )

  accl(0).fVirt = FCONTROL Or FVIRTKEY
  accl(0).key = Asc("N")
  accl(0).cmd = IDM_NEW
  accl(1).fVirt = FCONTROL Or FVIRTKEY
  accl(1).key = Asc("O")
  accl(1).cmd = IDM_OPEN
  accl(2).fVirt = FCONTROL Or FVIRTKEY
  accl(2).key = Asc("S")
  accl(2).cmd = IDM_SAVE

  g_hAccel = CreateAcceleratorTable( cast(LPACCEL,@accl(0)), 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

  Dim As RECT rcDlg

  Select Case uMsg

    Case WM_INITDIALOG

      SetMenu( hDlg, InitMenu() )

      g_hwndEdit = GetDlgItem( hDlg, IDC_EDIT )

      '------------------------------------------------------------
      '' The edit control expects the tab width to be expressed in
      '' Dialog Template Units. Since a DTU is 1/4 of the average
      '' width of the font used, the tab width in DTUs is the tab
      '' width in characters * 4.
      '------------------------------------------------------------

      Dim As Integer tw = TABWIDTH * 4
      SendMessage( g_hwndEdit, EM_SETTABSTOPS, 1, cast(LPARAM,@tw) )

      SetWindowText( hDlg, @g_szFile )

      Return true

    Case WM_COMMAND

      Select Case loword(wParam)

        Case IDM_NEW

          SendMessage( g_hwndEdit, WM_SETTEXT, 0, 0)
          g_szFile = "Untitled"
          SetWindowText( hDlg, @g_szFile )

        Case IDM_OPEN

          If GetOFN( hDlg, @g_szFile, MAX_PATH ) Then
            LoadTextFromFile( g_szFile )
            SetWindowText( hDlg, @g_szFile )
          End If

        Case IDM_SAVE

          If g_szFile = "Untitled" Then
            If GetSFN( hDlg, @g_szFile, MAX_PATH ) Then
              SaveTextToFile( g_szFile )
              SetWindowText( hDlg, @g_szFile )
            End If
          Else
            SaveTextToFile( g_szFile )
          End If

        Case IDM_SAVEAS

          If GetSFN( hDlg, @g_szFile, MAX_PATH ) Then
              SaveTextToFile( g_szFile )
              SetWindowText( hDlg, @g_szFile )
          End If

        Case IDM_EXIT

          DestroyWindow( hDlg )

      End Select

    Case WM_SIZE

      GetClientRect( hDlg, @rcDlg )

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

    Case WM_CLOSE

      DestroyWindow( hDlg )

    Case WM_DESTROY

      DestroyAcceleratorTable( g_hAccel )
      PostQuitMessage( null )

  End Select

  Return 0

End Function

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

Dim As LPDLGTEMPLATE lpdt
Dim As HWND hDlg
Dim As MSG wMsg
Dim As Integer sel

'----------------------------------------------------------------
'' The WS_VISIBLE style is necessary for a modeless dialog to be
'' visible. The WS_CLIPCHILDREN style is an attempt to improve
'' the appearance of the edit control when the dialog is resized.
'' Under Windows 2000 it has no apparent effect, but it may have
'' an effect under later versions of Windows. Under Windows 2000
'' the text in the edit control flashes whenever the dialog is
'' resized, but no worse than it does in notepad.
'----------------------------------------------------------------

Dialog( 1, 0, 0, 300, 225, "", lpdt, _
        WS_OVERLAPPEDWINDOW Or DS_CENTER Or WS_VISIBLE Or _
        WS_CLIPCHILDREN Or DS_SETFONT, 11, "fixedsys" )

'--------------------------------------------------------
'' Zeros can be used for the position and size of the
'' edit control because both will be set in the WM_SIZE
'' hander.
'--------------------------------------------------------

EditText( IDC_EDIT, 0, 0, 0, 0, "", WS_BORDER Or _
                                    WS_VSCROLL Or _
                                    WS_HSCROLL Or _
                                    ES_MULTILINE Or _
                                    ES_AUTOVSCROLL Or _
                                    ES_AUTOHSCROLL Or _
                                    ES_WANTRETURN )

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

Do While GetMessage( @wMsg, null, 0, 0 ) <> 0

  '---------------------------------------------------------------
  '' A multi-line edit control responds to the tab key by doing a
  '' select all, instead of doing what most people would expect.
  '' To modify this behavior, without having to subclass the edit
  '' control, we intercept the tab key in the message loop, get
  '' the current insertion point, kill any existing selection (by
  '' selecting a zero-length range at the insertion point), and
  '' insert a tab character. We then bypass further processing of
  '' the message, effectively discarding it.
  '---------------------------------------------------------------

  If wMsg.message = WM_KEYDOWN And wMsg.wParam = VK_TAB Then

    SendMessage( g_hwndEdit, EM_GETSEL, cast(wParam,@sel), 0 )
    SendMessage( g_hwndEdit, EM_SETSEL, sel, sel )
    SendMessage( g_hwndEdit, EM_REPLACESEL, 0, cast(lParam,Strptr(!"\t")) )

  Else

    If TranslateAccelerator( hDlg, g_hAccel, @wMsg ) = 0 Then
      If IsDialogMessage( hDlg,  @wMsg ) = 0 Then
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
      End If
    End If

  End If

Loop

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