Шаблон  MoveUpDown

Control-шаблон  MoveUpDown реализует четыре кнопки перемещения упорядоченных по ключу записей:

Идея этого очень полезного шаблона была подсказана аналогичным шаблоном из FreeAPIToolkit-а Vince Sorensen sorev@dlcwest.com.   Но оригинальный шаблон никак не хотел работать в случае, если в значениях  ключевого поля, по которому упорядочены записи, имеют пропуски.  Поэтому мне пришлось его полностью переписать, и теперь все работает просто здорово!

#CONTROL(MoveUpDown,'Перемещение записей вверх/вниз'),WINDOW #! ,REQ(BrowseBox(Clarion))
CONTROLS
  BUTTON,AT(,,16,16),TIP('Сделать первой'),USE(?MoveBegin),ICON('ARROWBEG.ICO')
  BUTTON,AT(16,0,16,16),TIP('Переместить вверх'),USE(?MoveUp),ICON('ARROWUP.ICO')
  BUTTON,AT(16,0,16,16),TIP('Переместить вниз'),USE(?MoveDown),ICON('ARROWDN.ICO')
  BUTTON,AT(16,0,16,16),TIP('Сделать последней'),USE(?MoveEnd),ICON('ARROWEND.ICO')
END
#BOXED('Перемещение записей')
  #PROMPT('Файл:',FILE),%MSFile
  #PROMPT('Ключ:',KEY),%MSFileKey
  #PROMPT('Поле:',FIELD),%MSSeqField
  #PROMPT('Макс.значение:',@n12),%MSHighValue,REQ,DEFAULT(9999999)
  #BUTTON('Поля для заполнения'),MULTI(%MSPrimeFields,%MSPrimeField & '=' & %MSPrimeFieldValue)
  #PROMPT('Поле:',FIELD),%MSPrimeField,REQ
  #PROMPT('Значение:',@S40),%MSPrimeFieldValue,REQ
  #ENDBUTTON
  #DISPLAY('')
  #DISPLAY('Включить для ускорения:')
  #PROMPT('Использовать Stream/Flush',CHECK),%MSStream,DEFAULT(1)
  #DISPLAY('')
  #DISPLAY('Если вы уже используете STREAM в процедуре:')
  #PROMPT('Включить Stream после завершения',CHECK),%MSStreamAfter
  #DISPLAY('')
#ENDBOXED
#LOCALDATA
  S:Rez     BYTE
  S:OrigPos ULONG
  S:NewPos  ULONG
#ENDLOCALDATA
#!-----------------------------------------------------------------------------
#ATSTART
#DECLARE(%MoveUpControl)
#DECLARE(%MoveBeginControl)
#DECLARE(%MoveDownControl)
#DECLARE(%MoveEndControl)
#FOR(%Control),WHERE(%ControlInstance=%ActiveTemplateInstance)
  #CASE(%ControlOriginal)
  #OF('?MoveUp')
    #SET(%MoveUpControl,%Control)
  #OF('?MoveBegin')
    #SET(%MoveBeginControl,%Control)
  #OF('?MoveDown')
    #SET(%MoveDownControl,%Control)
  #OF('?MoveEnd')
    #SET(%MoveEndControl,%Control)
  #ENDCASE
#ENDFOR
#ENDAT
#!-----------------------------------------------------------------------------
#AT(%ControlEventHandling,%MoveUpControl,'Accepted')
  if %MSSeqField > 1
    do MS:StepUp
    if S:Rez = True
      ForceRefresh = True
      do RefreshWindow
    .
  .
#ENDAT
#!-----------------------------------------------------------------------------
#AT(%ControlEventHandling,%MoveDownControl,'Accepted')
  if %MSSeqField < %MSHighValue
    do MS:StepDown
    if S:Rez = True
      ForceRefresh = True
      do RefreshWindow
    .
  .
#ENDAT
#!-----------------------------------------------------------------------------
#AT(%ControlEventHandling,%MoveBeginControl,'Accepted')
  if %MSSeqField > 1
#FIX(%File,%MSFile)
    S:OrigPos=%MSSeqField #<! Save original sequence
#IF(%MSStreamAfter)
    FLUSH(%MSFile)
#ENDIF
#IF(%MSStream)
    STREAM(%MSFile)
#ENDIF
    loop
      do MS:StepUp
      if S:Rez=False
        break
      .
    . ! end loop
#IF(%MSStream)
    FLUSH(%MSFile)
#ENDIF
#IF(%MSStreamAfter)
    STREAM(%MSFile)
#ENDIF
    ForceRefresh = True
    do RefreshWindow
  .
#ENDAT
#!-----------------------------------------------------------------------------
#AT(%ControlEventHandling,%MoveEndControl,'Accepted')
  if %MSSeqField < %MSHighValue
#FIX(%File,%MSFile)
    S:OrigPos=%MSSeqField    #<! Save original sequence
#IF(%MSStreamAfter)
    FLUSH(%MSFile)
#ENDIF
#IF(%MSStream)
    STREAM(%MSFile)
#ENDIF
    loop
      do MS:StepDown
      if S:Rez=False
        break
      .
    . ! end loop
#IF(%MSStream)
    FLUSH(%MSFile)
#ENDIF
#IF(%MSStreamAfter)
    STREAM(%MSFile)
#ENDIF
    ForceRefresh = True
    do RefreshWindow
  .
#ENDAT
#!-----------------------------------------------------------------------------
#AT(%ProcedureRoutines)
MS:StepUp   ROUTINE
#FIX(%File,%MSFile)
  S:OrigPos=%MSSeqField #<! Save original sequence
  ! Найти предыдущую запись
  CLEAR(%FilePrefix:Record)
#FOR(%MSPrimeFields)
  %MSPrimeField=%MSPrimeFieldValue
#ENDFOR
  %MSSeqField = S:OrigPos-1
  set( %MSFileKey, %MSFileKey )
  previous( %MSFile )
  if errorcode()
    S:Rez=False
    exit
#FOR(%MSPrimeFields)
  elsif %MSPrimeField<>%MSPrimeFieldValue
    S:Rez=False
    exit
#ENDFOR
  else
    S:NewPos = %MSSeqField
    ! Временно переместить оригинальную запись до упора
#FOR(%MSPrimeFields)
    %MSPrimeField=%MSPrimeFieldValue
#ENDFOR
    %MSSeqField = S:OrigPos
    get( %MSFile, %MSFileKey )
    if ~errorcode()
      %MSSeqField = %MSHighValue
      put( %MSFile )
    .
    ! Переместить вверх нижнюю запись
#FOR(%MSPrimeFields)
    %MSPrimeField=%MSPrimeFieldValue
#ENDFOR
    %MSSeqField = S:NewPos
    get( %MSFile, %MSFileKey )
    if ~errorcode()
      %MSSeqField = S:OrigPos
      put( %MSFile )
    .
    ! Перреместить вниз оригинальную запись
#FOR(%MSPrimeFields)
%MSPrimeField=%MSPrimeFieldValue
#ENDFOR
    %MSSeqField = %MSHighValue
    get( %MSFile, %MSFileKey )
    if ~errorcode()
      %MSSeqField = S:NewPos
      put( %MSFile )
    .
    S:Rez=True
  .
  exit


MS:StepDown   ROUTINE
  S:OrigPos = %MSSeqField
  clear( %FilePrefix:Record )
#FOR(%MSPrimeFields)
  %MSPrimeField=%MSPrimeFieldValue
#ENDFOR
  %MSSeqField = S:OrigPos+1
  set( %MSFileKey, %MSFileKey )
  next( %MSFile )
  if errorcode()
    S:Rez=False
    exit
#FOR(%MSPrimeFields)
  elsif %MSPrimeField<>%MSPrimeFieldValue
    S:Rez=False
    exit
#ENDFOR
  else
    S:NewPos = %MSSeqField
#FOR(%MSPrimeFields)
    %MSPrimeField=%MSPrimeFieldValue
#ENDFOR
    %MSSeqField = S:OrigPos
    get( %MSFile, %MSFileKey )
    if ~errorcode()
      %MSSeqField = %MSHighValue
      put( %MSFile )
    .
#FOR(%MSPrimeFields)
    %MSPrimeField=%MSPrimeFieldValue
#ENDFOR
    %MSSeqField = S:NewPos
    get( %MSFile, %MSFileKey )
    if ~errorcode()
      %MSSeqField = S:OrigPos
      put( %MSFile )
    .
#FOR(%MSPrimeFields)
    %MSPrimeField=%MSPrimeFieldValue
#ENDFOR
    %MSSeqField = %MSHighValue
    get( %MSFile, %MSFileKey )
    if ~errorcode()
      %MSSeqField = S:NewPos
      put( %MSFile )
    .
    S:Rez = True
  .
  exit
#ENDAT