rexx-things/modules/windows/oodialog/menus/UserMenuBar.rex

/*----------------------------------------------------------------------------*/
/*                                                                            */
/* Copyright (c) 2011-2014 Rexx Language Association. All rights reserved.    */
/*                                                                            */
/* This program and the accompanying materials are made available under       */
/* the terms of the Common Public License v1.0 which accompanies this         */
/* distribution. A copy is also available at the following address:           */
/* https://www.oorexx.org/license.html                                        */
/*                                                                            */
/* Redistribution and use in source and binary forms, with or                 */
/* without modification, are permitted provided that the following            */
/* conditions are met:                                                        */
/*                                                                            */
/* Redistributions of source code must retain the above copyright             */
/* notice, this list of conditions and the following disclaimer.              */
/* Redistributions in binary form must reproduce the above copyright          */
/* notice, this list of conditions and the following disclaimer in            */
/* the documentation and/or other materials provided with the distribution.   */
/*                                                                            */
/* Neither the name of Rexx Language Association nor the names                */
/* of its contributors may be used to endorse or promote products             */
/* derived from this software without specific prior written permission.      */
/*                                                                            */
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS        */
/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT          */
/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS          */
/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   */
/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,      */
/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED   */
/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,        */
/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY     */
/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING    */
/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS         */
/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.               */
/*                                                                            */
/*----------------------------------------------------------------------------*/

/**
 * A simple application that shows how to create an UserMenuBar menu.  The
 * dialog contains an Edit control and an UpDown control.  The menu is used to
 * change styles or behaviour of the two controls.
 *
 * About half of the menu items pop up a dialog to collect user input needed to
 * carry out the menu item action.
 *
 * This example uses a number of up-down controls in the different dialogs,
 * making it a good example of how to use up-down controls in addition, to being
 * a menu bar example.
 */

  sd = locate()
  .application~setDefaults("O", sd"UserMenuBar.h", .false)

  dlg = .SimpleDialog~new(sd"UserMenuBar.rc", IDD_MAIN_DIALOG)
  if dlg~initCode <> 0 then do
    return 99
  end

  dlg~execute("SHOWTOP")

return 0

::requires "ooDialog.cls"

-- We need 10 digits to work with the numbers in the full range of an up-down
-- control (-2147,483,648 to 2,147,483,647)
::options digits 10

::class 'SimpleDialog' subclass RcDialog

::constant DEFAULT_TEXT   "1, 2, 3, the Edit control Menu actions work better with text in the 1st edit control."
::constant WICKED_TEXT    "The wicked flee when none pursueth ..."
::constant LOTUS_TEXT     "Lotus 123 had its ups and downs."
::constant IDES_TEXT      "Ides of March - name of March 15 in Roman calendar."
::constant TITANIC_TEXT   "472 lifeboat seats not used when 1,503 people died on the Titanic."

::method init
  expose srcDir

  forward class (super) continue

  -- Grab the source dir value here and save it in an instance variable for
  -- convenience.
  srcDir = .application~srcDir

  if \ self~createMenuBar then do
    self~initCode = 1
    return
  end


::method initDialog
  expose menuBar edit upDown

  upDown = self~newUpDown(IDC_UPD)
  upDown~setRange(1, 20000)
  upDown~setPosition(1000)

  if \ menuBar~attachTo(self) then do
    msg = "Failed to attach menu bar System Error Code:" .SystemErrorCode
    z = MessageDialog(msg, self~hwnd, "Menu Error", "OK", "WARNING")
  end

  edit = self~newEdit(IDC_EDIT)
  edit~setText(.SimpleDialog~DEFAULT_TEXT)

  self~setRadioChecks(ID_EDITCONTROL_UNRESTRICTED)


-- Creates a UserMenuBar
::method createMenuBar private
  expose menuBar

  -- Create a menu bar that has a symbolic resource ID of IDM_MENUBAR, has no
  -- help ID, uses the default menu item count, and autoconnects all command
  -- menu items when it is attached to a dialog.
  menuBar = .UserMenuBar~new(IDM_MENUBAR, , , .true)

  -- Create the menu bar template.
  menuBar~addPopup(IDM_POP_FILES, "Files")
    menuBar~addItem(ID_FILES_HIDE_EDIT, "Hide Edit Control", "DEFAULT CHECK")
    menuBar~addItem(ID_FILES_HIDE_UPDOWN, "Hide UpDown Control", " CHECK")
    menuBar~addSeparator(IDM_SEP_FILES)
    menuBar~addItem(ID_FILES_EXIT, "Exit", "END")

  menuBar~addPopup(IDM_POP_EDITCONTROL, "Edit Control")
    menuBar~addItem(ID_EDITCONTROL_LOWER, "Lower Case Only", "CHECK RADIO")
    menuBar~addItem(ID_EDITCONTROL_NUMBER, "Numbers Only", "CHECK RADIO")
    menuBar~addItem(ID_EDITCONTROL_UPPER, "Upper Case Only", "CHECK RADIO")
    menuBar~addItem(ID_EDITCONTROL_UNRESTRICTED, "No Restriction", "CHECK RADIO DEFAULT")
    menuBar~addSeparator(IDM_SEP_EDITCONTROL)
    menuBar~addItem(ID_EDITCONTROL_INSERT, "Insert Text ...")
    menuBar~addItem(ID_EDITCONTROL_SELECT, "Select Text ...", "END")

  menuBar~addPopup(IDM_POP_UPDOWNCONTROL, "UpDown Control")
    menuBar~addItem(ID_UPDOWNCONTROL_HEXIDECIMAL, "Hexidecimal", "CHECK")
    menuBar~addSeparator(IDM_SEP_UPDOWNCONTROL)
    menuBar~addItem(ID_UPDOWNCONTROL_SET_ACCELERATION, "Set Acceleration ...")
    menuBar~addItem(ID_UPDOWNCONTROL_SET_RANGE, "Set Range ...")
    menuBar~addItem(ID_UPDOWNCONTROL_SET_POSITION, "Set Position ...", "END")

  menuBar~addPopup( IDM_POP_HELP, "Help", "END")
    menuBar~addItem(ID_HELP_ABOUT, "About User Menu Bar", "END")

  if \ menuBar~complete then do
    say 'User menu bar completion error:' .SystemErrorCode SysGetErrortext(.SystemErrorCode)
    return .false
  end

  return .true


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
--  The methods below, up to the next dividing lines, are the implementation
--  for each of the menu item command events.
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
::method hideEditControl unguarded
  expose menuBar edit

  if menuBar~isChecked(ID_FILES_HIDE_EDIT) then do
    menuBar~uncheck(ID_FILES_HIDE_EDIT)
    self~newStatic(IDC_ST_EDIT)~show
    edit~show
  end
  else do
    menuBar~check(ID_FILES_HIDE_EDIT)
    self~newStatic(IDC_ST_EDIT)~hide
    edit~hide
  end

::method hideUpDownControl unguarded
  expose menuBar upDown

  if menuBar~isChecked(ID_FILES_HIDE_UPDOWN) then do
    menuBar~uncheck(ID_FILES_HIDE_UPDOWN)
    self~newStatic(IDC_ST_UPD)~show
    self~newEdit(IDC_EDIT_BUDDY)~show
    upDown~show
  end
  else do
    menuBar~check(ID_FILES_HIDE_UPDOWN)
    self~newStatic(IDC_ST_UPD)~hide
    self~newEdit(IDC_EDIT_BUDDY)~hide
    upDown~hide
  end

::method exit unguarded
  self~cancel


::method lowerCaseOnly unguarded
  expose menuBar edit

  alreadyChecked = menuBar~isChecked(ID_EDITCONTROL_LOWER)

  self~setRadioChecks(ID_EDITCONTROL_LOWER)
  edit~replaceStyle("UPPER NUMBER", "LOWER")

  text = edit~getText
  edit~setText(text~lower)

  if \ alreadyChecked then do
    edit~assignFocus
    edit~select(1, 1)

    msg = "You can only enter lower case letters in" || .endOfLine || -
          "the edit control now.  Try it."
    z = MessageDialog(msg, self~hwnd, 'Edit Control Style Change', "OK", "INFORMATION")
  end


::method numbersOnly unguarded
  expose menuBar edit

  alreadyChecked = menuBar~isChecked(ID_EDITCONTROL_NUMBER)

  self~setRadioChecks(ID_EDITCONTROL_NUMBER)
  edit~replaceStyle("LOWER UPPER", "NUMBER")

  text = edit~getText
  edit~setText(text~translate("", xrange("00"X, "/") || xrange(":", "FF"X))~space(0))

  if \ alreadyChecked then do
    edit~assignFocus
    edit~select(1, 1)

    msg = "You can only enter numbers in the" || .endOfLine || -
          "edit control now.  Try it."
    z = MessageDialog(msg, self~hwnd, 'Edit Control Style Change', "OK", "INFORMATION")
  end


::method upperCaseOnly unguarded
  expose menuBar edit

  alreadyChecked = menuBar~isChecked(ID_EDITCONTROL_UPPER)

  self~setRadioChecks(ID_EDITCONTROL_UPPER)
  edit~replaceStyle("LOWER NUMBER", "UPPER")

  text = edit~getText
  edit~setText(text~upper)

  if \ alreadyChecked then do
    edit~assignFocus
    edit~select(1, 1)

    msg = "You can only enter upper case letters in" || .endOfLine || -
          "the edit control now.  Try it."
    z = MessageDialog(msg, self~hwnd, 'Edit Control Style Change', "OK", "INFORMATION")
  end


::method noRestriction unguarded
  expose menuBar edit

  alreadyChecked = menuBar~isChecked(ID_EDITCONTROL_UNRESTRICTED)

  self~setRadioChecks(ID_EDITCONTROL_UNRESTRICTED)
  edit~removeStyle("LOWER NUMBER UPPER")

  text = edit~getText
  edit~setText(.SimpleDialog~DEFAULT_TEXT)

  if \ alreadyChecked then do
    edit~assignFocus
    edit~select(1, 1)

    msg = "You can now enter unrestricted text in" || .endOfLine || -
          "the edit control.  Try it."
    z = MessageDialog(msg, self~hwnd, 'Edit Control Style Change', "OK", "INFORMATION")
  end


::method insertText unguarded
  expose edit srcDir

  dlg = .InsertDialog~new(srcDir"UserMenuBar.rc", IDD_INSERT_DIALOG, , srcDir"UserMenuBar.h")

  if dlg~execute("SHOWTOP", IDI_DLG_OODIALOG) == .PlainBaseDialog~IDOK then do
    edit~setText(dlg~selectedText)
  end


::method selectText unguarded
  expose edit srcDir

  dlg = .SelectDialog~new(srcDir"UserMenuBar.rc", IDD_SELECT_DIALOG, , srcDir"UserMenuBar.h")
  dlg~currentText = edit~getText
  edit~select(1, 1)

  if dlg~execute("SHOWTOP", IDI_DLG_APPICON) == .PlainBaseDialog~IDOK then do
    s = dlg~selection
    edit~select(s~x, s~y)
  end


::method hexidecimal unguarded
  expose menuBar upDown

  if menuBar~isChecked(ID_UPDOWNCONTROL_HEXIDECIMAL) then do
    menuBar~uncheck(ID_UPDOWNCONTROL_HEXIDECIMAL)
    upDown~setBase(10)
  end
  else do
    menuBar~check(ID_UPDOWNCONTROL_HEXIDECIMAL)
    upDown~setBase(16)
  end


::method setAcceleration unguarded
  expose upDown srcDir

  dlg = .AccelDialog~new(srcDir"UserMenuBar.rc", IDD_ACCEL_DIALOG, , srcDir"UserMenuBar.h")

  if dlg~execute("SHOWTOP", IDI_DLG_APPICON2) == .PlainBaseDialog~IDOK then do
    accel = dlg~acceleration
    upDown~setAcceleration(accel)
  end


::method setRange unguarded
  expose upDown srcDir

  dlg = .RangeDialog~new(srcDir"UserMenuBar.rc", IDD_RANGE_DIALOG, , srcDir"UserMenuBar.h")

  if dlg~execute("SHOWTOP", IDI_DLG_OOREXX) == .PlainBaseDialog~IDOK then do
    r = dlg~range
    upDown~setRange(r~x, r~y)

    -- If the current position was no longer within the new range, the up-down
    -- control will have internally reset its position so that it is within the
    -- new range.  But, the value displayed will still be the old value.  This
    -- forces the value displayed to match the current position.
    upDown~setPosition(upDown~getPosition)
  end


::method setPosition unguarded
  expose upDown srcDir

  dlg = .PositionDialog~new(srcDir"UserMenuBar.rc", IDD_POSITION_DIALOG, , srcDir"UserMenuBar.h")
  dlg~upDown = upDown

  if dlg~execute("SHOWTOP", IDI_DLG_DEFAULT) == .PlainBaseDialog~IDOK then do
    p = dlg~position
    upDown~setPosition(p)
  end


::method aboutUserMenuBar unguarded
  expose srcDir

  dlg = .AboutDialog~new(srcDir"UserMenuBar.rc", IDD_ABOUT_DIALOG, , srcDir"UserMenuBar.h")

  dlg~execute("SHOWTOP", IDI_DLG_DEFAULT)

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
--  End of the implementation methods for each of the menu item command events.
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/



-- Convenience method to set the radio button menu items.  The checkRadio()
-- method takes a start resource ID and an end resource, and the resource ID for
-- a single menu item within that range of IDs.  It removes the radio button
-- check mark from all the menu items in the range and adds the radio button
-- check mark to item specified by the third argument.
::method setRadioChecks private
  expose menuBar
  use strict arg item

  menuBar~checkRadio(ID_EDITCONTROL_LOWER, ID_EDITCONTROL_UNRESTRICTED, item)


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
--  The following classes all implement a single dialog that is used to collect
--  information, from the user, needed to carry out one of the menu item
--  commands.
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/

::class 'InsertDialog' subclass RcDialog

::attribute selectedText

::method initDialog
  self~newRadioButton(IDC_RB_WICKED)~check

::method ok unguarded

  select
    when self~newRadioButton(IDC_RB_WICKED)~checked then self~selectedText = .SimpleDialog~WICKED_TEXT
    when self~newRadioButton(IDC_RB_LOTUS)~checked then self~selectedText = .SimpleDialog~LOTUS_TEXT
    when self~newRadioButton(IDC_RB_IDES)~checked then self~selectedText = .SimpleDialog~IDES_TEXT
    when self~newRadioButton(IDC_RB_TITANIC)~checked then self~selectedText = .SimpleDialog~TITANIC_TEXT
    otherwise self~selectedText = ""
  end
  -- End select

  self~ok:super


::class 'SelectDialog' subclass RcDialog

::attribute selection
::attribute currentText

::method initDialog
  expose updStart updEnd currentText

  self~newStatic(IDC_ST_CURRENT_TEXT)~setText(currentText)

  updStart = self~newUpDown(IDC_UPD_START)
  updStart~setRange(0, currentText~length)
  updStart~setPosition(1)

  updEnd = self~newUpDown(IDC_UPD_END)
  updEnd~setRange(0, currentText~length)
  updEnd~setPosition(1)

::method ok unguarded
  expose updStart updEnd

  self~selection = .Point~new(updStart~getPosition, updEnd~getPosition)
  self~ok:super



::class 'AccelDialog' subclass RcDialog

::attribute acceleration

::method initDialog

  upd = self~newUpDown(IDC_UPD_ACCEL_SECONDS0)
  upd~setPosition(0)
  upd~disable
  self~newEdit(IDC_EDIT_ACCEL_SECONDS0)~disable

  upd = self~newUpDown(IDC_UPD_ACCEL0)
  upd~setPosition(1)
  upd~disable
  self~newEdit(IDC_EDIT_ACCEL0)~disable

  do i = 1 to 3
    upd = self~newUpDown(IDC_UPD_ACCEL_SECONDS || i)
    upd~setRange(i, 32)
    upd~setPosition(i)

    upd = self~newUpDown(IDC_UPD_ACCEL || i)
    upd~setRange(2 ** i, 256)
    upd~setPosition(2 ** i)
  end

  self~newUpDown(IDC_UPD_ACCEL_SECONDS1)~assignFocus


::method ok unguarded

  a = .array~new(3)

  do i = 1 to 3
    d = .directory~new

    updS = self~newUpDown(IDC_UPD_ACCEL_SECONDS || i)
    updA = self~newUpDown(IDC_UPD_ACCEL || i)

    d~seconds = updS~getPosition
    d~increment = updA~getPosition
    a[i] = d
  end

  -- Check that the user has an unique value for each acceleration entry.
  check = .set~of(a[1]~seconds, a[2]~seconds, a[3]~seconds)
  if check~items <> 3 then do
    msg = "For each of the 3 acceleration input" || .endOfLine || -
          "lines, you must use a unique value for" || .endOfLine || -
          "seconds.  Found:" a[1]~seconds',' a[2]~seconds', and' a[3]~seconds'.'

    z = MessageDialog(msg, self~hwnd, "Acceleration Input Error", "OK", "STOP")
    return .false
  end

  -- Sort the entries by seconds, ascending, using brute force.
  max = 0; min = 4
  do i = 1 to 3
    if a[i]~seconds > max then max = i
    if a[i]~seconds < min then min = i
  end

  -- The user only has 3 up-down pairs she can set.  But, we also have the
  -- first disabled up-down pair for seconds == 0, increment == 1
  aa = .array~new(4)
  aa[1] = .directory~new~~setEntry("SECONDS", 0)~~setEntry("INCREMENT", 1)

  aa[2] = a[min]
  aa[4] = a[max]

  do i = 1 to 3
    if i \== min, i \== max then do
      aa[3] = a[i]
      leave
    end
  end

  self~acceleration = aa
  self~ok:super


::class 'RangeDialog' subclass RcDialog

::attribute range

::method initDialog
  expose updLow updHigh

  -- Set an acceleration that goes very fast if the user hold down the arrow
  -- keys, or holds down the mouse on the up / down arrows.
  accel = .array~new(4)
  accel[1] = .directory~new~~setEntry("SECONDS", 0)~~setEntry("INCREMENT", 1)
  accel[2] = .directory~new~~setEntry("SECONDS", 1)~~setEntry("INCREMENT", 32)
  accel[3] = .directory~new~~setEntry("SECONDS", 2)~~setEntry("INCREMENT", 64)
  accel[4] = .directory~new~~setEntry("SECONDS", 3)~~setEntry("INCREMENT", 256)

  updLow = self~newUpDown(IDC_UPD_LOW)
  updLow~setRange(-2147483648, 2147483647)
  updLow~setPosition(0)
  updLow~setAcceleration(accel)

  updHigh = self~newUpDown(IDC_UPD_HIGH)
  updHigh~setRange(-2147483648, 2147483647)
  updHigh~setPosition(0)
  updHigh~setAcceleration(accel)

::method ok unguarded
  expose updLow updHigh

  self~range = .Point~new(updLow~getPosition, updHigh~getPosition)
  self~ok:super


::class 'PositionDialog' subclass RcDialog

::attribute position
::attribute upDown

::method initDialog
  expose upDown upd

  upd = self~newUpDown(IDC_UPD_POSITION)

  upd~setRange(upDown~getRange)
  upd~setPosition(upDown~getPosition)

::method ok unguarded
  expose upd

  self~position = upd~getPosition
  self~ok:super


::class 'AboutDialog' subclass RcDialog

::method initDialog
   expose font

   bitmap = .Image~getImage(.application~srcDir"UserMenuBar.bmp")
   self~newStatic(IDC_ST_BITMAP)~setImage(bitmap)

   font = self~createFontEx("Ariel", 14)
   self~newStatic(IDC_ST_ABOUT)~setFont(font)

::method leaving
   expose font
   self~deleteFont(font)