CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE APP
Moderator: Rathinagiri
-
- Posts: 21
- Joined: Fri Aug 30, 2013 5:38 am
CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE APP
I am clipper programmer. I converted 2-3 applicaton to HARBOUR. Which are running perfectly. But in HARBOUR it prints only to LPT1-4. It does not print on USB port printer EPSON LX-300+. Now I want to give print out on USB port printer. Can I give print on USB port printer and also on LASER printer HP Laerject 1020 plus.
In this regard I started to build a small application to HMG 3.0.22. I make a folder SLIP in c:\hmg.3.0.22 and started to build by following command and found following error
C:\HMG.3.0.22\SLIP>BUILD /CS SLIP.HBP
error:'
'redir' is not recognised as an internal or external command, operable program or batch file
I think that it was path problem So for testing I copy all prg & hbp file in C:\HMG.3.0.22 folder and started to build and found following error
C:\HMG.3.0.22\SLIP\BUILD /CS SLIP.HBP
error:
hbmk2: Processing configuration: C:\hmg.3.0.22\harbour\bin\hbmk.cfg
Harbour 2.0.0 (Rev. 13372)
Copyright (c) 1999-2010, http://www.harbour-project.org/" onclick="window.open(this.href);return false;" onclick="window.open(this.href);return false;
Cannot open STBOX.prg, assumed external
Cannot open YESNO.prg, assumed external
Cannot open SMSG.prg, assumed external
Cannot open MSG.prg, assumed external
Cannot open IND.prg, assumed external
Cannot open PRNTEST.prg, assumed external
Cannot open REPHEAD.prg, assumed external
Cannot open STBOX.prg, assumed external
Cannot open YESNO.prg, assumed external
Cannot open IND.prg, assumed external
Cannot open MSG.prg, assumed external
Cannot open SMSG.prg, assumed external
Cannot open PRNTEST.prg, assumed external
Cannot open REPHEAD.prg, assumed external
Cannot open STBOX.prg, assumed external
Cannot open IND.prg, assumed external
Cannot open SMSG.prg, assumed external
Cannot open YESNO.prg, assumed external
Cannot open STBOX.prg, assumed external
Cannot open YESNO.prg, assumed external
Cannot open MSG.prg, assumed external
Cannot open STBOX.prg, assumed external
Cannot open SMSG.prg, assumed external
Cannot open PRNTEST.prg, assumed external
Cannot open MSG.prg, assumed external
Cannot open REPHEAD.prg, assumed external
Cannot open STBOX.prg, assumed external
Cannot open YESNO.prg, assumed external
Cannot open SMSG.prg, assumed external
Cannot open COMPRPL.prg, assumed external
Cannot open INST.prg, assumed external
Cannot open MSG.prg, assumed external
Cannot open IND.prg, assumed external
Cannot open ITEMHELP.prg, assumed external
Cannot open CITYHELP.prg, assumed external
Cannot open ACHELP.prg, assumed external
Cannot open STBOX.prg, assumed external
main1.o:main1.c:(.text+0x0): multiple definition of `HB_FUN_REPORTPRN'
slip.o:slip.c:(.text+0x0): first defined here
main1.o:main1.c:(.text+0x20): multiple definition of `HB_FUN_REPORT1'
slip.o:slip.c:(.text+0x20): first defined here
main1.o:main1.c:(.text+0x40): multiple definition of `HB_FUN_REPORT'
slip.o:slip.c:(.text+0x40): first defined here
main1.o:main1.c:(.text+0x60): multiple definition of `HB_FUN_VOUBL'
slip.o:slip.c:(.text+0x60): first defined here
main1.o:main1.c:(.text+0x80): multiple definition of `HB_FUN_VOUSTR'
slip.o:slip.c:(.text+0x80): first defined here
main1.o:main1.c:(.text+0xa0): multiple definition of `HB_FUN_VOURPL'
slip.o:slip.c:(.text+0xa0): first defined here
main1.o:main1.c:(.text+0xc0): multiple definition of `HB_FUN_IAMTCALC'
slip.o:slip.c:(.text+0xc0): first defined here
main1.o:main1.c:(.text+0xe0): multiple definition of `HB_FUN_VIRATE'
slip.o:slip.c:(.text+0xe0): first defined here
main1.o:main1.c:(.text+0x100): multiple definition of `HB_FUN_VINUG'
slip.o:slip.c:(.text+0x100): first defined here
main1.o:main1.c:(.text+0x120): multiple definition of `HB_FUN_VOUGET'
slip.o:slip.c:(.text+0x120): first defined here
main1.o:main1.c:(.text+0x140): multiple definition of `HB_FUN_VOUDL'
slip.o:slip.c:(.text+0x140): first defined here
main1.o:main1.c:(.text+0x160): multiple definition of `HB_FUN_VOUAM'
slip.o:slip.c:(.text+0x160): first defined here
main1.o:main1.c:(.text+0x180): multiple definition of `HB_FUN_VOUAMD'
slip.o:slip.c:(.text+0x180): first defined here
main1.o:main1.c:(.text+0x1a0): multiple definition of `HB_FUN_VOUMAS'
slip.o:slip.c:(.text+0x1a0): first defined here
main1.o:main1.c:(.text+0x1c0): multiple definition of `HB_FUN_ACCRPL'
slip.o:slip.c:(.text+0x1c0): first defined here
main1.o:main1.c:(.text+0x1e0): multiple definition of `HB_FUN_VLNAME'
slip.o:slip.c:(.text+0x1e0): first defined here
main1.o:main1.c:(.text+0x200): multiple definition of `HB_FUN_CHCKACN'
slip.o:slip.c:(.text+0x200): first defined here
main1.o:main1.c:(.text+0x220): multiple definition of `HB_FUN_ACCDL'
slip.o:slip.c:(.text+0x220): first defined here
main1.o:main1.c:(.text+0x240): multiple definition of `HB_FUN_ACCAM'
slip.o:slip.c:(.text+0x240): first defined here
main1.o:main1.c:(.text+0x260): multiple definition of `HB_FUN_ACCAMD'
slip.o:slip.c:(.text+0x260): first defined here
main1.o:main1.c:(.text+0x280): multiple definition of `HB_FUN_ACCMAS'
slip.o:slip.c:(.text+0x280): first defined here
main1.o:main1.c:(.text+0x2a0): multiple definition of `HB_FUN_UPDDBF'
slip.o:slip.c:(.text+0x2a0): first defined here
main1.o:main1.c:(.text+0x2c0): multiple definition of `HB_FUN_MAIN1'
slip.o:slip.c:(.text+0x2c0): first defined here
accmas.o:accmas.c:(.text+0x0): multiple definition of `HB_FUN_ACCRPL'
slip.o:slip.c:(.text+0x1c0): first defined here
accmas.o:accmas.c:(.text+0x20): multiple definition of `HB_FUN_VLNAME'
slip.o:slip.c:(.text+0x1e0): first defined here
accmas.o:accmas.c:(.text+0x40): multiple definition of `HB_FUN_CHCKACN'
slip.o:slip.c:(.text+0x200): first defined here
accmas.o:accmas.c:(.text+0x60): multiple definition of `HB_FUN_ACCDL'
slip.o:slip.c:(.text+0x220): first defined here
accmas.o:accmas.c:(.text+0x80): multiple definition of `HB_FUN_ACCAM'
slip.o:slip.c:(.text+0x240): first defined here
accmas.o:accmas.c:(.text+0xa0): multiple definition of `HB_FUN_ACCAMD'
slip.o:slip.c:(.text+0x260): first defined here
accmas.o:accmas.c:(.text+0xc0): multiple definition of `HB_FUN_ACCMAS'
slip.o:slip.c:(.text+0x280): first defined here
voumas.o:voumas.c:(.text+0x0): multiple definition of `HB_FUN_VOUBL'
slip.o:slip.c:(.text+0x60): first defined here
voumas.o:voumas.c:(.text+0x20): multiple definition of `HB_FUN_VOUSTR'
slip.o:slip.c:(.text+0x80): first defined here
voumas.o:voumas.c:(.text+0x40): multiple definition of `HB_FUN_VOURPL'
slip.o:slip.c:(.text+0xa0): first defined here
voumas.o:voumas.c:(.text+0x60): multiple definition of `HB_FUN_IAMTCALC'
slip.o:slip.c:(.text+0xc0): first defined here
voumas.o:voumas.c:(.text+0x80): multiple definition of `HB_FUN_VIRATE'
slip.o:slip.c:(.text+0xe0): first defined here
voumas.o:voumas.c:(.text+0xa0): multiple definition of `HB_FUN_VINUG'
slip.o:slip.c:(.text+0x100): first defined here
voumas.o:voumas.c:(.text+0xc0): multiple definition of `HB_FUN_VOUGET'
slip.o:slip.c:(.text+0x120): first defined here
voumas.o:voumas.c:(.text+0xe0): multiple definition of `HB_FUN_VOUDL'
slip.o:slip.c:(.text+0x140): first defined here
voumas.o:voumas.c:(.text+0x100): multiple definition of `HB_FUN_VOUAM'
slip.o:slip.c:(.text+0x160): first defined here
voumas.o:voumas.c:(.text+0x120): multiple definition of `HB_FUN_VOUAMD'
slip.o:slip.c:(.text+0x180): first defined here
voumas.o:voumas.c:(.text+0x140): multiple definition of `HB_FUN_VOUMAS'
slip.o:slip.c:(.text+0x1a0): first defined here
report.o:report.c:(.text+0x0): multiple definition of `HB_FUN_REPORTPRN'
slip.o:slip.c:(.text+0x0): first defined here
report.o:report.c:(.text+0x20): multiple definition of `HB_FUN_REPORT1'
slip.o:slip.c:(.text+0x20): first defined here
report.o:report.c:(.text+0x40): multiple definition of `HB_FUN_REPORT'
slip.o:slip.c:(.text+0x40): first defined here
ganeshji.o:ganeshji.c:(.text+0x0): multiple definition of `HB_FUN_GANESHJI'
slip.o:slip.c:(.text+0x2e0): first defined here
collect2: ld returned 1 exit status
hbmk2: Error: Running linker. 1
gcc.exe slip.o main1.o accmas.o voumas.o report.o instny.o comman.o ganeshji.o helpfile.o C:/hmg.3.0.22//resources/minigui.o -mconsole -Wl,--start-group -lminigui -lhbmysql -lmysql -lcrypt -ledit -leditex -lgraph -lini -lreport -lhbwin -lhbziparc -lhbmzip -lmsvfw32 -lvfw32 -lsddodbc -lrddsql -lsddmy -lhbodbc -lodbc32 -lhbhpdf -lhbvpdf -lhbmemio -lhbsqlit3 -lsqlite3 -lhbfimage -lhbpgsql -lpq -lhbtip -lhbct -lhbmisc -lhbnetio -lxhb -lhbextern -lhbdebug -lhbvm -lhbrtl -lhblang -lhbcpage -lgtcgi -lgtpca -lgtstd -lgtwin -lgtwvt -lgtgui -lhbrdd -lhbuddall -lhbusrrdd -lrddntx -lrddcdx -lrddnsx -lrddfpt -lhbrdd -lhbhsx -lhbsix -lhbmacro -lhbcplr -lhbpp -lhbcommon -lkernel32 -luser32 -lgdi32 -ladvapi32 -lws2_32 -lwinspool -lcomctl32 -lcomdlg32 -lshell32 -luuid -lole32 -loleaut32 -lmpr -lwinmm -lmapi32 -limm32 -lmsimg32 -lwininet -lhbpcre -lhbzlib -Wl,--end-group -oSLIP.exe -LC:/hmg.3.0.22/harbour/lib -LC:/hmg.3.0.22//lib
I am attaching herewith code file and tell me Is it possible to convert CLIPPER CONSOLE APPLICATION TO HMG CONSOLE APPLICATION and I will be able to give print on EPSON LX-300+ dot matrix printer and HP LASERJET 1020 PLUS printer
In this regard I started to build a small application to HMG 3.0.22. I make a folder SLIP in c:\hmg.3.0.22 and started to build by following command and found following error
C:\HMG.3.0.22\SLIP>BUILD /CS SLIP.HBP
error:'
'redir' is not recognised as an internal or external command, operable program or batch file
I think that it was path problem So for testing I copy all prg & hbp file in C:\HMG.3.0.22 folder and started to build and found following error
C:\HMG.3.0.22\SLIP\BUILD /CS SLIP.HBP
error:
hbmk2: Processing configuration: C:\hmg.3.0.22\harbour\bin\hbmk.cfg
Harbour 2.0.0 (Rev. 13372)
Copyright (c) 1999-2010, http://www.harbour-project.org/" onclick="window.open(this.href);return false;" onclick="window.open(this.href);return false;
Cannot open STBOX.prg, assumed external
Cannot open YESNO.prg, assumed external
Cannot open SMSG.prg, assumed external
Cannot open MSG.prg, assumed external
Cannot open IND.prg, assumed external
Cannot open PRNTEST.prg, assumed external
Cannot open REPHEAD.prg, assumed external
Cannot open STBOX.prg, assumed external
Cannot open YESNO.prg, assumed external
Cannot open IND.prg, assumed external
Cannot open MSG.prg, assumed external
Cannot open SMSG.prg, assumed external
Cannot open PRNTEST.prg, assumed external
Cannot open REPHEAD.prg, assumed external
Cannot open STBOX.prg, assumed external
Cannot open IND.prg, assumed external
Cannot open SMSG.prg, assumed external
Cannot open YESNO.prg, assumed external
Cannot open STBOX.prg, assumed external
Cannot open YESNO.prg, assumed external
Cannot open MSG.prg, assumed external
Cannot open STBOX.prg, assumed external
Cannot open SMSG.prg, assumed external
Cannot open PRNTEST.prg, assumed external
Cannot open MSG.prg, assumed external
Cannot open REPHEAD.prg, assumed external
Cannot open STBOX.prg, assumed external
Cannot open YESNO.prg, assumed external
Cannot open SMSG.prg, assumed external
Cannot open COMPRPL.prg, assumed external
Cannot open INST.prg, assumed external
Cannot open MSG.prg, assumed external
Cannot open IND.prg, assumed external
Cannot open ITEMHELP.prg, assumed external
Cannot open CITYHELP.prg, assumed external
Cannot open ACHELP.prg, assumed external
Cannot open STBOX.prg, assumed external
main1.o:main1.c:(.text+0x0): multiple definition of `HB_FUN_REPORTPRN'
slip.o:slip.c:(.text+0x0): first defined here
main1.o:main1.c:(.text+0x20): multiple definition of `HB_FUN_REPORT1'
slip.o:slip.c:(.text+0x20): first defined here
main1.o:main1.c:(.text+0x40): multiple definition of `HB_FUN_REPORT'
slip.o:slip.c:(.text+0x40): first defined here
main1.o:main1.c:(.text+0x60): multiple definition of `HB_FUN_VOUBL'
slip.o:slip.c:(.text+0x60): first defined here
main1.o:main1.c:(.text+0x80): multiple definition of `HB_FUN_VOUSTR'
slip.o:slip.c:(.text+0x80): first defined here
main1.o:main1.c:(.text+0xa0): multiple definition of `HB_FUN_VOURPL'
slip.o:slip.c:(.text+0xa0): first defined here
main1.o:main1.c:(.text+0xc0): multiple definition of `HB_FUN_IAMTCALC'
slip.o:slip.c:(.text+0xc0): first defined here
main1.o:main1.c:(.text+0xe0): multiple definition of `HB_FUN_VIRATE'
slip.o:slip.c:(.text+0xe0): first defined here
main1.o:main1.c:(.text+0x100): multiple definition of `HB_FUN_VINUG'
slip.o:slip.c:(.text+0x100): first defined here
main1.o:main1.c:(.text+0x120): multiple definition of `HB_FUN_VOUGET'
slip.o:slip.c:(.text+0x120): first defined here
main1.o:main1.c:(.text+0x140): multiple definition of `HB_FUN_VOUDL'
slip.o:slip.c:(.text+0x140): first defined here
main1.o:main1.c:(.text+0x160): multiple definition of `HB_FUN_VOUAM'
slip.o:slip.c:(.text+0x160): first defined here
main1.o:main1.c:(.text+0x180): multiple definition of `HB_FUN_VOUAMD'
slip.o:slip.c:(.text+0x180): first defined here
main1.o:main1.c:(.text+0x1a0): multiple definition of `HB_FUN_VOUMAS'
slip.o:slip.c:(.text+0x1a0): first defined here
main1.o:main1.c:(.text+0x1c0): multiple definition of `HB_FUN_ACCRPL'
slip.o:slip.c:(.text+0x1c0): first defined here
main1.o:main1.c:(.text+0x1e0): multiple definition of `HB_FUN_VLNAME'
slip.o:slip.c:(.text+0x1e0): first defined here
main1.o:main1.c:(.text+0x200): multiple definition of `HB_FUN_CHCKACN'
slip.o:slip.c:(.text+0x200): first defined here
main1.o:main1.c:(.text+0x220): multiple definition of `HB_FUN_ACCDL'
slip.o:slip.c:(.text+0x220): first defined here
main1.o:main1.c:(.text+0x240): multiple definition of `HB_FUN_ACCAM'
slip.o:slip.c:(.text+0x240): first defined here
main1.o:main1.c:(.text+0x260): multiple definition of `HB_FUN_ACCAMD'
slip.o:slip.c:(.text+0x260): first defined here
main1.o:main1.c:(.text+0x280): multiple definition of `HB_FUN_ACCMAS'
slip.o:slip.c:(.text+0x280): first defined here
main1.o:main1.c:(.text+0x2a0): multiple definition of `HB_FUN_UPDDBF'
slip.o:slip.c:(.text+0x2a0): first defined here
main1.o:main1.c:(.text+0x2c0): multiple definition of `HB_FUN_MAIN1'
slip.o:slip.c:(.text+0x2c0): first defined here
accmas.o:accmas.c:(.text+0x0): multiple definition of `HB_FUN_ACCRPL'
slip.o:slip.c:(.text+0x1c0): first defined here
accmas.o:accmas.c:(.text+0x20): multiple definition of `HB_FUN_VLNAME'
slip.o:slip.c:(.text+0x1e0): first defined here
accmas.o:accmas.c:(.text+0x40): multiple definition of `HB_FUN_CHCKACN'
slip.o:slip.c:(.text+0x200): first defined here
accmas.o:accmas.c:(.text+0x60): multiple definition of `HB_FUN_ACCDL'
slip.o:slip.c:(.text+0x220): first defined here
accmas.o:accmas.c:(.text+0x80): multiple definition of `HB_FUN_ACCAM'
slip.o:slip.c:(.text+0x240): first defined here
accmas.o:accmas.c:(.text+0xa0): multiple definition of `HB_FUN_ACCAMD'
slip.o:slip.c:(.text+0x260): first defined here
accmas.o:accmas.c:(.text+0xc0): multiple definition of `HB_FUN_ACCMAS'
slip.o:slip.c:(.text+0x280): first defined here
voumas.o:voumas.c:(.text+0x0): multiple definition of `HB_FUN_VOUBL'
slip.o:slip.c:(.text+0x60): first defined here
voumas.o:voumas.c:(.text+0x20): multiple definition of `HB_FUN_VOUSTR'
slip.o:slip.c:(.text+0x80): first defined here
voumas.o:voumas.c:(.text+0x40): multiple definition of `HB_FUN_VOURPL'
slip.o:slip.c:(.text+0xa0): first defined here
voumas.o:voumas.c:(.text+0x60): multiple definition of `HB_FUN_IAMTCALC'
slip.o:slip.c:(.text+0xc0): first defined here
voumas.o:voumas.c:(.text+0x80): multiple definition of `HB_FUN_VIRATE'
slip.o:slip.c:(.text+0xe0): first defined here
voumas.o:voumas.c:(.text+0xa0): multiple definition of `HB_FUN_VINUG'
slip.o:slip.c:(.text+0x100): first defined here
voumas.o:voumas.c:(.text+0xc0): multiple definition of `HB_FUN_VOUGET'
slip.o:slip.c:(.text+0x120): first defined here
voumas.o:voumas.c:(.text+0xe0): multiple definition of `HB_FUN_VOUDL'
slip.o:slip.c:(.text+0x140): first defined here
voumas.o:voumas.c:(.text+0x100): multiple definition of `HB_FUN_VOUAM'
slip.o:slip.c:(.text+0x160): first defined here
voumas.o:voumas.c:(.text+0x120): multiple definition of `HB_FUN_VOUAMD'
slip.o:slip.c:(.text+0x180): first defined here
voumas.o:voumas.c:(.text+0x140): multiple definition of `HB_FUN_VOUMAS'
slip.o:slip.c:(.text+0x1a0): first defined here
report.o:report.c:(.text+0x0): multiple definition of `HB_FUN_REPORTPRN'
slip.o:slip.c:(.text+0x0): first defined here
report.o:report.c:(.text+0x20): multiple definition of `HB_FUN_REPORT1'
slip.o:slip.c:(.text+0x20): first defined here
report.o:report.c:(.text+0x40): multiple definition of `HB_FUN_REPORT'
slip.o:slip.c:(.text+0x40): first defined here
ganeshji.o:ganeshji.c:(.text+0x0): multiple definition of `HB_FUN_GANESHJI'
slip.o:slip.c:(.text+0x2e0): first defined here
collect2: ld returned 1 exit status
hbmk2: Error: Running linker. 1
gcc.exe slip.o main1.o accmas.o voumas.o report.o instny.o comman.o ganeshji.o helpfile.o C:/hmg.3.0.22//resources/minigui.o -mconsole -Wl,--start-group -lminigui -lhbmysql -lmysql -lcrypt -ledit -leditex -lgraph -lini -lreport -lhbwin -lhbziparc -lhbmzip -lmsvfw32 -lvfw32 -lsddodbc -lrddsql -lsddmy -lhbodbc -lodbc32 -lhbhpdf -lhbvpdf -lhbmemio -lhbsqlit3 -lsqlite3 -lhbfimage -lhbpgsql -lpq -lhbtip -lhbct -lhbmisc -lhbnetio -lxhb -lhbextern -lhbdebug -lhbvm -lhbrtl -lhblang -lhbcpage -lgtcgi -lgtpca -lgtstd -lgtwin -lgtwvt -lgtgui -lhbrdd -lhbuddall -lhbusrrdd -lrddntx -lrddcdx -lrddnsx -lrddfpt -lhbrdd -lhbhsx -lhbsix -lhbmacro -lhbcplr -lhbpp -lhbcommon -lkernel32 -luser32 -lgdi32 -ladvapi32 -lws2_32 -lwinspool -lcomctl32 -lcomdlg32 -lshell32 -luuid -lole32 -loleaut32 -lmpr -lwinmm -lmapi32 -limm32 -lmsimg32 -lwininet -lhbpcre -lhbzlib -Wl,--end-group -oSLIP.exe -LC:/hmg.3.0.22/harbour/lib -LC:/hmg.3.0.22//lib
I am attaching herewith code file and tell me Is it possible to convert CLIPPER CONSOLE APPLICATION TO HMG CONSOLE APPLICATION and I will be able to give print on EPSON LX-300+ dot matrix printer and HP LASERJET 1020 PLUS printer
- Attachments
-
- SLIP.ZIP
- (17.4 KiB) Downloaded 403 times
- serge_girard
- Posts: 3161
- Joined: Sun Nov 25, 2012 2:44 pm
- DBs Used: 1 MySQL - MariaDB
2 DBF - Location: Belgium
- Contact:
Re: CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE
manoj_duamzn,
First make sure to add the missing PRG files (Cannot open STBOX.prg, assumed external, Cannot open IND.prg, assumed external,....) and then recompile in order to see the real compile-errors.
Serge
First make sure to add the missing PRG files (Cannot open STBOX.prg, assumed external, Cannot open IND.prg, assumed external,....) and then recompile in order to see the real compile-errors.
Serge
There's nothing you can do that can't be done...
- serge_girard
- Posts: 3161
- Joined: Sun Nov 25, 2012 2:44 pm
- DBs Used: 1 MySQL - MariaDB
2 DBF - Location: Belgium
- Contact:
Re: CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE
manoj_duamzn,
I was too fast; the sources are complete. I will look further.
Serge
I was too fast; the sources are complete. I will look further.
Serge
There's nothing you can do that can't be done...
- serge_girard
- Posts: 3161
- Joined: Sun Nov 25, 2012 2:44 pm
- DBs Used: 1 MySQL - MariaDB
2 DBF - Location: Belgium
- Contact:
Re: CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE
manoj_duamzn,
Fast solution: (everything in one main.prg)
(color BLUE was commented)
But this gives several runtime errors:
Error DBFNTX/1001 Open error: DEF .dbf
(DOS Error 3) Quit Retry Default
Serge
Fast solution: (everything in one main.prg)
Code: Select all
REQUEST HB_GT_WIN_DEFAULT
**************
FUNCTION MAIN()
**************
SETMODE(25,80)
SET TALK OFF
SET BELL OFF
SET STAT OFF
SET MENU OFF
SET SAFE OFF
SET SCOR OFF
SET INTE ON
SET DATE GERMAN
SET CENT ON
SET EXACT ON
SET FIXED ON
SET DECIMAL TO 2
SET WRAP ON
SET EPOCH TO 2000
READINSERT(.T.)
CLEAR
CLOSE ALL
PUBLIC CC,CNAME,CADD1,CADD2,VARTRUE,VARFAL,PCOL,OPDT,CLDT,CDIR,COMPCOL,ABCKYN
PUBLIC NUMB1,NUMB2,NUMB3,NUMB4,NUMB5,NUMB6,NUMB7,NUMB8,NUMB9,NUMB0,ESC,ONE,EMDATE,DR,CR
PUBLIC BON,BOF,DON,DOF,CON,COF,UON,UOF,ION,IOF,DWON,DWOF
PUBLIC ONE,TWO,THREE,FOUR,FIVE,OPPWOK,ADMPWOK,DIRECTYN,UC,UN,UREPYN
C=0
DO WHILE C<10
VC=LTRIM(STR(C,1,0))
STORE C TO NUMB&VC
C=C+1
ENDDO
STORE CTOD(' . . ') TO EMDATE
STORE SPACE(NUMB1) TO CC,ONE
STORE SPACE(10) TO PASS,PAS,PASS2
STORE 27 TO ESC
STORE .T. TO VARTRUE
STORE .F. TO VARFAL,ADMPWOK,OPPWOK
STORE 'Y' TO YES,ABCKYN
STORE 'N' TO NO,DIRECTYN
STORE 'D' TO DR
STORE 'C' TO CR
STORE NUMB3 TO CMENU
STORE 'B' TO COMPCOL
STORE SPACE(NUMB2) TO TWO,UC
STORE SPACE(NUMB3) TO THREE
STORE SPACE(NUMB4) TO FOUR
STORE SPACE(NUMB5) TO FIVE
STORE SPACE(20) TO UN
STORE 'GANESH ' TO ADMPASS
BON=CHR(ESC)+'E'
BOF=CHR(ESC)+'F'
DON=CHR(ESC)+'w1'+CHR(ESC)+'W1'
DOF=CHR(ESC)+'w0'+CHR(ESC)+'W0'
CON=CHR(15)
COF=CHR(18)
UON=CHR(ESC)+'-1'
UOF=CHR(ESC)+'-0'
ION=CHR(ESC)+CHR(52)
IOF=CHR(ESC)+CHR(53)
DWON=CHR(ESC)+'W1'
DWOF=CHR(ESC)+'W0'
CDIR='\'+CURDIR()
BLINE=SPACE(80)
COL3='W+/R+'
*INSTFL='C:\WINDOWS\SYSTEM32\FONT.CTL'
*IF .NOT. FILE(INSTFL)
*DO SMSG WITH 'PIRATED COPY......'
*RETURN
*ENDIF
USE COLOR
STORE DIRECTYN TO DIRYN
STORE GANESHYN TO GANYN
CLOSE ALL
IF GANYN=YES
DO GANESHJI
ENDIF
COL1='GR+/B'
COL2='W+/BG+'
COL3='W+/R+'
COL4='W+/GR+'
COL5='W+/RB+'
COL6='W+/G+'
COL =COL1+","+COL2 //OLD BLUE COLOUR
BLUE =COL1+","+COL2 //OLD BLUE COLOUR
ORANGE=COL4+","+COL2 //OLD ORANGE COLOUR
VIOLET=COL5+","+COL2 //OLD VIOLET COLOUR
SET COLOR TO (COL)
STORE BLUE TO DEFCOL
IF DIRYN=YES
DO COMPVAR
USE COMPANY
DO WHILE .NOT. EOF()
IF .NOT. EMPTY(COMPCODE)
DO COMPSTR
ENDIF
SKIP
ENDDO
CLOSE ALL
DDN=CDIR+'\Y2&CC'
SET DEFA TO &DDN
@ 24, NUMB0 SAY SPACE(80) COLOR COL3
DO MAINm
ELSE
DO COMPMENU
ENDIF
CLOSE ALL
CLEAR
RETURN
******************
PROCEDURE COMPMENU
******************
CLOSE ALL
CLEAR
@ NUMB0,NUMB0 SAY SPACE(80) COLOR COL2
@ NUMB0,28 SAY ' RADHEY RADHEY SOFTWARE ' COLOR COL3
@ 24, NUMB0 SAY BLINE COLOR COL3
@ NUMB3,35 SAY " FIRM MENU " COLOR COL3
DO STBOX WITH NUMB5,22,17,57,''
DO WHILE VARTRUE
@ NUMB7,28 PROMPT "1. CREATE NEW FIRM "
@ NUMB9,28 PROMPT "2. EDIT FIRM DETAIL "
@ 11, 28 PROMPT "3. SELECT A FIRM "
@ 13, 28 PROMPT "4. DELETE A FIRM "
@ 15, 28 PROMPT "5. EXIT <Esc> "
MENU TO CMENU
IF CMENU =NUMB0 .OR. CMENU = ESC .OR. CMENU = NUMB5
CLEAR
RETURN
ENDIF
SAVE SCREEN TO CMPSCR
SAVE TO CMSCR ALL LIKE CMPSCR
RELE CMPSCR
MMENU=NUMB0
DO CASE
CASE CMENU=NUMB1
DO COMPADD
CASE CMENU=NUMB2
DO COMPMOD
CASE CMENU=NUMB3
DO COMPVAR
DO COMPSEL
IF LASTKEY()=ESC
LOOP
ENDIF
PASSOK=PASSTEST()
IF .NOT. EMPTY(CC) .AND. PASSOK
CLOSE ALL
DDN=CDIR+'\Y2&CC'
SET DEFA TO &DDN
DO MAINm
STORE BLUE TO DEFCOL
SET COLOR TO (DEFCOL)
ENDIF
DO COMPVAR
SET DEFA TO &CDIR
CASE CMENU=NUMB4
DO COMPDEL
ENDCASE
CLOSE ALL
REST FROM CMSCR ADDITIVE
RESTORE SCREEN FROM CMPSCR
RELE CMPSCR
ENDDO
RETURN
******************
PROCEDURE CHECKLIC
******************
LOCAL LIC
SET EXACT ON
LIC=NUMB1
PRIVATE LICNO[LIC]
LICNO[1]='MICROMEK ENTERPRISES'
FOR I=1 TO LIC
IF UPPER(ALLTRIM(LICNO[I])) $ UPPER(ALLTRIM(CNAME))
LICOK=.T.
EXIT
ENDIF
NEXT
RETURN
*****************
PROCEDURE COMPADD
*****************
STORE SPACE(40) TO PCNAME
DO COMPVAR
SAVE SCREEN TO COMPSCR
STORE YES TO YN
STORE VARTRUE TO COMPABC
USE COMPANY
DO WHILE COMPABC
DO COMPGET
IF LASTKEY()=ESC
RETURN
ENDIF
DO YESNO WITH 'Y'
IF YN=NO
LOOP
ENDIF
USE COMPANY
LOCA FOR COMPCODE=SPACE(NUMB2)
IF .NOT. FOUND()
APPE BLAN
CC=RECCOUNT()
IF CC=NUMB0
CC=NUMB1
ENDIF
GO BOTT
ELSE
CC=RECNO()
ENDIF
IF CC>99
DO SMSG WITH 'YOUR COMPANY HAS 99 COMPANIES, FIRST DELETE THE OLD COMPANIES....'
ENDIF
IF CC<10
CC='0'+LTRIM(STR(CC,NUMB2,NUMB0))
ELSEIF CC>NUMB9 .AND. CC<100
CC=LTRIM(STR(CC,NUMB2,NUMB0))
ENDIF
DO COMPRPL
DO INST
STORE VARFAL TO COMPABC
CLOSE ALL
ENDDO
RETURN
*****************
PROCEDURE COMPGET
*****************
@ NUMB1,NUMB0 CLEAR TO 24,79
@ NUMB0,33 SAY ' FIRM DETAILS ' COLOR COL3
@ NUMB2,NUMB0 SAY 'FIRM NAME & ADDRESS '
@ NUMB2,26 GET CNAME VALID CMPNAM()
@ NUMB3,26 GET CADD1
@ NUMB4,26 GET CADD2
@ NUMB6,NUMB0 SAY 'FINANCIAL YEAR FROM '
@ NUMB6,26 GET OPDT VALID .NOT. EMPTY(OPDT)
@ NUMB6,37 SAY 'TO'
@ NUMB6,40 GET CLDT VALID .NOT. EMPTY(CLDT) .AND. CLDT>=OPDT
@ NUMB8,NUMB0 SAY 'PASSWORD '
@ NUMB8,26 GET PASS PICT '@!'
*@ 10, NUMB0 SAY 'OPERATOR PASSWORD '
*@ 10, 26 GET PASS2
@ 10, NUMB0 SAY 'PRINTER [80/132] COLUMN ' GET PCOL PICT '999' VALID (PCOL=80 .OR. PCOL=132)
*@ 12, NUMB0 SAY 'AUTO BACKUP [Y/N] ' GET ABCKYN PICT '!' VALID ABCKYN$ 'YN'
@ 12, NUMB0 SAY 'COLOUR BLUE/ORANGE [B/O] ' GET COMPCOL PICT '!' VALID COMPCOL$ 'BO'
READ
RETURN
*****************
PROCEDURE COMPDSP
*****************
@ NUMB1,NUMB0 CLEAR TO 24,79
@ NUMB0,33 SAY ' FIRM DETAILS ' COLOR COL3
@ NUMB2,NUMB0 SAY 'FIRM NAME & ADDRESS '
@ NUMB2,26 SAY CNAME
@ NUMB3,26 SAY CADD1
@ NUMB4,26 SAY CADD2
@ NUMB6,NUMB0 SAY 'FINANCIAL YEAR FROM '
@ NUMB6,26 SAY OPDT
@ NUMB6,37 SAY 'TO'
@ NUMB6,40 SAY CLDT
@ NUMB8,NUMB0 SAY 'PASSWORD '
@ NUMB8,26 SAY PASS COLOR [R/R]
*@ 10, NUMB0 SAY 'OPERATOR PASSWORD'
*@ 10, 26 SAY PASS2 COLOR [R/R]
@ 10, NUMB0 SAY 'PRINTER [80/132] COLUMN '
@ 10, 26 SAY PCOL PICT '999'
*@ 12, NUMB0 SAY 'AUTO BACKUP [Y/N] '+ABCKYN
@ 12, NUMB0 SAY 'COLOUR BLUE/ORANGE [B/O] '+COMPCOL
READ
RETURN
*****************
PROCEDURE COMPRPL
*****************
REPL COMPCODE WITH CC
REPL COMPNAME WITH CNAME
REPL COMPADD1 WITH CADD1
REPL COMPADD2 WITH CADD2
REPL PASSWORD WITH PASS
REPL PASSWORD2 WITH PASS2
REPL OPDATE WITH OPDT
REPL CLDATE WITH CLDT
REPL PRNCOL WITH PCOL
REPL ABACKUPYN WITH ABCKYN
REPL COLOUR WITH COMPCOL
RETURN
*****************
PROCEDURE COMPSTR
*****************
STORE COMPCODE TO CC
STORE COMPNAME TO CNAME
STORE COMPADD1 TO CADD1
STORE COMPADD2 TO CADD2
STORE PASSWORD TO PASS
STORE PASSWORD2 TO PASS2
STORE OPDATE TO OPDT
STORE CLDATE TO CLDT
STORE PRNCOL TO PCOL
STORE ABACKUPYN TO ABCKYN,PABCKYN
STORE COLOUR TO COMPCOL
RETURN
*****************
PROCEDURE COMPMOD
*****************
DO COMPVAR
SAVE SCREEN TO COMPSCR
STORE YES TO YN
STORE VARTRUE TO COMPABC
DO COMPSEL
IF LASTKEY()=ESC
RETURN
ENDIF
STORE ABCKYN TO PABCKYN
CLOSE ALL
DO WHILE COMPABC
PASSOK=PASSTEST()
IF .NOT. PASSOK .OR. OPPWOK
RETURN
ENDIF
PCNAME=CNAME
DO COMPGET
IF LASTKEY()=ESC
RETURN
ENDIF
DO YESNO WITH YES
IF YN=YES
USE COMPANY
LOCA FOR COMPCODE=CC
DO COMPRPL
COMPABC=VARFAL
CLOSE ALL
IF (PABCKYN=NO .OR. EMPTY(PABCKYN)) .AND. ABCKYN=YES
FL=CDIR+'\Y2'+CC+'\'+'DEF'+CC
USE (FL)
REPL BACKDATE WITH EMDATE
CLOSE ALL
ENDIF
ENDIF
ENDDO
RETURN
*****************
PROCEDURE COMPDEL
*****************
YN=NO
DO YESNO WITH YN
IF YN=NO
RETURN
ENDIF
DO COMPVAR
SAVE SCREEN TO COMPSCR
STORE YES TO YN
STORE VARTRUE TO COMPABC
DO COMPSEL
IF LASTKEY()=ESC
RETURN
ENDIF
DO WHILE COMPABC
PASSOK=PASSTEST()
IF .NOT. PASSOK .OR. OPPWOK
RETURN
ENDIF
DO COMPDSP
DO SMSG WITH 'PRESS <Del> TO DELETE THIS FIRM, PRESS ANY KEY TO CONTINUE...'
IF LASTKEY()<>NUMB7
RETURN
ENDIF
DO YESNO WITH NO
IF YN=YES
USE COMPANY
LOCA FOR COMPCODE=CC
IF FOUND()
PCC=CC
DO COMPVAR
DO COMPRPL
COMPABC=VARFAL
CC=PCC
DO DELFILES
CC=SPACE(NUMB2)
RELE PCC
ENDIF
ELSEIF YN=NO
COMPABC=VARFAL
ENDIF
ENDDO
RETURN
******************
PROCEDURE DELFILES
******************
DO MSG WITH "DELETING FILES, PLEASE WAIT....."
CMFL=CDIR+'\Y2'+CC+'\ACMAST'+CC+'.DBF'
IF FILE(CMFL)
RUN CD Y2&CC
RUN DEL *.*
RUN CD..
RUN RD Y2&CC
ENDIF
RETURN
***************
FUNCTION CMPNAM
***************
IF EMPTY(CNAME)
RETURN VARFAL
ENDIF
IF CMENU=NUMB1
RETURN VARTRUE
ENDIF
USE COMPANY
LOCA FOR COMPNAME=CNAME
IF FOUND()
IF COMPNAME=PCNAME
RETURN VARTRUE
ENDIF
DO SMSG WITH 'THIS FIRM NAME ALREADY EXISTS, TRY ANOTHER....'
RETURN VARFAL
ELSE
RETURN VARTRUE
ENDIF
**************
PROCEDURE INST
**************
DO MSG WITH "Creating data files, Please wait....!"
DBF=".DBF"
MEM=".MEM"
INI=".INI"
RUN MD Y2&CC
DN=CDIR+'\Y2&CC'+'\'
TMP=COPYFILE("DEF",DBF)
TMP=COPYFILE("ACMAST",DBF)
DDN=CDIR+'\Y2&CC'
SET DEFA TO &DDN
DO IND
SET DEFA TO &CDIR
RETURN
****************************
FUNCTION COPYFILE(FL,DBFMEM)
****************************
SFILE=FL+DBFMEM
TFILE=DN+FL+CC+DBFMEM
COPY FILE "&SFILE" TO "&TFILE"
RETURN VARTRUE
*****************
PROCEDURE COMPVAR
*****************
STORE SPACE(40) TO CNAME,CADD1,CADD2,PCNAME
STORE SPACE(NUMB2) TO CC
STORE SPACE(10) TO PASS,PASS2
STORE 80 TO PCOL
STORE EMDATE TO OPDT,CLDT
STORE YES TO ABCKYN
STORE 'B' TO COMPCOL
RETURN
*****************
PROCEDURE COMPSEL
*****************
SAVE SCREEN TO SELSCR
USE COMPANY
I=NUMB1
PRIVATE COMPNAM[I],COMPCOD[I]
DO WHILE .NOT. EOF()
IF .NOT. EMPTY(COMPCODE)
COMPNAM[I]=COMPNAME+SPACE(NUMB3)+'('+COMPCODE+') '+DTOC(OPDATE)+' TO '+DTOC(CLDATE)
COMPCOD[I]=COMPCODE
SKIP
DO WHILE EMPTY(COMPCODE) .AND. .NOT. EOF()
SKIP
ENDDO
IF .NOT. EMPTY(COMPCODE)
AADD(COMPNAM,SPACE(71))
AADD(COMPCOD,SPACE(NUMB2))
I++
ENDIF
ELSEIF EMPTY(COMPCODE)
DO WHILE EMPTY(COMPCODE) .AND. .NOT. EOF()
SKIP
ENDDO
ENDIF
ENDDO
@ NUMB9,NUMB0 CLEAR TO 23,79
DO STBOX WITH 10,NUMB0,22,79,''
@ 10,31 SAY 'List of Companies' COLOR COL3
CHOICE=NUMB0
CHOICE=ACHOICE(12,NUMB3,21,76,COMPNAM)
DO CASE
CASE CHOICE=NUMB0 .OR. LASTKEY()=ESC
REST SCREEN FROM SELSCR
RETURN
OTHERWISE
USE COMPANY
LOCA FOR COMPCODE=COMPCOD[CHOICE]
IF MMENU=NUMB0
DO COMPSTR
ELSEIF MMENU=NUMB2
STORE COMPCODE TO PNCC
STORE COMPNAME TO PNCNAME
ELSEIF MMENU=NUMB1
STORE COMPCODE TO ICC
ENDIF
ENDCASE
REST SCREEN FROM SELSCR
RETURN
*****************
FUNCTION PASSTEST
*****************
STORE SPACE(10) TO UP,PAS
DO STBOX WITH 10,24,14,55,''
DO WHILE VARTRUE
DO STBOX WITH 10,24,14,55,''
*@ 10,22 SAY 'USER NAME ' GET UN VALID VLUN()
@ 12,27 SAY 'ENTER PASSWARD '
@ 12,43 GET PAS PICT '!!!!!!!!!!' COLOR [R/R]
READ
IF LASTKEY()=ESC
RETURN VARFAL
ENDIF
IF STR(CMENU,NUMB2,NUMB0)<>STR(NUMB3,NUMB2,NUMB0)
IF UPPER(ALLTRIM(PAS))<>UPPER(ALLTRIM(PASS))
DO SMSG WITH 'INVALID PASSWORD, PRESS ANY KEY TO CONTINUE.....'
RETURN VARFAL
ENDIF
ENDIF
IF UPPER(ALLTRIM(PAS))<>UPPER(ALLTRIM(PASS))
IF UPPER(ALLTRIM(UP))<>UPPER(ALLTRIM(PAS))
DO SMSG WITH 'INVALID PASSWORD.....'
RETURN VARFAL
ENDIF
IF UPPER(ALLTRIM(PAS))='DUA'
DIRECTYN=YES
ENDIF
IF UPPER(ALLTRIM(PAS))='COPY'
COPYYN=YES
ENDIF
IF UPPER(ALLTRIM(PAS))='IND'
INDYN=YES
ENDIF
STORE VARTRUE TO OPPWOK
RETURN VARTRUE
ELSE
STORE VARFAL TO OPPWOK
RETURN VARTRUE
ENDIF
ENDDO
function ganeshi()
set talk off
set color to gr/gr+
clea
y=18
SQRE=CHR(219)+CHR(223)+CHR(219)+CHR(219)+CHR(219)+CHR(220)+CHR(219)+CHR(219)
@ NUMB0,NUMB0,24,79 box sqre
@NUMB2,17 say" ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "
@NUMB3,y say" º ÛÛÛÛ º "
@NUMB4,y say" º º "
@NUMB5,y say" º ÛÛÛÛÛÛÛÛ º "
@NUMB6,y say" º ÛÛÛÛÛÛÛÛÛÛÛÛ º "
@NUMB7,y say " º º "
@NUMB8,y say" º ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ º "
@NUMB9,y say" º º "
@10,y say" º ÛÛÛ ³ ÛÛÛÛÛÛÛÛÛÛÛÛÛÛ ³ ÛÛÛ º "
@11,y say" º ÛÛÛ ³ ÛÛÛ"
@11,y+19 say"ÛÛÛÛÛÛ"
@11,y+26 say"ÛÛÛ ³ ÛÛÛ º "
@12,y say" º ÛÛÛ ³ ÛÛÛÛÛÛÛÛÛÛÛÛÛÛ ³ ÛÛÛ º "
@13,y say" º ÛÛÛÛÛÛÛÛÛ º "
@14,y say" º ÛÛÛÛÛÛÛ º "
@15,y say" º ÛÛÛ ³ ÛÛÛÛÛÛÛÛ ³ ÛÛÛ º "
@16,y say" º ÛÛÛ ³ ÛÛÛÛÛÛÛÛ ÛÛ ³ ÛÛÛ º "
@17,y say" º ÛÛÛ ³ ÛÛÛÛÛ ÛÛÛÛ ³ ÛÛÛ º "
@18,y say" º ÛÛÛÛÛÛ º "
@19,y say" º ÛÛÛÛÛÛ ÛÛÛÛÛ ÛÛÛÛÛÛÛÛ º "
@20,y say" º ÛÛÛÛÛÛÛÛÛÛÛ ÛÛÛÛÛÛÛÛÛÛ º "
@21,y say" º ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ º "
@22,y say " º ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ º "
@23,y say" ÈÍÍÍÍÍÍÍ Radhey Radhey Software ÍÍÍÍÍͼ "
wait""
clear
retu
******************
PROCEDURE ITEMHELP
******************
SET EXACT OFF
USE ITEM&CC INDEX NITEM&CC
IF EMPTY(VITNAME)
COUNT TO X FOR .NOT. EMPTY(ITEMNAME)
ELSE
COUNT TO X FOR .NOT. EMPTY(ITEMNAME) .AND. UPPER(ITEMNAME)=VITNAME
ENDIF
IF X=NUMB0
IF LEN(VITNAME)<20
VITNAME=VITNAME+SPACE(20-LEN(VITNAME))
ENDIF
SET EXACT ON
CLOSE ALL
RETURN
ENDIF
IF REPITEM .AND. EMPTY(VITNAME)
X++
ENDIF
PRIVATE ANAME[X]
STORE NUMB1 TO I
IF REPITEM .AND. EMPTY(VITNAME)
STORE SPACE(20) TO ANAME[I]
I++
ENDIF
GO TOP
DO WHILE .NOT. EOF()
IF EMPTY(ITEMNAME)
SKIP
LOOP
ENDIF
IF EMPTY(VITNAME)
ANAME[I]=ITEMNAME
I++
ELSE
IF UPPER(ITEMNAME)=VITNAME
ANAME[I]=ITEMNAME
I++
ENDIF
ENDIF
SKIP
ENDDO
IF .NOT. EMPTY(VITNAME) .AND. LEN(ANAME)=NUMB1
VITNAME=ANAME[NUMB1]
SET EXACT ON
RETURN
ENDIF
CPABC=VARTRUE
STORE NUMB1 TO CP4
STORE NUMB0 TO RP4,LKEY4
STORE '' TO SS
HELPSCR=SAVESCREEN(NUMB0,54,24,79)
SET COLOR TO (VIOLET)
DO STBOX WITH NUMB0,54,24,79,' ITEM NAME HELP '
@ NUMB3,55 TO NUMB3,78
@ NUMB4,57 SAY SPACE(20) COLOR COL2
@ NUMB5,55 TO NUMB5,78
@ 22,55 TO 22,78
@ 23,57 SAY I-NUMB1 PICT '9999' COLOR COL3
@ 23,62 SAY 'Items'
DO WHILE CPABC
HCHOICE=ACHOICE(NUMB6,57,21,76,ANAME,VARTRUE,"ITEMHLP",CP4,RP4)
IF LKEY4=ESC
CPABC=VARFAL
ENDIF
IF LKEY4=13
VITNAME=ANAME[CP4]
CPABC=VARFAL
ENDIF
ENDDO
SET EXACT ON
RESTSCREEN(NUMB0,54,24,79,HELPSCR)
SET COLOR TO (DEFCOL)
RETURN
****************
FUNCTION ITEMHLP
****************
PARAMETER MODE,CUR_ELEM,REL_POS
PRIVATE RET_VAL,KEY
KEY=LASTKEY()
IF MODE=NUMB3
IF KEY=ESC
LKEY4=ESC
RET_VAL=NUMB0
ELSE
IF KEY=NUMB8
LENSS=LEN(SS)-NUMB1
SS=SUBSTR(SS,NUMB1,LENSS)
@ NUMB4,57 SAY SS+ONE COLOR COL2
ELSEIF KEY=13
CP4=CUR_ELEM
RP4=REL_POS
LKEY4=KEY
RET_VAL=NUMB0
RETURN RET_VAL
ELSE
IF LEN(SS)<20
SS=SS+CHR(KEY)
ENDIF
ENDIF
OLDCP4=CP4
@ NUMB4,57 SAY SS COLOR COL2
SS=UPPER(SS)
CP4=ASCAN(ANAME,SS)
IF CP4=NUMB0
CP4=OLDCP4
ENDIF
RET_VAL=NUMB0
ENDIF
ELSE
RET_VAL=NUMB2
ENDIF
RETURN RET_VAL
******************
function CITYHELP
******************
SET EXACT OFF
USE CITY&CC INDEX CITY&CC
IF EMPTY(VCTNAME)
COUNT TO X FOR .NOT. EMPTY(CITY)
ELSE
COUNT TO X FOR .NOT. EMPTY(CITY) .AND. UPPER(CITY)=VCTNAME
ENDIF
IF X=NUMB0
IF LEN(VCTNAME)<20
VCTNAME=VCTNAME+SPACE(20-LEN(VCTNAME))
ENDIF
SET EXACT ON
CLOSE ALL
RETURN
ENDIF
IF REPCITY .AND. EMPTY(VCTNAME)
X++
ENDIF
PRIVATE ANAME[X]
STORE NUMB1 TO I
IF REPCITY .AND. EMPTY(VCTNAME)
STORE SPACE(20) TO ANAME[I]
I++
ENDIF
GO TOP
DO WHILE .NOT. EOF()
IF EMPTY(CITY)
SKIP
LOOP
ENDIF
IF EMPTY(VCTNAME)
ANAME[I]=CITY
I++
ELSE
IF UPPER(CITY)=VCTNAME
ANAME[I]=CITY
I++
ENDIF
ENDIF
SKIP
ENDDO
IF .NOT. EMPTY(VCTNAME) .AND. LEN(ANAME)=NUMB1
VCTNAME=ANAME[NUMB1]
SET EXACT ON
RETURN
ENDIF
CPABC=VARTRUE
STORE NUMB1 TO CP4
STORE NUMB0 TO RP4,LKEY4
STORE '' TO SS
HELPSCR=SAVESCREEN(NUMB0,54,24,79)
SET COLOR TO (VIOLET)
DO STBOX WITH NUMB0,54,24,79,' CITY NAME HELP '
@ NUMB3,55 TO NUMB3,78
@ NUMB4,57 SAY SPACE(20) COLOR COL2
@ NUMB5,55 TO NUMB5,78
@ 22, 55 TO 22,78
@ 23, 57 SAY LEN(ANAME) PICT '9999' COLOR COL3
@ 23, 62 SAY 'Cities'
DO WHILE CPABC
HCHOICE=ACHOICE(NUMB6,57,21,76,ANAME,VARTRUE,"CITYHLP",CP4,RP4)
IF LKEY4=ESC
CPABC=VARFAL
ENDIF
IF LKEY4=13
VCTNAME=ANAME[CP4]
CPABC=VARFAL
ENDIF
ENDDO
SET EXACT ON
RESTSCREEN(NUMB0,54,24,79,HELPSCR)
SET COLOR TO (DEFCOL)
RETURN
****************
FUNCTION CITYHLP
****************
PARAMETER MODE,CUR_ELEM,REL_POS
PRIVATE RET_VAL,KEY
KEY=LASTKEY()
IF MODE=NUMB3
IF KEY=ESC
LKEY4=ESC
RET_VAL=NUMB0
ELSE
IF KEY=NUMB8
LENSS=LEN(SS)-NUMB1
SS=SUBSTR(SS,NUMB1,LENSS)
@ NUMB4,57 SAY SS+ONE COLOR COL2
ELSEIF KEY=13
CP4=CUR_ELEM
RP4=REL_POS
LKEY4=KEY
RET_VAL=NUMB0
RETURN RET_VAL
ELSE
IF LEN(SS)<20
SS=SS+CHR(KEY)
ENDIF
ENDIF
OLDCP4=CP4
@ NUMB4,57 SAY SS COLOR COL2
SS=UPPER(SS)
CP4=ASCAN(ANAME,SS)
IF CP4=NUMB0
CP4=OLDCP4
ENDIF
RET_VAL=NUMB0
ENDIF
ELSE
RET_VAL=NUMB2
ENDIF
RETURN RET_VAL
****************
PROCEDURE ACHELP
****************
SET EXACT OFF
USE ACMAST&CC INDEX NACM&CC
IF EMPTY(VACNAME)
COUNT TO X FOR .NOT. EMPTY(ACNAME)
ELSE
COUNT TO X FOR .NOT. EMPTY(ACNAME) .AND. UPPER(ACNAME)=VACNAME
ENDIF
IF X=NUMB0
IF LEN(VACNAME)<35
VACNAME=VACNAME+SPACE(35-LEN(VACNAME))
ENDIF
SET EXACT ON
CLOSE ALL
RETURN
ENDIF
IF REPNAME .AND. EMPTY(VACNAME)
X++
ENDIF
PRIVATE ANAME[X]
STORE NUMB1 TO I
IF REPNAME .AND. EMPTY(VACNAME)
STORE SPACE(35) TO ANAME[I]
I++
ENDIF
GO TOP
DO WHILE .NOT. EOF()
IF EMPTY(ACNAME)
SKIP
LOOP
ENDIF
IF EMPTY(VACNAME)
ANAME[I]=ACNAME
I++
ELSE
IF UPPER(ACNAME)=VACNAME
ANAME[I]=ACNAME
I++
ENDIF
ENDIF
SKIP
ENDDO
CLOSE ALL
IF .NOT. EMPTY(VACNAME) .AND. LEN(ANAME)=NUMB1
VACNAME=ANAME[NUMB1]
SET EXACT ON
RETURN
ENDIF
CPABC=VARTRUE
STORE NUMB1 TO CP4
STORE NUMB0 TO RP4,LKEY4
STORE '' TO SS
HELPSCR=SAVESCREEN(NUMB0,39,24,79)
SET COLOR TO (VIOLET)
DO STBOX WITH NUMB0,39,24,79,' PARTY NAME HELP '
@ NUMB3,40 TO NUMB3,78
@ NUMB4,42 SAY SPACE(35) COLOR COL2
@ NUMB5,40 TO NUMB5,78
@ 22,40 TO 22,78
@ 23,40 SAY I-NUMB1 PICT '99999' COLOR COL3
@ 23,46 SAY 'Parties'
DO WHILE CPABC
HCHOICE=ACHOICE(NUMB6,42,21,76,ANAME,VARTRUE,"ACHLP",CP4,RP4)
IF LKEY4=ESC
CPABC=VARFAL
ENDIF
IF LKEY4=13
VACNAME=ANAME[CP4]
CPABC=VARFAL
ENDIF
ENDDO
SET EXACT ON
RESTSCREEN(NUMB0,39,24,79,HELPSCR)
SET COLOR TO (DEFCOL)
RETURN
**************
FUNCTION ACHLP
**************
PARAMETER MODE,CUR_ELEM,REL_POS
PRIVATE RET_VAL,KEY
KEY=LASTKEY()
IF MODE=NUMB3
IF KEY=ESC
LKEY4=ESC
RET_VAL=NUMB0
ELSE
IF KEY=NUMB8
LENSS=LEN(SS)-NUMB1
SS=SUBSTR(SS,NUMB1,LENSS)
@ NUMB4,42 SAY SS+ONE COLOR COL2
ELSEIF KEY=13
CP4=CUR_ELEM
RP4=REL_POS
LKEY4=KEY
RET_VAL=NUMB0
RETURN RET_VAL
ELSE
IF LEN(SS)<40
SS=SS+CHR(KEY)
ENDIF
ENDIF
OLDCP4=CP4
@ NUMB4,42 SAY SS COLOR COL2
SS=UPPER(SS)
CP4=ASCAN(ANAME,SS)
IF CP4=NUMB0
CP4=OLDCP4
ENDIF
RET_VAL=NUMB0
ENDIF
ELSE
CP4=CUR_ELEM
RET_VAL=NUMB2
ENDIF
RETURN RET_VAL
function instny()
IPASS=SPACE(10)
DO STBOX WITH 10,24,14,55,''
@ 12,ESC SAY 'Enter Password ' GET IPASS PICT '!!!!!!!!!!' COLOR [R/R]
READ
IF LASTKEY()=ESC
RETURN
ENDIF
IF UPPER(ALLTRIM(IPASS))<>'CROCIN'
RETURN
ENDIF
YN=NO
DO YESNO WITH YN
IF YN=NO
RETURN
ENDIF
NOPDT='01.04.'+STR(YEAR(CLDT),NUMB4,NUMB0)
NOPDT=CTOD(NOPDT)
NCLDT='31.03.'+STR((YEAR(CLDT)+NUMB1),NUMB4,NUMB0)
NCLDT=CTOD(NCLDT)
DO STBOX WITH NUMB8,18,12,69,''
@ 10,21 SAY 'Financial Year From ' GET NOPDT
@ 10,54 SAY 'To ' GET NCLDT
READ
IF LASTKEY()=ESC
RETURN
ENDIF
CLOSE ALL
SET DEFA TO &CDIR
STORE CC TO ORIGCC
STORE OPDT TO ORIGOPDT
STORE CLDT TO ORIGCLDT
CC=NUMB0
USE COMPANY
DO WHILE .NOT. EOF()
IF VAL(COMPCODE)>CC
CC=VAL(COMPCODE)
ENDIF
SKIP
ENDDO
CLOSE ALL
CC++
IF CC>99
DO SMSG WITH 'YOUR COMPANY HAS 99 COMPANIES, FIRST DELETE THE OLD COMPANIES....'
RETURN
ENDIF
IF CC<10
CC='0'+LTRIM(STR(CC,NUMB2,NUMB0))
ELSEIF CC>NUMB9 .AND. CC<100
CC=LTRIM(STR(CC,NUMB2,NUMB0))
ENDIF
USE COMPANY
LOCA FOR COMPCODE=CC
IF FOUND()
DO SMSG WITH 'THERE ARE SOMETHING MISTAKE, KINDLY CONTACT MANOJ DUA.....'
CLOSE ALL
RETURN
ELSE
OPDT=NOPDT
CLDT=NCLDT
APPE BLAN
DO COMPRPL
ENDIF
CLOSE ALL
DO INST // Y2FA1.PRG
ICC=ORIGCC
DDN=CDIR+'\Y2&CC'
SET DEFA TO &DDN
DO IMP1
CC=ORIGCC
OPDT=ORIGOPDT
CLDT=ORIGCLDT
DDN=CDIR+'\Y2&CC'
SET DEFA TO &DDN
RETURN
**************
PROCEDURE IMP1
**************
DIRN=CDIR+'\Y2'+'&ICC'+'\'
DO MSG WITH "IMPORTING DATA, PLEASE WAIT...."
******************************
FN=DIRN+"DEF"+ICC
USE DEF&CC
ZAP
APPE FROM (FN)
CLOSE ALL
******************************
CLOSE ALL
FN=DIRN+'ACMAST'+ICC
USE ACMAST&CC
ZAP
APPE FROM (FN)
******************************
FN=DIRN+'CUST'+ICC
USE CUST&CC
ZAP
APPE FROM (FN)
******************************
FN=DIRN+'ITEM'+ICC
USE ITEM&CC
ZAP
APPE FROM (FN)
******************************
FN=DIRN+'CITY'+ICC
USE CITY&CC
ZAP
APPE FROM (FN)
******************************
DO IND
RETURN
FUNCTION MAINM()
CLOSE ALL
IF COMPCOL='O'
STORE ORANGE TO DEFCOL
ELSE
STORE BLUE TO DEFCOL
ENDIF
SET COLOR TO (DEFCOL)
SET KEY -NUMB9 TO CALC()
@ NUMB1,NUMB0 CLEAR TO 23,79
L=(80-LEN(RTRIM(CNAME)))/NUMB2
@ 23,NUMB0 CLEAR TO 23,79
@ NUMB0, NUMB0 SAY SPACE(80) COLOR COL2
@ NUMB0, L-NUMB1 SAY ONE+ALLTRIM(CNAME)+ONE COLOR COL3
RELE L
CNAME=ALLTRIM(CNAME)
CADD1=ALLTRIM(CADD1)
CADD2=ALLTRIM(CADD2)
IF PCOL=80
SET MARGIN TO NUMB0
ELSEIF PCOL=132
SET MARGIN TO NUMB5
ENDIF
CCNAME=((80-(LEN(CNAME)*NUMB2))/NUMB2)
CCADD1=((80-LEN(CADD1))/NUMB2)
CCADD2=((80-LEN(CADD2))/NUMB2)
IF DIRECTYN<>YES
DO UPDDBF
ELSE
STORE VARTRUE TO OPPWOK
STORE VARFAL TO AMDPWOK
ENDIF
STORE VARFAL TO OPPWOK
STORE VARTRUE TO AMDPWOK
STORE NUMB2 TO MMENU
DO WHILE VARTRUE
@ NUMB3, 34 SAY " MAIN MENU " COLOR COL3
DO STBOX WITH NUMB5,29,17,51,''
@ 15,NUMB0 SAY OPDT
@ 16,NUMB4 SAY 'TO'
@ 17,NUMB0 SAY CLDT
@ 19,NUMB0 SAY '<F10>' COLOR COL3
@ 19,NUMB6 SAY 'Calculator'
@ NUMB7,32 PROMPT "1. PARTY LIST "
@ NUMB9,32 PROMPT "2. VOUCHER ENTRY"
@ 11, 32 PROMPT "3. REPORT "
@ 13, 32 PROMPT "4. INDEXING "
@ 15, 32 PROMPT "5. EXIT <Esc> "
MENU TO MMENU
IF MMENU =NUMB0 .OR. MMENU = ESC .OR. MMENU = NUMB5
YN=NO
DO YESNO WITH YN
IF YN=YES
CLOSE ALL
RETURN
ENDIF
RELE YN
ENDIF
SAVE SCREEN TO MAINSCR
SAVE TO MMSCR ALL LIKE MAINSCR
RELE MAINSCR
DO CASE
CASE MMENU=NUMB1
DO ACCMAS
CASE MMENU=NUMB2
DO VOUMAS
CASE MMENU=NUMB3
DO REPORT
CASE MMENU=NUMB4
DO IND
ENDCASE
CLOSE ALL
REST FROM MMSCR ADDITIVE
RESTORE SCREEN FROM MAINSCR
RELE MAINSCR
ENDDO
RETURN
****************
PROCEDURE UPDDBF
****************
UPDSCR=SAVESCREEN(23,NUMB0,23,79)
USE DEF&CC
IF DATE()<>BACKDATE
IF EMPTY(AUTOPATH) .OR. ABCKYN<>YES
REPL BACKDATE WITH DATE()
ENDIF
USE
DO IND
ELSE
CLOSE ALL
RETURN
ENDIF
CLOSE ALL
DO MSG WITH 'UPDATING DATA FILES, PLEASE WAIT....'
DELOK=VARFAL
USE VOU&CC INDEX DVOU&CC,VVOU&CC,NVOU&CC
DO WHILE EMPTY(DATE) .AND. .NOT. EOF()
DELE
DELOK=VARTRUE
SKIP
ENDDO
IF DELOK
PACK
ENDIF
CLOSE ALL
RESTSCREEN(23,NUMB0,23,79,UPDSCR)
RETURN
function report()
CLOSE ALL
STORE OPDT TO FDATE
STORE DATE() TO TDATE
STORE VARFAL TO REPNAME
STORE SPACE(35) TO NAME1
IF TDATE>CLDT
TDATE=CLDT
ENDIF
IF FDATE<OPDT
FDATE=OPDT
ENDIF
DO STBOX WITH 8,ESC,16,79,''
@ 10,30 SAY 'A/C NAME ' GET NAME1 VALID VLPNAM(NUMB1)
@ 12,30 SAY 'FROM DATE ' GET FDATE VALID FDATE>=OPDT .AND. FDATE<=CLDT
@ 14,30 SAY 'TO DATE ' GET TDATE VALID TDATE>=FDATE .AND. TDATE<=CLDT
READ
IF LASTKEY()=ESC
RETURN
ENDIF
STORE VARTRUE TO FIRST
STORE NUMB0 TO TAMT,BAL
USE VOU&CC INDEX NVOU&CC
SEEK NAME1
DO WHILE ACNAME1=NAME1 .AND. DATE<FDATE .AND. .NOT. EOF()
BAL=BAL+AMOUNT
SKIP
ENDDO
IF STR(BAL,10,NUMB2)<>STR(NUMB0,10,NUMB2)
IF FIRST
STORE VARFAL TO FIRST
STORE NUMB1 TO I
PRIVATE REPLINE[I]
ELSE
I++
AADD(REPLINE,ONE)
ENDIF
REPLINE[I]=DTOC(FDATE)+ONE+'Opening Balance'+SPACE(34)+STR(BAL,NUMB9,NUMB2)+SPACE(11)
TAMT=TAMT+BAL
ENDIF
DO WHILE ACNAME1=NAME1 .AND. DATE>=FDATE .AND. DATE<=TDATE .AND. .NOT. EOF()
IF FIRST
STORE VARFAL TO FIRST
STORE NUMB1 TO I
PRIVATE REPLINE[I]
ELSE
I++
AADD(REPLINE,ONE)
ENDIF
REPLINE[I]=DTOC(DATE)+ONE+ACNAME2+ONE+STR(NUG,NUMB3,NUMB0)+TWO+STR(RATE,NUMB7,NUMB2)+ONE+STR(AMOUNT,NUMB9,NUMB2)+ONE+REMARK
TAMT=TAMT+AMOUNT
SKIP
ENDDO
CLOSE ALL
IF FIRST
DO SMSG WITH 'THERE ARE NO REPORT FOR THIS CUSTOMER DURING GIVEN PERIOD, PLEASE WAIT.....'
RETURN
ENDIF
HEAD1=' DATE NAME OF PARTY NUG RATE AMOUNT REMARK'
*99.99.9999 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 999 9999.99 999999.99 XXXXXXXXXX
TITLE=ONE+ALLTRIM(NAME1)+' STATEMENT '
TITLE1=ONE+DTOC(FDATE)+' TO '+DTOC(TDATE)+ONE
CTITLE=(80-LEN(TITLE))/NUMB2
CTITLE1=(80-LEN(TITLE1))/NUMB2
@ NUMB1,NUMB0 CLEAR TO 24,79
@ NUMB2,CTITLE SAY TITLE COLOR COL3
@ NUMB3,CTITLE1 SAY TITLE1 COLOR COL6
@ NUMB4,NUMB0 TO NUMB4,79
@ NUMB5,NUMB0 SAY HEAD1
@ NUMB6,NUMB0 TO NUMB6,79
@ 23, NUMB0 TO 23,79
@ 24, NUMB0 SAY '<Ctrl>+P' COLOR COL3
@ 24, NUMB9 SAY '- Print'
@ 24, 59 SAY TAMT PICT '9999999.99' COLOR COL3
*99.99.9999 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 999 9999.99 999999.99 XXXXXXXXXX
STORE NUMB1 TO LKEY
DO WHILE LKEY<>ESC
CHOICE=ACHOICE(NUMB7,NUMB0,22,79,REPLINE,VARTRUE,"REPORT1",NUMB1,NUMB0)
ENDDO
RETURN
*****************
PROCEDURE REPORT1
*****************
PARAMETER MODE,CUR_ELEM,REL_POS
PARAMETER KEY,RET_VAL
DO CASE
CASE MODE=NUMB3
KEY=LASTKEY()
IF KEY=ESC
LKEY=ESC
RET_VAL=NUMB0
ELSEIF KEY=16
CP=CUR_ELEM
PR=ROW()
@ PR,NUMB0 SAY REPLINE[CP] COLOR COL2
SAVE SCREEN TO AMDSCR
SAVE TO AMD ALL LIKE AMDSCR
RELE AMDSCR
SET CURSOR ON
DO REPORTPRN
REST FROM AMD ADDITIVE
REST SCREEN FROM AMDSCR
RELE AMDSCR
SET CURSOR OFF
ELSE
RET_VAL=NUMB2
ENDIF
OTHERWISE
RET_VAL=NUMB2
ENDCASE
RETURN RET_VAL
*******************
PROCEDURE REPORTPRN
*******************
DO PRNTEST
IF LASTKEY()=ESC
RETURN
ENDIF
STORE NUMB0 TO COUNTER
STORE NUMB1 TO PAGE
STORE ONE TO HEAD2,HEAD3,TITLE2,TITLE3
STORE 6 TO INCH
HEADLINE=REPL('-',80)
DO MSG WITH 'PRINTING REPORT, PLEASE WAIT....'
LR=LEN(REPLINE)
*FL=CDIR+'\REP.TXT'
*SET PRINTER TO (FL)
SET DEVICE TO PRINT
SET PRINTER ON
SETPRC(NUMB0,NUMB0)
DO REPHEAD
FOR I=NUMB1 TO LR
IF COUNTER>28
DO REPHEAD
ENDIF
@ COUNTER++,NUMB0 SAY REPLINE[I]
NEXT
@ COUNTER++,NUMB0 SAY HEADLINE
@ COUNTER, NUMB0 SAY 'TOTAL'
@ COUNTER++,59 SAY TAMT PICT '9999999.99'
@ COUNTER++,NUMB0 SAY HEADLINE
EJECT
SET PRINTER OFF
SET DEVICE TO SCREEN
SET PRINTER TO
RETURN
function voumas()
CLOSE ALL
STORE OPDT TO FDATE
STORE DATE() TO TDATE
IF TDATE>CLDT
TDATE=CLDT
ENDIF
IF FDATE<OPDT
FDATE=OPDT
ENDIF
DO STBOX WITH 10,ESC,16,54,''
@ 12,30 SAY 'FROM DATE ' GET FDATE VALID FDATE>=OPDT .AND. FDATE<=CLDT
@ 14,30 SAY 'TO DATE ' GET TDATE VALID TDATE>=FDATE .AND. TDATE<=CLDT
READ
IF LASTKEY()=ESC
RETURN
ENDIF
HEAD1=' DATE A/C NAME FROM/TO PARTY NUG RATE AMOUNT REMARK'
TITLE=' VOUCHER ENTRY '
TITLE1=ONE+DTOC(FDATE)+' TO '+DTOC(TDATE)+ONE
@ NUMB1,NUMB0 CLEAR TO 24,79
@ NUMB2,33 SAY TITLE COLOR COL3
@ NUMB3,26 SAY TITLE1 COLOR COL6
@ NUMB4,NUMB0 TO NUMB4,79
@ NUMB5,NUMB0 SAY HEAD1
@ NUMB6,NUMB0 TO NUMB6,79
@ 23, NUMB0 TO 23,79
@ 24, NUMB0 SAY '<Ctrl>+P' COLOR COL3
@ 24, NUMB9 SAY '- Print'
*99.99.9999 xxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxx 999 9999.99 999999 XXXXXXXXXX
STORE NUMB1 TO CP
STORE NUMB0 TO RP
STORE VARTRUE TO CPFIRST
STORE VARFAL TO REPNAME
STORE DATE() TO DT
STORE SPACE(35) TO NAME1
IF DT>CLDT
DT=CLDT
ENDIF
DO WHILE VARTRUE
STORE NUMB1 TO I
PRIVATE LSLINE[I],LSVNO[I]
LSLN=SPACE(22)+'To add new voucher press <Enter> here'+SPACE(21)
LSLINE[I]=LSLN
STORE NUMB0 TO LSVNO[I],TAMT
SET SOFTSEEK ON
USE VOU&CC INDEX DVOU&CC
SEEK FDATE
SET SOFTSEEK OFF
DO WHILE DATE>=FDATE .AND. DATE<=TDATE .AND. .NOT. EOF()
AADD(LSLINE,LSLN)
AADD(LSVNO,NUMB0)
LSLINE[I]=DTOC(DATE)+ONE+SUBSTR(ACNAME1,NUMB1,19)+ONE+SUBSTR(ACNAME2,NUMB1,19)+ONE+STR(NUG,NUMB3,NUMB0)+ONE+STR(RATE,NUMB7,NUMB2)+ONE+STR(AMOUNT,NUMB6,NUMB0)+ONE+REMARK
LSVNO[I]=VNO
I++
TAMT=TAMT+AMOUNT
SKIP
ENDDO
CLOSE ALL
LR=LEN(LSLINE)
IF CPFIRST
CP=LR
CPFIRST=VARFAL
ENDIF
@ NUMB7,NUMB0 CLEAR TO 22,79
@ 24,61 SAY TAMT PICT '99999999' COLOR COL3
STORE NO TO ALT
STORE NUMB1 TO LKEY
DO WHILE ALT=NO .AND. LKEY<>ESC
CHOICE=ACHOICE(NUMB7,NUMB0,22,79,LSLINE,VARTRUE,"VOUAMD",CP,RP)
ENDDO
IF ALT=NO .AND. LKEY=ESC
EXIT
ENDIF
ENDDO
RETURN
****************
PROCEDURE VOUAMD
****************
PARAMETER MODE,CUR_ELEM,REL_POS
PARAMETER KEY,RET_VAL
DO CASE
CASE MODE=NUMB3
KEY=LASTKEY()
IF KEY=ESC
LKEY=ESC
RET_VAL=NUMB0
ELSEIF KEY=13 .OR. KEY=NUMB7
CP=CUR_ELEM
PR=ROW()
@ PR,NUMB0 SAY LSLINE[CP] COLOR COL2
SAVE SCREEN TO AMDSCR
SAVE TO AMD ALL LIKE AMDSCR
RELE AMDSCR
SET CURSOR ON
IF KEY=13
DO VOUAM
ELSEIF KEY=NUMB7
DO VOUDL
ENDIF
REST FROM AMD ADDITIVE
REST SCREEN FROM AMDSCR
RELE AMDSCR
SET CURSOR OFF
IF ALT=YES
RET_VAL=NUMB0
ELSEIF ALT=NO
RET_VAL=NUMB2
ENDIF
ELSE
RET_VAL=NUMB2
ENDIF
OTHERWISE
RET_VAL=NUMB2
ENDCASE
RETURN RET_VAL
***************
PROCEDURE VOUAM
***************
STORE SPACE(35) TO NAME2
STORE NUMB0 TO INUG,IRATE,IAMT,IVN
STORE SPACE(10) TO IREM
IF CP<LR
USE VOU&CC INDEX VVOU&CC
SEEK LSVNO[CP]
DO VOUSTR
CLOSE ALL
ENDIF
DO VOUGET
IF LASTKEY()=ESC
RETURN
ENDIF
IF CP=LR
USE DEF&CC
STORE VOUNO TO IVN
REPL VOUNO WITH VOUNO+NUMB1
CLOSE ALL
USE VOU&CC INDEX VVOU&CC,DVOU&CC,NVOU&CC
APPE BLAN
DO VOURPL
STORE VARTRUE TO CPFIRST,LASTENT
ELSEIF CP<LR
USE VOU&CC INDEX VVOU&CC,DVOU&CC,NVOU&CC
SEEK IVN
DO VOURPL
ENDIF
CLOSE ALL
ALT=YES
RETURN
**************
PROCEDUR VOUDL
**************
IF CP=LR
RETURN
ENDIF
YN=NO
DO YESNO WITH YN
IF YN=NO
RETURN
ENDIF
DO MSG WITH 'DELEING VOUCHER, PLEASE WAIT.....'
USE VOU&CC INDEX VVOU&CC,DVOU&CC,NVOU&CC
SEEK LSVNO[CP]
IF FOUND()
DO VOUBL
ENDIF
CLOSE ALL
ALT=YES
RETURN
****************
PROCEDURE VOUGET
****************
@ PR,NUMB0 CLEAR TO PR,79
@ PR,NUMB0 GET DT VALID DT>=OPDT .AND. DT<=CLDT
@ PR,11 GET NAME1 PICT '@S19' VALID VLPNAM(NUMB1)
@ PR,31 GET NAME2 PICT '@S19' VALID VLPNAM(NUMB2)
@ PR,51 GET INUG PICT '999' VALID VINUG()
@ PR,55 GET IRATE PICT '9999.99' VALID VIRATE()
@ PR,63 GET IAMT PICT '999999' WHEN IRATE=NUMB0
@ PR,70 GET IREM
READ
RETURN
**************
FUNCTION VINUG
**************
IF INUG<NUMB0
IF STR(INUG,10,NUMB3)=STR(NUMB0,10,NUMB3) .AND. LASTKEY()=NUMB5
DO IAMTCALC
RETURN VARTRUE
ELSE
RETURN VARFAL
ENDIF
ENDIF
DO IAMTCALC
RETURN VARTRUE
**************
FUNCTION VIRATE
**************
IF IRATE<NUMB0
IF STR(IRATE,10,NUMB3)=STR(NUMB0,10,NUMB3) .AND. LASTKEY()=NUMB5
DO IAMTCALC
RETURN VARTRUE
ELSE
RETURN VARFAL
ENDIF
ENDIF
DO IAMTCALC
RETURN VARTRUE
******************
PROCEDURE IAMTCALC
******************
IF STR(IRATE,NUMB8,NUMB2)<>STR(NUMB0,NUMB8,NUMB2)
IAMT=ROUND(INUG*IRATE,NUMB0)
ENDIF
@ PR,63 SAY IAMT PICT '999999' COLOR COL2
RETURN
****************
PROCEDURE VOURPL
****************
REPL DATE WITH DT
REPL ACNAME1 WITH NAME1
REPL ACNAME2 WITH NAME2
REPL NUG WITH INUG
REPL RATE WITH IRATE
REPL AMOUNT WITH IAMT
REPL REMARK WITH IREM
REPL VNO WITH IVN
RETURN
****************
PROCEDURE VOUSTR
****************
STORE DATE TO DT
STORE ACNAME1 TO NAME1
STORE ACNAME2 TO NAME2
STORE NUG TO INUG
STORE RATE TO IRATE
STORE AMOUNT TO IAMT
STORE VNO TO IVN
STORE REMARK TO IREM
RETURN
***************
PROCEDURE VOUBL
***************
REPL DATE WITH EMDATE
REPL ACNAME1 WITH ONE
REPL ACNAME2 WITH ONE
REPL NUG WITH NUMB0
REPL RATE WITH NUMB0
REPL AMOUNT WITH NUMB0
REPL VNO WITH NUMB0
REPL REMARK WITH ONE
RETURN
*************
PROCEDURE MSG
*************
PARAMETERS MESG
@ 23,NUMB0 CLEAR TO 23,79
@ 23,NUMB0 SAY 'MESSAGE : ' + MESG COLOR COL3
RETURN
**************
PROCEDURE SMSG
**************
PARAMETERS MESG
TEMPSCR=SAVESCREEN(23,NUMB0,23,79)
@ 23,NUMB0 CLEAR TO 23,79
@ 23,NUMB0 SAY 'MESSAGE : ' + MESG COLOR COL3
SET CURSOR OFF
WAIT""
SET CURSOR ON
RESTSCREEN(23,NUMB0,23,79,TEMPSCR)
RETURN
*************
PROCEDURE BOX
*************
PARAMET TR,TC,BR,BC,HEAD
HEADCOL=TC+ROUND((BC-TC-LEN(HEAD))/NUMB2,NUMB0)
@ TR, TC CLEAR TO BR,BC
@ TR, TC TO BR, BC DOUBLE COLOR COL2
SP=BC-NUMB1-TC
@ TR+NUMB1, TC+NUMB1 SAY SPACE(SP) COLOR COL2
@ TR+NUMB2, TC+NUMB1 SAY SPACE(SP) COLOR COL2
@ TR+NUMB1, HEADCOL SAY HEAD COLOR COL3
RETURN
*****************
PROCEDURE PRNTEST
*****************
IF .NOT. ISPRINTER()
DO WHILE .NOT. ISPRINTER()
DO SMSG WITH 'PRINTER NOT READY, PLEASE ON THE SWITCH...'
IF LASTKEY()=ESC
RETURN
ENDIF
ENDDO
ENDIF
RETURN
********************
PROCEDURE YESNO(VAR)
********************
SET COLOR TO (VIOLET)
YESNOSCR=SAVESCREEN(NUMB8,28,14,50)
@ NUMB8,28 CLEAR TO 14,50
IF VAR='Y'
DO STBOX WITH NUMB8,28,14,50,'Is It O.K.'
VYESNO=NUMB1
ELSEIF VAR='N'
DO STBOX WITH NUMB8,28,14,50,'Are You Sure'
VYESNO=NUMB2
ENDIF
YN1=' YES '
YN2=' NO '
@ 12,31 PROMPT YN1
@ 12,41 PROMPT YN2
MENU TO VYESNO
DO CASE
CASE VYESNO=NUMB1
YN='Y'
CASE VYESNO=NUMB2 .OR. VYESNO=NUMB0 .OR. VYESNO=ESC
YN='N'
ENDCASE
RESTSCREEN(NUMB8,28,14,50,YESNOSCR)
SET COLOR TO (DEFCOL)
RETURN
***************
PROCEDURE STBOX
***************
PARAMET TR,TC,BR,BC,HEAD
HEADCOL=TC+ROUND((BC-TC-LEN(HEAD))/NUMB2,NUMB0)
@ TR, TC CLEAR TO BR,BC
@ TR, TC TO BR, BC DOUBLE COLOR COL2
@ TR+NUMB2, HEADCOL SAY HEAD COLOR COL3
RETURN
**************
PROCEDURE DISP
**************
DISPSCR=SAVESCREEN(NUMB8,25,12,54)
DO STBOX WITH NUMB8,25,12,54,''
VDP=NUMB1
DP1=' Display '
DP2=' Print '
@ 10,28 PROMPT DP1
@ 10,43 PROMPT DP2
MENU TO VDP
DO CASE
CASE VDP=NUMB0
DP='R'
CASE VDP=NUMB1
DP='D'
CASE VDP=NUMB2
DP='P'
ENDCASE
RESTSCREEN(NUMB8,25,12,54,DISPSCR)
RETURN
*****************
PROCEDURE ALLPART
*****************
APSCR=SAVESCREEN(10,25,14,54)
DO STBOX WITH 10,25,14,54,''
VAP=NUMB1
AP1=' All '
AP2=' Particular '
@ 12,28 PROMPT AP1
@ 12,38 PROMPT AP2
MENU TO VAP
DO CASE
CASE VAP=NUMB0
AP='R'
CASE VAP=NUMB1
AP='A'
CASE VAP=NUMB2
AP='P'
ENDCASE
RESTSCREEN(10,25,14,54,APSCR)
RETURN
**************
FUNCTION CALC
**************
GetList := {}
STORE SPACE(240) TO EXP,BEXP
CAL=VARTRUE
CHLP=SAVESCREEN(NUMB1,NUMB0,NUMB9,79)
@ NUMB1,NUMB0 CLEAR TO NUMB9,79
@ NUMB1,NUMB0 TO NUMB9,79 DOUBLE
@ NUMB1,29 SAY ' M A T H M E N U ' COLOR COL3
@ NUMB7,NUMB4 SAY '<Enter>' COLOR COL3
@ NUMB7,30 SAY '^R' COLOR COL3
@ NUMB7,63 SAY '<Esc>' COLOR COL3
@ NUMB8,NUMB2 SAY ' Add Subtract Multiply Division Exponentiate'
@ NUMB8,NUMB4 SAY '+' COLOR COL3
@ NUMB8,15 SAY '-' COLOR COL3
@ NUMB8,31 SAY '*' COLOR COL3
@ NUMB8,47 SAY '/' COLOR COL3
@ NUMB8,62 SAY '^' COLOR COL3
@ NUMB7,13 SAY 'Calculate'
@ NUMB7,34 SAY 'Restores last equation'
@ NUMB7,69 SAY 'Exit'
SET CURSOR ON
DO WHILE CAL
@ NUMB3, NUMB4 SAY 'Type a Math Equation'
@ NUMB3,50 SAY 'Last Result : '
@ NUMB5, NUMB4 GET EXP PICT '@S73'
READ
TE=TYPE(RIGHT(ALLTRIM(EXP),1))
IF LASTKEY()=18
EXP=BEXP
LOOP
ENDIF
IF LASTKEY()=ESC
CAL=VARFAL
LOOP
ENDIF
IF EMPTY(EXP) .OR. TE='UE'
LOOP
ENDIF
IF TYPE(EXP)='U'
DO SMSG WITH 'TYPE ONLY DIGITS & OPERATORS, PRESS ANY KEY TO CONTINUE....'
LOOP
ENDIF
RESULT=&EXP
@ NUMB3,63 CLEAR TO NUMB3,78
@ NUMB3,63 SAY RESULT
BEXP=EXP
EXP=SPACE(240)
IF LASTKEY()=ESC
CAL=VARFAL
ENDIF
ENDDO
RESTSCREEN(NUMB1,NUMB0,NUMB9,79,CHLP)
RETURN VARTRUE
*****************
PROCEDURE REPHEAD
*****************
COUNTER=NUMB0
@ COUNTER,NUMB0 SAY COF
@ COUNTER,NUMB0 SAY CHR(ESC)+'C'+CHR(0)+CHR(INCH) // FOR PAGE LENGTH
@ COUNTER,NUMB0 SAY CHR(ESC)+'x0' // FOR DRAFT MODE
@ COUNTER,NUMB0 SAY CHR(ESC)+'P' // FOR 10 CHARACTERS PER INCH
@ COUNTER++,CCNAME+NUMB4 SAY DON+BON+CNAME+DOF+BOF+CHR(ESC)+'P'
COUNTER++
IF .NOT. EMPTY(CADD1)
@ COUNTER++,CCADD1 SAY UON+CADD1+UOF
ENDIF
IF .NOT. EMPTY(CADD2)
@ COUNTER++,CCADD2 SAY UON+CADD2+UOF
ENDIF
IF (.NOT. EMPTY(CADD1)) .OR. (.NOT. EMPTY(CADD2))
COUNTER++
ENDIF
CTITLE=((80-LEN(TITLE))/NUMB2)+NUMB1
CTITLE1=((80-LEN(TITLE1))/NUMB2)+NUMB1
CTITLE2=((80-LEN(TITLE2))/NUMB2)+NUMB1
CTITLE3=((80-LEN(TITLE3))/NUMB2)+NUMB1
IF .NOT. EMPTY(TITLE)
@ COUNTER++,CTITLE SAY BON+TITLE+BOF
ENDIF
IF .NOT. EMPTY(TITLE1)
@ COUNTER++,CTITLE1 SAY BON+TITLE1+BOF
ENDIF
IF .NOT. EMPTY(TITLE2)
@ COUNTER++,CTITLE2 SAY BON+TITLE2+BOF
ENDIF
IF .NOT. EMPTY(TITLE3)
@ COUNTER++,CTITLE3 SAY BON+TITLE3+BOF
ENDIF
@ COUNTER, 68 SAY 'Page No.'
@ COUNTER++,77 SAY PAGE PICT '###'
IF SUBSTR(HEADLINE,NUMB1,NUMB1)=CON
@ COUNTER++,NUMB0 SAY CON+ONE
ENDIF
@ COUNTER++,NUMB0 SAY HEADLINE
@ COUNTER++,NUMB0 SAY HEAD1
IF .NOT. EMPTY(HEAD2)
@ COUNTER++,NUMB0 SAY HEAD2
ENDIF
IF .NOT. EMPTY(HEAD3)
@ COUNTER++,NUMB0 SAY HEAD3
ENDIF
@ COUNTER++,NUMB0 SAY HEADLINE
PAGE++
RETURN
*************
PROCEDURE IND
*************
DO MSG WITH 'INDEXING, PLEASE WAIT...'
CLOSE ALL
USE ACMAST&CC
INDEX ON ACNAME TO NACM&CC
CLOSE ALL
USE VOU&CC
INDEX ON DATE TO DVOU&CC
INDEX ON VNO TO VVOU&CC
INDEX ON ACNAME1+DTOS(DATE) TO NVOU&CC
CLOSE ALL
RETURN
****************
PROCEDURE VLINM1
****************
IF LASTKEY()=13
VITNAME=UPPER(ALLTRIM(INAME))
DO ITEMHELP
IF LASTKEY()=ESC
RETURN VARFAL
ENDIF
IF .NOT. EMPTY(VITNAME)
INAME=VITNAME
ENDIF
ENDIF
USE ITEM&CC INDEX NITEM&CC
SEEK INAME
IF .NOT. FOUND()
DO SMSG WITH "THIS ITEM NAME DOES NOT EXISTS, PRESS `A' TO ADD IT...."
IF LASTKEY()=65 .OR. LASTKEY()=97
APPE BLAN
REPL ITEMNAME WITH INAME
CLOSE ALL
RETURN VARTRUE
ENDIF
CLOSE ALL
RETURN VARFAL
ELSE
STORE CUSTMONTH TO ICMTH
STORE DEALERMTH TO IDMTH
STORE SERVDAYS TO ISDAYS
CLOSE ALL
RETURN VARTRUE
ENDIF
*****************
PROCEDURE VLCITY1
*****************
IF LASTKEY()=13
VCTNAME=UPPER(ALLTRIM(CTNAME))
DO CITYHELP
IF LASTKEY()=ESC
RETURN VARFAL
ENDIF
IF .NOT. EMPTY(VCTNAME)
CTNAME=VCTNAME
ENDIF
ENDIF
IF REPCITY
IF EMPTY(CTNAME)
RETURN VARTRUE
ENDIF
ENDIF
USE CITY&CC INDEX CITY&CC
SEEK CTNAME
IF .NOT. FOUND()
DO SMSG WITH "THIS CITY NAME DOES NOT EXISTS, PRESS `A' TO ADD IT...."
IF LASTKEY()=65 .OR. LASTKEY()=97
APPE BLAN
REPL CITY WITH CTNAME
CLOSE ALL
RETURN VARTRUE
ENDIF
CLOSE ALL
RETURN VARFAL
ELSE
CLOSE ALL
RETURN VARTRUE
ENDIF
*****************
PROCEDURE VLCITY2
*****************
PARAMETER VARN
VARN=LTRIM(STR(VARN,NUMB2,NUMB0))
IF LASTKEY()=13
VCTNAME=UPPER(ALLTRIM(CTNAME&VARN))
DO CITYHELP
IF LASTKEY()=ESC
RETURN VARFAL
ENDIF
IF .NOT. EMPTY(VCTNAME)
CTNAME&VARN=VCTNAME
ENDIF
ELSEIF LASTKEY()=NUMB5
IF EMPTY(CTNAME&VARN)
RETURN VARTRUE
ENDIF
ENDIF
IF REPCITY
IF EMPTY(CTNAME&VARN)
RETURN VARTRUE
ENDIF
ENDIF
USE CITY&CC INDEX CITY&CC
SEEK CTNAME&VARN
IF .NOT. FOUND()
DO SMSG WITH "THIS CITY NAME DOES NOT EXISTS, PRESS `A' TO ADD IT...."
IF LASTKEY()=65 .OR. LASTKEY()=97
APPE BLAN
REPL CITY WITH CTNAME&VARN
CLOSE ALL
RETURN VARTRUE
ENDIF
CLOSE ALL
RETURN VARFAL
ELSE
CLOSE ALL
RETURN VARTRUE
ENDIF
****************
FUNCTION VLNAME1
****************
CLNAME=PROCNAME(NUMB1)
IF LASTKEY()=13
VACNAME=UPPER(ALLTRIM(NAME))
DO ACHELP
IF LASTKEY()=ESC
RETURN VARFAL
ENDIF
IF .NOT. EMPTY(VACNAME)
NAME=VACNAME
ENDIF
ELSEIF LASTKEY()=NUMB5
IF EMPTY(NAME)
RETURN VARTRUE
ENDIF
ENDIF
IF REPNAME
IF EMPTY(NAME)
RETURN VARTRUE
ENDIF
ELSE
IF EMPTY(NAME)
RETURN VARFAL
ENDIF
ENDIF
IF UPPER(ALLTRIM(NAME))='ALL'
RETURN VARTRUE
ENDIF
USE ACMAST&CC INDEX NACM&CC
SEEK NAME
IF .NOT. FOUND()
DO SMSG WITH "THIS DEALER NAME DOES NOT EXISTS, PRESS ANY KEY TO CONTINUE......"
CLOSE ALL
RETURN VARFAL
ELSE
STORE ADDRESS1 TO ADD1
STORE ADDRESS2 TO ADD2
STORE CITY TO ADD3
CLOSE ALL
RETURN VARTRUE
ENDIF
****************
PROCEDURE ITTRBL
****************
REPL DATE WITH EMDATE
REPL ACNAME WITH ONE
REPL ITEMNAME WITH ONE
REPL CUSTMONTH WITH NUMB0
REPL DEALERMTH WITH NUMB0
REPL SERVDAYS WITH NUMB0
REPL COUPANNO WITH ONE
REPL VOUTYPE WITH ONE
REPL BOOK WITH ONE
REPL VNO WITH NUMB0
REPL SLNO WITH NUMB0
RETURN
**********************
FUNCTION VLPNAM(VARNO)
**********************
IF LASTKEY()=NUMB3 .OR. LASTKEY()=23 .OR. LASTKEY()=18
RETURN VARFAL
ENDIF
VRNO=LTRIM(STR(VARNO,NUMB5,NUMB0))
IF LASTKEY()=13
VACNAME=UPPER(ALLTRIM(NAME&VRNO))
DO ACHELP
IF LASTKEY()=ESC
RETURN VARFAL
ENDIF
IF .NOT. EMPTY(VACNAME)
NAME&VRNO=VACNAME
ENDIF
ENDIF
IF EMPTY(NAME&VRNO) .AND. LASTKEY()=NUMB5
RETURN VARTRUE
ENDIF
USE ACMAST&CC INDEX NACM&CC
SEEK NAME&VRNO
IF .NOT. FOUND()
DO SMSG WITH "THIS PARTY NAME DOES NOT EXISTS, PRESS `A' TO ADD IT....."
IF LASTKEY()=65 .OR. LASTKEY()=97
APPE BLAN
REPL ACNAME WITH NAME&VRNO
CLOSE ALL
RETURN VARTRUE
ENDIF
CLOSE ALL
RETURN VARFAL
ELSE
CLOSE ALL
RETURN VARTRUE
ENDIF
function accmas()
CLOSE ALL
DO STBOX WITH NUMB0,39,24,79,' PARTY LIST '
@ NUMB3,40 TO NUMB3,78
@ NUMB5,40 TO NUMB5,78
@ 22,40 TO 22,78
STORE VARTRUE TO CPFIRST
STORE NUMB1 TO CP
STORE NUMB0 TO RP
DO WHILE VARTRUE
STORE NUMB1 TO J
PRIVATE LSLINE[J]
LLINE=SPACE(15)+'<Add>'+SPACE(15)
LSLINE[J]=LLINE
USE ACMAST&CC INDEX NACM&CC
DO WHILE .NOT. EOF()
AADD(LSLINE,LLINE)
LSLINE[J]=ACNAME
J++
SKIP
ENDDO
CLOSE ALL
LR=LEN(LSLINE)
IF CPFIRST
STORE VARFAL TO CPFIRST
STORE LR TO CP
ENDIF
@ NUMB6,42 CLEAR TO 21,76
@ NUMB4,42 SAY SPACE(35) COLOR COL2
@ 23,42 SAY LR-NUMB1 PICT '9999' COLOR COL3
@ 23,47 SAY 'Parties'
ALT=NO
LKEY=NUMB1
SSS=''
DO WHILE ALT=NO .AND. LKEY<>ESC
CHOICE=ACHOICE(NUMB6,42,21,76,LSLINE,VARTRUE,"ACCAMD",CP,RP)
ENDDO
IF ALT=NO .AND. LKEY=ESC
EXIT
ENDIF
ENDDO
RETURN
****************
PROCEDURE ACCAMD
****************
PARAMETER MODE,CUR_ELEM,REL_POS
PARAMETER RET_VAL,KEY
SET EXACT OFF
DO CASE
CASE MODE=NUMB3
KEY=LASTKEY()
IF KEY=ESC
LKEY=ESC
RET_VAL=NUMB0
ELSEIF KEY=13 .OR. KEY=NUMB7
CP=CUR_ELEM
RP=REL_POS
PR=ROW()
@ PR,42 SAY LSLINE[CP] COLOR COL2
SAVE SCREEN TO AMDSCR
SAVE TO AMD ALL LIKE AMDSCR
RELE AMDSCR
SET CURSOR ON
IF KEY=13
DO ACCAM
ELSEIF KEY=NUMB7
DO ACCDL
ENDIF
SET CURSOR OFF
REST FROM AMD ADDITIVE
REST SCREEN FROM AMDSCR
RELE AMDSCR
IF ALT=YES
RET_VAL=NUMB0
ELSEIF ALT=NO
RET_VAL=NUMB2
ENDIF
ELSEIF KEY=NUMB8
LENSSS=LEN(SSS)-NUMB1
SSS=SUBSTR(SSS,NUMB1,LENSSS)
@ NUMB4,42 SAY SSS+ONE COLOR COL2
ELSE
IF LEN(SSS)<35
SSS=SSS+CHR(KEY)
ENDIF
ENDIF
OLDCP=CP
@ NUMB4,42 SAY SSS COLOR COL2
SSS=UPPER(SSS)
CP=ASCAN(LSLINE,SSS)
IF CP=NUMB0 .OR. EMPTY(SSS)
CP=OLDCP
ENDIF
RET_VAL=NUMB0
OTHERWISE
RET_VAL=NUMB2
ENDCASE
RETURN RET_VAL
****************
PROCEDURE ACCAM
****************
STORE SPACE(35) TO NAME,PNAME
IF CP<LR
STORE LSLINE[CP] TO NAME,PNAME
ENDIF
@ PR,42 CLEAR TO PR,76
@ PR,42 GET NAME VALID VLNAME()
READ
IF LASTKEY()=ESC
RETURN
ENDIF
USE ACMAST&CC INDEX NACM&CC
IF CP=LR
APPE BLAN
DO ACCRPL
STORE VARTRUE TO CPFIRST
ELSEIF CP<LR
SEEK PNAME
DO ACCRPL
CLOSE ALL
IF PNAME<>NAME
CLOSE ALL
USE VOU&CC
REPL ALL ACNAME1 WITH NAME FOR ACNAME1=PNAME
REPL ALL ACNAME2 WITH NAME FOR ACNAME2=PNAME
CLOSE ALL
DO IND
ENDIF
ENDIF
ALT=YES
CLOSE ALL
RETURN
***************
PROCEDURE ACCDL
***************
IF CP=LR
RETURN
ENDIF
STORE VARFAL TO FOUNDOK
DO CHCKACN WITH "VOU&CC"
IF FOUNDOK
DO SMSG WITH 'YOU CAN NOT DELETE THIS PARTY BECAUSE YOU HAVE USED IT...'
CLOSE ALL
RETURN
ENDIF
YN=NO
DO YESNO WITH YN
IF YN=NO
RETURN
ENDIF
USE ACMAST&CC INDEX NACM&CC
SEEK LSLINE[CP]
IF FOUND()
DELE
PACK
ENDIF
CLOSE ALL
ALT=YES
RETURN
*****************
PROCEDURE CHCKACN
*****************
PARAMETER FN
USE (FN)
LOCA FOR ACNAME1=LSLINE[CP] .OR. ACNAME2=LSLINE[CP]
IF FOUND()
FOUNDOK=VARTRUE
ENDIF
CLOSE ALL
RETURN
****************
FUNCTION VLNAME
****************
IF EMPTY(NAME)
RETURN VARFAL
ENDIF
USE ACMAST&CC INDEX NACM&CC
SEEK NAME
IF FOUND()
IF CP<LR
IF ACNAME=PNAME
CLOSE ALL
RETURN VARTRUE
ENDIF
ENDIF
DO SMSG WITH 'THIS PARTY NAME ALREADY EXISTS, PRESS ANY KEY TO CONTINUE.....'
CLOSE ALL
RETURN VARFAL
ELSE
CLOSE ALL
RETURN VARTRUE
ENDIF
*****************
FUNCTION ACCRPL
*****************
REPL ACNAME WITH NAME
RETURN
But this gives several runtime errors:
Error DBFNTX/1001 Open error: DEF .dbf
(DOS Error 3) Quit Retry Default
Serge
There's nothing you can do that can't be done...
Re: CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE
Hi,
To print to USB printers, it is not necessary to convert your application to HMG. If you are interested, I can send you a generic text2gdi converter, which you can easily modify to suit your requirments.
HTH,
Warm regards,
Jayadev
To print to USB printers, it is not necessary to convert your application to HMG. If you are interested, I can send you a generic text2gdi converter, which you can easily modify to suit your requirments.
HTH,
Warm regards,
Jayadev
- danielmaximiliano
- Posts: 2611
- Joined: Fri Apr 09, 2010 4:53 pm
- Location: Argentina
- Contact:
Re: CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE
Hola Manoj:manoj_duamzn wrote:I am clipper programmer. I converted 2-3 applicaton to HARBOUR. Which are running perfectly. But in HARBOUR it prints only to LPT1-4. It does not print on USB port printer EPSON LX-300+. Now I want to give print out on USB port printer. Can I give print on USB port printer and also on LASER printer HP Laerject 1020 plus.
In this regard I started to build a small application to HMG 3.0.22. I make a folder SLIP in c:\hmg.3.0.22 and started to build by following command and found following error
C:\HMG.3.0.22\SLIP>BUILD /CS SLIP.HBP
utilizamos impresoras USB y de Puerto paralelo en la empresa; las mismas se comparten en la red para que sean usadas por los distintos usuarios del sistema.
para ello utilize con comando propio de windows para ello.
Code: Select all
net use lptx \\printserver\sharename /persistent:yes
http://support.microsoft.com/kb/314499/es
no importa si es USB o Paralelo.
utilize HMG.3.1.5 y aplique los respectivos patch que corrige muchas cosas implementadas en HMG3.0.22
o en su defecto utilize HMG.3.0.46 estable.
Translate Google
Hi Manoj:
printers use USB and parallel port in the company, the same is shared on the network to be used by different system users.
for it to used with windows own command for this.
Code: Select all
lptx net use \ \ printserver \ sharename / persistent: yes [/ code]
[url] http://support.microsoft.com/kb/314499/en" onclick="window.open(this.href);return false; [/ url]
[url] http://support.microsoft.com/kb/314499/es" onclick="window.open(this.href);return false; [/ url]
whether it is USB or Parallel.
Use HMG.3.1.5 and apply the relevant patch that fixes many things implemented HMG.3.0.22
or failing Use HMG.3.0.46 stable.
*´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´. (¸.·` *
.·`. Harbour/HMG : It's magic !
(¸.·``··*
Saludos / Regards
DaNiElMaXiMiLiAnO
Whatsapp. := +54901169026142
Telegram Name := DaNiElMaXiMiLiAnO
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´. (¸.·` *
.·`. Harbour/HMG : It's magic !
(¸.·``··*
Saludos / Regards
DaNiElMaXiMiLiAnO
Whatsapp. := +54901169026142
Telegram Name := DaNiElMaXiMiLiAnO
-
- Posts: 21
- Joined: Fri Aug 30, 2013 5:38 am
Re: CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE
Dear Serge_girard
First of All thanks for your quick replay. In this regard I have to say that it is my small application of 9 prg which I can merge in one prg but like this I have many application which have about 100 prgs. Which is not possible to merge them in one prg. So kindly tell me Is another way to build HMG console application. I want to convert it into HMG because I want to take benefits some command which is not supporting in Harbour.
My first requirment is to print on USB port printer. Kindly help me in this problem.
Dear jayadevu I request you to kindly send me generic text2gdi converter and also hint me how to use it.
Dear danielmaximiliano you have sugesst me to use NET USE LPT command. But it redirect print job to network printer not on local printer. Is it works for local printer then tell me the process.
Beside this I want to ask that I use ESC codes for DMP printer. Is they will run on LASER printer.
I am waiting all of your's support.
First of All thanks for your quick replay. In this regard I have to say that it is my small application of 9 prg which I can merge in one prg but like this I have many application which have about 100 prgs. Which is not possible to merge them in one prg. So kindly tell me Is another way to build HMG console application. I want to convert it into HMG because I want to take benefits some command which is not supporting in Harbour.
My first requirment is to print on USB port printer. Kindly help me in this problem.
Dear jayadevu I request you to kindly send me generic text2gdi converter and also hint me how to use it.
Dear danielmaximiliano you have sugesst me to use NET USE LPT command. But it redirect print job to network printer not on local printer. Is it works for local printer then tell me the process.
Beside this I want to ask that I use ESC codes for DMP printer. Is they will run on LASER printer.
I am waiting all of your's support.
- serge_girard
- Posts: 3161
- Joined: Sun Nov 25, 2012 2:44 pm
- DBs Used: 1 MySQL - MariaDB
2 DBF - Location: Belgium
- Contact:
Re: CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE
Manoj,
In SLIP.PRG:
SET PROC TO COMMAN
SET PROC TO HELPFILE
and in SLIP.HBP:
slip.prg
<remove other prg>
Succes and greetings,
Serge
In SLIP.PRG:
SET PROC TO COMMAN
SET PROC TO HELPFILE
and in SLIP.HBP:
slip.prg
<remove other prg>
Succes and greetings,
Serge
There's nothing you can do that can't be done...
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
Re: CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE
Good Serge, very good assitance !
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
- serge_girard
- Posts: 3161
- Joined: Sun Nov 25, 2012 2:44 pm
- DBs Used: 1 MySQL - MariaDB
2 DBF - Location: Belgium
- Contact:
Re: CONVERSION OF CLIPPER CONSOLE APPLICATION TO HMG CONSOLE
Pablo,
Thank you....
Sometimes I have some sparetime to help!
S
Thank you....
Sometimes I have some sparetime to help!
S
There's nothing you can do that can't be done...