Windows Setup Code for Databases
Windows Setup Code for Databases
* *
* * 29/11/1999 [Link] 16:37:31
* *
* *********************************************************
* *
* * Author's Name
* *
* * Copyright (c) 1999 Company Name
* * Address
* * City, Zip
* *
* * Description:
* * This program was automatically generated by GENSCRN.
* *
* *********************************************************
* *********************************************************
* *
* * bilh/Windows Setup Code - SECTION 1
* *
* *********************************************************
*
close data
on key label f1 do browdata
vtemp = []
#REGION 1
PRIVATE wzfields,wztalk
IF SET("TALK") = "ON"
SET TALK OFF
[Link] = "ON"
ELSE
[Link] = "OFF"
ENDIF
[Link]=SET('FIELDS')
SET FIELDS OFF
IF [Link] = "ON"
SET TALK ON
ENDIF
#REGION 0
REGIONAL [Link], [Link], [Link]
IF SET("TALK") = "ON"
SET TALK OFF
[Link] = "ON"
ELSE
[Link] = "OFF"
ENDIF
[Link] = SET("COMPATIBLE")
SET COMPATIBLE FOXPLUS
[Link] = SET("READBORDER")
SET READBORDER ON
[Link] = SELECT()
* *********************************************************
* *
* * S9851326/Windows Databases, Indexes, Relations
* *
* *********************************************************
*
IF USED("bilh")
SELECT bilh
SET ORDER TO 2
ELSE
SELECT 1
USE [Link] index [Link] alias bilh
set order to 2
ENDIF
* *********************************************************
* *
* * Windows Window definitions
* *
* *********************************************************
*
IF NOT WEXIST("_sai0zmtl6")
DEFINE WINDOW _sai0zmtl6 ;
AT 0.000, 0.000 ;
SIZE 28.538,83.571 ;
TITLE "��Ѻ�ҧ������˹��" ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
NOFLOAT ;
NOCLOSE ;
NOMINIMIZE ;
DOUBLE ;
FILL FILE LOCFILE("[Link]","BMP|ICO|PCT|ICN", ;
"Where is clouds?")
MOVE WINDOW _sai0zmtl6 CENTER
ENDIF
* *********************************************************
* *
* * bilh/Windows Setup Code - SECTION 2
* *
* *********************************************************
*
#REGION 1
IF EMPTY(ALIAS())
WAIT WINDOW C_NOTABLE
RETURN
ENDIF
[Link]= ''
[Link]=SELECT()
[Link]=.F.
[Link]=.F.
m.is2table = .F.
[Link]=SET('DELETE')
SET DELETED ON
[Link]=SYS(2015) &&used if General field
[Link] = 1
[Link]=ON('error')
ON ERROR DO wizerrorhandler
wzoldesc=ON('KEY','ESCAPE')
ON KEY LABEL ESCAPE
m.find_drop = IIF(_DOS,0,2)
[Link]=IIF(ISREAD(),.T.,.F.)
IF [Link]
WAIT WINDOW C_READONLY TIMEOUT 1
ENDIF
GOTO TOP
set order to 2
go bottom
SCATTER MEMVAR MEMO
set order to 2
* *********************************************************
* *
* * bilh/Windows Screen Layout
* *
* *********************************************************
*
#REGION 1
IF WVISIBLE("_sai0zmtl6")
ACTIVATE WINDOW _sai0zmtl6 SAME
ELSE
ACTIVATE WINDOW _sai0zmtl6 NOSHOW
ENDIF
@ 0.462,36.714 SAY "��Ѻ�ҧ���" ;
FONT "MS Sans Serif", 14 ;
STYLE "BT" ;
COLOR RGB(0,0,0,,,,)
@ 0.385,36.714 SAY "��Ѻ�ҧ���" ;
FONT "MS Sans Serif", 14 ;
STYLE "BT" ;
COLOR RGB(255,255,0,,,,)
@ 2.154,0.143 TO 2.154,83.286 ;
PEN 1, 8 ;
STYLE "1" ;
COLOR RGB(0,0,128,0,0,128)
@ 24.231,0.143 TO 24.231,83.286 ;
PEN 1, 8 ;
STYLE "1" ;
COLOR RGB(0,0,128,0,0,128)
@ 2.846,3.571 SAY "�����١���:" ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 2.846,14.000 GET [Link] ;
SIZE 1.000,22.857 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255) valid _chkidven()
@ 4.385,3.714 SAY "���ͼ���Ե:" ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 4.385,14.000 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 6.000,3.714 SAY "�������:" ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 6.000,14.000 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 7.615,14.000 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 9.231,3.714 SAY "���Ѿ��:" ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 9.231,14.000 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 10.846,3.714 SAY "����:" ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 10.846,20.000 GET m.no_in ;
SIZE 1.000,16.571 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 10.692,14.000 SAY "BR" ;
SIZE 1.000,4.571 ;
FONT "MS Sans Serif", 10 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 10.846,41.857 SAY "�ѹ���:" ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 10.846,52.286 GET [Link] ;
SIZE 1.000,22.714 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K 99/99/9999" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 12.538,33.000 SAY "�ѹ���Ѵ���Թ:" ;
SIZE 1.000,16.571 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 12.538,52.286 GET [Link] ;
SIZE 1.000,22.714 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K 99/99/9999" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 15.077,34.571 GET [Link] ;
PICTURE "@*HN \!��������´" ;
SIZE 1.769,14.000,0.571 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" valid _chkvdesc()
@ 17.846,34.571 SAY "��������:" ;
SIZE 1.000,14.857 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 17.846,51.714 GET [Link] ;
SIZE 1.000,13.000 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K 9,999,999.99" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 20.154,3.571 SAY "��ͤ ���:"
����ͤ ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 20.154,13.857 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 21.846,3.571 SAY "�����˵�:" ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 21.846,13.857 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 25.154,1.714 GET m.top_btn ;
PICTURE "@*HN \<��" ;
SIZE 1.769,7.857,0.714 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
VALID btn_val('TOP') ;
MESSAGE 'Go to first record.'
@ 25.154,9.714 GET m.prev_btn ;
PICTURE "@*HN \<�����ѧ" ;
SIZE 1.769,7.857,0.714 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
VALID btn_val('PREV') ;
MESSAGE 'Go to previous record.'
@ 25.154,17.714 GET m.next_btn ;
PICTURE "@*HN \<�˹��" ;
SIZE 1.769,7.857,0.714 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
VALID btn_val('NEXT') ;
MESSAGE 'Go to next record.'
@ 25.154,25.714 GET m.end_btn ;
PICTURE "@*HN \<��ҧ" ;
SIZE 1.769,7.857,0.714 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
VALID btn_val('END') ;
MESSAGE 'Go to last record.'
@ 25.154,33.714 GET m.loc_btn ;
PICTURE "@*HN \<����" ;
SIZE 1.769,7.857,0.714 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
VALID btn_val('LOCATE') ;
MESSAGE 'Locate a record.'
@ 25.154,41.714 GET m.add_btn ;
PICTURE "@*HN \<����" ;
SIZE 1.769,7.857,0.714 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
VALID btn_val('ADD') ;
MESSAGE 'Add a new record.'
@ 25.154,49.714 GET m.edit_btn ;
PICTURE "@*HN �\<���" ;
SIZE 1.769,7.857,0.714 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
VALID btn_val('EDIT') ;
MESSAGE 'Edit current record.'
@ 25.154,57.714 GET m.del_btn ;
PICTURE "@*HN \<ź" ;
SIZE 1.769,7.857,0.714 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
VALID btn_val('DELETE') ;
MESSAGE 'Delete current record.'
@ 25.154,65.714 GET m.prnt_btn ;
PICTURE "@*HN \<����" ;
SIZE 1.769,7.857,0.714 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
VALID btn_val('PRINT') ;
MESSAGE 'Print report.'
@ 25.154,73.714 GET m.exit_btn ;
PICTURE "@*HN \<��" ;
SIZE 1.769,7.857,0.714 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
VALID btn_val('EXIT') ;
MESSAGE 'Close screen.'
IF NOT WVISIBLE("_sai0zmtl6")
ACTIVATE WINDOW _sai0zmtl6
ENDIF
* *********************************************************
* *
* * WindowsREAD contains clauses from SCREEN s9851326
* *
* *********************************************************
*
READ CYCLE ;
ACTIVATE READACT() ;
DEACTIVATE READDEAC() ;
NOLOCK
on key label f1
close data
if file(vtemp)
erase &vtemp
endif
* *********************************************************
* *
* * Windows Closing Databases
* *
* *********************************************************
*
IF USED("bilh")
SELECT bilh
USE
ENDIF
SELECT ([Link])
#REGION 0
IF [Link] = "ON"
SET TALK ON
ENDIF
IF [Link] = "ON"
SET COMPATIBLE ON
ENDIF
* *********************************************************
* *
* * bilh/Windows Cleanup Code
* *
* *********************************************************
*
#REGION 1
SET DELETED &wzolddelete
SET FIELDS &wzfields
ON ERROR &wzolderror
ON KEY LABEL ESCAPE &wzoldesc
DO CASE
CASE _DOS AND SET('DISPLAY')='VGA25'
@24,0 CLEAR TO 24,79
CASE _DOS AND SET('DISPLAY')='VGA50'
@49,0 CLEAR TO 49,79
CASE _DOS
@24,0 CLEAR TO 24,79
ENDCASE
****Procedures****
* *********************************************************
* *
* * bilh/Windows Supporting Procedures and Functions
* *
* *********************************************************
*
#REGION 1
PROCEDURE readdeac
IF isediting
ACTIVATE WINDOW '_sai0zmtl6'
WAIT WINDOW C_EDITS NOWAIT
ENDIF
IF !WVISIBLE(WOUTPUT())
CLEAR READ
RETURN .T.
ENDIF
RETURN .F.
PROCEDURE readact
IF !isediting
SELECT ([Link])
SHOW GETS
ENDIF
DO REFRESH
RETURN
PROCEDURE wizerrorhandler
* This very simple error handler is primarily intended
* to trap for General field OLE errors which may occur
* during editing from the MODIFY GENERAL window.
WAIT WINDOW message()
RETURN
PROCEDURE printrec
PRIVATE sOldError,wizfname,saverec,savearea,tmpcurs,tmpstr
PRIVATE prnt_btn,p_recs,p_output,pr_out,pr_record
STORE 1 TO p_recs,p_output
STORE 0 TO prnt_btn
STORE RECNO() TO saverec
[Link]=ON('error')
DO pdialog
IF m.prnt_btn = 2
RETURN
ENDIF
IF !FILE(ALIAS()+'.FRX')
[Link]=SYS(2004)+'WIZARDS\'+'[Link]'
IF !FILE([Link])
ON ERROR *
[Link]=LOCFILE('[Link]','APP',C_LOCWIZ)
ON ERROR &sOldError
IF !'[Link]'$UPPER([Link])
WAIT WINDOW C_NOWIZ
RETURN
ENDIF
ENDIF
WAIT WINDOW C_MAKEREPO NOWAIT
[Link]=SELECT()
[Link]='_'+LEFT(SYS(3),7)
CREATE CURSOR ([Link]) (comment m)
[Link] = '* LAYOUT = COLUMNAR'+CHR(13)+CHR(10)
INSERT INTO ([Link]) VALUES([Link])
SELECT ([Link])
DO ([Link]) WITH '','WZ_QREPO','NOSCRN/CREATE',ALIAS(),[Link]
USE IN ([Link])
WAIT CLEAR
IF !FILE(ALIAS()+'.FRX') &&wizard could not create report
WAIT WINDOW C_NOREPO
RETURN
ENDIF
ENDIF
PROCEDURE BTN_VAL
PARAMETER [Link]
DO CASE
CASE [Link]='TOP'
GO TOP
WAIT WINDOW C_TOPFILE NOWAIT
CASE [Link]='PREV'
IF !BOF()
SKIP -1
ENDIF
IF BOF()
WAIT WINDOW C_TOPFILE NOWAIT
GO TOP
ENDIF
CASE [Link]='NEXT'
IF !EOF()
SKIP 1
ENDIF
IF EOF()
WAIT WINDOW C_ENDFILE NOWAIT
GO BOTTOM
ENDIF
CASE [Link]='END'
GO BOTTOM
WAIT WINDOW C_ENDFILE NOWAIT
CASE [Link]='LOCATE'
DO loc_dlog
CASE [Link]='ADD' AND !isediting &&add record
select 20
use [Link]
locate for alltrim(login) = alltrim(xloginname) .and.
alltrim(upper(menu)) = alltrim(upper(mprompt))
if .not. found()
wait window '���حҵ�����ҹ'
use
select 1
return
else
if (.not. read) .or. (.not. write)
wait window '���حҵ�����ҹ'
use
select 1
return
endif
endif
use
select 1
isediting=.T.
isadding=.T.
=edithand('ADD')
_curobj=1
DO refresh
SHOW GETS
show get m.no_in disable
RETURN
CASE [Link]='EDIT' AND !isediting &&edit record
select 20
use [Link]
locate for alltrim(login) = alltrim(xloginname) .and.
alltrim(upper(menu)) = alltrim(upper(mprompt))
if .not. found()
wait window '���حҵ�����ҹ'
use
select 1
return
else
if (.not. read) .or. (.not. write)
wait window '���حҵ�����ҹ'
use
select 1
return
endif
endif
use
select 1
IF EOF() OR BOF()
WAIT WINDOW C_ENDFILE NOWAIT
RETURN
ENDIF
IF RLOCK()
isediting=.T.
_curobj=1
DO refresh
show get [Link] disable
show get m.no_in disable
show get [Link] disable
RETURN
ELSE
WAIT WINDOW C_NOLOCK
ENDIF
CASE [Link]='EDIT' AND isediting &&save record
IF isadding
=edithand('SAVE')
ELSE
GATHER MEMVAR MEMO
do _writedata
ENDIF
UNLOCK
isediting=.F.
isadding=.F.
DO refresh
CASE [Link]='DELETE' AND isediting &&cancel record
IF isadding
=edithand('CANCEL')
ENDIF
isediting=.F.
isadding=.F.
UNLOCK
WAIT WINDOW C_ECANCEL NOWAIT
DO refresh
CASE [Link]='DELETE'
select 20
use [Link]
locate for alltrim(login) = alltrim(xloginname) .and.
alltrim(upper(menu)) = alltrim(upper(mprompt))
if .not. found()
wait window '���حҵ�����ҹ'
use
select 1
return
else
if (.not. deleted)
wait window '���حҵ�����ҹ'
use
select 1
return
endif
endif
use
select 1
IF EOF() OR BOF()
WAIT WINDOW C_ENDFILE NOWAIT
RETURN
ENDIF
IF fox_alert(C_DELREC)
select 1
if lock()
select 2
use [Link] index [Link] alias ind
set order to 1
do while .t.
select 2
seek
[Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in
if found()
vxzz = alltrim(inv_no)
do case
case alltrim(flag) = [*] && INV
select 20
use [Link] index [Link]
set order to 2
seek alltrim(vxzz)
if found() .and. lock()
replace billok with .f.
unlock
endif
use
case alltrim(flag) = [**] && cre
select 20
use [Link] index [Link]
set order to 2
seek alltrim(vxzz)
if found() .and. lock()
replace billok with .f.
unlock
endif
use
case alltrim(flag) = [***] && deb
select 20
use [Link] index [Link]
set order to 2
seek alltrim(vxzz)
if found() .and. lock()
replace billok with .f.
unlock
endif
use
endcase
select 2
delete record recno()
else
exit
endif
enddo
select 2
use
select 1
delete record recno()
unlock
endif
select 1
IF !EOF() AND DELETED()
SKIP 1
ENDIF
IF EOF()
WAIT WINDOW C_ENDFILE NOWAIT
GO BOTTOM
ENDIF
ENDIF
CASE [Link]='PRINT'
*:DO printrec
do printdata
RETURN
CASE [Link]='EXIT'
[Link]=.T. &&this is needed if used with FoxApp
CLEAR READ
RETURN
ENDCASE
SCATTER MEMVAR MEMO
SHOW GETS
RETURN
PROCEDURE REFRESH
DO CASE
CASE [Link] AND RECCOUNT()=0
SHOW GETS DISABLE
SHOW GET exit_btn ENABLE
CASE [Link]
SHOW GET add_btn DISABLE
SHOW GET del_btn DISABLE
SHOW GET edit_btn DISABLE
CASE (RECCOUNT()=0 OR EOF()) AND ![Link]
SHOW GETS DISABLE
SHOW GET add_btn ENABLE
SHOW GET exit_btn ENABLE
CASE [Link]
SHOW GET find_drop DISABLE
SHOW GET top_btn DISABLE
SHOW GET prev_btn DISABLE
SHOW GET loc_btn DISABLE
SHOW GET next_btn DISABLE
SHOW GET end_btn DISABLE
SHOW GET add_btn DISABLE
SHOW GET prnt_btn DISABLE
SHOW GET exit_btn DISABLE
SHOW GET edit_btn,1 PROMPT "\<�ѹ�֡"
SHOW GET del_btn,1 PROMPT "\<¡��ԡ"
ON KEY LABEL ESCAPE DO BTN_VAL WITH 'DELETE'
RETURN
OTHERWISE
SHOW GET edit_btn,1 PROMPT "�\<���"
SHOW GET del_btn,1 PROMPT "\<ź"
SHOW GETS ENABLE
ENDCASE
IF m.is2table
SHOW GET add_btn DISABLE
ENDIF
ON KEY LABEL ESCAPE
RETURN
PROCEDURE edithand
PARAMETER [Link]
* procedure handles edits
DO CASE
CASE [Link] = 'ADD'
SCATTER MEMVAR MEMO BLANK
[Link] = left(dtoc(date()),6)+alltrim(str(val(right(dtoc(date()),4))
+543))
select 2
use [Link]
go top
m.no_in = right([0000000000]+alltrim(str(val(no_in)+1)),10)
use
select 1
CASE [Link] = 'SAVE'
select 2
use [Link]
go top
do while .t.
if flock()
select 2
m.no_in = right([0000000000]+alltrim(str(val(no_in)+1)),10)
replace no_in with m.no_in
select 1
INSERT INTO (ALIAS()) FROM MEMVAR
do _writedata
unlock
exit
endif
enddo
select 2
use
select 1
CASE [Link] = 'CANCEL'
* nothing here
ENDCASE
RETURN
PROCEDURE fox_alert
PARAMETER wzalrtmess
PRIVATE alrtbtn
[Link]=2
DEFINE WINDOW _qec1ij2t7 AT 0,0 SIZE 8,50 ;
FONT "MS Sans Serif",10 STYLE 'B' ;
FLOAT NOCLOSE NOMINIMIZE DOUBLE TITLE '����/ź' &&WTITLE()
MOVE WINDOW _qec1ij2t7 CENTER
ACTIVATE WINDOW _qec1ij2t7 NOSHOW
@ 2,(50-txtwidth(wzalrtmess))/2 SAY wzalrtmess;
FONT "MS Sans Serif", 10 STYLE "B"
@ 6,18 GET [Link] ;
PICTURE "@*HT \<OK;\?\!\<Cancel" ;
SIZE 1.769,8.667,1.333 ;
FONT "MS Sans Serif", 8 STYLE "B"
ACTIVATE WINDOW _qec1ij2t7
READ CYCLE MODAL
RELEASE WINDOW _qec1ij2t7
RETURN [Link]=1
PROCEDURE pdialog
DEFINE WINDOW _qjn12zbvh ;
AT 0.000, 0.000 ;
SIZE 13.231,54.800 ;
TITLE "Microsoft FoxPro" ;
FONT "MS Sans Serif", 8 ;
FLOAT NOCLOSE MINIMIZE SYSTEM
MOVE WINDOW _qjn12zbvh CENTER
ACTIVATE WINDOW _qjn12zbvh NOSHOW
@ 2.846,33.600 SAY "Output:" ;
FONT "MS Sans Serif", 8 ;
STYLE "BT"
@ 2.846,4.800 SAY "Print:" ;
FONT "MS Sans Serif", 8 ;
STYLE "BT"
@ 4.692,7.200 GET m.p_recs ;
PICTURE "@*RVN \<Current Record;\<All Records" ;
SIZE 1.308,18.500,0.308 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT"
@ 4.692,36.000 GET m.p_output ;
PICTURE "@*RVN \<Printer;Pre\<view" ;
SIZE 1.308,12.000,0.308 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT"
@ 10.154,16.600 GET m.prnt_btn ;
PICTURE "@*HT P\<rint;Ca\<ncel" ;
SIZE 1.769,8.667,0.667 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B"
ACTIVATE WINDOW _qjn12zbvh
READ CYCLE MODAL
RELEASE WINDOW _qjn12zbvh
RETURN
PROCEDURE loc_dlog
PRIVATE gfields,i
DEFINE WINDOW wzlocate FROM 1,1 TO 20,40;
SYSTEM GROW CLOSE ZOOM FLOAT FONT "MS Sans Serif",8
MOVE WINDOW wzlocate CENTER
[Link]=SET('FIELDS',2)
IF !EMPTY(RELATION(1))
SET FIELDS ON
IF [Link] # 'GLOBAL'
SET FIELDS GLOBAL
ENDIF
IF EMPTY(FLDLIST())
m.i=1
DO WHILE !EMPTY(OBJVAR(m.i))
IF ATC('M.',OBJVAR(m.i))=0
SET FIELDS TO (OBJVAR(m.i))
ENDIF
m.i = m.i + 1
ENDDO
ENDIF
ENDIF
on key label f2 do _findidven
select 1
xsaverec = recno()
set order to 2
on key label escape
on key label enter keyboard chr(27)
vkhonline = []
DO [Link] WITH [FIELD(2)]
BROWSE WINDOW wzlocate NOEDIT NODELETE ;
NOMENU field cancel :h = '¡��ԡ' , ;
date :h = '�ѹ���', no_in :h = '�Ţ���' ,idvender :h = '����' , name :h =
'����' TITLE '���� , F2 = ������' &&C_BRTITLE
do [Link]
on key label enter
set order to 2
on key label f2
SET FIELDS &gfields
SET FIELDS OFF
RELEASE WINDOW wzlocate
RETURN
procedure _findidven
on key label f2
do [Link]
vkhonline = []
DO [Link] WITH [FIELD(5)]
on key label f2 do _findidven
select 1
set order to 1
go top
return
procedure _chkidven
on error
select 2
use [Link] index [Link]
set order to 1
seek [Link]
if found() .and. len(alltrim([Link])) <> 0
[Link] = idvender
[Link] = vender
[Link] = adda
[Link] = addb
[Link] = tel
else
select 2
if len(alltrim([Link])) = 1
locate for upper(alpha) = upper(alltrim([Link]))
else
locate for upper(left(alltrim(vender),len([Link]))) =
upper(alltrim([Link]))
endif
if found()
if len(alltrim([Link])) = 1
set filter to upper(alpha) = upper(alltrim([Link]))
else
set filter to upper(left(alltrim(vender),len([Link]))) =
upper(alltrim([Link]))
endif
go top
on key label escape
on key label enter keyboard chr(27)
brow field idvender :h = '���ʼ���Ե' , alpha :h = '�ѡ��' , vender :h =
'���ͼ���Ե' noapp nomenu nomodi
on key label enter
[Link] = idvender
[Link] = vender
[Link] = adda
[Link] = addb
[Link] = tel
else
[Link] = space(len([Link]))
[Link] = space(len([Link]))
[Link] = space(len([Link] ))
[Link] = space(len([Link]))
[Link] = space(len([Link]))
_curobj = 1
endif
endif
select 2
use
if len(alltrim([Link])) <> 0
show get [Link] disable
show get [Link] disable
show get [Link] disable
show get [Link] disable
endif
@ 2.846,14.000 GET [Link] ;
SIZE 1.000,22.857 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXX" ;
valid _chkidven() ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 4.385,3.714 SAY "���ͼ���Ե:" ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 4.385,14.000 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 6.000,3.714 SAY "�������:" ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 6.000,14.000 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 7.615,14.000 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 9.231,3.714 SAY "���Ѿ��:" ;
SIZE 1.000,7.714 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT" ;
PICTURE "@J" ;
COLOR RGB(0,0,128,255,255,255)
@ 9.231,14.000 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
clear gets
select 1
return
procedure browdata
on key label f1
do case
case _curobj = 1
select 2
use [Link] index [Link]
set order to 1
go top
on key label escape
on key label enter keyboard chr(27)
vkhonline = []
DO [Link] WITH [FIELD(1)]
brow field idvender :h = '���ʼ���Ե' , vender :h = '���ͼ���Ե' noapp nomenu
nomodi
on key label enter
do [Link]
[Link] = idvender
select 2
use
endcase
on key label f1 do browdata
select 1
return
procedure _chkvdesc
if .not. isediting
return
endif
on error
if .not. file(vtemp)
select 2
use [Link] index [Link] alias ind
set order to 1
do while .t.
select 2
if flock()
vtemp = [$]+left(sys(3),7)+[.dbf]
if .not. file(vtemp)
copy to &vtemp struc
unlock
exit
endif
endif
enddo
select 3
use &vtemp exclusive alias temp
else
select 2
use [Link] index [Link] alias ind
set order to 1
select 3
use &vtemp exclusive alias temp
zap
pack
endif
*:
if isediting
select 2
seek [Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in
do while .not. eof()
if [Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in <>
idvender+right(date,4)+substr(date,4,2)+left(date,2)+no_in
exit
endif
scatter memvar memo
if len(alltrim(inv_no)) <> 0
select 3
append blank
gather memvar
endif
select 2
skip
enddo
endif
select 3
go top
if reccount() < 20
vxxcnt = reccount() + 1
do while vxxcnt <= 20
select 3
append blank
replace num with right([0]+alltrim(str(vxxcnt)),2)
vxxcnt = vxxcnt + 1
enddo
endif
select 2
use
select 3
use
*:
vxxidvender = [Link]
vxxdate = [Link]
vxxno = m.no_in
do [Link]
[Link] = vxxidvender
[Link] = vxxdate
m.no_in = vxxno
*:
select 2
use [Link] index [Link] alias ind
set order to 1
select 3
use &vtemp exclusive alias temp
delete all for len(alltrim(inv_no)) = 0
pack
go top
[Link] = 0
do while .not. eof()
select 3
vxxcnt = recno()
replace num with right([0]+alltrim(str(recno())),2)
[Link] = [Link] + netamt
select 3
skip
enddo
do [Link] with [Link],[Link]
*:
@ 17.846,51.714 GET [Link] ;
SIZE 1.000,13.000 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K 9,999,999.99" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
@ 20.154,13.857 GET [Link] ;
SIZE 1.000,61.143 ;
DEFAULT " " ;
FONT "MS Sans Serif", 8 ;
STYLE "B" ;
PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
WHEN isediting ;
COLOR ,RGB(255,255,0,0,0,255)
clear gets
*:
select 2
use
select 3
use
select 1
return
procedure _writedata
on error
if .not. file(vtemp)
select 2
use [Link] index [Link] alias ind
set order to 1
do while .t.
select 2
if flock()
vtemp = [$]+left(sys(3),7)+[.dbf]
if .not. file(vtemp)
copy to &vtemp struc
unlock
exit
endif
endif
enddo
select 3
use &vtemp exclusive alias temp
select 2
seek [Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in
do while .not. eof()
if [Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in <>
idvender+right(date,4)+substr(date,4,2)+left(date,2)+no_in
exit
endif
scatter memvar memo
if len(alltrim(inv_no)) <> 0
select 3
append blank
gather memvar
endif
select 2
skip
enddo
else
select 2
use [Link] index [Link] alias ind
set order to 1
select 3
use &vtemp exclusive alias temp
if reccount() = 0
select 2
seek [Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in
do while .not. eof()
if [Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in <>
idvender+right(date,4)+substr(date,4,2)+left(date,2)+no_in
exit
endif
scatter memvar memo
if len(alltrim(inv_no)) <> 0
select 3
append blank
gather memvar
endif
select 2
skip
enddo
endif
endif
select 2
do while .t.
select 2
seek [Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in
if .not. found()
exit
else
if
len(alltrim([Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in))
= 0
exit
endif
endif
*:
vxzz = alltrim(inv_no)
do case
case alltrim(flag) = [*] && INV
select 20
use [Link] index [Link]
set order to 2
seek alltrim(vxzz)
if found() .and. lock()
replace billok with .f.
unlock
endif
use
case alltrim(flag) = [**] && cre
select 20
use [Link] index [Link]
set order to 2
seek alltrim(vxzz)
if found() .and. lock()
replace billok with .f.
unlock
endif
use
case alltrim(flag) = [***] && deb
select 20
use [Link] index [Link]
set order to 2
seek alltrim(vxzz)
if found() .and. lock()
replace billok with .f.
unlock
endif
use
endcase
*:
select 2
blank
enddo
select 3
go top
do while .not. eof()
replace no_in with m.no_in
replace date with [Link]
replace idvender with [Link]
if len(alltrim(Inv_no)) <> 0 .and. len(alltrim(idvender+no)) <> 0
scatter memvar memo
select 2
seek [ ]
if found()
if lock()
gather memvar
endif
else
select 2
do while .t.
if flock()
append blank
gather memvar
unlock
exit
endif
enddo
endif
endif
do case
case alltrim(flag) = [*] && INV
select 20
use [Link] index [Link]
set order to 2
seek alltrim(temp->inv_no)
if found() .and. lock()
replace billok with .t.
unlock
endif
use
case alltrim(flag) = [**] && cre
select 20
use [Link] index [Link]
set order to 2
seek alltrim(temp->inv_no)
if found() .and. lock()
replace billok with .t.
unlock
endif
use
case alltrim(flag) = [***] && deb
select 20
use [Link] index [Link]
set order to 2
seek alltrim(temp->inv_no)
if found() .and. lock()
replace billok with .t.
unlock
endif
use
endcase
select 3
skip
enddo
select 2
use
select 3
zap
pack
use
select 1
return
procedure printdata
vzztemp = []
select 2
use [Link]
go top
vxxcomid = idcom
vxxcomna = name
use
select 2
use [Link] index [Link] alias ind
set order to 1
do while .t.
select 2
if flock()
vzztemp = [$]+left(sys(3),7)+[.dbf]
if .not. file(vzztemp)
copy to &vzztemp struc
unlock
exit
endif
endif
enddo
select 3
use &vzztemp exclusive alias zztemp
*:
select 2
seek [Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in
do while .not. eof()
if [Link]+right([Link],4)+substr([Link],4,2)+left([Link],2)+m.no_in <> ;
idvender+right(date,4)+substr(date,4,2)+left(date,2)+no_in
exit
endif
scatter memvar memo
select 3
append blank
gather memvar
select 2
skip
enddo
select 3
go top
if reccount() < 20
vxxcnt = reccount() + 1
do while vxxcnt <= 20
select 3
append blank
replace num with right([0]+alltrim(str(vxxcnt)),2)
vxxcnt = vxxcnt + 1
enddo
endif
select 2
use
select 3
use
select 3
use &vzztemp exclusive alias zztemp
go top
do [Link]
select 3
use
if file(vzztemp)
erase &vzztemp
endif
select 1
return