.CM  SCRIPT , Version - 1.1 , last edited by barbara
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VIN06$
.tt 2 $$$
.TT 3 $HolgerB$PRINTERSETS AND ATTRIBUTES$1998-06-19$
***********************************************************
.nf
 
.nf
 
 .nf

    ========== licence begin  GPL
    Copyright (c) 2000-2005 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
.fo

 
.fo
 
 
.fo
.nf
.sp
MODULE  : printersets and attributes
=========
.sp
Purpose : Show and change of printer parameters and attributes
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              i06getattr (
                    attrindex  : tsp00_Int2;
                    VAR att    : tsp00_VtAttrib;
                    VAR foregr : tsp00_VtColor;
                    VAR backgr : tsp00_VtColor);
 
        PROCEDURE
              i06attrsel (
                    VAR act_attr_name : tsp00_Name;
                    from_sysdba       : boolean;
                    VAR ok            : boolean );
 
        PROCEDURE
              i06attrdefault (
                    VAR act_attr_name : tsp00_Name);
 
        PROCEDURE
              i06setattr;
 
        PROCEDURE
              i06insattr (
                    VAR ok          : boolean );
 
        FUNCTION
              i06attrindex (
                    VAR attr_name : tsp00_Name ) : integer;
 
        PROCEDURE
              i06newattr (
                    VAR attr_name : tsp00_Name;
                    VAR ok        : boolean );
 
        FUNCTION
              i06prtindex (
                    VAR prt_name : tsp00_Name ) : integer;
 
        PROCEDURE
              i06psetsel (
                    VAR act_print_name : tsp00_Name;
                    from_sysdba        : boolean;
                    VAR ok             : boolean );
 
        PROCEDURE
              i06psetdefault;
 
        PROCEDURE
              i06newprint (
                    VAR print_name : tsp00_Name;
                    VAR ok         : boolean );
 
        PROCEDURE
              i06psetins (
                    VAR ok          : boolean );
 
        PROCEDURE
              i06presentation (
                    component        : tsp00_C8;
                    release_id       : tsp00_C8;
                    VAR presentation : tin_attrset_type;
                    VAR attr_change  : boolean;
                    VAR exit         : boolean );
 
        PROCEDURE
              i06printerset (
                    component         : tsp00_C8;
                    release_id        : tsp00_C8;
                    VAR printformat   : tin_pset_type;
                    VAR printerchange : boolean;
                    VAR exit          : boolean );
 
        FUNCTION
              in0630 : tsp00_Int4;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              global_variable : VIN01;
 
        VAR
              i01g : tin_global_in_vars;
 
      ------------------------------ 
 
        FROM
              general-setprocedures : VIN09;
 
        PROCEDURE
              i09putonoff (
                    i01g         : tin_global_in_vars;
                    on_off       : boolean;
                    VAR s40      : tsp00_C40 );
 
        PROCEDURE
              i09onoff (
                    i01g         : tin_global_in_vars;
                    VAR input    : tin_ls_input_field;
                    VAR on_off   : boolean;
                    VAR csr_pos  : tin_ls_position;
                    VAR msg_no   : integer);
 
        PROCEDURE
              i09getmsg (
                    i01g      : tin_global_in_vars;
                    msg_no    : integer;
                    VAR msg   : tin_screenline);
 
        FUNCTION
              i09minmaxverified (
                    VAR input    : tin_ls_input_field;
                    minval       : integer;
                    maxval       : integer;
                    original     : integer;
                    VAR csr_pos  : tin_ls_position;
                    VAR msg_no   : integer) : tsp00_Int2;
 
        PROCEDURE
              i09itoc40 (
                    val     : tsp00_Int4;
                    VAR s40 : tsp00_C40);
 
        PROCEDURE
              i09ifromc40 (
                    VAR s40    : tsp00_C40;
                    VAR val    : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              standard_editor_functions: VIN14;
 
        PROCEDURE
              i14cleareform (
                    VAR evars     : tin_eform_vars);
 
        PROCEDURE
              i14puteline (
                    VAR eform     : tin_pickobject;
                    VAR evars     : tin_eform_vars;
                    VAR line      : tin_eline;
                    line_nr       : tin_natural;
                    length        : tin_natural;
                    VAR error     : boolean);
 
      ------------------------------ 
 
        FROM
              pop_up_menu: VIN17;
 
        PROCEDURE
              i17popup (
                    length            : tin_natural;
                    width             : tin_natural;
                    top_pos           : integer;
                    left_pos          : integer;
                    center            : boolean;
                    header            : tsp00_C20;
                    VAR eform         : tin_pickobject;
                    VAR evars         : tin_eform_vars;
                    VAR popup_record  : tin_popup_record;
                    VAR change        : boolean );
 
        PROCEDURE
              i17putinputfield (
                    screen_pos  : tin_ls_position;
                    selected    : boolean );
 
      ------------------------------ 
 
        FROM
              SQLDB-command-interface : VIN21;
 
        PROCEDURE
              i21findpart (
                    g_area    : tin_global_in_vars;
                    part_kind : tsp1_part_kind);
 
        PROCEDURE
              i21chngcostwarn (
                    g_area    : tin_global_in_vars;
                    costwarn  : boolean);
 
        PROCEDURE
              i21chnginfo (
                    g_area    : tin_global_in_vars;
                    with_info : boolean);
 
        FUNCTION
              i21dbok (
                    g_area : tin_global_in_vars ) : boolean;
 
        PROCEDURE
              i21finish_part (
                    g_area   : tin_global_in_vars);
 
        PROCEDURE
              i21gparaminfo (
                    g_area    : tin_global_in_vars;
                    info_no   : tin_natural;
                    VAR pi    : tsp1_param_info;
                    VAR found : boolean);
 
        PROCEDURE
              i21gvalcount (
                    g_area    : tin_global_in_vars;
                    VAR count : integer);
 
        PROCEDURE
              i21gval (
                    g_area      : tin_global_in_vars;
                    l_val       : tin_natural;
                    VAR pos     : tsp00_Int4;
                    VAR val     : tsp00_KnlIdentifier;
                    VAR is_null : boolean);
 
        PROCEDURE
              i21g1val (
                    g_area      : tin_global_in_vars;
                    l_val       : tin_natural;
                    VAR pos     : tsp00_Int4;
                    VAR val     : tsp00_C40;
                    VAR is_null : boolean);
 
        PROCEDURE
              i21g2val (
                    g_area      : tin_global_in_vars;
                    l_val       : tin_natural;
                    VAR pos     : tsp00_Int4;
                    VAR val     : tsp00_C64;
                    VAR is_null : boolean);
 
        PROCEDURE
              i21mfetch (
                    g_area       : tin_global_in_vars;
                    in_unicode   : boolean;
                    m_type       : tsp1_cmd_mess_type;
                    count        : tsp00_Int4;
                    dir          : tin_fetch_dir;
                    VAR res_name : tsp00_KnlIdentifier);
 
        PROCEDURE
              i21p2cmnd (
                    g_area : tin_global_in_vars;
                    VAR s  : tsp00_C40;
                    l_s    : tin_natural);
 
        PROCEDURE
              i21pcname (
                    g_area  : tin_global_in_vars;
                    VAR nam : tsp00_KnlIdentifier);
 
        PROCEDURE
              i21pstring (
                    g_area : tin_global_in_vars;
                    VAR s  : tsp00_C40;
                    l_s    : tin_natural);
 
        PROCEDURE
              i21p1string (
                    g_area : tin_global_in_vars;
                    VAR s  : tsp00_PrtName;
                    l_s    : tin_natural);
 
        PROCEDURE
              i21rebuild_session (
                    g_area     : tin_global_in_vars;
                    VAR status : tin_connect_status);
 
        PROCEDURE
              i21repcmnd (
                    g_area : tin_global_in_vars;
                    c      : char);
 
        PROCEDURE
              i21request (
                    g_area        : tin_global_in_vars;
                    VAR rq_status : tin_connect_status);
 
        PROCEDURE
              i21receive (
                    g_area         : tin_global_in_vars;
                    VAR rc_status  : tin_connect_status;
                    VAR sqlstate   : tsp00_SqlState;
                    VAR returncode : tsp00_Int2;
                    VAR errorpos   : tsp00_Int4);
 
        PROCEDURE
              i21reset (
                    g_area : tin_global_in_vars;
                    m_type : tsp1_cmd_mess_type);
 
      ------------------------------ 
 
        FROM
              logical_screen : VIN50;
 
        PROCEDURE
              i50clear (
                    part : tin_ls_part);
 
        PROCEDURE
              i50put2field (
                    VAR field  : tin_screenline;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put3field (
                    VAR field  : tsp00_PrtName;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put4field (
                    VAR field  : tsp00_C40;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50getfield (
                    VAR vt_input    : tin_ls_input_field;
                    VAR field_found : boolean);
 
      ------------------------------ 
 
        FROM
              logical_screen_layout : VIN51;
 
        PROCEDURE
              i51layout (
                    functionmenu_length : tin_natural;
                    inputarea_length    : tin_natural;
                    msglines            : tin_natural);
 
      ------------------------------ 
 
        FROM
              logical_screen_modules : VIN56;
 
        PROCEDURE
              i56title (
                    blinking_modefield : boolean;
                    screen_nr          : integer;
                    VAR title          : tsp00_OnlineHeader);
 
        PROCEDURE
              i56putframe (
                    with_name   :  boolean;
                    with_parms  :  boolean );
 
        PROCEDURE
              i56putlabels (
                    fct_cursorpos      : tin_ls_releasemode;
                    functionline_label : boolean);
&       ifdef WINDOWS
 
        PROCEDURE
              i56vrange (
                    screen_nr  : tsp00_Int2;
                    VAR lbl    : tsp00_C8;
                    VAR vrange : tin_display_range );
&       endif
 
      ------------------------------ 
 
        FROM
              logical_screen_IO : VIN57 ;
 
        PROCEDURE
              i57ioscreen (
                    VAR csr_pos        : tin_ls_position;
                    VAR rf             : tin_ls_releasemode;
                    VAR screen_changed : boolean);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill: VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-70: VSP70;
 
        PROCEDURE
              s70attrtoint1 (
                    attr : tsp00_VtAttrib; VAR integ : tsp00_Uint1 );
 
        PROCEDURE
              s70colorint1 (
                    attr : tsp00_VtColor; VAR integ : tsp00_Uint1 );
 
        PROCEDURE
              s70int1toattr (
                    VAR attr : tsp00_VtAttrib; integ : tsp00_Uint1 );
 
        PROCEDURE
              s70int1color (
                    VAR attr : tsp00_VtColor; integ : tsp00_Uint1 );
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqlttable (
                    i          : tsp00_Int2;
                    att        : tsp00_VtAttrib;
                    foreground : tsp00_VtColor;
                    background : tsp00_VtColor);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              i14puteline;
 
              tin_eform_buffer tin_pickobject
 
        PROCEDURE
              i17popup;
 
              tin_eform_buffer tin_pickobject
 
        PROCEDURE
              i21gval;
 
              tsp00_Buf tsp00_KnlIdentifier
 
        PROCEDURE
              i21g1val;
 
              tsp00_Buf tsp00_C40
 
        PROCEDURE
              i21g2val;
 
              tsp00_Buf tsp00_C64
 
        PROCEDURE
              i21pstring;
 
              tsp00_Buf tsp00_C40
 
        PROCEDURE
              i21p1string;
 
              tsp00_Buf tsp00_PrtName
 
        PROCEDURE
              i50put2field;
 
              tsp00_MoveObj tin_screenline
 
        PROCEDURE
              i50put3field;
 
              tsp00_MoveObj tsp00_PrtName
 
        PROCEDURE
              i50put4field;
 
              tsp00_MoveObj tsp00_C40
 
        PROCEDURE
              sqlttable;
 
              tsp00_Int2     tsp00_Int2
              tsp00_VtAttrib tsp00_VtAttrib
              tsp00_VtColor  tsp00_VtColor
              tsp00_VtColor  tsp00_VtColor
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : HolgerB
.sp
.cp 3
Created : 1992-06-23
.sp
.cp 3
.sp
.cp 3
Release :      Date : 1998-06-19
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
.sp 2
 
.sp 3;H.B. Rel 3.0.01 27 Jan 1992
.CM *-END-* description ---------------------------------
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      (* Konstanten fuer die Printer Parameter *)
      pset_result_table =
            'I06PRINTR                                                       ';
      pset_read_table   = 'SYSDBA.PRINT_R                          ';
      pset_write_table  = 'SYSDBA.PRINT_W                          ';
      cin06_pset_header       = 17350;
      cin06_pset_printer      = 17353;
      cin06_pset_pagewidth    = 17354;
      cin06_pset_pagelength   = 17355;
      cin06_pset_topmargin    = 17356;
      cin06_pset_bottommargin = 17357;
      cin06_pset_leftmargin   = 17358;
      cin06_pset_rightmargin  = 17359;
      cin06_pset_newpage      = 17360;
      cin06_yes               = 'YES                                     ';
      cin06_no                = 'NO                                      ';
      cin06_m_duplicate       = 17805;
      cin06_m_maxreached      = 17806;
      cin06_m_del_last        = 17807;
      cin06_m_more            = 17809;
      cin06_m_new_pset        = 17810;
      (* Konstanten fuer die Attribute *)
      attr_result_table    =
            'I06PRES_R                                                       ';
      attr_read_table      = 'SYSDBA.PRESENT_R                        ';
      attr_write_table     = 'SYSDBA.PRESENT_W                        ';
      cin06_attrib_offset  = 17930;
      cin06_color_offset   = 17949;
      cin06_m_popup_header = 17960;
      cin06_attrname_base  = 17500;
      cin06_m_new_attr     = 17811;
      cin06_m_mark         = 17221;
      cin06_m_wrong_char   = 17222;
      cin06_default        = 'DEFAULT           ';
      firstcol             = 1;
      secondcol            = 34;
      thirdcol             = 45;
 
TYPE
 
      tin06_check_record = RECORD
            checked  : ARRAY [1..16] OF boolean;
            max_attr : integer;
      END;
 
 
 
(*------------------------------*) 
 
FUNCTION
      in0630 : tsp00_Int4;
 
BEGIN
(* linkcheck function *)
in0630 := 219020723;
END; (* in0630 *)
 
(*------------------------------*) 
 
PROCEDURE
      i06attrsel (
            VAR act_attr_name : tsp00_Name;
            from_sysdba       : boolean;
            VAR ok            : boolean );
 
VAR
      i       : integer;
      found   : boolean;
 
BEGIN
WITH i01g^.set_parms DO
    BEGIN
    in06_selall_attr (presentation, from_sysdba, ok);
    IF  ok
    THEN
        BEGIN
        found := false;
        WITH presentation DO
            FOR i := 1 TO count DO
                IF  attrset [i].attr_name = act_attr_name
                THEN
                    BEGIN
                    act_attr := i;
                    found := true;
                    END;
                (*ENDIF*) 
            (*ENDFOR*) 
        (*ENDWITH*) 
        IF  NOT found
        THEN
            i06attrdefault (act_attr_name);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* i06attrsel *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_selall_attr (
            VAR presentation   : tin_attrset_type;
            sysdba             : boolean;
            VAR ok             : boolean );
 
VAR
      timeout  : boolean;
      r_code   : tsp00_Int2;
      s40      : tsp00_C40;
      res_name : tsp00_KnlIdentifier;
 
BEGIN
REPEAT
    i21reset (i01g, sp1m_dbs);
    i21chnginfo (i01g, true);
    i21chngcostwarn (i01g, false);
    s40  := 'SELECT                                  ';
    i21p2cmnd (i01g, s40, 8);
    res_name := attr_result_table;
    i21pcname (i01g, res_name);
    s40  := ' (*) FROM                               ';
    i21p2cmnd (i01g, s40, 11);
    s40 := attr_read_table;
    i21p2cmnd (i01g, s40, 40);
    IF  sysdba
    THEN
        s40  := ' WHERE USERNAME = SYSDBA                '
    ELSE
        s40  := ' WHERE USERNAME = USERGROUP             ';
    (*ENDIF*) 
    i21p2cmnd (i01g, s40, 29);
    s40  := ' WITH LOCK ISOLATION LEVEL 0            ';
    i21p2cmnd (i01g, s40, 30);
    i21finish_part (i01g);
    in06_sendsql (timeout, r_code);
UNTIL
    NOT timeout;
(*ENDREPEAT*) 
ok := (r_code = 0);
IF  r_code = 0
THEN
    in06_readall_attr (presentation);
(*ENDIF*) 
END; (* in06_selall_attr *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_readall_attr (
            VAR presentation  : tin_attrset_type );
 
VAR
      timeout    : boolean;
      is_null    : boolean;
      error      : boolean;
      found      : boolean;
      i, j       : integer;
      user_len   : integer;
      r_code     : tsp00_Int2;
      dcount     : tsp00_Int4;
      pos_offset : tsp00_Int4;
      res_name   : tsp00_KnlIdentifier;
      user       : tsp00_KnlIdentifier;
      help       : tsp00_C40;
      pi         : tsp1_param_info;
 
BEGIN
WITH presentation DO
    BEGIN
    i21findpart (i01g, sp1pk_shortinfo);
    i21gparaminfo (i01g, 1, pi, found);
    IF  found
    THEN
        user_len := pi.sp1i_in_out_len - 1
    ELSE
        user_len := 0;
    (*ENDIF*) 
    res_name := attr_result_table;
    dcount := cin_max_ap;
    error := false;
    REPEAT
        i21mfetch (i01g, false, sp1m_dbs, dcount, mf_next, res_name);
        in06_sendsql (timeout, r_code);
    UNTIL
        NOT timeout;
    (*ENDREPEAT*) 
    IF  r_code = 0
    THEN
        BEGIN
        i21findpart (i01g, sp1pk_data);
        i21gvalcount (i01g, count);
        i := 1;
        pos_offset := 1;
        WHILE (i <= count) AND (i <= cin_max_ap) DO
            BEGIN
            WITH attrset [i] DO
                BEGIN
                user := bsp_knl_identifier;
                i21gval (i01g, user_len, pos_offset, user, is_null);
                (* attr_name should be tsp00_C18, not tsp00_Name *)
                i21g1val (i01g, mxsp_c18, pos_offset, help, is_null);
                FOR j := 1 TO mxsp_c18 DO
                    attr_name [j] := help [j] ;
                (*ENDFOR*) 
                in06_get_attr_color (pos_offset, attr_array);
                END;
            (*ENDWITH*) 
            i := i + 1;
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in06_readall_attr *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_get_attr_color (
            VAR pos_offset   : tsp00_Int4;
            VAR attr_array   : tin_attr_array );
 
VAR
      i          : integer;
      help       : tsp00_C40;
      helpint    : tsp00_Int4;
      is_null    : boolean;
 
BEGIN
FOR i := 1 TO 16 DO
    BEGIN
    (************)
    (* Attribut *)
    (************)
    help := bsp_c40;
    i21g1val (i01g, 5, pos_offset, help, is_null);
    i09ifromc40 (help, helpint);
    s70int1toattr (attr_array [i].attribut, helpint);
    (***************)
    (* Vordergrund *)
    (***************)
    help := bsp_c40;
    i21g1val (i01g, 5, pos_offset, help, is_null);
    i09ifromc40 (help, helpint);
    s70int1color (attr_array [i].foreground, helpint);
    (***************)
    (* Hintergrund *)
    (***************)
    help := bsp_c40;
    i21g1val (i01g, 5, pos_offset, help, is_null);
    i09ifromc40 (help, helpint);
    s70int1color (attr_array [i].background, helpint);
    END;
(*ENDFOR*) 
END; (* in06_get_attr_color *)
 
(*------------------------------*) 
 
PROCEDURE
      i06attrdefault (
            VAR act_attr_name : tsp00_Name);
 
BEGIN
act_attr_name := cin06_default;
WITH i01g^.set_parms.presentation DO
    BEGIN
    IF  count < cin_max_ap
    THEN
        count := count + 1
    ELSE
        count := cin_max_ap;
    (*ENDIF*) 
    act_attr := count;
    WITH attrset [act_attr] DO
        BEGIN
        attr_name := cin06_default;
        in06_init_attr_array (attr_array);
        END;
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END; (* i06attrdefault *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_init_attr_array (
            VAR attr_array : tin_attr_array);
 
VAR
      i : integer;
 
BEGIN
FOR i := 1 TO 16 DO
    WITH attr_array [i] DO
        BEGIN
        attribut := [ ];
        foreground := vt_white;
        background := vt_blue;
        END;
    (*ENDWITH*) 
(*ENDFOR*) 
(* text enhanced *)
attr_array [2].attribut  := [vt_bright];
(* title *)
attr_array [3].attribut  := [vt_inverse];
(* status *)
attr_array [4].attribut  := [vt_inverse, vt_blink];
(* info *)
attr_array [5].foreground := vt_yellow;
attr_array [5].attribut  := [vt_bright];
(* error *)
attr_array [6].background := vt_red;
attr_array [6].attribut  := [vt_bright];
(* graphic *)
attr_array [7].foreground := vt_light_blue;
&if $MACH in [ HP9, SUN, T31 ] || $OSSPEC == SOLARIS
(* select char normal*)
attr_array [8].attribut := [vt_bright, vt_underline];
(* select char enhanced *)
attr_array [9].attribut := [vt_bright, vt_inverse, vt_underline];
&else
&if $MACH in [ _IBMR2 ]
(* Hier gibts kein HIGH und kein UNDERLINE und die Farben sind *)
(* beim Auswahlbuchstaben nicht gut zu unterscheiden. *)
attr_array [8].attribut := [vt_inverse];
(* select char enhanced *)
attr_array [9].attribut := [ ];
(* item passive *)
attr_array [12].foreground := vt_black;
&else
(* select char normal*)
attr_array [8].attribut := [vt_bright];
(* select char enhanced *)
attr_array [9].attribut := [vt_bright, vt_inverse];
&endif
&endif
(* function key enhanced *)
attr_array [11].attribut := [vt_inverse];
(* item passive *)
attr_array [12].attribut := [ ];
(* pl inverse *)
attr_array [13].attribut := [vt_inverse];
(* pl underline *)
attr_array [14].attribut := [vt_underline];
(* pl dark *)
attr_array [15].attribut := [vt_invisible];
END; (* in06_init_attr_array *)
 
(*------------------------------*) 
 
FUNCTION
      i06prtindex (
            VAR prt_name : tsp00_Name ) : integer;
 
VAR
      i      : integer;
      result : integer;
 
BEGIN
result := 0;
WITH i01g^.set_parms.printformat DO
    BEGIN
    FOR i := 1 TO count DO
        IF  printerset [i].formatname = prt_name
        THEN
            result := i;
        (*ENDIF*) 
    (*ENDFOR*) 
    IF  (result = 0) AND (count < cin_max_ap)
    THEN
        BEGIN
        count := count + 1;
        result := count;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
i06prtindex := result;
END; (* i06prtindex *)
 
(*------------------------------*) 
 
PROCEDURE
      i06psetsel (
            VAR act_print_name : tsp00_Name;
            from_sysdba        : boolean;
            VAR ok             : boolean );
 
VAR
      i       : integer;
      found   : boolean;
 
BEGIN
WITH i01g^.set_parms DO
    BEGIN
    in06_selall_format (printformat, from_sysdba,  ok);
    IF  ok
    THEN
        BEGIN
        found := false;
        WITH printformat DO
            FOR i := 1 TO count DO
                IF  printerset [i]. formatname = act_print_name
                THEN
                    BEGIN
                    act_print := i;
                    found := true;
                    END;
                (*ENDIF*) 
            (*ENDFOR*) 
        (*ENDWITH*) 
        IF  NOT found
        THEN
            i06psetdefault;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* i06psetsel *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_selall_format (
            VAR printformat : tin_pset_type;
            sysdba          : boolean;
            VAR ok          : boolean );
 
VAR
      timeout  : boolean;
      r_code   : tsp00_Int2;
      s40      : tsp00_C40;
      res_name : tsp00_KnlIdentifier;
 
BEGIN
REPEAT
    i21reset (i01g, sp1m_dbs);
    i21chnginfo (i01g, true);
    i21chngcostwarn (i01g, false);
    s40  := 'SELECT "                                ';
    i21p2cmnd (i01g, s40, 8);
    res_name := pset_result_table;
    i21pcname (i01g, res_name);
    s40  := '" (*) FROM                              ';
    i21p2cmnd (i01g, s40, 11);
    s40 := pset_read_table;
    i21p2cmnd (i01g, s40, 40);
    IF  sysdba
    THEN
        s40  := ' WHERE USERNAME = SYSDBA                '
    ELSE
        s40  := ' WHERE USERNAME = USERGROUP             ';
    (*ENDIF*) 
    i21p2cmnd (i01g, s40, 29);
    s40  := ' WITH LOCK ISOLATION LEVEL 0            ';
    i21p2cmnd (i01g, s40, 40);
    i21finish_part (i01g);
    in06_sendsql (timeout, r_code);
UNTIL
    NOT timeout;
(*ENDREPEAT*) 
ok := (r_code = 0);
IF  r_code = 0
THEN
    in06_readall_format (printformat);
(*ENDIF*) 
END; (* in06_selall_format *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_readall_format (
            VAR printformat : tin_pset_type );
 
VAR
      timeout    : boolean;
      is_null    : boolean;
      error      : boolean;
      found      : boolean;
      i, j       : integer;
      user_len   : integer;
      r_code     : tsp00_Int2;
      pos_offset : tsp00_Int4;
      dcount     : tsp00_Int4;
      helpint    : tsp00_Int4;
      res_name   : tsp00_KnlIdentifier;
      user       : tsp00_KnlIdentifier;
      help       : tsp00_C40;
      pi         : tsp1_param_info;
 
BEGIN
WITH printformat DO
    BEGIN
    i21findpart (i01g, sp1pk_shortinfo);
    i21gparaminfo (i01g, 1, pi, found);
    IF  found
    THEN
        user_len := pi.sp1i_in_out_len - 1
    ELSE
        user_len := 0;
    (*ENDIF*) 
    res_name := pset_result_table;
    dcount := cin_max_ap;
    error := false;
    REPEAT
        i21mfetch (i01g, false, sp1m_dbs, dcount, mf_next, res_name);
        in06_sendsql (timeout, r_code);
    UNTIL
        NOT timeout;
    (*ENDREPEAT*) 
    IF  r_code = 0
    THEN
        BEGIN
        i21findpart (i01g, sp1pk_data);
        i21gvalcount (i01g, count);
        i := 1;
        pos_offset := 1;
        WHILE (i <= count) AND (i <= cin_max_ap) DO
            BEGIN
            WITH printerset [i]  DO
                BEGIN
                user := bsp_knl_identifier;
                i21gval (i01g, user_len, pos_offset, user, is_null);
                i21g1val (i01g, mxsp_c40, pos_offset, help, is_null);
                FOR j := 1 TO mxsp_name DO
                    formatname [j] := help [j];
                (*ENDFOR*) 
                i21g2val (i01g, mxsp_c64, pos_offset, printer, is_null);
                i21g1val (i01g, mxsp_c40, pos_offset, help, is_null);
                i09ifromc40 (help, helpint);
                pagelength := helpint;
                i21g1val (i01g, mxsp_c40, pos_offset, help, is_null);
                i09ifromc40 (help, helpint);
                pagewidth := helpint;
                i21g1val (i01g, mxsp_c40, pos_offset, help, is_null);
                i09ifromc40 (help, helpint);
                tmargin := helpint;
                i21g1val (i01g, mxsp_c40, pos_offset, help, is_null);
                i09ifromc40 (help, helpint);
                bmargin := helpint;
                i21g1val (i01g, mxsp_c40, pos_offset, help, is_null);
                i09ifromc40 (help, helpint);
                lmargin := helpint;
                i21g1val (i01g, mxsp_c40, pos_offset, help, is_null);
                i09ifromc40 (help, helpint);
                rmargin := helpint;
                i21g1val (i01g, mxsp_c40, pos_offset, help, is_null);
                IF  help = cin06_yes
                THEN
                    newpage := true
                ELSE
                    newpage := false;
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
            i := i + 1;
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in06_readall_format *)
 
(*------------------------------*) 
 
PROCEDURE
      i06psetdefault;
 
BEGIN
WITH  i01g^.set_parms.printformat DO
    BEGIN
    IF  count < cin_max_ap
    THEN
        count := count + 1
    ELSE
        count := cin_max_ap;
    (*ENDIF*) 
    act_print := count;
    WITH printerset [act_print] DO
        BEGIN
        formatname    := cin06_default;
        in06_init_printerparms (printerset [act_print]);
        END;
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END; (* i06psetdefault *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_init_printerparms (
            VAR printerparms : tin_printerparms);
 
BEGIN
WITH printerparms DO
    BEGIN
    printer       := bsp_c64;
&   if $OS in [ DOS, OS2, WIN32 ]
    printer  [1]  := 'p';
    printer  [2]  := 'r';
    printer  [3]  := 'n';
&   else
    printer  [1]  := ' ';
    printer  [2]  := ' ';
&   endif
    pagelength    := 65;
    pagewidth     := 75;
    tmargin       := 0;
    bmargin       := 0;
    lmargin       := 0;
    rmargin       := 0;
    newpage       := false;
    END;
(*ENDWITH*) 
END; (* in06_init_printerparms *)
 
(*------------------------------*) 
 
FUNCTION
      i06attrindex (
            VAR attr_name : tsp00_Name ) : integer;
 
VAR
      i      : integer;
      result : integer;
 
BEGIN
result := 0;
WITH i01g^.set_parms.presentation DO
    BEGIN
    FOR i := 1 TO count DO
        IF  attrset [i].attr_name = attr_name
        THEN
            result := i;
        (*ENDIF*) 
    (*ENDFOR*) 
    IF  (result = 0) AND (count < cin_max_ap)
    THEN
        BEGIN
        count := count + 1;
        result := count;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
i06attrindex := result;
END; (* i06attrindex *)
 
(*------------------------------*) 
 
PROCEDURE
      i06newattr (
            VAR attr_name : tsp00_Name;
            VAR ok        : boolean );
 
VAR
      i       : integer;
 
BEGIN
WITH i01g^.set_parms DO
    BEGIN
    ok := false;
    WITH presentation DO
        FOR i := 1 TO count DO
            IF  attrset [i].attr_name = attr_name
            THEN
                BEGIN
                act_attr := i;
                ok := true;
                END;
            (*ENDIF*) 
        (*ENDFOR*) 
    (*ENDWITH*) 
    IF  NOT ok
    THEN
        IF  (attr_name = bsp_c18) OR (attr_name = cin06_default)
        THEN
            BEGIN
            i06attrdefault (attr_name);
            ok := true;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
i06setattr;
END; (* i06newattr *)
 
(*------------------------------*) 
 
PROCEDURE
      i06setattr;
 
BEGIN
WITH i01g^.set_parms.presentation DO
    in06_set_new_attr (attrset [act_attr].attr_array)
(*ENDWITH*) 
END; (* i06setattr *)
 
(*------------------------------*) 
 
PROCEDURE
      i06newprint (
            VAR print_name : tsp00_Name;
            VAR ok         : boolean );
 
VAR
      i       : integer;
 
BEGIN
WITH i01g^.set_parms DO
    BEGIN
    ok := false;
    WITH printformat DO
        FOR i := 1 TO count DO
            IF  printerset [i]. formatname = print_name
            THEN
                BEGIN
                act_print := i;
                ok := true;
                END;
            (*ENDIF*) 
        (*ENDFOR*) 
    (*ENDWITH*) 
    IF  NOT ok
    THEN
        IF  (print_name = bsp_c18) OR (print_name = cin06_default)
        THEN
            BEGIN
            i06psetdefault;
            print_name := cin06_default;
            ok := true;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* i06newprint *)
 
(*------------------------------*) 
 
PROCEDURE
      i06insattr (
            VAR ok      : boolean);
 
VAR
      i   : integer;
 
BEGIN
in06_delete_all_attr (ok);
WITH i01g^.set_parms.presentation DO
    FOR i := 1 TO count DO
        in06_insert_attr (attrset [i] , ok);
    (*ENDFOR*) 
(*ENDWITH*) 
END; (* i06insattr *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_delete_all_attr (
            VAR ok          : boolean );
 
VAR
      timeout  : boolean;
      r_code   : tsp00_Int2;
      s40      : tsp00_C40;
 
BEGIN
REPEAT
    i21reset (i01g, sp1m_dbs);
    s40  := 'DELETE FROM                             ';
    i21p2cmnd (i01g, s40, 12);
    s40 := attr_write_table;
    i21p2cmnd (i01g, s40, 40);
    s40  := ' WHERE USERNAME = USERGROUP             ';
    i21p2cmnd (i01g, s40, 29);
    i21finish_part (i01g);
    in06_sendsql (timeout, r_code);
UNTIL
    NOT timeout;
(*ENDREPEAT*) 
ok := (r_code = 0);
END; (* in06_delete_all_attr *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_insert_attr (
            VAR attrparm    : tin_attrparm;
            VAR ok          : boolean );
 
VAR
      timeout  : boolean;
      i        : integer;
      r_code   : tsp00_Int2;
      s40      : tsp00_C40;
 
BEGIN
WITH attrparm DO
    BEGIN
    REPEAT
        i21reset (i01g, sp1m_dbs);
        s40  := 'INSERT INTO                             ';
        i21p2cmnd (i01g, s40, 13);
        s40 := attr_write_table;
        i21p2cmnd (i01g, s40, 40);
        s40  := ' VALUES ( USERGROUP,                    ';
        i21p2cmnd (i01g, s40, 21);
        (********************)
        (* attr_name        *)
        (********************)
        FOR i := 1 TO mxsp_c18 DO
            s40 [i] := attr_name [i] ;
        (*ENDFOR*) 
        i21pstring (i01g, s40, mxsp_c18);
        (********************)
        (* Attr. und Farben *)
        (********************)
        in06_put_attr_color ( attr_array );
        i21repcmnd (i01g, ')');
        i21finish_part (i01g);
        in06_sendsql (timeout, r_code);
    UNTIL
        NOT timeout;
    (*ENDREPEAT*) 
    ok := (r_code = 0);
    END;
(*ENDWITH*) 
END; (* in06_insert_attr *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_put_attr_color (
            VAR attr_array : tin_attr_array );
 
VAR
      i        : integer;
      val      : tsp00_Uint1;
      s40      : tsp00_C40;
 
BEGIN
FOR i := 1 TO 16 DO
    BEGIN
    (************)
    (* Attribut *)
    (************)
    s70attrtoint1 (attr_array [i].attribut, val);
    s40 := bsp_c40;
    i09itoc40 (val, s40);
    i21pstring (i01g, s40, 5);
    (***************)
    (* Vordergrund *)
    (***************)
    s70colorint1 (attr_array [i].foreground, val);
    s40 := bsp_c40;
    i09itoc40 (val, s40);
    i21pstring (i01g, s40, 5);
    (***************)
    (* Hintergrund *)
    (***************)
    s70colorint1 (attr_array [i].background, val);
    s40 := bsp_c40;
    i09itoc40 (val, s40);
    i21pstring (i01g, s40, 5);
    END;
(*ENDFOR*) 
END; (* in06_put_attr_color *)
 
(*------------------------------*) 
 
PROCEDURE
      i06psetins (
            VAR ok      : boolean);
 
VAR
      i   : integer;
 
BEGIN
in06_fdelete_all_format (ok);
WITH i01g^.set_parms.printformat DO
    FOR i := 1 TO count DO
        in06_insert_pset (printerset  [i] , ok);
    (*ENDFOR*) 
(*ENDWITH*) 
END; (* i06psetins *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_fdelete_all_format (
            VAR ok          : boolean );
 
VAR
      timeout  : boolean;
      r_code   : tsp00_Int2;
      s40      : tsp00_C40;
 
BEGIN
REPEAT
    i21reset (i01g, sp1m_dbs);
    s40  := 'DELETE FROM                             ';
    i21p2cmnd (i01g, s40, 12);
    s40 := pset_write_table;
    i21p2cmnd (i01g, s40, 40);
    s40  := ' WHERE USERNAME = USERGROUP             ';
    i21p2cmnd (i01g, s40, 29);
    i21finish_part (i01g);
    in06_sendsql (timeout, r_code);
UNTIL
    NOT timeout;
(*ENDREPEAT*) 
ok := (r_code = 0);
END; (* in06_fdelete_all_format *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_insert_pset (
            VAR printerparm : tin_printerparms;
            VAR ok          : boolean );
 
VAR
      timeout  : boolean;
      i        : integer;
      val      : integer;
      r_code   : tsp00_Int2;
      s40      : tsp00_C40;
 
BEGIN
WITH printerparm DO
    BEGIN
    REPEAT
        i21reset (i01g, sp1m_dbs);
        s40  := 'INSERT INTO                             ';
        i21p2cmnd (i01g, s40, 13);
        s40 := pset_write_table;
        i21p2cmnd (i01g, s40, 40);
        s40  := ' VALUES ( USERGROUP,                    ';
        i21p2cmnd (i01g, s40, 22);
        (*********************)
        (* formatname        *)
        (*********************)
        FOR i := 1 TO mxsp_c18 DO
            s40 [i] := formatname [i] ;
        (*ENDFOR*) 
        i21pstring (i01g, s40, mxsp_c18);
        (*********************)
        (* printername       *)
        (*********************)
        i21p1string (i01g, printer, 64);
        (*********************)
        (* pagelength        *)
        (*********************)
        val := pagelength;
        i09itoc40 (val, s40);
        i21pstring (i01g, s40, 40);
        (*********************)
        (* pagewidth         *)
        (*********************)
        val := pagewidth;
        i09itoc40 (val, s40);
        i21pstring (i01g, s40, 40);
        (*********************)
        (* topmargin         *)
        (*********************)
        val := tmargin;
        i09itoc40 (val, s40);
        i21pstring (i01g, s40, 40);
        (*********************)
        (* bottommargin      *)
        (*********************)
        val := bmargin;
        i09itoc40 (val, s40);
        i21pstring (i01g, s40, 40);
        (*********************)
        (* leftmargin        *)
        (*********************)
        val := lmargin;
        i09itoc40 (val, s40);
        i21pstring (i01g, s40, 40);
        (*********************)
        (* rightmargin       *)
        (*********************)
        val := rmargin;
        i09itoc40 (val, s40);
        i21pstring (i01g, s40, 40);
        (*********************)
        (* newpage           *)
        (*********************)
        IF  newpage
        THEN
            s40 := cin06_yes
        ELSE
            s40 := cin06_no;
        (*ENDIF*) 
        i21pstring (i01g, s40, 40);
        i21repcmnd (i01g, ')');
        i21finish_part (i01g);
        in06_sendsql (timeout, r_code);
    UNTIL
        NOT timeout;
    (*ENDREPEAT*) 
    ok := (r_code = 0);
    END;
(*ENDWITH*) 
END; (* in06_insert_pset *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_sendsql (
            VAR timeout : boolean;
            VAR r_code  : tsp00_Int2);
 
VAR
      ret        : tin_connect_status;
      sqlstate   : tsp00_SqlState;
      e_code     : tsp00_Int4;
 
BEGIN
timeout := false;
r_code := - 1;
IF  i21dbok (i01g)
THEN
    BEGIN
    i21request (i01g, ret);
    IF  ret = rc_ok
    THEN
        i21receive (i01g, ret, sqlstate, r_code, e_code);
    (*ENDIF*) 
    IF  ret in [ rc_timeout, rc_logon_required]
    THEN
        BEGIN
        i21rebuild_session (i01g, ret);
        timeout := true;
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* in06_sendsql *)
 
(*------------------------------*) 
 
PROCEDURE
      i06presentation (
            component          : tsp00_C8;
            release_id         : tsp00_C8;
            VAR presentation   : tin_attrset_type;
            VAR attr_change    : boolean;
            VAR exit           : boolean );
 
VAR
      old_ls       : tin_ls_record;
      old_key_type : tin_ls_key_type;
 
BEGIN
WITH i01g^ DO
    BEGIN
    old_ls := ls;
    old_key_type := key_type;
    END;
(*ENDWITH*) 
in06_screenio_attrset (component, release_id, presentation,
      attr_change, exit);
i50clear (cin_ls_workarea);
WITH i01g^ DO
    BEGIN
    ls := old_ls;
    key_type := old_key_type;
    END;
(*ENDWITH*) 
END; (* i06presentation *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_screenio_attrset (
            component         : tsp00_C8;
            release_id        : tsp00_C8;
            VAR presentation  : tin_attrset_type;
            VAR attrib_change : boolean;
            VAR exit          : boolean);
 
CONST
      inputarea_length    = 0;
      functionmenu_length = 1;
      message_lines       = 1;
      max_color           = 8;
 
VAR
      i, j           : integer;
      line_len       : integer;
      msg_no         : integer;
      save_act       : integer;
      screen_changed : boolean;
      again          : boolean;
      ok             : boolean;
      check_rec      : tin06_check_record;
      csr_pos        : tin_ls_position;
      rf             : tin_ls_releasemode;
      help_attrparm  : tin_attrparm;
      color_eform    : tin_pickobject;
      color_evars    : tin_eform_vars;
      attr_eform     : tin_pickobject;
      attr_evars     : tin_eform_vars;
      mode           : tsp00_VtMode;
      popup_header   : ARRAY [1..3] OF tsp00_C20;
      line           : tin_screenline;
 
BEGIN
exit := false;
i09getmsg (i01g, cin06_m_popup_header, line);
j := 1;
FOR i := 1 TO 3 DO
    BEGIN
    s10mv (mxin_screenline,mxsp_c20,
          @line,j,
          @popup_header [i],1,mxsp_c20 );
    j := j + mxsp_c20;
    END;
(*ENDFOR*) 
color_evars.size := mxin_pickobject;
i14cleareform (color_evars);
FOR i := 1 TO max_color DO
    BEGIN
    SAPDB_PascalForcedFill (mxin_screenline, @line, 1, mxin_screenline, bsp_c1);
    i09getmsg (i01g, cin06_color_offset + i, line);
    line_len := 14;
    i14puteline(color_eform, color_evars, line, i, line_len, ok);
    END;
(*ENDFOR*) 
attr_evars.size := mxin_pickobject;
i14cleareform (attr_evars);
i := 1;
FOR mode := vt_bright TO vt_grayed DO
    BEGIN
    IF  (mode in i01g^.vt.desc.attributes) AND
        (mode <> vt_mixed)
    THEN
        BEGIN
        SAPDB_PascalForcedFill (mxin_screenline, @line, 1, mxin_screenline, bsp_c1);
        i09getmsg (i01g, cin06_attrib_offset + ord (mode), line);
        line_len := 14;
        i14puteline  (attr_eform, attr_evars, line, i, line_len, ok);
        i := i + 1;
        END;
    (*ENDIF*) 
    END;
(*ENDFOR*) 
WITH i01g^.vt.opt DO
    BEGIN
    wait_for_input  := true;
    usage_mode      := vt_form;
    return_on_last  := false;
    return_on_first := false;
    returnkeys      :=  [  ] ;
    reject_keys     :=  [  ] ;
    bell := false;
    END;
(*ENDWITH*) 
WITH check_rec DO
    BEGIN
    FOR i := 1 TO 16 DO
        checked [i] := false;
    (*ENDFOR*) 
    IF  i01g^.i20.comp_enum in [sp4co_sql_query, sp4co_sql_load]
    THEN
        max_attr := 7
    ELSE
        max_attr := 16;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
msg_no := 0;
WITH presentation DO
    BEGIN
    attrib_change := false;
    again := true;
    save_act := act_attr;
    help_attrparm := attrset [act_attr];
    WHILE again AND i21dbok (i01g) DO
        BEGIN
        WITH csr_pos DO
            BEGIN
            screen_nr := 1;
            screen_part := cin_ls_workarea;
            sline := 2;
            scol := secondcol;
            END;
        (*ENDWITH*) 
        IF  (count > 1) AND (msg_no = 0)
        THEN
            msg_no := cin06_m_more
        ELSE
            IF  (msg_no = cin06_m_more)
            THEN
                msg_no := 0;
            (*ENDIF*) 
        (*ENDIF*) 
        i51layout  (functionmenu_length, inputarea_length, message_lines);
        i50clear (cin_ls_workarea);
        in06_attr_keys;
        in06_attr_body  (component, release_id, help_attrparm,
              check_rec, msg_no);
        msg_no := 0;
        i56putlabels  (f_clear, false);
        i57ioscreen  (csr_pos, rf, screen_changed);
        IF  screen_changed
        THEN
            in06_inscreen_attrparms (help_attrparm, check_rec, msg_no);
        (*ENDIF*) 
        CASE rf OF
            f_enter : (* read new name after COPY *)
                BEGIN
                IF  msg_no = 0
                THEN
                    BEGIN
                    attrset [act_attr] := help_attrparm;
                    in06_chk_attr_names (msg_no);
                    END;
                (*ENDIF*) 
                END;
            f1 : (* SAVE *)
                BEGIN
                IF  msg_no = 0
                THEN
                    BEGIN
                    attrset [act_attr] := help_attrparm;
                    in06_chk_attr_names (msg_no);
                    END;
                (*ENDIF*) 
                IF  msg_no = 0
                THEN
                    BEGIN
                    attrib_change := true;
                    again := false;
                    END;
                (*ENDIF*) 
                END;
            f2 : (* COPY *)
                BEGIN
                IF  msg_no = 0
                THEN
                    IF  count < cin_max_ap
                    THEN
                        BEGIN
                        help_attrparm.attr_name := bsp_c18;
                        count := count + 1;
                        act_attr := count;
                        attrset [act_attr] := help_attrparm;
                        msg_no := cin06_m_new_attr;
                        END
                    ELSE
                        msg_no := cin06_m_maxreached;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            f3 : (* ATTRIBUTES *)
                BEGIN
                IF  msg_no = 0
                THEN
                    in06_attr_popup (help_attrparm.attr_array, check_rec,
                          popup_header [1], attr_eform, attr_evars, msg_no);
                (*ENDIF*) 
                END;
            f4 : (* BACKGROUND *)
                BEGIN
                IF  msg_no = 0
                THEN
                    in06_backgrd_popup (help_attrparm.attr_array, check_rec,
                          popup_header [3], color_eform, color_evars, msg_no);
                (*ENDIF*) 
                END;
            f5 : (* FOREGROUND *)
                BEGIN
                IF  msg_no = 0
                THEN
                    in06_foregrd_popup (help_attrparm.attr_array, check_rec,
                          popup_header [2], color_eform, color_evars, msg_no);
                (*ENDIF*) 
                END;
            f6: (* DELETE *)
                BEGIN
                msg_no := 0;
                IF  count > 1
                THEN
                    BEGIN
                    FOR i := act_attr TO count - 1 DO
                        attrset [i] := attrset [i + 1];
                    (*ENDFOR*) 
                    count := count - 1;
                    IF  count < act_attr
                    THEN
                        act_attr := count;
                    (*ENDIF*) 
                    in06_set_new_attr (attrset [act_attr].attr_array);
                    help_attrparm := attrset [act_attr];
                    END
                ELSE
                    msg_no := cin06_m_del_last;
                (*ENDIF*) 
                END;
            f7 : (* =PF2=MARK *)
                in06_mark_toggle (check_rec);
            f8 : (* =PF4=DEFAULT *)
                BEGIN
                in06_init_attr_array (help_attrparm.attr_array);
                in06_set_new_attr (help_attrparm.attr_array);
                END;
            f9, f_exit, f_end, f_clear :
                BEGIN
                again := false;
                act_attr := save_act;
                exit := rf = f_exit;
                END;
            f_up :
                BEGIN
                IF  msg_no = 0
                THEN
                    BEGIN
                    attrset [act_attr] := help_attrparm;
                    IF  act_attr > 1
                    THEN
                        act_attr := act_attr - 1
                    ELSE
                        act_attr := count;
                    (*ENDIF*) 
                    in06_set_new_attr (attrset [act_attr].attr_array);
                    help_attrparm := attrset [act_attr];
                    END;
                (*ENDIF*) 
                END;
            f_down :
                BEGIN
                IF  msg_no = 0
                THEN
                    BEGIN
                    attrset [act_attr] := help_attrparm;
                    IF  act_attr < count
                    THEN
                        act_attr := act_attr + 1
                    ELSE
                        act_attr := 1;
                    (*ENDIF*) 
                    in06_set_new_attr (attrset [act_attr].attr_array);
                    help_attrparm := attrset [act_attr];
                    END;
                (*ENDIF*) 
                END;
            OTHERWISE
            END;
        (*ENDCASE*) 
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END; (* in06_screenio_attrset *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_attr_keys;
 
CONST
      cin06_first_attr_pfkey    = 17880;
      cin06_blank_sk_label      = '        ';
 
VAR
      f      : tin_prog_function;
      j      : integer;
      lab    : tin_ls_sk_label;
      msg    : tin_screenline;
 
BEGIN
WITH i01g^.key_type DO
    BEGIN
    FOR f := f1 TO f_down DO
        key_labels [ f ] := cin06_blank_sk_label;
    (*ENDFOR*) 
    j := cin06_first_attr_pfkey;
    FOR f := f1 TO f_down DO
        BEGIN
        IF  ( f IN [  f1, f2, f3, f4, f5, f6, f7, f8, f9, f_up, f_down ] )
        THEN
            BEGIN
            i09getmsg (i01g, j, msg);
            j := j + 1;
            s10mv (mxin_screenline,csp_lslabel,
                  @msg,1,
                  @lab,1,csp_lslabel );
            key_labels  [f]  := lab;
            END;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    activated := [  f1, f2, f3, f6, f7, f8, f9,
          f_up, f_down, f_end, f_exit, f_enter ] ;
    IF  [ vt_red..vt_light_blue] * i01g^.vt.desc.colors <> [   ]
    THEN
        activated := activated + [ f4, f5 ] ;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in06_attr_keys *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_attr_body (
            component      : tsp00_C8;
            release_id     : tsp00_C8;
            VAR attrparm   : tin_attrparm;
            VAR check_rec  : tin06_check_record;
            VAR msg_no     : integer);
 
CONST
      titlelinepos   = 2;
      collength      = 32;
      calm_mode      = false;
      screen_1       = 1;
 
VAR
      header       : tsp00_OnlineHeader;
      t40          : tsp00_C40;
      msg          : tin_screenline;
      fieldname    : tin_screenline;
      fieldpos     : tin_ls_position;
      fieldtype    : tin_ls_fieldtype;
      offset       : integer;
      i, k         : integer;
 
BEGIN
WITH header DO
    BEGIN
    id_field := component;
    relno_field := release_id;
    mode_field := cin_k_set;
    text_field := bsp_c40;
    END;
(*ENDWITH*) 
i50clear (cin_ls_header);
i56title (calm_mode, screen_1, header);
i56putframe (true, true);
WITH fieldpos, fieldtype DO
    BEGIN
    field_att := cin_attr1;
    fieldmode := [  ] ;
    screen_nr := 1;
    screen_part := cin_ls_workarea;
    sline := titlelinepos;
    scol  := firstcol;
    i09getmsg (i01g, cin06_attrname_base, fieldname);
    i50put2field (fieldname, collength, fieldpos, fieldtype);
    scol  := secondcol;
    fieldmode := [ ls_input] ;
    field_att := cin_attr2;
    FOR i := 1 TO mxsp_name DO
        t40  [i]  := attrparm.attr_name [i];
    (*ENDFOR*) 
    i50put4field (t40, mxsp_name, fieldpos, fieldtype);
    sline := sline + 2;
    CASE i01g^.i20.comp_enum OF
        sp4co_sql_dialog :
            offset := 3;
        sp4co_sql_easy   :
            offset := 2;
        OTHERWISE  :
            offset := 1;
        END;
    (*ENDCASE*) 
    FOR k := 1 TO check_rec.max_attr DO
        BEGIN
        i09getmsg (i01g, cin06_attrname_base + offset, fieldname);
        scol  := firstcol;
        field_att := cin_attr1;
        fieldmode := [  ] ;
        i50put2field (fieldname, collength, fieldpos, fieldtype);
        scol  := secondcol;
        fieldmode := [ ] ;
        field_att := (k-1);
        FOR i := 1 TO 6 DO
            t40  [i]  := fieldname  [i + secondcol] ;
        (*ENDFOR*) 
        i50put4field (t40, 6, fieldpos, fieldtype);
        scol  := thirdcol;
        i17putinputfield (fieldpos, check_rec.checked [k] );
        sline := sline + 1;
        offset := offset + 3;
        END;
    (*ENDFOR*) 
    screen_part := cin_ls_sysline;
    sline := 1;
    scol  := 1;
    field_att := cin_attr5;
    fieldmode :=  [  ] ;
    END;
(*ENDWITH*) 
i09getmsg (i01g, msg_no, msg);
i50put2field  (msg, mxin_screenline, fieldpos, fieldtype);
msg_no := 0;
END; (* in06_attr_body *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_inscreen_attrparms (
            VAR attrparm  : tin_attrparm;
            VAR check_rec : tin06_check_record;
            VAR msg_no    : integer);
 
VAR
      input          : tin_ls_input_field;
      field_found    : boolean;
      i, j           : integer;
 
BEGIN
WITH attrparm DO
    BEGIN
    i50getfield  (input, field_found);
    IF  field_found
    THEN
        BEGIN
        attr_name := bsp_c18;
        FOR i := 1 TO input.len DO
            attr_name  [i]  := input.buf  [i];
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
    FOR j := 1 TO check_rec.max_attr DO
        BEGIN
        i50getfield (input, field_found);
        IF  field_found
        THEN
            BEGIN
            IF  input.buf [1] in ['x', 'X']
            THEN
                check_rec.checked [j] := true
            ELSE
                IF  input.buf [1] = bsp_c1
                THEN
                    check_rec.checked [j] := false
                ELSE
                    msg_no := cin06_m_wrong_char;
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END; (* in06_inscreen_attrparms *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_attr_popup (
            VAR attr      : tin_attr_array;
            VAR check_rec : tin06_check_record;
            VAR header    : tsp00_C20;
            VAR eform     : tin_pickobject;
            VAR evars     : tin_eform_vars;
            VAR msg_no    : integer);
 
VAR
      i        : integer;
      current  : integer;
      width    : tin_natural;
      length   : tin_natural;
      dummy    : integer;
      vt_mode  : tsp00_VtMode;
      popupbuf : tin_popup_record;
      change   : boolean;
 
BEGIN
length := 10;
width  := 25;
dummy := 0;
current := 0;
FOR i := check_rec.max_attr DOWNTO 1 DO
    IF  check_rec.checked [i]
    THEN
        current := i;
    (*ENDIF*) 
(*ENDFOR*) 
IF  current > 0
THEN
    BEGIN
    WITH popupbuf DO
        BEGIN
        only_one := false;
        used := 0;
        i := 1;
        FOR vt_mode := vt_bright TO vt_grayed DO
            BEGIN
            IF  (vt_mode in i01g^.vt.desc.attributes) AND
                (vt_mode <> vt_mixed)
            THEN
                BEGIN
                used := used + 1;
                IF  vt_mode in attr [current].attribut
                THEN
                    popup_set [i] := true
                ELSE
                    popup_set [i] := false;
                (*ENDIF*) 
                i := i + 1;
                END;
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
        END;
    (*ENDWITH*) 
    i17popup (length, width, dummy, dummy, true,
          header, eform, evars, popupbuf, change);
    END
ELSE
    BEGIN
    change := false;
    msg_no := cin06_m_mark;
    END;
(*ENDIF*) 
IF  change AND (current > 0)
THEN
    FOR current := 1 TO check_rec.max_attr DO
        BEGIN
        IF  check_rec.checked [current]
        THEN
            WITH attr [current] DO
                BEGIN
                i := 1;
                attribut := [ ];
                FOR vt_mode := vt_bright TO vt_grayed DO
                    BEGIN
                    IF  (vt_mode in i01g^.vt.desc.attributes) AND
                        (vt_mode <> vt_mixed)
                    THEN
                        BEGIN
                        IF  popupbuf.popup_set [i] = true
                        THEN
                            attribut := attribut + [vt_mode];
                        (*ENDIF*) 
                        i := i + 1;
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDFOR*) 
                in06_ttable (current, attribut, foreground, background );
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
(*ENDIF*) 
END; (* in06_attr_popup *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_foregrd_popup (
            VAR attr      : tin_attr_array;
            VAR check_rec : tin06_check_record;
            VAR header    : tsp00_C20;
            VAR eform     : tin_pickobject;
            VAR evars     : tin_eform_vars;
            VAR msg_no    : integer);
 
VAR
      i        : integer;
      current  : integer;
      width    : tin_natural;
      length   : tin_natural;
      dummy    : integer;
      vt_color : tsp00_VtColor;
      popupbuf : tin_popup_record;
      change   : boolean;
 
BEGIN
length := 10;
width  := 25;
dummy := 0;
current := 0;
FOR i := check_rec.max_attr DOWNTO 1 DO
    IF  check_rec.checked [i]
    THEN
        current := i;
    (*ENDIF*) 
(*ENDFOR*) 
IF  current > 0
THEN
    BEGIN
    WITH popupbuf DO
        BEGIN
        only_one := true;
        used := 0;
        i := 1;
        FOR vt_color := vt_white TO vt_light_blue DO
            BEGIN
            used := used + 1;
            IF  vt_color = attr [current].foreground
            THEN
                popup_set [ord(vt_color)] := true
            ELSE
                popup_set [ord(vt_color)] := false;
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
        END;
    (*ENDWITH*) 
    i17popup (length, width, dummy, dummy, true,
          header, eform, evars, popupbuf, change);
    END
ELSE
    BEGIN
    change := false;
    msg_no := cin06_m_mark;
    END;
(*ENDIF*) 
IF  change AND (current > 0)
THEN
    FOR current := 1 TO check_rec.max_attr DO
        BEGIN
        IF  check_rec.checked [current]
        THEN
            FOR vt_color := vt_white TO vt_light_blue DO
                BEGIN
                IF  popupbuf.popup_set [ord(vt_color)] = true
                THEN
                    attr [current].foreground := vt_color;
                (*ENDIF*) 
                END;
            (*ENDFOR*) 
        (*ENDIF*) 
        WITH attr [current] DO
            in06_ttable (current, attribut, foreground, background );
        (*ENDWITH*) 
        END;
    (*ENDFOR*) 
(*ENDIF*) 
END; (* in06_foregrd_popup *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_backgrd_popup (
            VAR attr      : tin_attr_array;
            VAR check_rec : tin06_check_record;
            VAR header    : tsp00_C20;
            VAR eform     : tin_pickobject;
            VAR evars     : tin_eform_vars;
            VAR msg_no    : integer);
 
VAR
      i        : integer;
      current  : integer;
      width    : tin_natural;
      length   : tin_natural;
      dummy    : integer;
      vt_color : tsp00_VtColor;
      popupbuf : tin_popup_record;
      change   : boolean;
 
BEGIN
length := 10;
width  := 25;
dummy := 0;
current := 0;
FOR i := check_rec.max_attr DOWNTO 1 DO
    IF  check_rec.checked [i]
    THEN
        current := i;
    (*ENDIF*) 
(*ENDFOR*) 
IF  current > 0
THEN
    BEGIN
    WITH popupbuf DO
        BEGIN
        only_one := true;
        used := 0;
        i := 1;
        FOR vt_color := vt_white TO vt_light_blue DO
            BEGIN
            used := used + 1;
            IF  vt_color = attr [current].background
            THEN
                popup_set [ord(vt_color)] := true
            ELSE
                popup_set [ord(vt_color)] := false;
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
        END;
    (*ENDWITH*) 
    i17popup (length, width, dummy, dummy, true,
          header, eform, evars, popupbuf, change);
    END
ELSE
    BEGIN
    change := false;
    msg_no := cin06_m_mark;
    END;
(*ENDIF*) 
IF  change AND (current > 0)
THEN
    FOR current := 1 TO check_rec.max_attr DO
        BEGIN
        IF  check_rec.checked [current]
        THEN
            FOR vt_color := vt_white TO vt_light_blue DO
                BEGIN
                IF  popupbuf.popup_set [ord(vt_color)] = true
                THEN
                    attr [current].background := vt_color;
                (*ENDIF*) 
                END;
            (*ENDFOR*) 
        (*ENDIF*) 
        WITH attr [current] DO
            in06_ttable (current, attribut, foreground, background );
        (*ENDWITH*) 
        END;
    (*ENDFOR*) 
(*ENDIF*) 
END; (* in06_backgrd_popup *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_set_new_attr (
            VAR attr_array : tin_attr_array );
 
VAR
      i        : integer;
 
BEGIN
FOR i := 1 TO 16 DO
    WITH attr_array [i] DO
        in06_ttable (i, attribut, foreground, background);
    (*ENDWITH*) 
(*ENDFOR*) 
END; (* in06_set_new_attr *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_ttable (
            i          : tsp00_Int2;
            attr       : tsp00_VtAttrib;
            foreground : tsp00_VtColor;
            background : tsp00_VtColor);
 
BEGIN
IF  background = foreground
THEN
    attr := attr + [vt_bright];
&if $OS=UNIX
&if $OSSPEC=SCO
(* Bei libcurses kommt unter SCO das vt_inverse Attribut nicht durch *)
(* wenn das ansi-File beschreibt, dass der Bildschirm Farben hat. *)
(*ENDIF*) 
IF  ( [vt_red..vt_light_blue] * i01g^.vt.desc.colors <> [   ])
    AND (vt_inverse in attr)
THEN
    sqlttable (i - 1, attr - [vt_inverse], background, foreground)
ELSE
    sqlttable (i - 1, attr, foreground, background);
(*ENDIF*) 
&else
sqlttable (i - 1, attr, foreground, background);
&endif
&else
sqlttable (i - 1, attr, foreground, background);
&endif
END; (* in06_ttable *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_chk_attr_names (
            VAR msg_no : integer);
 
VAR
      i, j : integer;
      ok   : boolean;
 
BEGIN
ok := true;
WITH i01g^.set_parms.presentation DO
    FOR i := 1 TO count - 1 DO
        FOR j := i + 1 TO count DO
            IF  ok (* checked 28 times *)
            THEN
                IF  attrset [i].attr_name = attrset [j].attr_name
                THEN
                    ok := false;
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDFOR*) 
    (*ENDFOR*) 
(*ENDWITH*) 
IF  NOT ok
THEN
    msg_no := cin06_m_duplicate
ELSE
    msg_no := 0;
(*ENDIF*) 
END; (* in06_chk_attr_names *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_mark_toggle (
            VAR check_rec : tin06_check_record);
 
VAR
      all_checked : boolean;
      i           : integer;
 
BEGIN
WITH check_rec DO
    BEGIN
    all_checked := true;
    FOR i := 1 TO max_attr DO
        IF  NOT checked [i]
        THEN
            all_checked := false;
        (*ENDIF*) 
    (*ENDFOR*) 
    IF  all_checked
    THEN
        FOR i := 1 TO max_attr DO
            checked [i] := false
        (*ENDFOR*) 
    ELSE
        FOR i := 1 TO max_attr DO
            checked [i] := true;
        (*ENDFOR*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in06_mark_toggle *)
 
(*------------------------------*) 
 
PROCEDURE
      i06printerset (
            component         : tsp00_C8;
            release_id        : tsp00_C8;
            VAR printformat   : tin_pset_type;
            VAR printerchange : boolean;
            VAR exit          : boolean );
 
VAR
      old_ls       : tin_ls_record;
      old_key_type : tin_ls_key_type;
 
BEGIN
WITH i01g^ DO
    BEGIN
    old_ls := ls;
    old_key_type := key_type;
    END;
(*ENDWITH*) 
in06_screenio_printerset (component, release_id, printformat,
      printerchange, exit);
i50clear (cin_ls_workarea);
WITH i01g^ DO
    BEGIN
    ls := old_ls;
    key_type := old_key_type;
    END;
(*ENDWITH*) 
END; (* i06printerset *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_screenio_printerset (
            component         : tsp00_C8;
            release_id        : tsp00_C8;
            VAR printformat   : tin_pset_type;
            VAR printerchange : boolean;
            VAR exit          : boolean );
 
CONST
      inputarea_length    = 0;
      functionmenu_length = 1;
      message_lines       = 1;
 
VAR
      i              : integer;
      msg_no         : integer;
      screen_changed : boolean;
      again          : boolean;
      csr_pos        : tin_ls_position;
      rf             : tin_ls_releasemode;
      help_pset      : tin_printerparms;
      save_act       : integer;
&     ifdef WINDOWS
      lbl     : tsp00_C8;
      vrange  : tin_display_range;
&     endif
 
BEGIN
WITH printformat DO
    BEGIN
    exit := false;
    i51layout  (functionmenu_length, inputarea_length, message_lines);
    i50clear  (cin_ls_workarea);
    in06_pset_keys;
    printerchange := false;
    again := true;
    save_act := act_print;
    msg_no := 0;
    WHILE again AND i21dbok (i01g) DO
        BEGIN
        IF  (count > 1) AND (msg_no = 0)
        THEN
            msg_no := cin06_m_more
        ELSE
            IF  (msg_no = cin06_m_more)
            THEN
                msg_no := 0;
            (*ENDIF*) 
        (*ENDIF*) 
        help_pset := printerset [act_print];
        in06_pset_body  (component, release_id, help_pset, msg_no);
        WITH i01g^.vt.opt DO
            BEGIN
            wait_for_input  := true;
            usage_mode      := vt_form;
            return_on_last  := false;
            return_on_first := false;
            returnkeys      :=  [  ] ;
            reject_keys     :=  [  ] ;
            bell := false;
            END;
        (*ENDWITH*) 
        WITH csr_pos DO
            BEGIN
            screen_nr := 1;
            screen_part := cin_ls_workarea;
            sline := 3;
            scol := secondcol;
            END;
        (*ENDWITH*) 
&       ifdef WINDOWS
        WITH vrange DO
            BEGIN
            total_begin := 1;
            total_end   := count;
            displ_begin := act_print;
            displ_end   := act_print;
            END;
        (*ENDWITH*) 
        lbl := bsp_c8;
        i56vrange(1,lbl,vrange);
&       endif
        i56putlabels  (f_clear, false);
        i57ioscreen  (csr_pos, rf, screen_changed);
        IF  screen_changed
        THEN
            in06_inscreen_printerparms (help_pset,
                  csr_pos, msg_no);
        (*ENDIF*) 
        IF  ((msg_no = cin_setmsg_reduced_to_max) OR
            (msg_no = cin_setmsg_increased_to_min))
            AND NOT (rf in [ f9, f_end, f_clear ])
        THEN
            printerset [act_print] := help_pset;
        (*ENDIF*) 
        CASE rf OF
            f_enter : (* read new name after COPY *)
                IF  msg_no = 0
                THEN
                    BEGIN
                    printerset [act_print] := help_pset;
                    in06_chk_print_names (msg_no);
                    END;
                (*ENDIF*) 
            f1 : (* =PF5=SAVE *)
                BEGIN
                IF  msg_no = 0
                THEN
                    BEGIN
                    printerset [act_print] := help_pset;
                    in06_chk_print_names (msg_no);
                    END;
                (*ENDIF*) 
                IF  msg_no = 0
                THEN
                    BEGIN
                    printerchange := true;
                    again := false;
                    END;
                (*ENDIF*) 
                END;
            f2 : (* =PF9=COPY *)
                BEGIN
                IF  msg_no = 0
                THEN
                    IF  count < cin_max_ap
                    THEN
                        BEGIN
                        help_pset.formatname := bsp_name;
                        count := count + 1;
                        act_print := count;
                        printerset [act_print] := help_pset;
                        msg_no := cin06_m_new_pset;
                        END
                    ELSE
                        msg_no := cin06_m_maxreached;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            f6 : (* =PF6=DELETE *)
                BEGIN
                msg_no := 0;
                IF  count > 1
                THEN
                    BEGIN
                    FOR i := act_print TO count - 1 DO
                        printerset [i] := printerset [i + 1];
                    (*ENDFOR*) 
                    count := count - 1;
                    IF  count < act_print
                    THEN
                        act_print := count;
                    (*ENDIF*) 
                    END
                ELSE
                    msg_no := cin06_m_del_last;
                (*ENDIF*) 
                END;
            f8 : (* =PF4=DEFAULT *)
                in06_init_printerparms (printerset [act_print]);
            f9, f_exit, f_end, f_clear : (* =PF3=END *)
                BEGIN
                again := false;
                act_print := save_act;
                exit := rf = f_exit;
                END;
            f_up :
                BEGIN
                IF  msg_no = 0
                THEN
                    BEGIN
                    printerset [act_print] := help_pset;
                    IF  act_print > 1
                    THEN
                        act_print := act_print - 1
                    ELSE
                        act_print := count;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
            f_down :
                BEGIN
                IF  msg_no = 0
                THEN
                    BEGIN
                    printerset [act_print] := help_pset;
                    IF  act_print < count
                    THEN
                        act_print := act_print + 1
                    ELSE
                        act_print := 1;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
&           ifdef WINDOWS
            f_vscroll :
                BEGIN
                IF  msg_no = 0
                THEN
                    IF  i01g^.vt.parms.scroll_dir > 0
                    THEN
                        BEGIN
                        printerset [act_print] := help_pset;
                        IF  act_print < count
                        THEN
                            act_print := act_print + 1
                        ELSE
                            act_print := 1;
                        (*ENDIF*) 
                        END
                    ELSE
                        BEGIN
                        printerset [act_print] := help_pset;
                        IF  act_print > 1
                        THEN
                            act_print := act_print - 1
                        ELSE
                            act_print := count;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
&           endif
            OTHERWISE
            END;
        (*ENDCASE*) 
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END; (* in06_screenio_printerset *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_pset_keys;
 
CONST
      cin06_first_pset_pfkey    = 17870;
      cin06_blank_sk_label      = '        ';
 
VAR
      f      : tin_prog_function;
      j      : integer;
      lab    : tin_ls_sk_label;
      msg    : tin_screenline;
 
BEGIN
WITH i01g^.key_type DO
    BEGIN
    FOR f := f1 TO f_down DO
        key_labels [ f ] := cin06_blank_sk_label;
    (*ENDFOR*) 
    j := cin06_first_pset_pfkey;
    FOR f := f1 TO f_down DO
        BEGIN
        IF  ( f IN [  f1, f2, f6, f8, f9, f_up, f_down ] )
        THEN
            BEGIN
            i09getmsg (i01g, j, msg);
            j := j + 1;
            s10mv (mxin_screenline,csp_lslabel,
                  @msg,1,
                  @lab,1,csp_lslabel );
            key_labels  [f]  := lab;
            END;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    activated := [  f1, f2, f6, f8, f9,
          f_up, f_down, f_vscroll, f_end, f_exit, f_enter ] ;
    END;
(*ENDWITH*) 
END; (* in06_pset_keys *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_pset_body (
            component         : tsp00_C8;
            release_id        : tsp00_C8;
            VAR printerparm   : tin_printerparms;
            VAR msg_no        : integer );
 
CONST
      titlelinepos   = 3;
      firstcol       = 1;
      secondcol      = 34;
      collength      = 32;
      calm_mode      = false;
      screen_1       = 1;
 
VAR
      header       : tsp00_OnlineHeader;
      t40          : tsp00_C40;
      msg          : tin_screenline;
      fieldname    : tin_screenline;
      fieldpos     : tin_ls_position;
      fieldtype    : tin_ls_fieldtype;
      i            : integer;
 
BEGIN
WITH header DO
    BEGIN
    id_field := component;
    relno_field := release_id;
    mode_field := cin_k_set;
    text_field := bsp_c40;
    END;
(*ENDWITH*) 
i56title (calm_mode, screen_1, header);
i56putframe (true, true);
WITH fieldpos, fieldtype DO
    BEGIN
    field_att := cin_attr1;
    fieldmode := [  ] ;
    screen_nr := 1;
    screen_part := cin_ls_workarea;
    sline := titlelinepos;
    scol  := firstcol;
    i09getmsg (i01g, cin06_pset_header, fieldname);
    i50put2field (fieldname, collength, fieldpos, fieldtype);
    scol  := secondcol;
    fieldmode := [ ls_input] ;
    field_att := cin_attr2;
    FOR i := 1 TO mxsp_name DO
        t40  [i]  := printerparm.formatname  [i] ;
    (*ENDFOR*) 
    i50put4field (t40, mxsp_name, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    i09getmsg (i01g, cin06_pset_printer, fieldname);
    sline := sline + 2;
    scol  := firstcol;
    field_att := cin_attr1;
    fieldmode := [  ] ;
    i50put2field (fieldname, collength, fieldpos, fieldtype);
    scol  := secondcol;
    fieldmode := [ ls_input] ;
    field_att := cin_attr2;
    i50put3field(printerparm.printer, 64, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    i09getmsg (i01g, cin06_pset_pagewidth, fieldname);
    sline := sline + 1;
    scol  := firstcol;
    field_att := cin_attr1;
    fieldmode := [  ] ;
    i50put2field (fieldname, collength, fieldpos, fieldtype);
    scol  := secondcol;
    fieldmode := [ ls_input] ;
    field_att := cin_attr2;
    i09itoc40 (printerparm.pagewidth, t40);
    i50put4field (t40, mxsp_c40, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    i09getmsg (i01g, cin06_pset_pagelength, fieldname);
    sline := sline + 1;
    scol  := firstcol;
    field_att := cin_attr1;
    fieldmode := [  ] ;
    i50put2field (fieldname, collength, fieldpos, fieldtype);
    scol  := secondcol;
    fieldmode := [ ls_input] ;
    field_att := cin_attr2;
    i09itoc40 (printerparm.pagelength, t40);
    i50put4field (t40, mxsp_c40, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    i09getmsg (i01g, cin06_pset_leftmargin, fieldname);
    sline := sline + 1;
    scol  := firstcol;
    field_att := cin_attr1;
    fieldmode := [  ] ;
    i50put2field (fieldname, collength, fieldpos, fieldtype);
    scol  := secondcol;
    fieldmode := [ ls_input] ;
    field_att := cin_attr2;
    i09itoc40 (printerparm.lmargin, t40);
    i50put4field (t40, mxsp_c40, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    i09getmsg (i01g, cin06_pset_rightmargin, fieldname);
    sline := sline + 1;
    scol  := firstcol;
    field_att := cin_attr1;
    fieldmode := [  ] ;
    i50put2field (fieldname, collength, fieldpos, fieldtype);
    scol  := secondcol;
    fieldmode := [ ls_input] ;
    field_att := cin_attr2;
    i09itoc40 (printerparm.rmargin, t40);
    i50put4field (t40, mxsp_c40, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    i09getmsg (i01g, cin06_pset_topmargin, fieldname);
    sline := sline + 1;
    scol  := firstcol;
    field_att := cin_attr1;
    fieldmode := [  ] ;
    i50put2field (fieldname, collength, fieldpos, fieldtype);
    scol  := secondcol;
    fieldmode := [ ls_input] ;
    field_att := cin_attr2;
    i09itoc40 (printerparm.tmargin, t40);
    i50put4field (t40, mxsp_c40, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    i09getmsg (i01g, cin06_pset_bottommargin, fieldname);
    sline := sline + 1;
    scol  := firstcol;
    field_att := cin_attr1;
    fieldmode := [  ] ;
    i50put2field (fieldname, collength, fieldpos, fieldtype);
    scol  := secondcol;
    fieldmode := [ ls_input] ;
    field_att := cin_attr2;
    i09itoc40 (printerparm.bmargin, t40);
    i50put4field (t40, mxsp_c40, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    i09getmsg (i01g, cin06_pset_newpage, fieldname);
    sline := sline + 1;
    scol  := firstcol;
    field_att := cin_attr1;
    fieldmode := [  ] ;
    i50put2field (fieldname, collength, fieldpos, fieldtype);
    scol  := secondcol;
    fieldmode := [ ls_input] ;
    field_att := cin_attr2;
    i09putonoff (i01g, printerparm.newpage, t40);
    i50put4field (t40, 5, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    screen_part := cin_ls_sysline;
    sline := 1;
    scol  := 1;
    field_att := cin_attr5;
    fieldmode :=  [  ] ;
    END;
(*ENDWITH*) 
i09getmsg (i01g, msg_no, msg);
i50put2field  (msg, mxin_screenline, fieldpos, fieldtype);
msg_no := 0;
END; (* in06_pset_body *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_inscreen_printerparms (
            VAR printerparm : tin_printerparms;
            VAR csr_pos     : tin_ls_position;
            VAR msg_no      : integer);
 
VAR
      input          : tin_ls_input_field;
      field_found     : boolean;
      i, j            : integer;
 
BEGIN
WITH printerparm DO
    BEGIN
    i50getfield  (input, field_found);
    IF  field_found
    THEN
        BEGIN
        formatname := bsp_c18;
        FOR i := 1 TO input.len DO
            formatname  [i]  := input.buf  [i];
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
    i50getfield  (input, field_found);
    IF  field_found
    THEN
        BEGIN
        i := 1;
        printer := bsp_c64;
        WHILE (i <= input.len) AND (i <= 64) DO
            BEGIN
            printer  [i]  := input.buf  [i] ;
            i := i + 1;
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    i50getfield (input, field_found);
    IF  field_found
    THEN
        pagewidth := i09minmaxverified (input, 1,
              cin_maxpagewidth, pagewidth, csr_pos,
              msg_no);
    (*ENDIF*) 
    i50getfield (input, field_found);
    IF  field_found
    THEN
        pagelength := i09minmaxverified (input, 1,
              cin_maxpagelength, pagelength, csr_pos,
              msg_no);
    (*ENDIF*) 
    i50getfield (input, field_found);
    IF  field_found
    THEN
        lmargin := i09minmaxverified (input, 0,
              cin_maxpagewidth, lmargin, csr_pos, msg_no);
    (*ENDIF*) 
    i50getfield (input, field_found);
    IF  field_found
    THEN
        rmargin := i09minmaxverified (input, 0,
              cin_maxpagewidth, rmargin, csr_pos, msg_no);
    (*ENDIF*) 
    i50getfield (input, field_found);
    IF  field_found
    THEN
        tmargin := i09minmaxverified (input, 0,
              cin_maxpagelength, tmargin, csr_pos, msg_no);
    (*ENDIF*) 
    i50getfield (input, field_found);
    IF  field_found
    THEN
        bmargin := i09minmaxverified (input, 0,
              cin_maxpagelength, bmargin, csr_pos, msg_no);
    (*ENDIF*) 
    i50getfield (input, field_found);
    IF  field_found
    THEN
        i09onoff (i01g, input, newpage, csr_pos, msg_no);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in06_inscreen_printerparms *)
 
(*------------------------------*) 
 
PROCEDURE
      in06_chk_print_names (
            VAR msg_no : integer);
 
VAR
      i, j : integer;
      ok   : boolean;
 
BEGIN
ok := true;
WITH i01g^.set_parms.printformat DO
    FOR i := 1 TO count - 1 DO
        FOR j := i + 1 TO count DO
            IF  ok (* checked 28 times *)
            THEN
                IF  printerset [i].formatname = printerset [j].formatname
                THEN
                    ok := false;
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDFOR*) 
    (*ENDFOR*) 
(*ENDWITH*) 
IF  NOT ok
THEN
    msg_no := cin06_m_duplicate;
(*ENDIF*) 
END; (* in06_chk_print_names *)
 
(*------------------------------*) 
 
PROCEDURE
      i06getattr (
            attrindex  : tsp00_Int2;
            VAR att    : tsp00_VtAttrib;
            VAR foregr : tsp00_VtColor;
            VAR backgr : tsp00_VtColor);
 
BEGIN
WITH i01g^.set_parms.presentation DO
    WITH attrset [act_attr] .attr_array [ attrindex + 1 ] DO
        BEGIN
        att    := attribut;
        foregr := foreground;
        backgr := background;
        END;
    (*ENDWITH*) 
(*ENDWITH*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
