|
|
The RPG for Mouse & Scroll Bar
*************************************************************
* A program for the key cabinet *
* 12/99 Booth Martin *
* (Uses mouse button click) *
* *
*************************************************************
FGCKFM CF E WORKSTN
F SFILE(SFLA:RRNA)
FGCKF UF A E DISK INFDS(INFDS)
FGCKFL1 IF E K DISK Rename(RGCKF:RGCKF1)
F INFDS(DB1) BLOCK(*NO)
FGCKFL2 IF E K DISK Rename(RGCKF:RGCKF2)
F INFDS(DB2) BLOCK(*NO)
FGCKFL3 IF E K DISK Rename(RGCKF:RGCKF3)
F INFDS(DB3) BLOCK(*NO)
* ..................................................
D Col# S 1 0
D CTL1Saved S Like(CTL1)
D CTL2Saved S Like(CTL2)
D ColSaved S Like(Col#)
* INFDS for database file. FileSize will contain the number
* of records in the file when the file is opened.
DINFDS DS
D FILESIZE 156 159B 0
* Get the record Number, to know which record to update/process:
D DB1 DS
D DB1RRN 397 400B 0
D DB2 DS
D DB2RRN 397 400B 0
D DB3 DS
D DB3RRN 397 400B 0
* ..................................................
DRecordDataDS E DS ExtName(GCKF)
D SavedData S Like(RecordDataDs)
D ChangedData S Like(SavedData)
D CheckData S Like(SavedData)
* ..................................................
DRecord4 DS
D GNNAME
D RecNbr
D Data 300
D AR4 S 400 Dim(3000)
* ..................................................
* If file is empty:
C FILESIZE IFLE *ZEROS
C Clear RecNbr
C EXSR AddFixSR
C Else
C Z-ADD 1 RRN 4 0
C Z-ADD 1 RRNA
C If Col#=ColSaved and
C CTL1=CTL1Saved and
C CTL2=CTL2Saved
C Write FMT01
C Else
C Eval ColSaved=Col#
C Eval CTL1Saved=CTL1
C Eval CTL2Saved=CTL2
* Clear subfile & screen, prepare to re-fill or fill:
C Eval *IN90=*OFF
C Clear SFLA
C Write FOOTR
C Write FMT01
* Show Partial note, or not:
C IF CTL1=1
C Eval *IN42=*ON
C Else
C Eval *IN42=*OFF
C End
C Select
C When Col#=1
C Exsr FillSFL1
C
C When Col#=2
C Exsr FillSFL2
C
C When Col#=3
C Exsr FillSFL3
C
C When Col#=4
C Exsr FillSFL4
C EndSL
C EndIf
C
**
C RRNA IFGT 17
C MOVE *ON *IN91
C END
C Z-ADD RRNA NBRREC
C MOVE *ON *IN90
C WRITE FOOTR
C EXFMT FMT01
C Read Footr
C Select
C When *INKC=*ON
C Eval *INLR=*ON
* Was a column heading clicked?
C When CURFLD = 'COL1 ' or
C CURFLD = 'COL2 ' or
C CURFLD = 'COL3 ' or
C CURFLD = 'COL4 '
C Eval *IN31=*OFF
C Eval *IN32=*OFF
C Eval *IN33=*OFF
C Eval *IN34=*OFF
c Select
C When CURFLD = 'COL1 '
C Eval Col# = 1
C Eval *IN31=*ON
C When CURFLD = 'COL2 '
C Eval Col# = 2
C Eval *IN32=*ON
C When CURFLD = 'COL3 '
C Eval Col# = 3
C Eval *IN33=*ON
C When CURFLD = 'COL4 '
C Eval Col# = 4
C Eval *IN34=*ON
C EndSL
* Footer Push button Choices:
* Settings
C When F1=2
C
* Issue key:
C When F1=3
C Exsr IssueSR
* Add Key :
C When F1=4
C Clear RecNbr
C Exsr ADDFIXSR
* Exit
C When F1=5
C Eval *INLR=*ON
C
* If a choice was made, then do the required action:
C When RRNA>*ZEROS
C RRNA CHAIN SFLA 54
C EXSR ADDFIXSR
* Do either the maintain window or the note window:(PushButton 2)
C When PB2=1
C EXSR ADDFIXSR
C When PB2=2
C EXSR ADDFIXSR
C When PB2=3
C EXSR IssueSR
C EndSL
C END
* ________________________________________________________
* Add or Fix a record:
C AddFixSR BegSR
C If RecNbr > *zeros
C RecNbr Chain (N) GCKF
C Movel RecordDataDS Saveddata
C Else
C Clear FMT05
C End
C EXFMT FMT05
* If accepted:
C If NOT *INKC and NOT *INKL
C If RecNbr > *zeros
C Movel RecordDataDS ChangedData
C RecNbr Chain GCKF
C Movel RecordDataDS CheckData
C If CheckData = SavedData
C Movel ChangedData RecordDataDS
C Update(E) RGCKF
C Else
* send a mesage: the record wa changed at another work station
C End
C Else
C Write (E) RGCKF
C End
C End
C ENDSr
* _____________________________________________________________
C IssueSR BegSR
* Get name to use:
C Clear FMT05
C Exsr AddFixSR
C EndSR
* _____________________________________________________
C AddKeySR BegSR
* Get name to use:
C Clear FMT05
C Exsr AddFixSR
C EndSR
* _____________________________________________________
C SettingSR BegSR
C EndSR
* _____________________________________________________
C *INZSR BegSR
C Eval Col# = 2
C Eval *IN32=*ON
C Eval CTL1=1
C Eval CTL2=1
C Eval PB2=2
C EndSR
* ____________________________________________________________
* Write the line(s) in the subfile:
C WriteLineSR BegSR
C Movel GCKNOTE PNNO
* Show Name as pink if "!", or not:
C Eval *IN41=*Off
C If CTL2=1
* If first character of Note is "!" then turn the name pink:
C Movel GCKNOTE Test1 1
C If Test1 = '!'
C Eval *IN41=*On
C End
C Movel GCKNOTE PNNO
* Show Name as pink if "!", or not:
C Eval *IN41=*Off
C If CTL2=1
* If first character of Note is "!" then turn the name pink:
C Movel GCKNOTE Test1 1
C If Test1 = '!'
C Eval *IN41=*On
C End
C End
* Get name(s), if key(s) issued:
C WRITE SFLA
C ADD 1 RRN
C Z-ADD RRN RRNA
C EndSR
* ____________________________________________________________
* Logical on Name:
C FillSFL1 BegSR
* This uses the array filled earlier. "I" is the number of elements.
C SORTA AR4
C 3000 Sub I J 4 0
C J DOUGT 3000
C If AR4(J)>*Blanks
C MOVEL AR4(J) Record4
C MoveL Data RecordDataDS
C EXSR WriteLinesr
C END
C Eval J=J+1
C END
C EndSR
* _________________________________________________________________
* Logical on Key #
C FillSFL2 BegSR
C *LoVal Setll RGCKF1
C READ RGCKF1 58
* prepare an array so that a request for an alph listing will work:
C Move *Blanks AR4
C Z-Add 0 I 4 0
C* Fill the subfile:
C *IN58 DOWEQ *OFF
C Z-Add DB1RRN RecNbr
C EXSR WriteLinesr
* fill array:
C If GNNAME>*Blanks
C Eval I=I+1
C MoveL RecordDataDS Data
C Movel Record4 AR4(I)
C END
C READ RGCKF1 58
C END
C EndSR
* _________________________________________________________________
* Logical on Hook #:
C FillSFL3 BegSR
C *LoVal Setll RGCKF2
C READ RGCKF2 58
C* Fill the subfile:
C *IN58 DOWEQ *OFF
C Z-Add DB2RRN RecNbr
C EXSR WriteLinesr
C READ RGCKF2 58
C END
C EndSR
* _________________________________________________________________
* Logical on Building & door:
C FillSFL4 BegSR
C *Loval Setll RGCKF3
C READ RGCKF3 58
C* Fill the subfile:
C *IN58 DOWEQ *OFF
C Z-Add DB3RRN RecNbr
C EXSR WriteLinesr
C READ RGCKF3 58
C END
C EndSR
* _________________________________________________________________
|
The DDS for the Scroll Bar & Mouse example
A*%%TS SD 20000525 213546 BOOTH REL-V4R4M0 5769-PW1
A*
A*%%EC
A DSPSIZ(27 132 *DS4)
A REF(*LIBL/GCKFL1 RGCKF)
A CHGINPDFT(HI UL)
A ERRSFL
A CF03(03 'Exit')
A CF12(12 'Exit')
A MOUBTN(*ULD ENTER)
A R SFLA SFL
A*%%TS SD 19991213 152103 BOOTH REL-V4R4M0 5769-PW1
A GNNAME R O 6 3
A 41 COLOR(PNK)
A GCKKEY# R O 6 34
A GCKHOOK# R O 6 45
A GCKBLDG R O 6 56
A GCKDOOR# R O 6 77
A RECNBR 5S 0O 6 89
A** PNNO 40A O 6 89
A PNNO 30A O 6 99
A N42 DSPATR(ND)
A GCKNOTE R H
A** RECNBR 5S 0H
A R FMT01 SFLCTL(SFLA)
A*%%TS SD 19991215 110627 BOOTH REL-V4R4M0 5769-PW1
A SFLPAG(0015)
A RTNCSRLOC(&CURREC &CURFLD)
A SFLSIZ(&NBRREC)
A OVERLAY
A SFLCSRRRN(&RRNA)
A 90 SFLDSP
A 90 SFLDSPCTL
A N90 SFLCLR
A 91 SFLEND(*SCRBAR *MORE)
A 1 3DATE
A EDTCDE(Y)
A 2 3TIME
A 1 79' Selection Criteria for this scr-
A een: '
A DSPATR(UL)
A COLOR(BLU)
A 1 34' Key Cabinets'
A COLOR(WHT)
A PB1 2Y 0B 2 80MLTCHCFLD
A CHOICE(1 'Show partial >note')
A CHCCTL(1 &CTL1)
A CHOICE(2 'Show ! as >pink')
A CHCCTL(2 &CTL2)
A CTL1 1Y 0H
A CTL2 1Y 0H
A PB2 2Y 0B 2105SNGCHCFLD
A CHOICE(1 'Maintain Note ')
A CHOICE(2 'Maintain Record')
A CHOICE(3 'Issue Key ')
A COL1 30A B 5 3DFTVAL('Name -
A ')
A DSPATR(UL)
A DSPATR(PR)
A N31 COLOR(BLU)
A 31 COLOR(GRN)
A COL2 10A B 5 34DFTVAL('Key # ')
A DSPATR(UL)
A DSPATR(PR)
A N32 COLOR(BLU)
A 32 COLOR(GRN)
A COL3 10A B 5 45DFTVAL('Hook # ')
A DSPATR(UL)
A DSPATR(PR)
A N33 COLOR(BLU)
A 33 COLOR(GRN)
A COL4 31A B 5 56DFTVAL('Door # ')
A DSPATR(UL)
A DSPATR(PR)
A N34 COLOR(BLU)
A 34 COLOR(GRN)
A 5 88'Comment... (First characters only)-
A '
A COLOR(BLU)
A DSPATR(UL)
A N42 DSPATR(ND)
A RRNA 5S 0H
A NBRREC 5S 0P
A CURREC 10A H
A CURFLD 10A H
A R FOOTR
A*%%TS SD 19991030 132706 BOOTH REL-V4R4M0 5769-PW1
A 24 3' -
A -
A -
A '
A DSPATR(UL)
A COLOR(BLU)
A F1 2Y 0B 26 10PSHBTNFLD
A DSPATR(PC)
A PSHBTNCHC(1 '>Enter' ENTER)
A PSHBTNCHC(2 '>Settings' ENTER)
A PSHBTNCHC(3 '>Add Key' ENTER)
A PSHBTNCHC(4 'E>xit' CF03)
A R FMT02
A*%%TS SD 19991206 112347 BOOTH REL-V4R4M0 5769-PW1
A WINDOW(*DFT 12 45 *NOMSGLIN)
A TEXT('Key Cabinet')
A BLINK
A OVERLAY
A WDWTITLE((*TEXT ' Maintain Key Reco-
A rd '))
A GCKKEY# R B 1 1
A GCKHOOK# R B 2 1CHECK(LC)
A GCKBLDG R B 3 1CHECK(LC)
A GCKDOOR# R B 3 21CHECK(LC)
A GCKNOTE R B 5 1CHECK(LC)
A CNTFLD(043)
A F2 2Y 0B 12 3PSHBTNFLD
A PSHBTNCHC(1 'Cancel' CF12)
A PSHBTNCHC(2 'Accept')
A 1 13'Key Number'
A 2 13'Hook Number'
A** 3 13'Door Number'
A R FMT03
A*%%TS SD 19991101 102059 BOOTH REL-V4R4M0 5769-PW1
A WINDOW(*DFT 8 45 *NOMSGLIN)
A TEXT('Maintain Notes ')
A BLINK
A OVERLAY
A* WDWTITLE((*TEXT ' Sample ') *BOTTOM)
A* WDWTITLE((*TEXT ' Top ') *TOP)
A WDWTITLE((*TEXT ' Maintain Notes '))
A GCKNOTE R B 1 1CNTFLD(043)
A CHECK(LC)
A F3 2Y 0B 8 3PSHBTNFLD
A PSHBTNCHC(1 'Cancel' CF12)
A PSHBTNCHC(2 'Accept')
|
|
|
|
|
|
