rexx-things/modules/windows/oodialog/controls/upDown.rex

/*----------------------------------------------------------------------------*/
/*                                                                            */
/* Copyright (c) 2009-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.               */
/*                                                                            */
/*----------------------------------------------------------------------------*/

/**
 * UpDown control example.
 *
 * The dialog produced by this example contains 3 up down controls.  Two of the
 * up down controls are integer up down controls.  These are commonly referred
 * to as 'spinners.'
 *
 * The third up down control is used to simulate paging through database
 * records.  It demonstrates how the up down control is useful in non-integer
 * situations.
 *
 * The methods within the dialog class show the usage of mose of the methods of
 * the UpDown class.
 */

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

  dlg = .AnUpDownDlg~new(sd"upDown.rc", IDD_UP_DOWN)
  dlg~execute("SHOWTOP", IDI_DLG_OOREXX)

return 0
-- End of entry point.

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\
  Directives, Classes, or Routines.
\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
::requires "ooDialog.cls"

::class 'AnUpDownDlg' subclass RcDialog

-- initDialog()
-- There are many different approaches that can be taken to doing the set up for
-- a dialog.  For myself, it seems simplest to just do all the initialization in
-- the initDialog() method, which is what is done here.
--
-- The initialization for this example falls naturally into 3 steps:
--  * Initialize the 2 integer up down controls and set up the data related to
--    maintaining the state for those controls.
--  * Initalize the 'client records' up down control and data structures related
--    to that up down.
--  * Connect all our button controls.
::method initDialog

  self~setupNumericUpDowns
  self~setupClientUpDown
  self~connectPushButtons


-- onClientChange()
-- Invoked when the client up down's position is changed.  I.e., the user clicks
-- on one of the arrows of the up down or uses the up or down arrow keys when
-- the focus is on the client edit control.
--
-- Four arguments are sent to the method: the current position of the up down,
-- the amount the position is to be changed (which can be negative depending on
-- the direction of the change,) the control ID, and the window handle of the
-- control.  We don't need the ID or  window handle, so those args are just
-- ignored.
--
-- Each position of the up down maps to the index of a record in the client
-- database, so we just update the record fields using the new index.
::method onClientChange unguarded
  expose clientUPD clientDB
  use arg curPos, increment
  self~refreshClientDisplay(curPos + increment)

  -- Return a delta position reply.  With no arguments the reply essentially
  -- says to allow the change.
  return .UpDown~deltaPosReply


-- onChangeAcceleration()
-- Invoked when the user clicks on the "Change Acceleration" button.  We keep
-- track of the origianl acceleration values and then loop through 3 new values
-- each time the button is clicked.  Returning to the original values every 4th
-- click.
--
-- The acceleration values consist of an array of directory objects.  Each
-- directory object has a SECONDS index and an INCREMENT index.  This
-- essentially says after x seconds, set the increment to this value.  Typically
-- the first record is 0 seconds and an increment of 1.
--
-- To get the current acceleration of an up down control you use the
-- getAcceleration() method and an array as described above is returned.  To set
-- a new / different acceleration you construct an array as described above and
-- use the setAcceleration() method.  Note that the records (directory objects)
-- in the array have to be sorted by the seconds field, lowest to highest.
--
-- See the printAccelValues(), getFirstAccelIncrease(), and doubleAccel()
-- methods to see the acceleration array works.
::method onChangeAcceleration unguarded
  expose decUpDown originalAccel index

  currentAccel = decUpDown~getAcceleration
  reverting = .false

  if \ originalAccel~isA(.array) then do
    originalAccel = currentAccel
    index = 1
  end

  select
    when index == 1 then do
      newAccel = self~getFirstAccelIncrease(currentAccel)
      index = 2
    end
    when index == 2 then do
      newAccel = self~doubleAccel(currentAccel)
      index = 3
    end
    when index == 3 then do
      newAccel = self~doubleAccel(currentAccel)
      index = 4
    end
    otherwise do
      index = 1
      reverting = .true
      newAccel = originalAccel
    end
  end
  -- End select

  decUpDown~setAcceleration(newAccel)

  self~printAccelValues(currentAccel, newAccel, reverting)

  return 0


-- onChangeRange()
-- Invoked when the "Change Range" button is clicked.  The range of the up down
-- control on the right is changed.  This up down starts out as base 16, but the
-- base may have been changed by the user.
--
-- The example program has a set of ranges and we just cycle though them.  We
-- keep a different set of ranges for base 10 and base 16.  The up down controls
-- seem to behave rather oddly if the base is 16 and the range includes negative
-- numbers.  So the decimal set has some ranges using negative numbers, but the
-- set for base 16 has only ranges with all positive positions.
::method onChangeRange unguarded
  expose hexUpDown decRanges hexRanges

  -- Get the index of the next range and keep track of the current position in
  -- the up down control.
  index = self~getNextRange
  currentPos = hexUpDown~getPosition

  -- Get the appropriate new range, and then set it.
  if hexUpDown~getBase == 10 then range = decRanges[index]
  else range = hexRanges[index]

  hexUpDown~setRange(range)

  -- Check if the current position is within the new range.  If not, change the
  -- current position.
  if currentPos < range~min | currentPos > range~max then hexUpDown~setPosition(range~max)

  -- Display to the user what we did.
  msg = 'Set new range for up down control on right to:' || .endOfLine || -
        '  minimum:' range~min                           || .endOfLine || -
        '  maximum:' range~max
  self~information(msg)

  return 0


-- onChangeBase()
-- Invoked when the user pushes the "Change Base" putton.  Changes the base for
-- the integer up down control whose radio button is checked.
--
-- Integer up down controls can be either base 10 or base 16.  This method seems
-- to have a lot in it, but changing the base is actually simple.  The rest of
-- the code is to keep the user interface consistent and looking "good."
::method onChangeBase unguarded
  expose decUpDown hexUpDown leftUpDownDecimalRange leftUpDownHexadecimalRange

  if self~decimalRBSelected then do
    upd = decUpDown
    static = self~newStatic(IDC_ST_DECIMAL)
    side = 'left'
  end
  else do
    upd = hexUpDown
    static = self~newStatic(IDC_ST_HEXADECIMAL)
    side = 'right'
  end

  oldBase = upd~getBase
  if oldBase == 10 then do
    newBase = 16
    if side == 'right' then newText = ":Hexadecimal"
    else newText = "Hexadecimal:"
  end
  else do
    newBase = 10
    if side == 'right' then newText = ":Decimal"
    else newText = "Decimal:"
  end

  upd~setBase(newBase)
  static~setText(newText)

  -- Setting the position twice, is the only reliable way I've found to force
  -- the text in the buddy window (the edit control) to update.
  upd~setPosition(1)

  -- Read the comments for the setDecimalUpDown() method to see why we treat
  -- the range for the left-side up down, (the one that starts out as decimal,)
  -- special.
  if side == 'left' then do
    if base == 10 then upd~setRange(leftUpDownDecimalRange)
    else upd~setRange(leftUpDownHexadecimalRange)
  end

  upd~setPosition(0)

  msg = 'Changed the base of the up down control' || .endOfLine || -
        'on the' side 'from base' oldBase ' to'   || .endOfLine || -
        'base' newBase'.'
  self~information(msg)

  return 0


-- onGetPostion()
-- Invoked when the user clicks the 'Get Position' push button.  We simply
-- display the value for the integer up down selected by a checked radio button.
::method onGetPosition
  expose decUpDown hexUpDown

  if self~decimalRBSelected then do
    pos = decUpDown~getPosition
    side = 'left'
  end
  else do
    pos = hexUpDown~getPosition
    side = 'right'
  end

  msg = "The position of the up down control on the" side "is" pos
  self~information(msg)

  return 0


-- onGetBuddy()
-- Invoked when the "Get Buddy" push button is clicked.  The getBuddy() method
-- is used to get the 'buddy' control of the up down control.  The setBuddy()
-- method can be used to set the buddy control for an up down control, but that
-- method is not demonstrated in this example.  Here we just display the window
-- handle value.
--
-- Note that the getBuddy() method can return .nil if there is no buddy control.
-- We do not check for that here, since we know there is a buddy control.  The
-- up-downs were created with the AUTOBUDDY style.
::method onGetBuddy
  expose decUpDown hexUpDown

  if self~decimalRBSelected then do
    buddy = decUpDown~getBuddy
    side = 'left'
  end
  else do
    buddy = hexUpDown~getBuddy
    side = 'right'
  end

  msg = "The window handle of the up down control on the" side "is" buddy~hwnd
  self~information(msg)

  return 0


-- connectPushButtons()
-- Convenience method, connects the clicked event of all the push buttons to
-- our corresponding event handling method.
::method connectPushButtons private

  self~connectButtonEvent(IDC_PB_ACCEL, "CLICKED", onChangeAcceleration)
  self~connectButtonEvent(IDC_PB_RANGE, "CLICKED", onChangeRange)
  self~connectButtonEvent(IDC_PB_BASE, "CLICKED", onChangeBase)
  self~connectButtonEvent(IDC_PB_POS, "CLICKED", onGetPosition)
  self~connectButtonEvent(IDC_PB_BUDDY, "CLICKED", onGetBuddy)

  -- At start up have the decimal radio button checked.
  self~newRadioButton(IDC_RB_DECIMAL)~check


-- decimalRBSelected()
-- Returns true if the decimal radio button is checked, otherwise false.
::method decimalRBSelected private
  return self~newRadioButton(IDC_RB_DECIMAL)~checked


-- setupNumericUpDowns()
-- Does all the initial set up for the two numeric up down controls.  The left
-- up down control starts out with base 10 (decimal) and the right up down
-- control starts out with base 16 (hexadecimal.)  However, these bases can be
-- changed after the dialog comes up.
::method setupNumericUpDowns private
  expose decUpDown hexUpDown

  decUpDown = self~newUpDown(IDC_UD_DECIMAL)
  hexUpDown = self~newUpDown(IDC_UD_HEXADECIMAL)

  -- By default an integer up down uses base 10 (deicmal.)  We set the other
  -- integer up down to base 16.
  hexUpDown~setBase(16)

  -- Set the minimum value in the range to 0 and the maximum range to 1024.  The
  -- range can also be set using a .directory object, see the setDecimalUpDonw()
  -- method.
  hexUpDown~setRange(0, 1024)

  -- Set the position at the top of the range.
  hexUpDown~setPosition(1024)

  -- Invoke some convenience methods to finish the set up.
  self~setDecimalUpDown
  self~setupRangeChanges


-- setDecimalUpDown()
-- Does the set up for the left-side up down.  This up down controls starts out
-- with a decimal base, but the user can change the base after the dialog has
-- come up.
--
-- The behavior of an up down control, when the base is set to 16, and the range
-- includes negative numbers, seems rather bizarre.  So, in this example, only
-- the left-hand side up down control uses ranges that include negative numbers.
-- When the left-hand up down has its base changed to base 16, the range is
-- changed to not include negative numbers.
::method setDecimalUpDown private
  expose decUpDown leftUpDownDecimalRange leftUpDownHexadecimalRange

  -- The setRange() method of the UpDown class accepts a Direcory object to set
  -- the range.  The MIN and MAX indexes of the Directory object set the range.
  leftUpDownDecimalRange = .directory~new
  leftUpDownDecimalRange~min = -200
  leftUpDownDecimalRange~max = 200

  leftUpDownHexadecimalRange = .directory~new
  leftUpDownHexadecimalRange~min = 0
  leftUpDownHexadecimalRange~max = 65536

  -- Set the range with the values used when the base is 10.
  decUpDown~setRange(leftUpDownDecimalRange)

  -- Set the position to -100.
  decUpDown~setPosition(-100)


-- setupRangeChanges()
-- Creates two arrays that contain different ranges for the integer up down
-- controls.  These ranges are used to change the range when the user clicks the
-- "Change Range" button.  The rangeIndex is used to keep track of where we are
-- and to select the new range.
::method setupRangeChanges private
  expose decRanges hexRanges rangeIndex

  rangeIndex = 1

  d1 = .directory~new~~setEntry("MIN", -400)~~setEntry("MAX", 400)
  d2 = .directory~new~~setEntry("MIN",   -5)~~setEntry("MAX", 5000)
  d3 = .directory~new~~setEntry("MIN",  600)~~setEntry("MAX", 700)
  decRanges = .array~of(d1, d2, d3)

  d1 = .directory~new~~setEntry("MIN", 1024)~~setEntry("MAX", 2048)
  d2 = .directory~new~~setEntry("MIN",    0)~~setEntry("MAX", 15)
  d3 = .directory~new~~setEntry("MIN",    0)~~setEntry("MAX", 700)
  hexRanges = .array~of(d1, d2, d3)


-- getNextRange()
-- Produce the next index to use when changing the range of an up down control
::method getNextRange private
  expose rangeIndex
  rangeIndex += 1
  if rangeIndex > 3 then rangeIndex = 1
  return rangeIndex


-- setupClientUpDown()
-- Sets up the third up down control.  This up down is meant to demonstrate how
-- the up down control can be used to scroll through things other than integers.
--
-- The example is for a set of data base records consisting of several fields.
-- The controlling field is the 'client.'  Each time the up down control has  a
-- position change, the matching data base record is displayed.
::method setupClientUpDown private
  expose clientUPD clientDB nameInfo ageInfo genderInfo paidInfo

  clientUPD = self~newUpDown(IDC_UD_CLIENT)

  -- We will use 20 records.
  clientDB = .array~new(20)
  self~fillClientDB(clientDB)

  -- 20 records, so use a range of 1 to 20.
  clientUPD~setRange(1, 20)

  -- Start at record 1.
  clientUPD~setPosition(1)

  -- Connect the position change event to our onClientChange() method
  self~connectUpDownEvent(IDC_UD_CLIENT, "DELTAPOS", onClientChange)

  nameInfo = self~newEdit(IDC_EDIT_CLIENT)
  ageInfo = self~newEdit(IDC_EDIT_AGE)
  genderInfo = self~newEdit(IDC_EDIT_GENDER)
  paidInfo = self~newEdit(IDC_EDIT_PAID)

  -- Set the initial values for the record.
  self~refreshClientDisplay(1)


-- getFirstAccelIncrease()
-- Generates new acceleration values using the default values of the up down
-- control.  Observation has shown that, on Windows XP, an up down control
-- starts out with an acceleration array of 3 values, the first being 0 seconds,
-- an increment of 1.  That is not documented and could not be a hard fast rule,
-- but works well enough for this example.
::method getFirstAccelIncrease private
  use strict arg accel

  newAccel = .array~new(4)
  newAccel[1] = accel[1]
  newAccel[2] = .directory~new~~setEntry("SECONDS", 1)~~setEntry("INCREMENT", 2)
  newAccel[3] = .directory~new~~setEntry("SECONDS", accel[2]~seconds)~~setEntry("INCREMENT", accel[2]~increment + 2)
  newAccel[4] = .directory~new~~setEntry("SECONDS", accel[3]~seconds)~~setEntry("INCREMENT", accel[3]~increment + 4)

  return newAccel


-- doubleAccel()
-- Generates new acceleration values by doubling the increment of the passed in
-- values.
::method doubleAccel private
  use strict arg accel

  newAccel = .array~new(accel~items)
  newAccel[1] = accel[1]

  do i = 2 to accel~items
    d = .directory~new
    d~seconds = accel[i]~seconds
    d~increment = accel[i]~increment * 2
    newAccel[i] = d
  end

  return newAccel


-- printAccelValues()
-- Convenience method to display acceleration values
::method printAccelValues private
  use strict arg currentAccel, newAccel, reverting

  tab = '09'x

  msg = "The current acceleration values are:"   || .endOfLine || -
        tab || "Items:  " currentAccel~items     || .endOfLine

  do a over currentAccel
    msg ||= tab || "Seconds:" a~seconds || tab || "Increment:" a~increment || .endOfLine
  end

  msg ||= .endOfLine

  if reverting then msg ||= "Reverting to original values of:" || .endOfLine
  else msg ||= "Changing acceleration values to:" || .endOfLine

  msg ||= tab || "Items:  " newAccel~items  || .endOfLine

  do a over newAccel
    msg ||= tab || "Seconds:" a~seconds || tab || "Increment:" a~increment || .endOfLine
  end

  self~information(msg)


-- refreshClientDisplay()
-- Updates the display to show the fields for the specified record.
::method refreshClientDisplay private
  expose nameInfo ageInfo genderInfo paidInfo clientDB
  use strict arg index

  -- There are numerous ways to handle reaching the end of the range for an up
  -- down control.  Here we put up a message box when either end of the range is
  -- reached.
  if index < 1 then do
    self~clientEnd("bottom")
    return
  end
  if index > 20 then do
    self~clientEnd("top")
    return
  end

  nameInfo~setText(clientDB[index][1])
  ageInfo~setText(clientDB[index][2])
  genderInfo~setText(clientDB[index][3])
  paidInfo~setText(clientDB[index][4])


-- clientEnd()
-- Put up a message box informing the user that they hit the end of the range of
-- records.
::method clientEnd private
  use strict arg whichEnd

  msg = "At the" whichEnd "of the client list."
  self~information(msg)


-- information()
-- A convenience method to display informational messages to the user.
::method information private
  use strict arg msg

  title = "UpDown Controls"
  button = "OK"
  icon = "INFORMATION"
  miscStyles = "APPLMODAL TOPMOST"
  j = messageDialog(msg, self~hwnd, title, button, icon, miscStyles)


-- fillClientDB()
-- Convenience method for this example.  Fills an array with the 'database'
-- records.
::method fillClientDB private
  use strict arg db

  db[1]  = .array~of("Cathy Smart", 44, "female", "yes")
  db[2]  = .array~of("Tom Jones", 34, "male", "no")
  db[3]  = .array~of("Bill Harris", 23, "male", "yes")
  db[4]  = .array~of("Larry Bonds", 41, "male", "yes")
  db[5]  = .array~of("Sue Evans", 55, "female", "no")
  db[6]  = .array~of("Ashley Wright", 17, "female", "yes")
  db[7]  = .array~of("Deb Newsome", 22, "female", "yes")
  db[8]  = .array~of("Frank Getts", 22, "male", "yes")
  db[9]  = .array~of("Betty Boop", 34, "female", "no")
  db[10] = .array~of("Fred Aston", 56, "male", "no")
  db[11] = .array~of("Cary Thule", 85, "female", "no")
  db[12] = .array~of("Brianna Medford", 24, "female", "yes")
  db[13] = .array~of("Sol Price", 26, "male", "no")
  db[14] = .array~of("Hugh Dentry", 41, "male", "no")
  db[15] = .array~of("Tina McGrath", 49, "female", "yes")
  db[16] = .array~of("Tom Denard", 26, "female", "yes")
  db[17] = .array~of("Crissy Albright", 21, "female", "yes")
  db[18] = .array~of("Phil Logan", 19, "male", "no")
  db[19] = .array~of("Walter Perkins", 50, "male", "yes")
  db[20] = .array~of("Zoe Sharpe", 28, "female", "no")