-
Hier ein Bsp.:
in einer PF-SRC stehen Je User max. 20 Pulldown Befehle.
PC Aufrufe oder AS400 (muß von der Emulation unterstützt werden)
Code:
A************************************************************************
A* *
A* (C) 2002 MEINIKAT INFORMATIONSSYSTEME, 30655 HANNOVER *
A* *
A* PROGRAMMM....: MOOH17FM MODUL.........: *
A* *
A* FUNKTION.....: *
A* *
A* AUTOR........: AZUBISOFT DATUM..........: 23.01.2002 *
A* *
A*----------------------------------------------------------------------*
A* ÄNDERUNG MIT PROJEKT : *
A* VON................. : AM: *
A* INHALT.............. : *
A************************************************************************
A*%%EC
A DSPSIZ(24 80 *DS3 -
A 27 132 *DS4)
A INVITE
A PRINT
A INDARA
A WDWBORDER((*COLOR BLU) (*DSPATR RI))
A MNUBARSW(CA10)
A CF03(03)
A CF05(05)
A CF12(12)
A CA10
*A*-------------------------------------------------------------------------
A* Definition der Menüleiste und der Menüs 1 MENÜPUNKT 20 ZEILEN
*A*-------------------------------------------------------------------------
A R M20CTL
A RTNCSRLOC(&##CSRC &##CSFL &##CSPS)
A N99 DSPMOD(*DS4)
A CLRL(01)
A CSRLOC(##LINE ##POS)
A OVERLAY
A MNUBAR
A MNUBARDSP(&OPT)
A MNUFLD 2Y 0I 1 2MNUBARSEP((*COLOR BLU) (*DSPATR HI)-
A (*CHAR '-'))
A CHCAVAIL((*COLOR WHT) (*DSPATR HI))
A CHCSLT((*COLOR YLW) (*DSPATR HI))
A 10 MNUBARCHC(1 P20CTL &ML)
A ML 30A P
A OPT 2S 0H
A ##LINE 3S 0H
A ##POS 3S 0H
A ##FLD 10A H
A ##CSRC 10A H
A ##CSFL 10A H
A ##CSPS 4S 0H
A MNUCHC 2Y 0H
A R P20CTL
A PULLDOWN
A WDWBORDER((*COLOR BLU) (*DSPATR RI)-
A (*CHAR ' '))
A A20CTL 2Y 0B 1 2SNGCHCFLD
A CHANGE(90)
A CHCUNAVAIL((*COLOR YLW))
A CHECK(ER)
A CHOICE(1 &P20MP101)
A CHCCTL(1 &P20STA101)
A CHOICE(2 &P20MP102)
A CHCCTL(2 &P20STA102)
A CHOICE(3 &P20MP103)
A CHCCTL(3 &P20STA103)
A CHOICE(4 &P20MP104)
A CHCCTL(4 &P20STA104)
A CHOICE(5 &P20MP105)
A CHCCTL(5 &P20STA105)
A CHOICE(6 &P20MP106)
A CHCCTL(6 &P20STA106)
A CHOICE(7 &P20MP107)
A CHCCTL(7 &P20STA107)
A CHOICE(8 &P20MP108)
A CHCCTL(8 &P20STA108)
A CHOICE(9 &P20MP109)
A CHCCTL(9 &P20STA109)
A CHOICE(10 &P20MP110)
A CHCCTL(10 &P20STA110)
A CHOICE(11 &P20MP111)
A CHCCTL(11 &P20STA111)
A CHOICE(12 &P20MP112)
A CHCCTL(12 &P20STA112)
A CHOICE(13 &P20MP113)
A CHCCTL(13 &P20STA113)
A CHOICE(14 &P20MP114)
A CHCCTL(14 &P20STA114)
A CHOICE(15 &P20MP115)
A CHCCTL(15 &P20STA115)
A CHOICE(16 &P20MP116)
A CHCCTL(16 &P20STA116)
A CHOICE(17 &P20MP117)
A CHCCTL(17 &P20STA117)
A CHOICE(18 &P20MP118)
A CHCCTL(18 &P20STA118)
A CHOICE(19 &P20MP119)
A CHCCTL(19 &P20STA119)
A CHOICE(20 &P20MP120)
A CHCCTL(20 &P20STA120)
A P20STA101 1Y 0H
A P20STA102 1Y 0H
A P20STA103 1Y 0H
A P20STA104 1Y 0H
A P20STA105 1Y 0H
A P20STA106 1Y 0H
A P20STA107 1Y 0H
A P20STA108 1Y 0H
A P20STA109 1Y 0H
A P20STA110 1Y 0H
A P20STA111 1Y 0H
A P20STA112 1Y 0H
A P20STA113 1Y 0H
A P20STA114 1Y 0H
A P20STA115 1Y 0H
A P20STA116 1Y 0H
A P20STA117 1Y 0H
A P20STA118 1Y 0H
A P20STA119 1Y 0H
A P20STA120 1Y 0H
A*
A P20MP101 30A P
A P20MP102 30A P
A P20MP103 30A P
A P20MP104 30A P
A P20MP105 30A P
A P20MP106 30A P
A P20MP107 30A P
A P20MP108 30A P
A P20MP109 30A P
A P20MP110 30A P
A P20MP111 30A P
A P20MP112 30A P
A P20MP113 30A P
A P20MP114 30A P
A P20MP115 30A P
A P20MP116 30A P
A P20MP117 30A P
A P20MP118 30A P
A P20MP119 30A P
A P20MP120 30A P
***------------------------------------------------
* ENDE DER DEFINITIONEN ZU EINER MENÜLEISTE
***------------------------------------------------
A R S01F99
A ASSUME
A 5 1' '
Das PGM
H/COPY QCPYSRC,Z_H_ZEILE Standard Header Zeile
**********************************************************************************************
* *
* (C) 2001 Meinikat Informationssysteme GmbH, 30655 Hannover *
* *
* PROGRAMM...: MOOH17 MODUL......: *NONE *
* *
* FUNKTION...: STEUERUNG DER MENÜLEISTE UND AUSWERTUNG DES MENÜPUNKTES *
* .. *
* AUTOR......: AZUBISOFT DATUM......: 23.01.2002 *
* ------------------------------------------------------------------------------------------ *
**********************************************************************************************
FMOOH17FM CF E WORKSTN USROPN INFDS(DSPATR) Menüleiste
FSOURCE IF F 202 DISK USROPN
* --------------------------------------------------------------- *
* STD. VARIABLEN FÜR PGM
* --------------------------------------------------------------- *
D DSPATR DS
D SAFO 261 270
D LINE 370 370
D POS 371 371
D PTM1PARM S 2500
D PTM2PARM S 1024
D PTM3PARM S 1024
D LONG S 500
D LONGCMD S 536
D Z S 2 0
D MNU_Z S 2 0
D MNU_ZA S 2
D HK S 1 INZ('''')
D CMD S 200
D SATZ S LIKE(P940SATZ)
D VERLASSEN S 1
D MP_TAB S 30 DIM(30)
D CM_TAB S 132 DIM(30)
/COPY QPRCSRC,QCMDEXEC_
/COPY QPRCSRC,GET_MBRD_
ISOURCE KF
I 13 190 STRING
* *************************************************************** *
* (MAIN) H A U P T P R O G R A M M
* *************************************************************** *
* LÄUFT SOLANGE BIS F3 ODER ENDE GEWÄHLT WURDE
C DOW *INKL <> *ON AND *INKC <> *ON
C CLEAR OPT
C EXFMT M20CTL
C READ P20CTL 30
* WENN F12, F03 ODER EXITMENÜ
C IF *INKL = *ON OR *INKC = *ON IF: 1 *INKL = *ON OR *INKC = *usw.
C LEAVE
C ENDIF ENDIF: 1 *INKL = *ON OR *INKC = *usw.
C EXSR AUSWER
* ================
C IF VERLASSEN = 'J' IF: 1 VERLASSEN = 'J'
C LEAVE
C ENDIF ENDIF: 1 VERLASSEN = 'J'
* ENDE DER SCHLEIFE
C ENDDO ENDDO: 1 *INKL <> *ON AND *INKC <>usw.
C EVAL *INLR = *ON
* *************************************************************** *
* (SUBROUTINE) WERTE DIE TABELLE AUS
* *************************************************************** *
C AUSWER BEGSR
C IF %SUBST(CM_TAB(OPT):1:4) = '*PC*' IF: 1 %SUBST(CM_TAB(OPT):1:4) =
C EVAL LONG = 'START ' + %SUBST(CM_TAB(OPT):5)
C EVAL LONGCMD ='CALL OPN_PCDOPR PARM(' + HK + LONG
C + HK + ' N' + ')'
C ELSE ELSE: 1 %SUBST(CM_TAB(OPT):1:4) =
C EVAL LONGCMD =CM_TAB(OPT)
C ENDIF ENDIF: 1 %SUBST(CM_TAB(OPT):1:4) =
C CALLP(E) QCMD(LONGCMD:
* ==== ============
C %LEN(%TRIM(LONGCMD)))
C EVAL *INKL = *OFF
C AUSWE99 ENDSR
* *************************************************************** *
* (SUBROUTINE) INZSR
* *************************************************************** *
C *INZSR BEGSR
***------------------------------------***
* LEGE DIE BS-GRÖßE FEST
*
* SELBER etwas machen !!!!
*
***------------------------------------***
C IF DSPMOD = ' ' OR DSPMOD = '3' IF: 1 DSPMOD = ' ' OR DSPMOD = usw.
C EVAL *IN99 = *ON
C ELSE ELSE: 1 DSPMOD = ' ' OR DSPMOD = usw.
C EVAL *IN99 = *OFF
C ENDIF ENDIF: 1 DSPMOD = ' ' OR DSPMOD = usw.
*------------------------------------------------------------------------------------------------------------
* Hier auch ewas selber mache, gesucht wird in der Datei (PF-SRC ) das member username oder das menber pulldown
C EVAL MBRD_DS = GET_MBRD('*LIBL':'PULLDOWN':
C ##PGUS)
* --- SRC NICHT GEFUNDEN ---
C IF MBRD_MBR = *BLANK IF: 1 MBRD_MBR = *BLANK
C EVAL MBRD_DS = GET_MBRD('*LIBL':'PULLDOWN':
C 'PULLDOWN')
C IF MBRD_MBR = *BLANK IF: 2 MBRD_MBR = *BLANK
* RETURN
C ENDIF ENDIF: 2 MBRD_MBR = *BLANK
C ENDIF ENDIF: 1 MBRD_MBR = *BLANK
C EVAL CMD = 'OVRDBF FILE(SOURCE) TOFILE(*LIBL/' +
C 'PULLDOWN) MBR('+ %TRIM(MBRD_MBR) +
C ') OVRSCOPE(*JOB)'
C CALLP(E) QCMD(CMD :%LEN(%TRIM(CMD)))
* ==== ============
* ---------------------------------------------------------------------------- *
* ANLESEN UND ANZAHL DER ZEILEN HERAUSHOLEN DIE DANN IM P-MENÜ ANGEZEIGT WERDEN*
* ---------------------------------------------------------------------------- *
C OPEN SOURCE
C READ SOURCE 98 LESE AKTUELLES PGM
C IF *IN98 = *ON IF: 1 *IN98 = *ON
C EVAL *INKC = *ON
C ELSE ELSE: 1 *IN98 = *ON
C EVAL Z = 0
C EVAL MNU_ZA = %SUBST(STRING:40:2)
C EVAL VERLASSEN = %SUBST(STRING:62:1)
C EVAL ML = %SUBST(STRING:1:30)
C MOVEL MNU_ZA MNU_Z
C READ SOURCE 98 LESE AKTUELLES PGM
C DOW *IN98 = *OFF DOW: 1 *IN98 = *OFF
C EVAL Z = Z + 1
C EVAL MP_TAB(Z) = %SUBST(STRING:1:30)
C EVAL CM_TAB(Z) = %SUBST(STRING:38)
C READ SOURCE 98 LESE AKTUELLES PGM
C ENDDO ENDDO: 1 *IN98 = *OFF
C EVAL CMD = 'DLTOVR FILE(SOURCE) LVL(*JOB)'
C CALLP(E) QCMD(CMD :%LEN(%TRIM(CMD)))
* ==== ============
***------------------------------------***
* ÖFFNE MENÜLEISTE UND LEGE FEST WAS
* ANGEZEIGT WERDEN SOLL UND WAS NICHT
***------------------------------------***
C OPEN MOOH17FM
C EVAL P20MP101 = MP_TAB(1)
C EVAL P20MP102 = MP_TAB(2)
C EVAL P20MP103 = MP_TAB(3)
C EVAL P20MP104 = MP_TAB(4)
C EVAL P20MP105 = MP_TAB(5)
C EVAL P20MP106 = MP_TAB(6)
C EVAL P20MP107 = MP_TAB(7)
C EVAL P20MP108 = MP_TAB(8)
C EVAL P20MP109 = MP_TAB(9)
C EVAL P20MP110 = MP_TAB(10)
C EVAL P20MP111 = MP_TAB(11)
C EVAL P20MP112 = MP_TAB(12)
C EVAL P20MP113 = MP_TAB(13)
C EVAL P20MP114 = MP_TAB(14)
C EVAL P20MP115 = MP_TAB(15)
C EVAL P20MP116 = MP_TAB(16)
C EVAL P20MP117 = MP_TAB(17)
C EVAL P20MP118 = MP_TAB(18)
C EVAL P20MP119 = MP_TAB(19)
C EVAL P20MP120 = MP_TAB(20)
C WRITE P201CTL
C SETON 10
C ENDIF ENDIF: 1 *IN98 = *ON
C INZSR99 ENDSR
Die Datei Pulldown, member = Username oder Pulldown
>Befehl 15 VERLASSEN : J
>1. wrksplf wrksplf
>2. wrkactjob wrkactjob
>3. wrkusrjob wrkusrjob
>4. SQL starten STRSQL
>5. PDM starten STRPDM
>6. Msg an alle ?sndbrkmsg tomsgq(*allws)
>7. Senden per FTP FTP
>8. Telnet zu KD ?A170
>9. MO1 für Feld ?ZF
>A. MY3 für Source ?ZP
>B. MO0 für Datei ?ZD
>C. MYD für Source ?ZH
>D. DSPMSG dspmsg
>E. BRKMSG BM ?sndmsg tousr(bm) msgtype(*inq)
>D. WRKJOB WRKjob
--------------------
und die anleitung *
--------------------
Befehl:
Was soll ausgeführt werden (TEXT)
Nach dem '>' kommt die SchnellTaste
12 : Anzahl Befehle in diesem PulldownMenü
Verlassen : N
Soll das Pulldown danach verlassen werden ?
(gilt für alle Befehle)
Muster ist das Member PULLDOWN
Individuell je User zu kopieren als USERNAME
TEXT BEFEHL (? = mit prompt) *PC* = strpccmd
>1. Active Jobs WRKACTJOB
>2. Benutzerjobs WRKUSRJOB
>3. Objektsperren ?WRKOBJLCK
>4. Mit Spool's arb. WRKSPLF
>5. Nachrichten anz. DSPMSG
>6. Mit Jobq's arb. WRKJOBQ
>7. Mit Outq's arb. WRKOUTQ
>8. SQL starten STRSQL
>9. PDM starten STRPDM
>A. Mit Teildateien arbeiten ?WRKMBRPDM
>B. Mit Objekten arbeiten ?WRKOBJPDM
>E. Nochmal wrkactjob ?WA
>F. WORD *PC*WINWORD.EXE
Similar Threads
-
By Stannek in forum IBM i Hauptforum
Antworten: 1
Letzter Beitrag: 23-01-07, 07:36
-
By tm1104 in forum IBM i Hauptforum
Antworten: 4
Letzter Beitrag: 21-01-07, 18:55
-
By emax in forum IBM i Hauptforum
Antworten: 7
Letzter Beitrag: 08-09-06, 17:24
-
By Freezer in forum IBM i Hauptforum
Antworten: 2
Letzter Beitrag: 18-08-06, 08:11
-
By hteufl in forum NEWSboard Programmierung
Antworten: 4
Letzter Beitrag: 18-01-06, 10:58
Berechtigungen
- Neue Themen erstellen: Nein
- Themen beantworten: Nein
- You may not post attachments
- You may not edit your posts
-
Foren-Regeln
|
Erweiterte Foren Suche
Google Foren Suche
Forum & Artikel Update eMail
AS/400 / IBM i
Server Expert Gruppen
Unternehmens IT
|
Kategorien online Artikel
- Big Data, Analytics, BI, MIS
- Cloud, Social Media, Devices
- DMS, Archivierung, Druck
- ERP + Add-ons, Business Software
- Hochverfügbarkeit
- Human Resources, Personal
- IBM Announcements
- IT-Karikaturen
- Leitartikel
- Load`n`go
- Messen, Veranstaltungen
- NEWSolutions Dossiers
- Programmierung
- Security
- Software Development + Change Mgmt.
- Solutions & Provider
- Speicher – Storage
- Strategische Berichte
- Systemmanagement
- Tools, Hot-Tips
Auf dem Laufenden bleiben
|
Bookmarks