d.prg

包括出车记录

SET TALK OFF
SET ECHO OFF
SET STAT OFF
SET SCOR OFF
SET BELL OFF
SET CONF ON
SET COLO TO w/B
CLEAR
DO WHILE .T.
 CLOSE DATA
 DO hk WITH 1,2,23,76
 @ 3,2 SAY "+"+REPL("-",37)+"+"
 SET COLO TO W/B,GR+/R
 @ 2,4 PROM"选择数据库"
 @ 2,16 PROM"选择输出字段"
 @ 2,30 PROM"输入条件"
 @ 2,44 PROM"显   示"
 @ 2,54 PROM"退   出"
 MENU TO xz 
 DO CASE 
    CASE xz=1
       DO stsr
    CASE xz=2
       DO strz
    CASE xz=3 
       DO stsr2
    CASE xz=4
       DO iag440
    CASE xz=5
       RETURN
    ENDCASE
 ENDDO
*************
PROCEDURE hk
*************
PARA line1,col1,col2
IF (col2_col1)/2<>INT((col2_col1)/2)
   col2=col2+1
ENDIF
@ line1,col1 SAY "["+REPLICATE("-",(col2-col1)/2)+"]"
i=line1+1
DO WHILE i<line2
   @ i,col1 SAY "|"+SPACE(col2-col1)+"]"
   i=i+1
ENDDO
@ line2,col1 SAY "["+REPLICATE("-",(col2-col1)/2)+"]"  
RETURN
**************
PROCEDURE stsr
**************
SET BELL OFF
SET STAT OFF
SET SCOR OFF
SET SAFE OFF
SET TALK OFF
SET ECHO OFF
SET CONF ON
RELE jsq
PUBLI jsq
xscolor="w/b,b/w"
SELE 1
USE stwj
ZAP
gs=0
SET COLO TO &xscolor
jxq=0
DO hk WITH 5,10,9,50
SET COLO TO &xscolor
@ 7,12 SAY "数据库名："
@ 8,12 SAY "数据库中文名："
@ 6,12 SAY "请输入查询的数据库个数" GET gs>0.and.gs<9
READ
pp=READKEY()
IF pp=12
   CLOSE DATA
   RETURN
ENDIF
APPE BLAN
sz="V"+STR(gs,1)
REPL v_file WITH sz
j=1
DO WHILE J<=gs
   APPEN BLAN
   j=j+1
ENDDO
! DIR *.dbf>aaa.txt
SELE 2
USE stk
ZAP
APPE FROM aaa.txt SDF
! del aaa.txt
RELE asg,choice
PUBL choice,asg(100)
j=1
DO WHILE j<=gs
  SET COLO TO &xscolor
  @ 7,42 SAY "第"+STR(j,2)+"个"
  @ 7,22 SAY SPACE(12)
  @ 8,22 SAY SPACE(20)
  SELE 2
  DO sthelp2
  bbmc1=SUBS(asg(choice),1,8)
  bbmc2=TRIM(bbmc1)+".dbf"
  IF .NOT. FILE("&bbmc2")
     @ 1,10 SAY ":该表没有打印程序"
     ? CHR(7)+CHR(7)+CHR(7)+CHR(7)
     @ 1,10 SAY SPACE(69)
     LOOP
   ENDIF
   SET COLO TO &xscolor
   @ 7,22 SAY bbmc2
   zwm=SPACE(20)
   @ 8,26 GET zwm
   READ
   SELE 1
   GO j+1
   REPL v_file WITH TRIM(bbmc1),v_note WITH TRIM(zwm)
   j=j+1
ENDDO 
! del A*.dbf
RETURN
*****************
PROCEDURE sthelp2
*****************
gsq=1
DO WHILE gsq<=100
   asg(gsq)=SPACE(12)
   gsq=gsq+1
ENDDO
gsq=1
GO TOP 
SKIP 4
DO WHILE .not.eof()
  asg(gsq)=cxm
  SKIP
  gsq=gsq+1
ENDDO
gsq=gsq-1
DO stwin1 WHTH 4,62,12,12,100
IF choice=0
   bz1=1
ELSE
   bz1=0
ENDIF
RETURN
****************
PROCEDURE stwin1
****************
***********************
window display program
***********************
PARAM windx,windy,viewh,vieww,NUMB
PRIVA i,viewstart,vcurrent,linestart,KEY,lenth
*****************************************
*****view pointer*****
viewstart=1
******line pointer******
linestart=1
******current cursor****
vcurrent=1
SET ESCA OFF
DO WHILE .T.
   SET COLOR TO W/B,W/B,B
   i=0
   DO WHILE i<viewh
      @windx+i+1,windy SAY SUBSTR(asg(viewstart+i),1,vieww)
      @0,0 SAY ""
      i=i+1
   ENDDO
   **************************************
   SET COLOR TO R/BG,W+/B,B
   @windx+vcurrent,windy SAY SUBSTR(asg(viewstart+;
         vcurrent-1),linestart,vieww)
   @0,0 SAY ""
   **************************************
   KEY=0
   DO WHILE KEY <> -1
      KEY = INKEY()
      DO CASE
      CASE KEY=5
         vcurrent=vcurrent-1
         *******move up a line**********
      IF vcurrent<1
         vcurrent=1
         IF viewstart>1
           viewstart=viewstart-1
         ENDIF
       ENDIF
       KEY=-1   
     CASE KEY=24
       vcurrent=vcurrent+1
       ********move down a line********
       IF vcurrent>viewh
          vcurrent=viewh
          IF (viewstart+vjewh)<=NUMB
             viewstart=viewstart+1
          ENDIF
          KEY=-1
     CASE KEY=3
      *******move down viewh lines *****
      IF (viewstart+2*viewh-1)<=NUMB
          viewstart=viewstart+viewh
      ELSE
          viswstart=NUMB-viewh+1
          vcurrent=viewh
      ENDIF
      KEY=-1
     CASE KEY=18
     ********move up viewh lines ********** 
      IF (viewstart-viewh)>=1
         viewstart=viewstart-viewh
      ELSE
         viewstart=1
         vcurrent=1
      ENDIF
      KEY=-1
     CASE KEY=29
      ******move to start line ***************
      viewstart=1
      vcurrent=1
      KEY=-1
     CASE KEY=23
     *******move to end line *******************
      viewstart=NUMB-viewh+1
      vcurrent=viewh
      KEY=-1
     CASE KEY=19
     *******move left a char ***********************
      linestart=linestart-1
      IF linestart<1
         linsetart=1
      ENDIF
      KEY=-1
     CASE KEY=4
     *******move right a char ***************
      linstart=linestart+1
      lenth=LEN(asg(viewstart+vcurrent-1))
      IF linestart>(lenth-vieww+1)
         linsetart=lenth-vieww+1
      ENDIF
      KEY=-1
     CASE KEY=1
     *******move to start of a line ****************
      linestart=1
      KEY=-1
     CASE KEY=6
     ********move to end of a line *********************
      linestart=LEN(asg(viewstart+vcurrent-1))-vieww+1
      KEY=-1
     CASE KEY=13
      choice=viewstart+vcurrent-1
      RETURN
     CASE KEY=27
      choice=0
      RETURN
     ENDCASE
    ENDDO
ENDDO
********************************
PROCEDURE stsr1
********************************     
gsq=1
DO WHILE gsq<=100
  asg(gsq)=SPACE(12)
  gsq=gsq+1
ENDDO
gsq=1
GO TOP 
DO WHIL .not.eof()
  asg(gsq)=field_name
  SKIP
  gsq=gsq+1
ENDDO
gsq=gsq-1
@ 9,52 SAY "输出字段选择"
DO WHILE .T.
  DO stwi1 WITH 10,52,10,10,100
  IF choice=0
     EXIT
  ENDIF