/****************************************
*  FontCode für FW 3+                   *
*  $VER: 3.0 © Heiko Schröder 04.01.98  *
*****************************************/

/* neu: auslesen eines Codes */

Parse ARG FW

if ~show('L',"rexxreqtools.library") then
   if ~addlib('rexxreqtools.library',0,-30,0) then do
      'ShowMessage 1 1 "Fehler...." "Benötige Libs:rexxreqtools.library" " A B B R U C H ! !" "Okay" "" ""'
       exit
   end
IF ~SHOW('L','tritonrexx.library') THEN
   IF ~ADDLIB('tritonrexx.library',10,-30,0) THEN DO
      'ShowMessage 2 1 "Fehler...." "Benötige Libs:tritonrexx.library" "" "Abbruch" "" ""'
      exit
   END

R='0A'X

If FW='' then do
   Address='FinalW'
   Options results

   STATUS PORTNAME
   FW = result
End
   address(FW)

SIGNAL ON SYNTAX

If open('Hilfe',"S:FW_Paket.prefs","R") then do
   HilfeVerz=readln('Hilfe')
   Call Close('Hilfe')
End
else HilfeVerz=''

apptags = 'TRCA_Name     FontCode',
          'TRCA_LongName "FontCode"',
          'TRCA_Info     "Makro für Finalwriter"',
          'TRCA_Version  "3.0 registered"',
          'TRCA_Release  "3"',
          'TRCA_Date     "04.01.98"',
          'TAG_END'

windowtags = WindowID(1),
             WindowPosition('TRWP_CENTERDISPLAY'),
             WindowFlags('TRWF_ACTIVATESTRGAD|TRWF_NOSIZEGADGET'),
             PubScreenName('FinalWriterPubScreen'),
             WindowTitle('FontCode'),
             BeginMenu('Projekt'),
                MenuItem('Q_Verlassen...',104),
             BeginMenu('?'),
                MenuItem('?_Info',101),
                MenuItem('H_Hilfe',103),
             'HorizGroupAC',
                'SpaceS',
                'VertGroupAC',
                   'SpaceS',
                   'HorizGroupEC',
                      CheckBox(3),
                      'SpaceS',
                      StringGadget('',10),
                   'EndGroup',
                   'SpaceS',
                   'HorizGroupEC',
                      Button('_Anwenden',2),
                      'SpaceS',
                      Button('Ab_bruch',4),
                   'EndGroup',
                'SpaceS',
                'EndGroup',
                'SpaceS',
             'EndGroup',
          'EndProject'

app = TR_CREATEAPP('TRCA_Name FontCode')
IF app ~= '00000000'x THEN DO
   ende=0
   window1 = TR_OPENPROJECT(app,windowtags)
   IF window1 ~= '00000000'x THEN DO
      DO WHILE ende ~= 1
         CALL TR_WAIT(app,'')

         DO WHILE TR_HANDLEMSG(app,'event')
            IF event.trm_class = 'TRMS_NEWVALUE' THEN DO
               SELECT
                  WHEN event.trm_id = 3 THEN Do
                     Extract
                     a = c2d(result)
                     CALL TR_SETATTRIBUTE(window1,10,'TROB_STRING',a)
                     CALL TR_SETATTRIBUTE(window1, 3,'TRAT_VALUE',0)
                  END

                  WHEN event.trm_id = 10 THEN Call Write

                  OTHERWISE NOP
               END
            END

            IF event.trm_class = 'TRMS_ACTION' THEN DO
               SELECT
                  WHEN event.trm_id = 2 THEN Call Write

                  WHEN event.trm_id = 4 THEN ende=1

                  WHEN event.trm_id = 101 THEN Call rtezrequest("Aus dem Makro-Paket:"||R||R||"FontCode V3.0 für FW"||R||"© 1998 Heiko Schröder","Danke für Ihre Registrierung.","Info","rt_pubscrname=FinalWriterPubScreen")
                  WHEN event.trm_id = 103 THEN address command "run Multiview PUBSCREEN=FinalWriterPubScreen "||d2c(34)||HilfeVerz||"FontCode.guide"||d2c(34)
                  WHEN event.trm_id = 104 THEN ende=1

                  OTHERWISE NOP
               END
            END
         END

         IF event.trm_class = 'TRMS_CLOSEWINDOW' THEN ende=1
      END

      CALL TR_CLOSEPROJECT(window1)
   END

   CALL TR_DELETEAPP(app)
END
ELSE
   CALL quit('Kann das Fenster nicht öffnen',10)

Exit

Write:
  a = TR_GETATTRIBUTE(window1,10,'TROB_String')
  if a>15&a<256 then Type d2c(a)
Return
/*******************************************************************************
** Routine, die bei einer Unterbrechung des Scripts aufgerufen wird
*******************************************************************************/

SYNTAX:
   CALL quit('Fehler' rc 'in Zeile' sigl '-' ERRORTEXT(rc)||R||SOURCELINE(sigl)||R||'Bitte informieren Sie den Autor...',20)


/*******************************************************************************
** Script beenden
*******************************************************************************/

quit:
   PARSE ARG message,rcode

   IF app ~= '00000000'x THEN DO
      IF message ~= '' THEN
         ret=rtezrequest(message,"_Okay","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")

      CALL TR_DELETEAPP(app)
   END
   ELSE DO
      IF message ~= '' THEN DO
         SAY message
         SAY
         OPTIONS PROMPT 'Bitte <RETURN> drücken'
         PULL taste
      END
   END
   Address command "C:FlushTRX All >NIL:"

   EXIT(rcode)