Saturday, October 28, 2017

Number of Days Before Christmas Counter in JavaScript

Here is a sample program that I wrote that will count the number of days before Christmas using JavaScript.

My email address are the following jakerpomperada@gmail.com and jakerpomperada@yahoo.com.

My mobile number here in the Philippines is 09173084360.

My telephone number at home here in Bacolod City, Negros Occidental is (034) 4335675.



Sample Program Output


Program Listing

<html>
<title>  Number of Days Before Christmas in JavaScript </title>
<body>
<style>
body {
 font-family:arial;
 font-size:50px;
 font-weight:bold;
 color:blue;
 background-color:lightgreen;
}
</style>
<br>
<h4> Number of Days Before Christmas in JavaScript </h4>
<script>
var day_description = "Christmas";
var day_before = "Christmas Eve";

var today = new Date();
var year = today.getYear();
if ((navigator.appName == "Microsoft Internet Explorer") && (year < 2000))
year="19" + year;
if (navigator.appName == "Netscape")
year=1900 + year;
var date = new Date("December 25, " + year);
var diff = date.getTime() - today.getTime();
var days = Math.floor(diff / (1000 * 60 * 60 * 24));

if (days > 1)
document.write("There are " + (days+1) + " days until " + day_description + "!");
else if (days == 1)
document.write("Tommorrow is " + day_before  + "!");
else if (days == 0)
document.write("Today is " + day_before + "!");
else if (days == -1)
document.write("It's " + day_description + "!");
else if (days < -1)
document.write(day_description + " was " + ((days+1)*-1) + (days < -2 ? " days" : " day") + " ago this year!");

</script>
</body></html>
Posted by at No comments:
Labels: ,

Current Day in JavaScript

A very simple script that I wrote using JavaScript to display the current day based on the date of your computer.

My email address are the following jakerpomperada@gmail.com and jakerpomperada@yahoo.com.

My mobile number here in the Philippines is 09173084360.

My telephone number at home here in Bacolod City, Negros Occidental is (034) 4335675.



Sample Program Output


Program Listing

<html>
<title> Current Date in JavaScript </title>
<body>
<style>
body {
 font-family:arial;
 font-size:50px;
 font-weight:bold;
 color:blue;
 background-color:lightgreen;
}
</style>
<br><br>
<script>
var months=new Array(13);
months[1]="January";
months[2]="February";
months[3]="March";
months[4]="April";
months[5]="May";
months[6]="June";
months[7]="July";
months[8]="August";
months[9]="September";
months[10]="October";
months[11]="November";
months[12]="December";
var time=new Date();
var lmonth=months[time.getMonth() + 1];
var date=time.getDate();
var year=time.getYear();
if (year < 2000)    
year = year + 1900; 
document.write("Today is " + lmonth + " ");
document.write(date + ", " + year );
</script>
</body></html>
Posted by at No comments:
Labels:

Sorting Techniques in Turbo Basic

Here is a program that I wrote way back in 1998 it is BASIC program to demonstrate the different sorting techniques I use Turbo Basic in writing this program.

My email address are the following jakerpomperada@gmail.com and jakerpomperada@yahoo.com.

My mobile number here in the Philippines is 09173084360.

My telephone number at home here in Bacolod City, Negros Occidental is (034) 4335675.


Program Listing


 REM NAME OF PROJECT : SORTING TECHNIQUES
REM DATE FINISHED   : SEPTEMBER 19, 1998
REM AUTHOR          : JAKE R. POMPERADA
CLS
100
COLOR 10
PRINT
PRINT
FOR C = 1 TO 28
PRINT CHR$(205);
NEXT C
PRINT
print TAB(5) " SORTING TECHNIQUES"
PRINT TAB(8) " MAIN MENU "
FOR C = 1 TO 28
PRINT CHR$(205);
NEXT C
COLOR 11
PRINT
PRINT
PRINT " [1] System Date & Time "
PRINT " [2] Bubble Sort "
Print " [3] Insertion Sort"
PRINT " [4] Selection Sort "
PRINT " [5] Quicksort"
PRINT " [6] Mergesort "
PRINT " [7] Quit / Exit Program"
PRINT " "
FOR C = 1 TO 28
PRINT Chr$(205);
NEXT C
print
input "Enter Your Choice => ",a

 IF ( A > 7 OR A < 1) THEN GOTO 105

 IF A = 1 THEN
 CLS
 GOTO 110
 END IF

 IF A = 2 THEN
  CLS
  GOTO 210
  END IF

 IF A = 3 THEN
  CLS
  GOTO 310
  END IF

 IF A = 4 THEN
  CLS
  GOTO 410
  END IF

 IF A = 5 THEN
  CLS
  GOTO 510
  END IF

 IF A = 6 THEN
  CLS
  GOTO 610
  END IF
IF A = 7 THEN
  CLS
 FOR C = 1 TO 75
 PRINT CHR$(205);
 delay .03
 NEXT C
 LOCATE 3,28:  Print "Exit Program To DOS..."
 LOCATE 5,29:  Print "Designed By: Servo"
 FOR C = 1 TO 75
 PRINT CHR$(205);
 delay .03
 NEXT C
 REM  THE KEYWORD SYSTEM EXIT PROGRAM TO DOS !!!
 SYSTEM
 END IF
105
PRINT
FOR C = 1 TO 75
PRINT CHR$(205);
NEXT C
color 31
LOCATE 20,29: PRINT "Invalid Option !!!"
LOCATE 21,23: PRINT "Choose Only Options [1/2/3/4/5/6/7]"
BEEP
FOR C = 1 TO 75
color 11
PRINT CHR$(205);
NEXT C
DELAY 1.5
CLS
GOTO 100

 110
CLS
FOR C = 1 TO 28
PRINT CHR$(205);
NEXT C
print
PRINT TAB(3) "SYSTEM DATE AND TIME :"
FOR C = 1 TO 28
PRINT CHR$(205);
NEXT C
print
print
COLOR 15
PRINT "Date :" ,Date$
PRINT "Time :" ,Time$
DELAY 3
CLS
GOTO 100

 210
REM BUBBLE SORT MODULE
CLS
DIM A(100)
COLOR 15
FOR F = 1 TO 20
PRINT "=";
NEXT F
PRINT
PRINT " BUBBLE SORT MODULE"
FOR G = 1 TO 20
PRINT "=";
NEXT G
PRINT
PRINT
Input "How many inputs :",A
FOR I = 1 To A
PRINT "Item #";i;
INPUT A(i)
NEXT I
Let N = I - 1
For J = 1 To N - 1
For I = 1 To N-J
If a(i) <= A(i+1) then 270
Let T=A(I)
Let A(i)=A(i+1)
Let A(i+1)=T
270 Next I
Next J
print
print " Sorted List of";a; "items"
PRINT
For I = 1 To N
Print a(i)" ";
next I
delay 3
cls
goto 100
end

 310
REM INSERTION SORT MODULE
CLS
Dim B(100)
COLOR 15
FOR F = 1 TO 22
PRINT "=";
NEXT F
PRINT
PRINT "INSERTION SORT MODULE"
FOR F = 1 TO 22
PRINT "=";
NEXT F
PRINT
PRINT
Input "How many inputs :",a
for i = 1 To a
print "Item #";i;
input B(i)
next i
Let N = I - 1
For I = 1 To N - 1
Let J = I
Let T = B(I+1)
540 If J < 1 then 590
IF T >= B(J) THEN 590
Let B(J+1)=B(J)
Let J = J -1
Goto 540
590 Let B(J+1)=T
Next I
Print
print " Sorted List of";a; "items"
PRINT
For I = 1 To N
Print B(i)" ";
NEXT I
DELAY 3
CLS
GOTO 100
END

 410
REM SELECTION SORT MODULE
CLS
DIM L(100)
COLOR 15
FOR F = 1 TO 23
PRINT "=";
NEXT F
PRINT
PRINT "SELECTION SORT MODULE"
FOR F = 1 TO 23
PRINT "=";
NEXT F
PRINT
PRINT
Input "How many inputs :",a
for i = 1 To a
print "Item #";i;
input L(i)
next i
Let N = I - 1
FOR I = 1 TO N - 1
FOR J = I + 1 TO N
IF L(J) >= L(I) THEN 330
LET Q = L(J)
LET L(J)=L(I)
LET L(I) = Q
330 NEXT J
NEXT I
PRINT
PRINT " Sorted List of";a; "items"
PRINT
For I = 1 To N
PRINT L(i)" ";
NEXT I
delay 3
cls
GOTO 100
END

 510
REM QUICKSORT MODULE
CLS
Dim S(100)
COLOR 15
FOR F = 1 TO 22
PRINT "=";
NEXT F
PRINT
PRINT TAB(3) "QUICKSORT MODULE"
FOR F = 1 TO 22
PRINT "=";
NEXT F
PRINT
PRINT

 PRINT "How many inputs :";
INPUT V
for R = 1 To V
print "Item #";R;
INPUT S(R)
next R
for O = 1 TO V - 1
FOR I = O + 1 TO V
IF  S(I) >=  S(O) THEN 130
LET C = S(O)
LET S(O) = S(I)
LET S(I) = C
130 NEXT I
    NEXT O
PRINT
PRINT " Sorted List of";V "items"
PRINT
FOR F = 1 TO V
PRINT S(F);
NEXT F
delay 3
cls
GOTO 100
END

 610
REM MERGESORT MODULE
CLS
DIM X(100)
COLOR 15
FOR F = 1 TO 20
PRINT "=";
NEXT F
PRINT
PRINT " MERGESORT MODULE"
FOR F = 1 TO 20
PRINT "=";
NEXT F
PRINT
PRINT
Input "How many inputs :",a
for i = 1 To A
PRINT "Item #";i;
INPUT X(i)
next i
LET N = I - 1
For J = 1 To N - 1
For I = 1 To N-J
If X(i) <= X(i+1) then 970
Let T=X(I)
LET X(i)=X(i+1)
LET X(i+1)=T
970 Next I
Next J
PRINT
PRINT " Sorted List of";a; "items"
PRINT
For I = 1 To N
PRINT X(I)" ";
NEXT I
DELAY 3
CLS
GOTO 100
END

 1000 END
Posted by at No comments:
Labels: , ,

Addition of Two Numbers Using Function in Turbo Pascal

A very simple program that I wrote that will ask the user to give two numbers and then our program will compute the sum of the two numbers using function in Turbo Pascal.

My email address are the following jakerpomperada@gmail.com and jakerpomperada@yahoo.com.

My mobile number here in the Philippines is 09173084360.

My telephone number at home here in Bacolod City, Negros Occidental is (034) 4335675.


Program Listing

Program Addition;
Uses Crt;

Var A,B  : Integer;
    Ch   : Char;

Function Add(Var C,D : Integer) : integer;
Begin
 Add := C + D;
End;

Begin
 Repeat
 Clrscr;
 Write('Enter the First Value :');
 Readln(A);
 Write('Enter the First Value :');
 Readln(B);
 Writeln;
 Write('The sum of two values is',' ',Add(A,B));
 Writeln;
 Writeln;
 Repeat
 Write('Do You Want To Continue y/n ? ');
 Ch := Upcase(Readkey);
 Until Ch in ['Y','N'];
 Clrscr;
 Until Ch = 'N';
 Exit;
 Readln;
End.



Posted by at No comments:
Labels:

Add Record in Clipper Summer '87

A simple program that I wrote using Nantucket Clipper Summer '87 a very long time ago while I am working as a freelance database developer using DOS environment.

My email address are the following jakerpomperada@gmail.com and jakerpomperada@yahoo.com.

My mobile number here in the Philippines is 09173084360.

My telephone number at home here in Bacolod City, Negros Occidental is (034) 4335675.


Program Listing


********************************
** Payroll System
** Add Employees Record Routine
** Add.Prg
** Author : Jake R. Pomperada
** Language : Clipper Summer '87
** Date : March 07,2001
********************************

Set Talk Off
Set Echo Off
* Set Escape Off
Set Scoreboard Off
Set Procedure To Kes
Set Procedure To Sys
Set Procedure To Pass
Set Cursor On
Set Wrap On
Set Century On
Set Safety Off
Set Confirm Off
Set Delimiters On
Set Delimiters to "[]"
Set Cursor On
Set Decimal to 2
Set Message to 24
Clear Typeahead
Clear Memory
Clear Screen
@ 1,3 Clear To 23,79
@ 1,3 To 23,79 Double
Set Color To W/N
@ 2,12 Clear to 3,65
XTitle1 = Chr(5) + " ADD EMPLOYEES RECORD ROUTINE " + Chr(5)
Set Color To W+/N
@ 2,8 Say xTitle1
Set Color To
@ 3,4 Say Replicate("=",75)
Set Color To GR+/N
@ 2,62 Say "Date: " + Dtoc(Date())
Set Color To
@ 04,6 Clear To 22,77
Set color To Bg+/N
@ 4,52 Say "ESC -> Return To Main Menu"
Set Color To
Do While .T.
Use Pay
Index on ChapaNo to Xchapa
Reindex
Store 0 To XChapaNo
Store 0.00 To XSalaryRate
Store 0.00 To XTaxUnits
Store 0.00 To XST
Store 0.00 To XROT
Store 0.00 To XPOT
Store 0.00 To XEMERALLOW
Store 0.00 To ST2
Store 0.00 To ROT2
Store 0.00 To POT2
Store 0.00 To XWithTax
Store 0.00 To XPagibig
Store 0.00 To XPH
Store 0.00 To XSSS
Store 0.00 To XEMPLOYACC
Store 0.00 To XPhilH
Store 0.00 To XGross
Store 0.00 To XGrossTotal
Store 0.00 To XTotalNetPay
Store 0.00 To XTotalDeduc
Store 0.00 To XTotalDeduction
Store 0.00 To XYRTDGross
Store 0.00 To XYRTDWTax
Store Ctod(" / / ") To XDate
Store Space(25) to XLname
Store Space(20) to XFname
@ 04,8 Say "CHAPA NO.............þ " Get XChapaNo Pict "9999999999"
Read
If readkey() = 12
Return
*do kes
endif
XFind = XChapaNo
Seek XFind
if empty(XChapaNo)
    Tone(200,2)
    Tone(341,2)
    Set Cursor Off
    Set Color To N/W
    @ 10,11 Clear To 12,53
    @ 10,11 To 12,53
    @ 11,16 say 'SORRY CHAPA NO. CANNOT BE EMPTY.'
    Set Color To
    Xdelay=inkey(2)
    Set Cursor On
    @ 10,11 Clear To 12,53
    Loop
 endif
 If Found()
    Tone(200,2)
    Tone(341,2)
    Set Cursor Off
    Set Color To N/W
    @ 13,14 Clear To 15,57
    @ 13,14 To 15,57
    @ 14,16 say 'SORRY DUPLICATE RECORDS IS NOT ALLLOWED.'
    Set Color To
    Xdelay=inkey(2)
    Set Cursor On
    @ 13,14 Clear To 15,57
    Loop
  endif
If .NOT. Found()
@ 05,8 Say "PAY ENDING...........þ " Get XDate  Pict "99/99/9999"
@ 06,8 Say "LASTNAME.............þ " Get XLName Pict "@!"
@ 07,8 Say "FIRSTNAME............þ " Get XFName Pict "@!"
@ 08,8 Say "SALARY RATE..........þ " Get XSalaryRate Pict "99999999.99"
@ 09,8 Say "TAX UNITS............þ " Get XTaxUnits Pict "99999999"
SetColor("W+/N")
@ 10,25 Say "GROSS PAY"
Set Color To
@ 11,8 Say "STRAIGHT TIME........þ " Get XST Pict "9999999.99"
@ 12,8 Say "REGULAR O/T..........þ " Get XROT Pict "9999999.99"
@ 13,8 Say "PAID O/T.............þ " Get XPOT Pict "999999999.99"
@ 14,8 Say "PAID HOLIDAY.........þ " Get XPH Pict "999999999.99"
@ 15,8 Say "EMERGENCY ALLOWANCE..þ " Get XEMERALLOW Pict "999999999.99"
Read
If readkey() = 12
Return
*do kes
endif
ST2  =  XSt  * XSalaryRate / 8
ROT2 =  XRot * XSalaryRate / 8 * 1.25
POT2 =  XPot * XSalaryRate / 8 * 1.30
@ 16,8 Say "STRAIGHT TIME........þ " + ' '+Str(ST2,10,2)
@ 17,8 Say "REGULAR O/TIME.......þ " + ' '+Str(ROT2,10,2)
@ 18,8 Say "PAID O/TIME..........þ " + ' '+Str(POT2,10,2)
@ 19,8 Say "PAID HOLIDAY.........þ " + ' '+Str(XPH,10,2)
@ 20,8 Say "EMERGENCY ALLOWANCE..þ " + ' '+Str(XEMERALLOW,10,2)
XTOTALGross = ST2+ROT2+POT2+XPH+XEMERALLOW
Set Color TO W+/N
@ 22,8 Say "TOTAL GROSS..........þ " + ' '+Str(XTOTALGROSS,10,2)
Set Color To
XTotalNetPay = XTotalGross - XTotalDeduc
if xTotalNetPay <= 3000
 xphilh = 37.50
 endif
if xTotalNetPay >= 3500
 xphilh = 43.75
 endif
if xTotalNetPay >= 4000
 xphilh = 50.00
 endif
if xTotalNetPay >= 4500
 xphilh = 56.25
 endif
if xTotalNetPay >= 5000
 xphilh = 62.50
 endif
if xTotalNetPay >= 5500
 xphilh = 68.75
 endif
if xTotalNetPay >= 6000
 xphilh = 75.00
 endif
if xTotalNetPay >= 6500
 xphilh = 81.25
 endif
if xTotalNetPay >= 7000
 xphilh = 87.50
 endif
if xTotalNetPay >= 7500 .or. xTotalNetPay >= 30000
 xphilh =93.75
 endif

Set Color TO W+/N
@ 09,55 Say "DEDUCTIONS"
Set Color To
@ 10,47 Say "WHOLDING TAX.....þ" Get XWithTax Pict "9999999.99"
@ 11,47 Say "SSS PREMIUM......þ" Get XSSS Pict "9999999.99"
@ 12,47 Say "PAG-IBIG.........þ" Get XPAGIBIG Pict "9999999.99"
@ 13,47 Say  "EMPLOYEE ACCT....þ" Get XEMPLOYACC Pict "9999999.99"
@ 14,47 Say "PHILHEALTH.......þ" + ' ' +Str(XPhilh,10,2)
* Get XPHILH Pict "9999999.99"
Read
Set Color To W+/N
XTotalDeduc = XWithTax+XSSS+XPAGIBIG+XEMPLOYACC+XPHILH
XTotalNetPay = XTotalGross - XTotalDeduc

@ 16,47 Say "TOTAL DEDUCTION..þ " + ' ' +Str(XTotalDeduc,10,2)
@ 17,47 Say "TOTAL NET PAY....þ " + ' ' +Str(XTotalNetPay,10,2)
Set Color To
@ 19,47 Say "YR.TO DATE GROSS.þ" Get XYRTDGROSS Pict "9999999.99"
@ 20,47 Say "YR.TO DATE W/TAX.þ" Get XYRTDWTAX Pict "9999999.99"
Read
If readkey() = 12
Return
*do kes
endif

endif
Mess1 = "    SAVING EMPLOYEES RECORD IN DATABASE FILE."
Mess2 = "    CHANGE OR UPDATE THE EMPLOYEES RECORD."
Mess3 = "    ABORT OPERATION AND RETURN TO MAIN MENU."
Set Color To W+/n,W+*/W,W/N
@ 22,48 Prompt " SAVE "   Message Mess1
@ 22,57 Prompt " EDIT "   Message Mess2
@ 22,65 Prompt " CANCEL "  Message Mess3
Menu To XChoice
Do Case
 Case XChoice = 1
 Tone(345,2)
 Tone(145,2)
 Case XChoice = 2
 Tone(345,2)
 Tone(145,2)
 Case XChoice = 3
 Tone(345,2)
 Tone(145,2)
endcase
Set Color To
*sdelay=inkey(4)
* do kes
Return
enddo


Posted by at No comments:
Labels: ,

Menu Program in Clipper Summer '87

A menu program that I wrote using Nantucket Clipper Summer '87 a very long time ago.
My email address are the following jakerpomperada@gmail.com and jakerpomperada@yahoo.com.

My mobile number here in the Philippines is 09173084360.

My telephone number at home here in Bacolod City, Negros Occidental is (034) 4335675.


Program Listing



***************************
** MAIN.PRG
** MENU PROGRAM
** AUTHOR   : JAKE R. POMPERADA
** DATE     : MARCH 06,2001
** LANGUAGE : CLIPPER SUMMER '87
****************************

Set Talk Off
Set Echo Off
Set Scoreboard Off
Set Status Off
Set Safety Off
Set Escape Off
Set Wrap On
Set Procedure To Add
Set Procedure To Pass
Set Procedure To Sys
Set Message to 21 Center
Clear Memory
Clear Typeahead
Clear Screen
Do While .T.
@ 1,3 Clear To 24,79
@ 1,3 To 24,79 Double
@ 2,4,23,78 BOX Replicate(Chr(177),10)
Set Color To w+/N
@ 3,6 Clear To 17,27
@ 3,6 To 17,27 Double
Shadow(3,6,17,27)
Set Color To
Set Color TO B+/N
@ 20,10 Clear To 22,68
@ 20,10 TO 22,68
Set Color To
Set Color To W+/Bg
@ 3,32 Clear To 12,74
@ 3,32 To 12,74
Shadow(3,32,12,74)
Title1 = "XYZ CONSTRUCTION SERVICES"
Title2 = "Genovea Compound, C.V. Ramos Avenue"
Title3 = "Taculing Bacolod City 6100."
Title4 = "Mr. John Smith"
Title6 = "Owner / Manager"
DateNow = CMonth(date()) + Chr(32)+ Str(day(date()),2) +;
          ','+Chr(32) + Str(Year(Date()), 4)
TITLE5 = "Developed By: SERVO Software Unlimited."
SetColor("GR+/BG")
@ 04,34 Say Title1
SetColor("W+/Bg")
@ 05,36 Say Title2
@ 06,39 Say Title3
SetColor("B+/Bg")
@ 08,39 Say Title4
Set Color To
Set Color To R/Bg
@ 09,46 Say Title6
Set Color To
Set Color To GR+/Bg
@ 10,41 Say "Date: " + DateNow
Set Color To G+/BG
@ 11,34 Say Title5
Set Color To
Set Color To W+/Bg
@ 15,32 Clear To 18,68
@ 15,32 To 18,68
XGuide1 = "USE THE Up AND Down ARROW KEYS"
XGuide2 = "TO NAVIGATE THE MAIN MENU  "
Char = Chr(024)+ " "+ Chr(025)
Set Color To
Set Color To GR+/Bg
@ 16,34 Say XGuide1
@ 17,34 Say XGuide2
Set Color To G+*/Bg
@ 17, 60 Say Char
Set Color To
Mess1= "ADD EMPLOYEES TO DATABASE FILE"
Mess2= "CHANGE AND UPDATE EMPLOYEES RECORDS"
Mess3= "ERASE EMPLOYEES RECORDS IN DATABASE FILE"
Mess4= "GENERATE PRINTED REPORTS."
Mess5= "DATABASE FILE BACK-UP,REINDEX, ZAP RECORDS"
Mess6= "QUIT KES PAYROLL SYSTEM"
Set Color To GR+/N
@ 04,13 Say  "MAIN MENU "
Set Color To
@ 06,8 Prompt "A> DD EMPLOYEES    "  Message  Mess1
@ 08,8 Prompt "U> PDATE RECORDS   "  Message  Mess2
@ 10,8 Prompt "E> RASE RECORDS    "  Message  Mess3 
@ 12,8 Prompt "G> ENERATE REPORTS "  Message  Mess4
@ 14,8 Prompt "S> YSTEM UTILITY   "  Message  Mess5
@ 16,8 Prompt "Q> UIT PROGRAM     "  Message  Mess6
Menu To Choice
Do Case
 Case Choice = 1 
 Tone(226,1)
 Tone(341,1)
 Add()
 Case Choice = 2
 Tone(152,1)
 Tone(341,1)
 Case Choice = 3
 Case Choice = 4 
 Case Choice = 5 
 Tone(452,1)
 Tone(741,1)
 Do Sys.Prg
 Case Choice = 6
 Tone(452,1)
 Tone(741,1)
 xExit()
EndCase
Set Color To
Enddo
Return


Procedure xExit
@ 20,8 Say Replicate(Chr(177),61)
@ 21,8 Say Replicate(Chr(177),61)
@ 22,8 Say Replicate(Chr(177),61)
@ 16,30 Say Replicate(Chr(177),6)
@ 17,30 Say Replicate(Chr(177),6)
@ 15,32 Say Replicate(Chr(177),8)
@ 18,30 Say Replicate(Chr(177),6)
Set Color To W+/Bg
@ 15,35 Clear To 18,75
@ 15,35 To 18,75 Double
Shadow(15,35,18,75)
Set Color To
Set Color To G/Bg+
@ 16,42 Say "QUIT PAYROLL SYSTEM PROGRAM ?"
Set Color To
Set Message to 21 Center
Set Color To B+/N
@ 20,10 Clear To 22,68
@ 20,10 TO 22,68
Set Color To
QTitle1 = "EXIT PAYROLL PROGRAM AND RETURN TO DOS"
QTitle2 = "RETURN TO PAYROLL PROGRAM SYSTEM MAIN MENU"
Set Color To N+*/Bg
@ 17,44 Prompt "  Y> ES  " Message QTitle1
@ 17,58 Prompt "  N> O   " Message QTitle2
Set Color To
Menu To XChoice
Do Case
Case XChoice = 1
For X = 1 To 25
 Scroll(00,00,24,40,1)
 Scroll(00,41,24,79,-1)
 inkey(.1)
Next X
Clear
Inkey(1)
Set Cursor Off
SetColor("W+/BG")
@ 1,1 Clear to 4,80
@ 1,1 To 4,80 Double
Set Color To
Set Color To G+/Bg
Set Color To
Set Color To G+/Bg
Fin1 = " KONSTRUCTION ENGINEERING SERVICES PAYROLL SYSTEM Version 1.0"
Fin2 = " Developed By: SERVO Software Unlimited 2001." + Chr(234)
Set Color To B+/Bg
@ 2,Int(80-Len(Fin1))/2 Say Fin1
Set Color To
Set Color To GR+*/Bg
@ 3,Int(80-Len(Fin2))/2 Say Fin2
Set Color TO
@ 5,1 Say " "
Set Cursor On
Do Jeopardy
Quit
Case XChoice = 2
Tone(201,3)
Tone(931,2)
Do Kes
EndCase
Set Color To
Return

Posted by at No comments:
Labels: ,
Subscribe to: Posts (Atom)