wizweirdo's Source Code: April 2009

Tuesday, April 7, 2009

Qbasic 4.5 - Encrypt/Decrypt File

'Encrypt

Dim r(1000) As Integer
Dim rev As String
Dim mik As String
Dim laba As Integer
file$ = txtfile.Text
Open file$ For Input As #1
laba = Len(file$)
file2$ = Mid(file$, 1, laba - 3) + "rev"
While Not EOF(1)
kim$ = ";" + " gzeus"
Input #1, k$
If k$ = kim$ Then
Close #1
Exit Sub
Else
Close #1
Open file$ For Input As #1
Open file2$ For Output As #2
Print #2, kim$
For X = 1 To 10
Randomize Timer
r(X) = Int(Rnd * 75) + 50
Print #2, r(X)
Next X
While Not EOF(1)
Line Input #1, j$
je$ = ""
For z = 1 To Len(j$)
m = 1000000000
mik = Mid(j$, z, 1)
m = Asc(mik)
If m = 1000000000 Then GoTo 1
q = q + 1
If q = 11 Then q = 1
m = m + r(q) - 48
If m > 999999999 Then m = m - 999999999
mik = Chr$(m)
1 je$ = je$ + mik
Next z
Print #2, je$
Wend
Close #1
Close #2
Open file2$ For Input As #1
Open file$ For Output As #2
Line Input #1, j$
Print #2, j$
While Not EOF(1)
Line Input #1, j$
rev = ""
For c = 1 To Len(j$)
rev = rev + Left$(Right$(j$, c), 1)
Next
Print #2, rev
Wend
Close #1
Close #2
Kill file2$
Exit Sub
End If
Wend

'Decrypt

Dim r(1000) As Integer
Dim rev As String
Dim mik As String
Dim lent As String
file$ = txtfile.Text
Open file$ For Input As #1
lent = Len(file$)
file2$ = UCase$(Mid$(file$, 1, lent - 3)) + "rev"
While Not EOF(1)
kim$ = ";" + " gzeus"
Input #1, k$
If k$ = kim$ Then
Close #1
Open file$ For Input As #1
Open file2$ For Output As #2
Line Input #1, j$
Print #2, j$
While Not EOF(1)
Line Input #1, j$
rev = ""
For c = Len(j$) To 1 Step -1
rev = rev + Right$(Left$(j$, c), 1)
Next
Print #2, rev
Wend
Close #1
Close #2
Open file2$ For Input As #1
Open file$ For Output As #2
Input #1, j$
For X = 1 To 10
Input #1, r(X)
Next X

While Not EOF(1)
Line Input #1, j$
je$ = ""
For z = 1 To Len(j$)
m = 1000000000
mik = Mid$(j$, z, 1)
m = Asc(mik)
If m = 1000000000 Then GoTo 2
q = q + 1
If q = 11 Then q = 1
m = m - r(q) + 48
If m > 999999999 Then m = m - 999999999
mik = Chr$(m)
2 je$ = je$ + mik
Next z
Print #2, je$
Wend
Close #1
Close #2
Kill file2$
Exit Sub
Else
Close #1
Exit Sub
End If
Wend

Foxpro 2.6 - Simple Loan Program

note: ***************THIS IS THE LOAN PROGRAM MENU'S***********************

set echo off
set talk off
set stat off
set cons off
set scor off
set bell off
set esca on
SET PROCEDURE TO LOANPROG
set message to 24
set colo to w+/w

clea
store 0 to aa
do password
do heading
do curdate
do while aa<5
@9,3 prompt "1TRANSACTION" mess "TRANSACTION"
@9,17 prompt "2FILE INFORMATION" mess "FILE INFORMATION"
@9,36 prompt "3REPORTS" mess "REPORTS"
@9,46 prompt "4SYSTEM SUPPORT" mess "SYSTEM SUPPORT"
@9,63 prompt "5EXIT" mess "WANNA EXIT?"
menu to aa
do case
case readkey()=12
save scre to aaa
do wana_x
rest scre from aaa
case aa=1
save scre to aab
do transact
rest scre from aab
case aa=2
save scre to aac
do file_info
rest scre from aac
case aa=3
save scre to aad
do reports
rest scre from aad
case aa=4
save scre to aae
do sys_sup
rest scre from aae
case aa=5
save scre to aaf
do wana_x
rest scre from aaf
endcase
enddo

note: .............this procedure is for transaction menu..................

procedure transact
store 0 to bb
do while bb <3
@11,3,14,16 box
@12,4 prompt 'LOAN OPENING' mess 'LOAN OPENING'
@13,4 prompt 'PAYMENT ' mess 'PAYMENT'
menu to bb
do case
case readkey()=12
close all
return
case bb =1
save scre to bba
do opening
rest scre from bba
case bb =2
save scre to bbb
do payment
rest scre from bbb
endcase
enddo
return

note: ..............this procedure is for payment menu.....................

proc payment
store 0 to cc
do while cc <4
@14,8,18,21 box
@15,9 prompt 'ON INTEREST ' mess 'ON INTEREST'
@16,9 prompt 'ON PRINCIPAL' mess 'ON PRINCIPAL'
@17,9 prompt 'ON PENALTY ' mess 'ON PENALTY'
menu to cc
do case
case readkey()=12
close all
return
case cc =1
save scre to cca
do interest
rest scre from cca
case cc =2
save scre to ccb
do principal
rest scre from ccb
case cc =3
save scre to ccc
do penalty
rest scre from ccc
endcase
enddo
return

note: .........this procedure is for file information menu.................

proc file_info
store 0 to dd
do while dd <3
@11,18,14,32 box
@12,19 prompt 'BORROWER ' mess 'BORROWER'
@13,19 prompt 'LOAN CONTRACT' mess 'LOAN CONTRACT'
menu to dd
do case
case readkey()=12
close all
return
case dd =1
save scre to dda
do borrower
rest scre from dda
case dd =2
save scre to ddb
do lcontrct
rest scre from ddb
endcase
enddo
return

note: ..............this procedure is for reports menu.....................

proc reports
store 0 to ee
do while ee <6
@11,27,17,54 box
@12,28 prompt 'ALPHA LISTING ' mess 'ALPHA LISTING'
@13,28 prompt 'DAILY PAYMENT ' mess 'DAILY PAYMENT'
@14,28 prompt 'MONTHLY PAYMENT ' mess 'MONTHLY PAYMENT'
@15,28 prompt 'NEW LOAN ' mess 'NEW LOAN'
@16,28 prompt 'INVENTORY OF LOAN ACCTS. 'mess'INVENTORY OF LOAN ACCOUNTS'
menu to ee
do case
case readkey()=12
close all
return
case ee =1
save scre to eea
do alpha
rest scre from eea
case ee =2
save scre to eeb
do daily
rest scre from eeb
case ee =3
save scre to eec
do monthly
rest scre from eec
case ee =4
save scre to eed
do new_loan
rest scre from eed
case ee =5
save scre to eee
do inv_loan
rest scre from eee
endcase
enddo
return

note: ............this procedure is for alpha listing menu.................

proc alpha
store 0 to ff
do while ff <3
@11,55,14,63 box
@12,56 prompt 'SCREEN ' mess 'SCREEN'
@13,56 prompt 'PRINTER' mess 'PRINTER'
menu to ff
do case
case readkey()=12
close all
return
case ff =1
save scre to ffa
do listing1
rest scre from ffa
case ff =2
save scre to ffb
do listing2
rest scre from ffb
endcase
enddo
return

note: ......this procedure is for inventory of loan accounts menu..........

proc inv_loan
store 0 to gg
do while gg <3
@15,55,18,63 box
@16,56 prompt 'SCREEN ' mess 'SCREEN'
@17,56 prompt 'PRINTER' mess 'PRINTER'
menu to gg
do case
case readkey()=12
close all
return
case gg =1
save scre to gga
do inven1
rest scre from gga
case gg =2
save scre to ggb
do inven2
rest scre from ggb
endcase
enddo
return

note: ...........this procedure is for system support menu.................

proc sys_sup
store 0 to hh
do while hh <5
@11,46,16,61 box
@12,47 prompt 'BACK UP FILES ' mess 'BACK UP FILES'
@13,47 prompt 'RESTORE FILES ' mess 'RESTORE FILES'
@14,47 prompt 'REINDEX FILES ' mess 'REINDEX FILES'
@15,47 prompt 'EDIT DATA ' mess 'EDIT DATA'
menu to hh
do case
case readkey()=12
close all
return
case hh =1
save scre to hha
do back_up
rest scre from hha
case hh =2
save scre to hhb
do restor
rest scre from hhb
case hh =3
save scre to hhc
do re_index
rest scre from hhc
case hh =4
save scre to hhd
do edit_dat
rest scre from hhd
endcase
enddo
return

set talk on
set echo on
set stat on
set esca on
set stat on
set scor on
set colo to
set cons off

***********************E N D O F M A I N M E N U ***********************

note: ................This Procedure is For Heading........................

proc heading
@0,0,23,79 box
@1,2,7,69 box
@8,2,10,69 box
@8,2,20,69 box
@2,3 say "É» ÉÍÍÍ»ÉÍÍÍ»ÉÍÍ» É» "
@3,3 say "ºº ºÉ» ººÉÍ»ººÉ»º ºº "
@4,3 say "ºº ºÈ¼ ººÈÍ¼ººººÈÍ¼º "
@5,3 say "ºÈÍÍ»º ººÉÍ»ºººº º "
@6,3 say "ÈÍÍÍ¼ÈÍÍÍ¼È¼ È¼È¼ÈÍÍÍ¼ "
@2,26 say "ÉÍÍÍÍ»ÉÍÍÍÍ»ÉÍÍÍÍ» ÉÍÍÍ» ÉÍÍÍÍ»ÉÍÍÍ»ÉÍ» ÉÍ»"
@3,26 say "ÌÍÍÍÍ¼ÌÍÍÍË¼ÈÍÍÍÍ¼ ºÉÍÍ¼ ºÉÍ» ººÉÍ»ºº º º º"
@4,26 say " ºº ÉÍ»ºÈÍ¼ ººÈÍ¼ºº ÈÍ¼ º"
@5,26 say " ºÈÍÊ¼ººÉÍËË¼ºÉÍ»ººÉ» É»º"
@6,26 say " ÈÍÍÍÍ¼È¼ È¼ È¼ È¼È¼ÈÍ¼È¼"
@4,25 to 6,44
m=0
do while m<17
m=m+1
mm= left("M A I N M E N U",m)
@5,27 say mm
do delay
enddo
return
***************
proc delay
d=0
do while d<300
d=d+1
enddo
return
***************
proc dalay
d=0
do while d<30000
d=d+1
enddo
return
***************

note: ..........This procedure is for Exiting The Program..................

procedure wana_x
ans=' '
do while ans#'Y'
@13,19 clea to 15,49
@13,19 to 15,49
@14,20 say "EXIT THE PROGRAM :REALLY.?" get ans pict '!'
read
if ans ='Y'
wait''
close all
quit
endif
if ans='N'
wait''
close all
return
endif
enddo
return

note: .............this procedure is for the password cheking..............

procedure password
clear
crt = 0
do while crt < 3
passwrd = 'grifter'
pass=''
cnt = 0
@7,20,12,60 box
@4,20,6,60 box
@5,29 say' L O A N P R O G R A M'
@8,23 say' S E C U R I T Y W I N D O W'
@10,43 clea to 10,50
@10,28 say 'ENTER PASSWORD:'
do while cnt < 8
wait"" to pas
pass = pass + chr(asc(upper(trim(pas))))
if asc(upper(pas)) = 0
wait""
quit
endif
@10,43 + cnt say ''
cnt = cnt + 1
enddo
if passwrd = trim(pass)
@14,24 to 16,57
@15,25 say 'A C C E S S G R A N T E D ! ! !'
wait""
!cls
!date
exit
else
save scre to denied
@14,25 to 16,57
@15,26 say ' A C C E S S D E N I E D ! ! !'
wait""
pl = 0
do while pl <66
pl = pl + 1
pp = LEFT("Please do not Attemp If You are not a Registered User....",pl)
@20,67 clea to 20,78
@20,79-pl say pp
do delay
enddo
wait""
rest scre from denied
endif
crt = crt + 1
if crt = 3
@20,25 to 22,58
@21,26 say'I N T R U D E R A L E R T ! ! !'
wait""
@20,25 clea to 20,59
@21,25 clea to 21,59
@22,25 clea to 22,59
pl = 0
do while pl <2
pl = pl + 2
aa = LEFT("I",pl)
bb = LEFT("N",pl)
cc = LEFT("T",pl)
dd = LEFT("R",pl)
ee = LEFT("U",pl)
ff = LEFT("D",pl)
gg = LEFT("E",pl)
hh = right("R",pl)
ii = right("A",pl)
jj = right("L",pl)
kk = right("E",pl)
ll = right("R",pl)
mm = right("T",pl)
nn = right("!",pl)
oo = right("!",pl)
pp = right("!",pl)
@21+pl,26 say aa
@21,28+pl say bb
@21-pl,30 say cc
@21-pl,32 say dd
@21+pl,36 say ee
@21+pl,38 say ff
@21-pl,40 say gg
@21,43+pl say hh
@21+pl,45 say ii
@21,47+pl say jj
@21-pl,49 say kk
@21+pl,51 say ll
@21,53-pl say mm
@21+pl,55 say nn
@21+pl,57-pl say oo
@21-pl,59 say pp
do dalay
wait""
wait""
wait""
enddo
quit
endif
enddo
clear
return

note: ............this procedure is for inputing mcode.....................

proc inmcode
do curdate
save scre to kliumz
if readkey() =12
exit
endif
@3,28,5,53 box
@4,29 say'PLEASE INPUT MCODE:' get mcod pict'!999'
read
rest scre from kliumz
close all
use masfile index mcode
seek mcod
return

note: ..........this procedure is for displaying the current date..........

proc curdate
store date() to dat
@1,66 say 'DATE:' + transform(dat,' / / ')
return

note: ......this procedure is for displaying the not found message.........

proc notfound
save scre to luz
@16,25,18,54 box
@17,26 say 'M C O D E N O T F O U N D!'
wait''
rest scre from luz
return
0
note: .............this procedure is for the back grounds..................

proc ground
clear
@0,0,24,79 box
l=0
do while l<23
l=l+1
lo= left("L O A N O P E N I N G",l)
@0,29 say lo
do delay
enddo
return

proc inputg
clear
@0,0,24,79 box
i=0
do while i<21
i=i+1
id= left("I N P U T D A T A",i)
@0,31 say id
do delay
enddo
do curdate
return

proc backg
clear
@0,0 to 24,79 doub
t=0
do while t<22
t=t+1
tt= left("T R A N S A C T I O N",t)
@0,29 say tt
do delay
enddo
return

proc design
clear
@0,0,24,79 box
f=0
do while f<32
f=f+1
ff= left("F I L E I N F O R M A T I O N",f)
@0,25 say ff
do delay
enddo
return

proc repor
clear
@0,0,24,79 box
r=0
do while r<14
r=r+1
rp= left("R E P O R T S",r)
@0,33 say rp
do delay
enddo
return

proc alplist1
clear
@0,0,24,79 box
a=0
do while a<26
a=a+1
ap= left("A L P H A L I S T I N G",a)
@0,28 say ap
do delay
enddo
return

proc syste
@0,0 clea to 24,79
@0,0 to 24,79 doub
@10,20 clea to 13,61
@10,20 to 13,61 doub
s=0
do while s<29
s=s+1
ss= left("S Y S T E M S U P P O R T",s)
@0,27 say ss
do delay
enddo

note: .............this procedure is for the loan opening..................

proc opening
store space(4) to mcod
anoder='Y'
do while anoder='Y'
do ground
do inmcode
if .not. found()
save scre to kim
clea
do inputg
all=' '
do while all#'N'
**************************I N I T I A L I Z E ******************************
store space(35) to nam,spous,co_borow
store space(40) to addr1,addr2,remar
store space(20) to relat,colater
store space(10) to amor1
store 0.00 to amt_gran,in_rat,interes,penal,surchar,other,balan,princip
store ctod(' / / ') to bda1,bda2,mat_dat,dat_gran,amor2,ld_paym
store 0 to ag1,ag2,ter
store ' ' to type_in
store space(2) to typ_lon
****************************************************************************
@2,3 say 'MCODE: ' + mcod
@3,3 say 'NAME: ' get nam pict'@!,35'
@4,3 say 'ADDRESS: ' get addr1 pict'@!,40'
@5,3 say 'AGE: ' get ag1 pict'99'
@6,3 say 'SPOUSE: ' get spous pict'@!,35'
@7,3 say 'BIRTHDAY: ' get bda1 pict'@d'
@8,3 say 'TYPE OF LOAN: ' get typ_lon pict'@!,2'
@9,3 say 'AMOUNT GRANTED: ' get amt_gran pict'9999999999999.99'
@10,3 say 'TERM OF LOAN: ' get ter pict'999'
@11,3 say 'MATURITY DATE: ' get mat_dat pict'@d'
@12,3 say 'INTEREST RATE: ' get in_rat pict'9999.99'
@13,3 say 'INTEREST: ' get interes pict'99999999999.99'
@14,3 say 'PENALTY: ' get penal pict'99999999999.99'
@15,3 say 'TYPE OF INTEREST: ' get type_in pict'!'
@16,3 say 'DATE GRANTED: ' get dat_gran pict'@d'
@17,3 say 'SURCHARGE: ' get surchar pict'99999999999.99'
@18,3 say 'OTHERS: ' get other pict'99999999999.99'
@19,3 say 'REMARKS: ' get remar pict'@!,40'
@20,3 say 'CO BORROWER: ' get co_borow pict'@!,35'
@21,3 say 'ADDRESS: ' get addr2 pict'@!,40'
@22,3 say 'AGE: ' get ag2 pict'99'
@23,3 say 'BIRTHDAY: ' get bda2 pict'@d'
read
clea
do inputg
@2,3 say 'RELATION: ' get relat pict'@!,10'
@3,3 say 'BALANCE: ' get balan pict'9999999999999.99'
@4,3 say 'AMORTIZATION: ' get amor1 pict'@!,10'
@5,3 say 'AMORTIZATION DATE: ' get amor2 pict'@d'
@6,3 say 'PRINCIPAL: ' get princip pict'99999999999.99'
@7,3 say 'LAST DAY OF PAYMENT: ' get ld_paym pict'@d'
@8,3 say 'COLLATERAL: ' get colater pict'@!,20'
read
@23,23 say' '
@14,3 say'SAVE ALL INPUTED DATA? [Y/N/F]' get all pict'!'
read
rest scre from kim
if all='Y'
*************************S A V I N G D A T A ******************************
close all
set safe off
use masfile
append blank
replace mcode with mcod,name with nam,address1 with addr1,age1 with ag1
replace spouse with spous,birthday1 with bda1,type_loan with typ_lon
replace amt_grant with amt_gran,term with ter,mat_date with mat_dat
replace int_rate with in_rat,interest with interes,penalty with penal
replace type_int with type_in,date_grant with dat_gran
replace surcharge with surchar,others with other,remarks with remar
replace co_borrow with co_borow,address2 with addr2,age2 with ag2
replace birthday2 with bda2,relation with relat,balance with balan
replace amort1 with amor1,amort2 with amor2,principal with princip
replace ld_payment with ld_paym , collateral with colater
index on mcode to mcode
reindex
set safe on
****************************************************************************
************************S A V I N G D E S I G N ***************************
save scre to yes
clear
sv=0
do while sv<20
sv = sv + 1
@12,30 say'²²²²²²²²²²²²²²²²²²²²'
saving = left("ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ",sv)
@9,29,14,50 box
@10,30 say 'S A V I N G D A T A'
@12,30 say saving
dlayer=0
do while dlayer<1000
dlayer = dlayer + 1
enddo
@10,19,13,60 box
@11,23 say ' I N P U T E D D A T A '
@12,23 say 'S U C C E S S F U L L Y S A V E D!'
wait""
rest scre from yes
exit
enddo
****************************************************************************
endif
if all='N'
close all
endif
if all='F'
loop
endif
enddo
else
save scre to luz
@11,23,13,60 box
@12,24 say 'M C O D E A L R E A D Y E X I S T!'
wait""
rest scre from luz
endif
save scre to mice
@21,55,23,77 box
@22,56 say "WANT ANOTHER? [Y/N]" get anoder pict'Y'
read
rest scre from mice
enddo
return

note: ..................this procedure is for interest.....................

proc interest
store space(4) to mcod
another='Y'
do while another='Y'
do backg
do inmcode
if found()
amt=0.00
save scre to kim
@7,4,15,62 box
@8,5 say 'MCODE: ' + mcode
@9,5 say 'NAME: ' + name
@10,5 say 'ADDRESS: ' + address1
@11,5 say 'TYPE OF LOAN: ' + type_loan
@12,5 say 'AMOUNT GRANTED:' + transform(amt_grant,'9999999999999.99')
@13,5 say 'BALANCE: ' + transform(balance,'9999999999999.99')
@14,5 say 'INPUT PAYMENT: ' get amt pict'99999999999.99'
read
store date() to dat
store ctod(' / / ') to ld_payment
no_days = dat - ld_payment
time= no_days / 365
inter = principal * .1425 * time
principal = principal - balance
balance = balance - principal
replace interest with inter - amt
select 2
use transact
tra='I'
replace mcode with mcode,trans_date with dat,amount with amt
replace trans with tra
@18,18,20,58 box
@19,19 say'PAYMENT FOR INTEREST SUCCESFULLY SAVED!'
wait""
rest scre from kim
else
do notfound
endif
save scre to joy
@21,55,23,77 box
@22,56 say "WANT ANOTHER? [Y/N]" get another pict'Y'
read
rest scre from joy
enddo
return

note: ..................this procedure is for principal....................

proc principal
store space(4) to mcod
another='Y'
do while another='Y'
do backg
do inmcode
if found()
amt=0.00
save scre to kim
@7,4,15,62 box
@8,5 say 'MCODE: ' + mcode
@9,5 say 'NAME: ' + name
@10,5 say 'ADDRESS: ' + address1
@11,5 say 'TYPE OF LOAN: ' + type_loan
@12,5 say 'AMOUNT GRANTED:' + transform(amt_grant,'9999999999999.99')
@13,5 say 'BALANCE: ' + transform(balance,'9999999999999.99')
@14,5 say 'INPUT PAYMENT: ' get amt pict'99999999999.99'
read
store date() to dat
store 0.00 to prin,balan
balan= balance
prin = principal
principal = principal - balance
balan = balance - principal
replace balance with balan - amt
select 2
use transact
tra='P'
replace mcode with mcode,trans_date with dat,amount with amt
replace trans with tra
@18,18,20,59 box
@19,19 say'PAYMENT FOR PRINCIPAL SUCCESFULLY SAVED!'
wait""
rest scre from kim
else
do notfound
endif
save scre to joy
@21,55,23,77 box
@22,56 say "WANT ANOTHER? [Y/N]" get another pict'Y'
read
rest scre from joy
enddo
return

note: ..................this procedure is for penalty.......................

proc penalty
store space(4) to mcod
another='Y'
do while another='Y'
do backg
do inmcode
if found()
amt=0.00
save scre to kim
@7,4,15,62 box
@8,5 say 'MCODE: ' + mcode
@9,5 say 'NAME: ' + name
@10,5 say 'ADDRESS: ' + address1
@11,5 say 'TYPE OF LOAN: ' + type_loan
@12,5 say 'AMOUNT GRANTED:' + transform(amt_grant,'9999999999999.99')
@13,5 say 'BALANCE: ' + transform(balance,'9999999999999.99')
@14,5 say 'INPUT PAYMENT: ' get amt pict'99999999999.99'
read
store date() to dat
penal = penalty
store ctod(' / / ') to amort2
no_days = dat - amort2
time = no_days / 365
interest = principal * .1425 * time
penal = interest * .24 * time
replace penalty with penal - amt
select 2
use transact
append blank
tra='E'
replace mcode with mcode,trans_date with dat,amount with amt
replace trans with tra
@18,19,20,58 box
@19,20 say'PAYMENT FOR PENALTY SUCCESFULLY SAVED!'
wait""
rest scre from kim
else
do notfound
endif
save scre to joy
@21,55,23,77 box
@22,56 say "WANT ANOTHER? [Y/N]" get another pict'Y'
read
rest scre from joy
enddo
return

note: ...............this procedures is for file information...............

proc borrower
store space(4) to mcod
another='Y'
do while another='Y'
do design
do inmcode
if found()
save scre to kim
@2,2,19,72 box
@3,3 say 'MCODE: ' + mcode
@4,3 say 'NAME: ' + name
@5,3 say 'ADDRESS: ' + address1
@6,3 say 'SPOUSE: ' + spouse
@7,3 say 'BIRTHDAY: ' + transform(birthday1,' / / ')
@8,3 say 'TYPE OF LOAN: ' + type_loan
@9,3 say 'AMOUNT GRANTED: ' + transform(amt_grant,'9999999999999.99')
@10,3 say 'DATE GRANTED: ' + transform(date_grant,' / / ')
@11,3 say 'MATURITY DATE: ' + transform(mat_date,' / / ')
@12,3 say 'CO BORROWER: ' + co_borrow
@13,3 say 'ADDRESS: ' + address2
@14,3 say 'AGE: ' + transform(age2,'99')
@15,3 say 'BIRTHDAY: ' + transform(birthday2,' / / ')
@16,3 say 'RELATION: ' + relation
@17,3 say 'BALANCE: ' + transform(balance,'9999999999999.99')
@18,3 say 'LAST DAY OF PAYMENT: ' + cdow(ld_payment)
wait""
else
do notfound
endif
save scre to joy
@21,55,23,77 box
@22,56 say "WANT ANOTHER? [Y/N]" get another pict'Y'
read
rest scre from joy
enddo
return

proc lcontrct
store space(4) to mcod
another='Y'
do while another='Y'
do design
do inmcode
if found()
save scre to kim
@2,2,19,74 box
@3,3 say 'MCODE: ' + mcode
@4,3 say 'NAME: ' + name
@5,3 say 'ADDRESS: ' + address1
@6,3 say 'SPOUSE: ' + spouse
@7,3 say 'BIRTHDAY: ' + transform(birthday1,' / / ')
@8,3 say 'TYPE OF LOAN: ' + type_loan
@9,3 say 'AMOUNT GRANTED: ' + transform(amt_grant,'9999999999999.99')
@10,3 say 'TERM OF LOAN: ' + transform(term,'999')
@11,3 say 'DATE GRANTED: ' + transform(date_grant,' / / ')
@12,3 say 'MATURITY DATE: ' + transform(mat_date,' / / ')
@13,3 say 'REMARKS: ' + remarks
@14,3 say 'AMORTIZATION: ' + amort1
@15,3 say 'AMORTIZATION DATE: ' + transform(amort2,' / / ')
@16,3 say 'PRINCIPAL: ' + transform(principal,'9999999999999.99')
@17,3 say 'BALANCE: ' + transform(balance,'9999999999999.99')
@18,3 say 'LAST DAY OF PAYMENT: ' + cdow(ld_payment)
wait""
else
do notfound
endif
save scre to joy
@21,55,23,77 box
@22,56 say "WANT ANOTHER? [Y/N]" get another pict'Y'
read
rest scre from joy
enddo
return

note: ...........this procedure is for alphabetical listing................

proc listing1
clear
close all
use masfile
tot = 0
gtot = 0
ctr = 0
go top
do alplist1
do while .not. eof()
@1,1 say " "
@2,1 say "mcode name "
@3,1 say "----- ---------------------------------"
@2,39 say" address "
@3,39 say" -------------------------------------"
@4+ctr,1 say + mcode+' ' +name+address1
ctr=ctr+1
if ctr = 15
wait""
clear
do alplist1
ctr = 0
endif
skip
enddo
wait""
return

proc listing2
set device to print
set print on
clear
close all
use masfile
tot = 0
gtot = 0
ctr = 0
go top
do while .not. eof()
? " ALPHABETICAL LISTING "
? " "
? " "
? "mcode name address "
? "----- ------------------------------ ----------------------------------"
? transform(ctr,'###') + mcode+' ' +name+address1
ctr=ctr+1
if ctr = 15
wait""
clear
eject
ctr = 0
endif
skip
enddo
wait""
set device to screen
return

note: ...............this procedure is for daily reports....................

proc daily
clear
close all
select b
use masfile
tot = 0
ctr = 0
do repor
save scre to kliumz
store ctod(' / / ') to dat
@3,28,5,56 box
@4,29 say'PLEASE INPUT DATE:' get dat pict'!999'
read
rest scre from kliumz
sele a
use transact index trans_date
seek dat
if found()
do while day(dat) = day(a.trans_date) .and. a.mcode = b.mcode
select b
tot=tot+amt_grant
@1,1 say " "
@2,1 say "mcode name"
@2,38 say"address "
@3,1 say "----- ---------------------------------"
@3,38 say "-------------------------------------"
@4+ctr,1 say + mcode+' ' +name+address1
ctr=ctr+1
if ctr = 15
wait""
clear
do repor
ctr = 0
endif
skip
enddo
@19,1 say"-----------------------"
@20,1 say"Total :" + transform(tot,'9999999999999.99')
@21,1 say"======================="
wait''
else
@10,25,12,54 box
@11,26 say"D A T E N O T F O U N D!"
wait""
endif
return

note: ...............this procedure is for monthly reports....................

proc monthly
clear
close all
select b
use masfile
tot = 0
ctr = 0
do repor
save scre to kliumz
store ctod(' / / ') to dat
@3,28,5,56 box
@4,29 say'PLEASE INPUT DATE:' get dat pict'!999'
read
rest scre from kliumz
sele a
use transact index trans_date
seek dat
if found()
do while month(dat) = month(a.trans_date) .and. a.mcode = b.mcode
select b
tot=tot+amt_grant
@1,1 say " "
@2,1 say "mcode name"
@2,38 say"address "
@3,1 say "----- ---------------------------------"
@3,38 say "-------------------------------------"
@4+ctr,1 say + mcode+' ' +name+address1
ctr=ctr+1
if ctr = 15
wait""
clear
do repor
ctr = 0
endif
skip
enddo
@19,1 say"-----------------------"
@20,1 say"Total :" + transform(tot,'9999999999999.99')
@21,1 say"======================="
wait''
else
@10,25,12,54 box
@11,26 say"D A T E N O T F O U N D!"
wait""
endif
return

note: .................this procedure is for new loan.......................

proc new_loan
clear
tot = 0
ctr = 0
do repor
save scre to kliumz
store ctod(' / / ') to dat
@3,28,5,56 box
@4,29 say'PLEASE INPUT DATE:' get dat pict'!999'
read
rest scre from kliumz
close all
use masfile index date_grant
seek dat
do while .not. eof()
if month(dat) = month(date_grant) .and. year(date_grant) = year(dat)
tot=tot+amt_grant
@3,9,14,69 box
@4,10 say " Amount Date "
@5,10 say " mcode Granted Granted balance type term"
@6,10 say " ----- --------------- --------- --------------- ---- ----"
@7+ctr,11 say + mcode + ' '+transform(amt_grant,'9999999999999.99');
+ ' '+transform(date_grant,' / / ')+' ';
+ transform(balance,'9999999999999.99')+ ' '+ type_loan+' ';
+ transform(term,'999')
ctr=ctr+1
if ctr = 7
wait""
clear
do repor
ctr = 0
endif
skip
@19,5 say"-----------------------"
@20,5 say"Total :" + transform(tot,'9999999999999.99')
@21,5 say"======================="
else
@10,25,12,54 box
@11,26 say"D A T E N O T F O U N D!"
wait""
exit
endif
enddo
wait""
return

note: ..........this procedure is for inventory of loan accounts...........

proc inven1
clear
close all
use masfile
tot = 0
gtot = 0
ctr = 0
go top
do repor
do while .not. eof()
tot=tot+amt_grant
gtot=gtot+balance
@3,9,14,69 box
@4,10 say " Amount Date "
@5,10 say " mcode Granted Granted balance type term"
@6,10 say " ----- --------------- --------- --------------- ---- ----"
@7+ctr,11 say + mcode + ' '+transform(amt_grant,'9999999999999.99');
+ ' '+transform(date_grant,' / / ')+' ';
+ transform(balance,'9999999999999.99')+ ' '+ type_loan+' ';
+ transform(term,'999')
ctr=ctr+1
if ctr = 7
wait""
clear
do repor
ctr = 0
endif
skip
enddo
@19,5 say"-----------------------"
@20,5 say"Total :" + transform(tot,'9999999999999.99')
@21,5 say"gtotal:" + transform(gtot,'9999999999999.99')
@22,5 say"======================="
wait""
return

proc inven2
set device to print
set print on
clear
close all
use masfile
tot = 0
gtot = 0
ctr = 0
go top
do while .not. eof()
tot=tot+amt_grant
gtot=gtot+balance
@0,0,23,79 box
?" INVENTORY OF LOAN ACCOUNTS "
?" "
?" Amount Date "
?"mcode name Granted Granted balance "
?"----- ---------------------------------- --------------- --------- -----------"
?trans(ctr,'###')+ mcode + ' '+name+transform(amt_grant,'9999999999999.99');
+ ' '+transform(date_grant,' / / ')+' '+ transform(balance,'999999999.99')
ctr=ctr+1
if ctr = 15
wait""
clear
eject
ctr = 0
endif
skip
enddo
@19,55 say"-----------------------"
@20,55 say"Total :" + transform(tot,'9999999999999.99')
@21,55 say"gtotal:" + transform(gtot,'9999999999999.99')
@22,55 say"======================="
wait""
set device to screen
return

note: ...............this procedure is for back up files....................

proc back_up
driv = ' '
do while .t.
do syste
@11,21 say ' P L E A S E I N P U T D E S I R E '
@12,21 say ' D R I V E [ A / B ]... 'get driv pict '!'
read
do case
case driv = 'A'
@11,21 say 'INSERT DESTINATION DISK TO DRIVE [A]...'
@12,21 say 'PRESS KEY WHEN YOU ARE READY...'
wait""
@10,36 clea to 13,77
@10,36,13,77 box
@11,37 say ' PREPARING DRIVE [A] FOR BACK UP '
@12,37 say ' THIS MAY TAKE A MOMENT... '
do process
clea
do syste
@11,21 say ' BACK UP PROCESS FOR DRIVE [A] '
@12,21 say ' COMPLETE... '
wait''
exit
case driv = 'B'
@11,21 say 'INSERT DESTINATION DISK TO DRIVE [B]...'
@12,21 say 'PRESS KEY WHEN YOU ARE READY...'
wait""
@10,36 clea to 13,77
@10,36,13,77 box
@11,37 say ' PREPARING DRIVE [B] FOR BACK UP '
@12,37 say ' THIS MAY TAKE A MOMENT... '
do process
clea
do syste
@11,21 say ' BACK UP PROCESS FOR DRIVE [B] '
@12,21 say ' COMPLETE... '
wait''
exit
case driv#'A' .and. driv#'B'
clea
do syste
@11,21 say ' I N V A L I D '
@12,21 say ' D R I V E '
wait''
exit
endcase
enddo
return

note: ...............this procedure is for restore files....................

proc restor
dis = ' '
do syste
do while .t.
@11,21 say ' P L E A S E I N P U T D E S I R E '
@12,21 say ' D R I V E [ A / B ]... 'get dis pict '!'
read
do case
case dis = 'A'
@11,21 say ' INSERT SOURCE DISK TO DRIVE [A]... '
@12,21 say 'PRESS KEY WHEN YOU ARE READY...'
wait""
@10,36 clea to 13,77
@10,36,13,77 box
@11,37 say ' R E S T O R E F I L E(s) T O [A] '
@12,37 say ' THIS MAY TAKE A MOMENT... '
do process2
clea
do syste
@11,21 say ' RESTORE PROCESS FOR DRIVE [A] '
@12,21 say ' COMPLETE... '
wait''
exit
case dis = 'B'
@11,21 say ' INSERT SOURCE DISK TO DRIVE [B]... '
@12,21 say 'PRESS [ENTER] KEY WHEN YOU ARE READY...'
wait""
@10,36 clea to 13,77
@10,36,13,77 box
@11,37 say ' R E S T O R E F I L E(s) T O [B] '
@12,37 say ' THIS MAY TAKE A MOMENT... '
do process
clea
do syste
@11,21 say ' RESTORE PROCESS FOR DRIVE [B] '
@12,21 say ' COMPLETE... '
wait''
exit
case dis#'A' .and. dis#'B'
clea
do syste
@11,21 say ' I N V A L I D '
@12,21 say ' D R I V E '
wait''
exit
endcase
enddo
return

note: ...............this procedure is for reindex files...................

proc re_index
act='Y'
do while act='Y'
clea
do syste
@11,21 say ' ACTIVATE ALL DATABASES AND THIER... '
@12,21 say ' I N D E X E S [Y/N]:.. ' get act pict'!'
read
do case
case act='Y'
close all
use masfile
index on mcode to mcode
reindex
index on date_grant to date_grant
reindex
close all
use transact
index on trans_date to trans_date
reindex
@11,21 say ' ALL DATABASE AND THEIR INDEXES... '
@12,21 say ' A C T I V A T E D '
wait""
exit
case act#'Y'
wait""
exit
endcase
enddo
return

note: ...............this procedure is for editing data....................

proc edit_dat
edi='Y'
do while edi='Y'
clea
do syste
@11,21 say ' W A N T T O E D I T D A T A '
@12,21 say ' N O W [Y/N]:.. ' get edi pict'!'
read
do case
case edi='Y'
close all
use masfile
set stat off
BROWSE fields mcode,name,address1,age1,spouse,birthday1,type_loan,;
amt_grant,term,mat_date,int_rate,interest,penalty,type_int,;
date_grant,surcharge,others,remarks,co_borrow,address2,age2,;
birthday2,relation,balance,amort1,amort2,principal,ld_payment;
NOAPPEND
do syste
@11,21 say ' E D I T I N G D A T A '
@12,21 say ' C O M P L E T E ... '
wait""
exit
case edi#'Y'
wait""
exit
endcase
enddo
return

note: ...this procedure is for processing the back up and restore files...

proc process
dd=0
do while dd<21
dd=dd+1
@1 +dd,2 clea to 1+dd,35
do delay
enddo
p=0
do while p<32
p=p+1
pb=left('P R O C E S S I N G B A C K U P',p)
@1,2 say pb
do delay
enddo
@2,0 say''
!COPY *.* A:
return

proc process2
dd=0
do while dd<21
dd=dd+1
@1 +dd,2 clea to 1+dd,35
do delay
enddo
p=0
do while p<34
p=p+1
pb=left("P R O C E S S I N G R E S T O R E",p)
@1,2 say pb
do delay
enddo
@2,0 say''
!COPY a:*.*
return
*********************E N D O F L O A N P R O G R A M ********************

Cobol - Simple Data Entry

000010 @OPTIONS MAIN
000020 IDENTIFICATION DIVISION.
000030 PROGRAM-ID. EmpInfo_Data_Entry.
000070 Environment Division.
000071 Configuration Section.
000072 Special-Names.
000073 Crt Status is Keyboard-Status
000074 Cursor is Cursor-Position.
000075 Source-Computer. IBM-PC With Debugging Mode.
000076 Object-Computer. IBM-PC.
000077 INPUT-OUTPUT SECTION.
000078 FILE-CONTROL.
000079 SELECT EmpInfoDataFile
000080 ASSIGN TO "EMPINFO.TXT"
000081 ORGANIZATION IS LINE SEQUENTIAL.
000082 Data Division.
000083 WORKING-STORAGE SECTION.
000084 FILE SECTION.
000085 FD EmpInfoDataFile.
000086 01 EmpInfoTable.
000087 03 EF_EmpNum Pic X(25).
000088 03 EF_FirstName Pic X(25).
000089 03 EF_MiddleName Pic X(25).
000090 03 EF_LastName Pic X(25).
000091 03 EF_HomeAddress Pic X(50).
000092 03 EF_City Pic X(40).
000093 03 EF_HomePhone Pic X(20).
000094 03 EF_MobilePhone Pic X(20).
000095 01 Keyboard-Status.
000096 03 Accept-Status Pic 9.
000097 03 Function-key Pic X.
000098 88 F2-Pressed Value X"02".
000099 88 F3-Pressed Value X"03".
000100 88 F4-Pressed Value X"04".
000101 88 F5-Pressed Value X"05".
000102 88 F6-Pressed Value X"06".
000103 88 F7-Pressed Value X"07".
000104 88 F8-Pressed Value X"08".
000105 88 F10-Pressed Value X"10".
000106 03 System-Use Pic X.
000107 01 Cursor-Position.
000108 03 Cursor-Row Pic 9(2) Value 1.
000109 03 Cursor-Column Pic 9(2) Value 1.
000110 01 Screen-Items.
000111 03 Emp-Num Pic X(4) Value Spaces.
000112 03 First-Name Pic X(25) Value Spaces.
000113 03 Middle-Name Pic X(25) Value Spaces.
000114 03 Last-Name Pic X(25) Value Spaces.
000115 03 Home-Address Pic X(50) Value Spaces.
000116 03 City Pic X(40) Value Spaces.
000117 03 Home-Phone Pic X(20) Value Spaces.
000118 03 Mobile-Phone Pic X(20) Value Spaces.
000119 Screen Section.
000120 01 Data-Entry-Screen
000121 Blank Screen, Auto, Foreground-Color is 7, Background-Color is 0.
000122 03 Line 01 Column 01 Value "Human Resources Management System"
000123 Highlight Foreground-Color 2 Background-Color 0.
000124 03 Line 03 Column 01 Value "Employee Information Data Entry" Highlight.
000125 03 Line 04 Column 01 Value "Employee No. : ".
000126 03 Line 05 Column 01 Value "First Name : ".
000127 03 Line 06 Column 01 Value "Middle Name : ".
000128 03 Line 07 Column 01 Value "Last Name : ".
000129 03 Line 08 Column 01 Value "Home Address : ".
000130 03 Line 09 Column 01 Value "City : ".
000131 03 Line 10 Column 01 Value "Home Phone : ".
000132 03 Line 11 Column 01 Value "Mobile Phone : ".
000133 03 Line 04 Column 18 Pic X(4) Using Emp-Num Reverse-Video Required.
000134 03 Line 05 Column 18 Pic X(25) Using First-Name Reverse-Video Required.
000135 03 Line 06 Column 18 Pic X(25) Using Middle-Name Reverse-Video.
000136 03 Line 07 Column 18 Pic X(25) Using Last-Name Reverse-Video Required.
000137 03 Line 08 Column 18 Pic X(50) Using Home-Address Reverse-Video.
000138 03 Line 09 Column 18 Pic X(40) Using City Reverse-Video.
000139 03 Line 10 Column 18 Pic X(20) Using Home-Phone Reverse-Video.
000140 03 Line 11 Column 18 Pic X(20) Using Mobile-Phone Reverse-Video.
000141 01 Form-Buttons.
000142 03 Line 15 Column 01 Value "F2 - Prev" Foreground-Color 3 Highlight.
000143 03 Line 15 Column 11 Value "F3 - Next" Foreground-Color 3 Highlight.
000144 03 Line 15 Column 21 Value "F4 - Find" Foreground-Color 3 Highlight.
000145 03 Line 15 Column 31 Value "F6 - Add" Foreground-Color 3 Highlight.
000146 03 Line 15 Column 41 Value "F7 - Edit" Foreground-Color 3 Highlight.
000147 03 Line 15 Column 51 Value "F8 - Del" Foreground-Color 3 Highlight.
000148 03 Line 15 Column 61 Value "F10 - Exit" Foreground-Color 3 Highlight.
000149 03 Line 17 Column 01 Value "F5 - Save" Foreground-Color 4 Highlight.
000150 03 Line 17 Column 11 Value "F9 - Cancel" Foreground-Color 4 Highlight.
000151 PROCEDURE DIVISION.
000152 EmpInfo_Data_Entry-Start.
000153 Perform Until F10-Pressed
000154 Display Data-Entry-Screen
000155 Display form-Buttons
000156 Accept Data-Entry-Screen
000157 If F5-Pressed
000158 Perform Save-EmpInfo
000159 Initialize Screen-Items
000160 Move 1 to Cursor-Row
000161 Cursor-Column
000162 End-if
000163 If F9-Pressed
000164 Initialize Screen-Items
000165 Move 1 to Cursor-Row
000166 Cursor-Column
000167 End-if
000168 End-Perform
000169 Stop Run
000170 .
000171 EmpInfo_Data_Entry-End.
000172 Save-EmpInfo.
000173 Open Extend EmpInfoFile.
000174 Move Emp-Num To EF_EmpNum.
000175 Move First-Name To EF_FirstName.
000176 Move Middle-Name To EF_MiddleName.
000177 Move Last-Name To EF_LastName.
000178 Move Home-Address To EF_HomeAddress.
000179 Move City To EF_City.
000180 Move Home-Phone To EF_HomePhone.
000181 Move Mobile-Phone To EF_MobilePhone.
000182 Write EmpFileTable.
000183 Close EmpInfoFile.
000184 .
000190 END PROGRAM EmpInfo_Data_Entry.

AutoIT - Simple FileCompare Utility

#include
#include
#Include
#include
#include

Opt("GUIOnEventMode", 1)
opt("GUIDataSeparatorChar",",")
Opt("WinTitleMatchMode", 2)
Opt("ColorMode",0)

$LogFileName = "FC_Logfile.CSV"
Global $File_Array
Global $LogFileList
$MainWindow = GuiCreate("File Compare Utility", 1010, 690, 100,100, -1, 0x00000018)
GUISetOnEvent($GUI_EVENT_CLOSE, "ExitButton")
GUISetOnEvent($GUI_EVENT_DROPPED, "SpecialEvents")
; GUICtrlCreatePic("background.jpg", 0, 0, 1010, 690)

;GUICtrlCreateGroup("Browse Files to Compare", 20, 20, 750, 150)
GUICtrlCreateGroup("", 20, 20, 750, 150)
$GetFileName1 = GuiCtrlCreateButton("Browse/Drag && Drop File 1", 30, 50, 200, 30)
GUICtrlSetOnEvent($GetFileName1, "ShowDialog1")
$GetFileName2 = GuiCtrlCreateButton("Browse/Drag && Drop File 2", 30, 90, 200, 30)
GUICtrlSetOnEvent($GetFileName2, "ShowDialog2")

$FileName1 = GuiCtrlCreateInput("", 235, 50, 510, 30)
GUICtrlSetState(-1,$GUI_DROPACCEPTED)
$FileName2 = GuiCtrlCreateInput("", 235, 90, 510, 30)
GUICtrlSetState(-1,$GUI_DROPACCEPTED)

GuiCtrlCreateAvi("FC.avi",125, 33, 125, 16, 16, $ACS_AUTOPLAY)
$Header1 = GUICtrlCreateLabel ("File 1 Header : ", 100, 130, 400, 14)
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
$Header2 = GUICtrlCreateLabel ("File 2 Header : ", 100, 150, 400, 14)
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)

;GUICtrlCreateGroup("File 1 Info", 780, 170, 210, 145)
GUICtrlCreateGroup("", 780, 170, 210, 145)
GuiCtrlCreateLabel("Lines Read", 790, 200, 100, 30)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
GuiCtrlCreateLabel("File Size", 790, 220, 100, 30)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
GuiCtrlCreateLabel("File Date/Time", 790, 240, 100, 30)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
GuiCtrlCreateLabel("File Type", 790, 260, 100, 30)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
;GUICtrlCreateGroup("File 2 Info", 780, 320, 210, 145)
GUICtrlCreateGroup("", 780, 320, 210, 145)
GuiCtrlCreateLabel("Lines Read", 790, 350, 100, 30)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
GuiCtrlCreateLabel("File Size", 790, 370, 100, 30)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
GuiCtrlCreateLabel("File Date/Time", 790, 390, 100, 30)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
GuiCtrlCreateLabel("File Type", 790, 410, 100, 30)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)

;GUICtrlCreateGroup("Summary : ", 780, 470, 210, 200)
GUICtrlCreateGroup("", 780, 470, 210, 200)
GUICtrlSetFont(-1,14)

$LinesRead1 = GuiCtrlCreateLabel("", 872, 200, 110, 18, BitOR($SS_SUNKEN, $SS_CENTER))
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetBkColor(-1,0xffffff)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
$LinesRead2 = GuiCtrlCreateLabel("", 872, 350, 110, 18, BitOR($SS_SUNKEN, $SS_CENTER))
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetBkColor(-1,0xffffff)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)

$Size1 = GuiCtrlCreateLabel("", 872, 220, 110, 18, BitOR($SS_SUNKEN, $SS_CENTER))
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetBkColor(-1,0xffffff)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
$Size2 = GuiCtrlCreateLabel("", 872, 370, 70, 18, BitOR($SS_SUNKEN, $SS_CENTER))
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetBkColor(-1,0xffffff)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)

$DateTime1 = GuiCtrlCreateLabel("", 872, 240, 110, 18, BitOR($SS_SUNKEN, $SS_CENTER))
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetBkColor(-1,0xffffff)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
$DateTime2 = GuiCtrlCreateLabel("", 872, 390, 110, 18, BitOR($SS_SUNKEN, $SS_CENTER))
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetBkColor(-1,0xffffff)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)

$Type1 = GuiCtrlCreateLabel("", 872, 260, 110, 18, BitOR($SS_SUNKEN, $SS_CENTER))
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetBkColor(-1,0xffffff)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)
$Type2 = GuiCtrlCreateLabel("", 872, 410, 110, 18, BitOR($SS_SUNKEN, $SS_CENTER))
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetBkColor(-1,0xffffff)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)

GuiCtrlCreateLabel("Total Errors", 830, 500, 100, 30)
GUICtrlSetFont(-1,14)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)

$ErrorCtr = GuiCtrlCreateLabel("", 880, 540, 70, 30)
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetFont(-1,24)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)

$Failed = GuiCtrlCreateLabel("", 830, 600, 120, 40)
GUICtrlSetColor(-1,0xff0000)
GUICtrlSetFont(-1,16)
GUICtrlSetBkColor(-1, $GUI_BKCOLOR_TRANSPARENT)

$Strings_Inside_The_Files = GuiCtrlCreateListView("First File - Invalid Item(s) , Second File - Invalid Item(s) ", 20, 180, 750, 490, BitOR($LVS_SHOWSELALWAYS, $LVS_NOSORTHEADER, $LVS_REPORT))
_GUICtrlListViewSetColumnWidth ($Strings_Inside_The_Files, 0, 360)
_GUICtrlListViewSetColumnWidth ($Strings_Inside_The_Files, 1, 360)
GUICtrlSetFont($Strings_Inside_The_Files , 9 , 400 , 0 , "Lucida Console" )

$Process_Button = GuiCtrlCreateButton("Process", 800, 30, 160, 30)
GUICtrlSetOnEvent($Process_Button, "ProcessButton")
GUICtrlSetState($Process_Button, $GUI_DISABLE)
$Clear_All = GuiCtrlCreateButton("Clear", 800, 65, 160, 30)
GUICtrlSetOnEvent($Clear_All, "ClearAll")
GUICtrlSetState($Clear_All, $GUI_DISABLE)
$View_Log_Button = GuiCtrlCreateButton("View Log", 800, 100, 160, 30)
GUICtrlSetOnEvent($View_Log_Button, "ViewLog")
$Exit_Button = GuiCtrlCreateButton("Exit", 800, 135, 160, 30)
GUICtrlSetOnEvent($Exit_Button, "ExitButton")

GUISwitch($MainWindow)
GUISetState (@SW_SHOW)

WinSetOnTop("File Compare Utility", "Browse/Drag && Drop File 1", 0)
While 1
Sleep(1000)
Wend

Func SpecialEvents()
Select
Case @GUI_DROPID = $FileName1
Call("FuncCheckFile1")
Case @GUI_DROPID = $FileName2
Call("FuncCheckFile2")
EndSelect
EndFunc

Func FuncCheckFile1()
If FileExists(GUICtrlRead($FileName1)) = 1 Then
If CheckFileExtensionIsTXTorCSV(GUICtrlRead($FileName1)) = 0 Then
Msgbox(4096 + 48,"First File Selection Error","Only Comma Separated File (.CSV) and Text File (.TXT) are Allowed" & @CRLF & "First TextBox will be cleared!")
GUICtrlSetData($FileName1,"")
If GUICtrlRead($FileName2) = "" Then GUICtrlSetState($Clear_All, $GUI_DISABLE)
EndIf
If FileExists(GUICtrlRead($FileName1)) = 1 Or FileExists(GUICtrlRead($FileName2)) = 1 Then
GUICtrlSetState($Clear_All, $GUI_ENABLE)
EndIf
If FileExists(GUICtrlRead($FileName1)) = 1 And FileExists(GUICtrlRead($FileName2)) = 1 Then
GUICtrlSetState($Process_Button, $GUI_ENABLE)
Else
GUICtrlSetState($Process_Button, $GUI_DISABLE)
EndIf
Else
GUICtrlSetData($FileName1,"")
GUICtrlSetState($Process_Button, $GUI_DISABLE)
EndIf
EndFunc

Func FuncCheckFile2()
If FileExists(GUICtrlRead($FileName2)) = 1 Then
If CheckFileExtensionIsTXTorCSV(GUICtrlRead($FileName2)) = 0 Then
Msgbox(4096 + 48,"Second File Selection Error","Only Comma Separated File (.CSV) and Text File (.TXT) are Allowed" & @CRLF & "Second TextBox will be cleared!")
GUICtrlSetData($FileName2,"")
If GUICtrlRead($FileName1) = "" Then GUICtrlSetState($Clear_All, $GUI_DISABLE)
EndIf
If FileExists(GUICtrlRead($FileName1)) = 1 Or FileExists(GUICtrlRead($FileName2)) = 1 Then
GUICtrlSetState($Clear_All, $GUI_ENABLE)
EndIf
If FileExists(GUICtrlRead($FileName1)) = 1 And FileExists(GUICtrlRead($FileName2)) = 1 Then
GUICtrlSetState($Process_Button, $GUI_ENABLE)
Else
GUICtrlSetState($Process_Button, $GUI_DISABLE)
EndIf
Else
GUICtrlSetData($FileName2,"")
GUICtrlSetState($Process_Button, $GUI_DISABLE)
EndIf
EndFunc

Func ShowDialog1()
$Dialog1 = FileOpenDialog("Open files to Compare", @WorkingDir & "\", "Text files (*.txt) | Comma Separated Values (*.csv)" , 1)
If @error Then
; MsgBox(4096,"","No File(s) chosen")
Else
$Dialog1 = StringReplace($Dialog1, "|", @CRLF)
GUICtrlSetData($FileName1,$Dialog1)
Call("FuncCheckFile1")
EndIf
EndFunc

Func ShowDialog2()
$Dialog2 = FileOpenDialog("Open files to Compare", @WorkingDir & "\", "Text files (*.txt) | Comma Separated Values (*.csv)" , 1)
If @error Then
; MsgBox(4096,"","No File(s) chosen")
Else
$Dialog2 = StringReplace($Dialog2, "|", @CRLF)
GUICtrlSetData($FileName2,$Dialog2)
Call("FuncCheckFile2")
EndIf
EndFunc

Func ProcessButton()
$FirstFile = GUICtrlRead($FileName1)
$SecondFile = GUICtrlRead($FileName2)
If FileExists($FirstFile) = 0 Or FileExists($SecondFile) = 0 Or CheckFileExtensionIsTXTorCSV($FirstFile) = 0 Or CheckFileExtensionIsTXTorCSV($SecondFile) = 0 Then
Msgbox(4096 + 48,"First File Or Second File Selection Error","Only Comma Separated File (.CSV) and Text File (.TXT) are Allowed and Must Exists" & @CRLF & "TextBoxes will be cleared!")
Call("ClearAll")
Return 0
EndIf
If $FirstFile = $SecondFile Then
Msgbox (4096 + 64, "FC Utility" , "First file is the same as Second file..." & @CRLF & "This file needs not to compare." & @CRLF & "Text Box will be cleared...")
Call ("ClearAll")
Return 0
EndIf
If CheckIfFileAlreadyCompared(GetFileName($FirstFile),GetFileName($SecondFile)) = 0 Then
$FileSize1 = FileGetSize($FirstFile)
GUICtrlSetData($Size1,$FileSize1 & " KB")
$FileSize2 = FileGetSize($SecondFile)
GUICtrlSetData($Size2,$FileSize2 & " KB")
Dim $FileDate1[6]
Dim $FileDate2[6]
$FileDate1 = FileGetTime($FirstFile,1)
GUICtrlSetData($DateTime1, $FileDate1[1] & "/" & $FileDate1[2] & "/" & $FileDate1[0] & " " & $FileDate1[3] & ":" & $FileDate1[4] & ":" & $FileDate1[5])
$FileDate2 = FileGetTime($SecondFile,1)
GUICtrlSetData($DateTime2, $FileDate2[1] & "/" & $FileDate2[2] & "/" & $FileDate2[0] & " " & $FileDate2[3] & ":" & $FileDate2[4] & ":" & $FileDate2[5])
$FileType1 = SetFileType($FirstFile)
GUICtrlSetData($Type1,$FileType1)
$FileType2 = SetFileType($SecondFile)
GUICtrlSetData($Type2,$FileType2)

$ReadFile1 = FileOpen($FirstFile,0)
$ReadFile2 = FileOpen($SecondFile,0)
If $ReadFile1 = -1 Or $ReadFile2 = -1 Then
MsgBox(4096 + 48, "Error", "Unable to open files.")
Call ClearAll
Return 0
EndIf

Dim $line1[50000]
Dim $line2[50000]
$ctr1 = 0
While 1
$ctr1 = $ctr1 + 1
$line1[$ctr1] = FileReadLine($ReadFile1)
If @error = -1 Then ExitLoop
Wend
FileClose($FirstFile)
$ctr2 = 0
While 1
$ctr2 = $ctr2 + 1
$line2[$ctr2] = FileReadLine($ReadFile2)
If @error = -1 Then ExitLoop
Wend
FileClose($SecondFile)
$ctr = 0
if $ctr1 > $ctr2 Then
$ctr = $ctr1
Else
$ctr = $ctr2
EndIf
if $ctr > 0 then
GUICtrlSetData($Header1, "File 1 Header : " & $line1[1])
GUICtrlSetData($Header2, "File 2 Header : " & $line2[1])
Endif
$i = 0
For $Counter = 1 to $ctr Step 1
if $line1[$Counter] <> $line2[$Counter] then
$i = $i + 1
$Line1Line2 = GuiCtrlCreateListViewItem($line1[$Counter] & "," & $line2[$Counter], $Strings_Inside_The_Files)
Endif
Next
GUICtrlSetData($LinesRead1, $ctr1)
GUICtrlSetData($LinesRead2, $ctr2)
GUICtrlSetData($ErrorCtr, $i)
if $i > 0 then
GUICtrlSetData($Failed, "Test Failed.")
GUICtrlSetColor($Failed,0xff0000)
$TestResult = "Failed"
Else
GUICtrlSetData($Failed, "PASSED!")
GUICtrlSetColor($Failed,0x000000)
$TestResult = "Passed"
Endif
If FileExists ($LogFileName) = 0 Then
$LogFileOpened = Fileopen($LogFileName,1)
FileWriteLine($LogFileOpened, "First File Compared, Second File Compared , Date Compared , Time Compared , Test Result")
Else
$LogFileOpened = Fileopen($LogFileName,1)
EndIf
FileWriteLine($LogFileOpened, GetFileName($FirstFile) & "," & GetFileName($SecondFile) & "," & _NowDate() & "," & _NowTime() & "," & $TestResult)
FileClose($LogFileOpened)
GUICtrlSetOnEvent($Clear_All, "ClearAll")
GUICtrlSetState($Clear_All, $GUI_ENABLE)
GUICtrlSetState($Process_Button, $GUI_DISABLE)
GUICtrlSetState($FileName1, $GUI_DISABLE)
GUICtrlSetState($FileName2, $GUI_DISABLE)
GUICtrlSetState($GetFileName1, $GUI_DISABLE)
GUICtrlSetState($GetFileName2, $GUI_DISABLE)
EndIf
EndFunc

Func ClearAll()
_GUICtrlListViewDeleteAllItems($Strings_Inside_The_Files)
GUICtrlSetData($FileName1,"")
GUICtrlSetData($FileName2,"")
GUICtrlSetData($Header1,"File 1 Header : ")
GUICtrlSetData($Header2,"File 2 Header : ")
GUICtrlSetData($Size1,"")
GUICtrlSetData($Size2,"")
GUICtrlSetData($LinesRead1,"")
GUICtrlSetData($LinesRead2,"")
GUICtrlSetData($DateTime1,"")
GUICtrlSetData($DateTime2,"")
GUICtrlSetData($Type1,"")
GUICtrlSetData($Type2,"")
GUICtrlSetData($ErrorCtr,"")
GUICtrlSetData($Failed,"")
GUICtrlSetState($Process_Button, $GUI_DISABLE)
GUICtrlSetState($Clear_All, $GUI_DISABLE)
GUICtrlSetState($FileName1, $GUI_ENABLE)
GUICtrlSetState($FileName2, $GUI_ENABLE)
GUICtrlSetState($GetFileName1, $GUI_ENABLE)
GUICtrlSetState($GetFileName2, $GUI_ENABLE)
GuiSetState()
EndFunc

Func ViewLog()
If WinExists("View Log File for Previously Tested Files.") Then
WinActivate("View Log File for Previously Tested Files.")
Return 0
EndIf
Global $radio1, $radio2, $radio3, $Date, $AllDate, $LogWindow, $LogFileList
$LogWindow = GuiCreate("View Log File for Previously Tested Files.", 830, 500, 180,180)
GUISetOnEvent($GUI_EVENT_CLOSE, "ExitLog")

$Date = GUICtrlCreateMonthCal(_NowDate(),615, 50,200,200)
GUICtrlSetOnEvent($Date, "ShowLog")
$AllDate = GUICtrlCreateCheckbox("Show Results for All Dates", 615, 250, 150, 50)
GUICtrlSetOnEvent($AllDate, "ShowLog")
$DeleteButton = GuiCtrlCreateButton("Delete Selected Log", 630, 320, 160, 30)
GUICtrlSetOnEvent($DeleteButton, "DeleteSelectedLog")
$ShellExcel = GuiCtrlCreateButton("Open Log File", 630, 365, 160, 30)
GUICtrlSetOnEvent($ShellExcel, "OpenFile")
$ExitLogWindow = GuiCtrlCreateButton("Exit", 630, 400, 160, 30)
GUICtrlSetOnEvent($ExitLogWindow, "ExitLog")
GUICtrlCreateGroup("Filter Results ", 20, 445, 580, 45)
$radio1 = GUICtrlCreateRadio("View All", 90, 463, 80, 20)
GUICtrlSetState($radio1, $GUI_CHECKED)
GUICtrlSetStyle($radio1, $BS_AUTORADIOBUTTON)
GUICtrlSetOnEvent($radio1, "ShowLog")
$radio2 = GUICtrlCreateRadio("View Passed", 190, 463, 100, 20)
GUICtrlSetStyle($radio2, $BS_AUTORADIOBUTTON)
GUICtrlSetOnEvent($radio2, "ShowLog")
$radio3 = GUICtrlCreateRadio("View Failed", 310, 463, 100, 20)
GUICtrlSetStyle($radio3, $BS_AUTORADIOBUTTON)
GUICtrlSetOnEvent($radio3, "ShowLog")
$LogFileList = GuiCtrlCreateListView("I , First File , Second File , Date Comp. , Time Comp. , Result", 20, 20, 580, 420, BitOR($LVS_SHOWSELALWAYS, $LVS_NOSORTHEADER))
GUICtrlSetFont($LogFileList, 8 , 400 , 0 , "Verdana" )
GUICtrlSendMsg($LogFileList, $LVM_SETEXTENDEDLISTVIEWSTYLE, $LVS_EX_GRIDLINES, $LVS_EX_GRIDLINES)
GUICtrlSendMsg($LogFileList, $LVM_SETEXTENDEDLISTVIEWSTYLE, $LVS_EX_FULLROWSELECT, $LVS_EX_FULLROWSELECT)
_GUICtrlListViewSetColumnWidth($LogFileList, 0, 1)
_GUICtrlListViewSetColumnWidth($LogFileList, 1, 150)
_GUICtrlListViewSetColumnWidth($LogFileList, 2, 150)
_GUICtrlListViewSetColumnWidth($LogFileList, 3, 95)
_GUICtrlListViewSetColumnWidth($LogFileList, 4, 95)
_GUICtrlListViewSetColumnWidth($LogFileList, 5, 70)
GuiSetState()
HotKeySet("{DEL}", "DeleteItem")
Call("ShowLog")
EndFunc

Func ShowLog()
$SelectedDate = _DateTimeFormat(GUICtrlRead($Date),2)
$ShowAllDate = GUICtrlRead($AllDate)
$ViewAllIsSelected = GUICtrlRead($radio1)
$ViewPassedIsSelected = GUICtrlRead($radio2)
$ViewFailedIsSelected = GUICtrlRead($radio3)
_GUICtrlListViewDeleteAllItems ($LogFileList)
$OpenLogFile = FileOpen($LogFileName,0)
_FileReadToArray($LogFileName,$File_Array)
_ArrayDelete($File_Array, 0)
$Counter = 0
While 1
$LogFileLineItem = FileReadLine($OpenLogFile)
$Counter = $Counter + 1
If $LogFileLineItem = "" Or $LogFileLineItem = -1 Then ExitLoop
If $ShowAllDate = $GUI_CHECKED Then
If StringInStr($LogFileLineItem, "Result") <> 0 Then
Else
If $ViewAllIsSelected = $GUI_CHECKED Then
$LogFileItem = GuiCtrlCreateListViewItem($Counter & "," & $LogFileLineItem, $LogFileList)
ElseIf $ViewPassedIsSelected = $GUI_CHECKED Then
If StringInStr($LogFileLineItem, "Passed") > 0 Then $LogFileItem = GuiCtrlCreateListViewItem($Counter & "," & $LogFileLineItem, $LogFileList)
ElseIf $ViewFailedIsSelected = $GUI_CHECKED Then
If StringInStr($LogFileLineItem, "Failed") > 0 Then $LogFileItem = GuiCtrlCreateListViewItem($Counter & "," & $LogFileLineItem, $LogFileList)
Else
EndIf
EndIf
Else
If StringInStr($LogFileLineItem, $SelectedDate) > 0 Then
If $ViewAllIsSelected = $GUI_CHECKED Then
$LogFileItem = GuiCtrlCreateListViewItem($Counter & "," & $LogFileLineItem, $LogFileList)
ElseIf $ViewPassedIsSelected = $GUI_CHECKED Then
If StringInStr($LogFileLineItem, "Passed") > 0 Then $LogFileItem = GuiCtrlCreateListViewItem($Counter & "," & $LogFileLineItem, $LogFileList)
ElseIf $ViewFailedIsSelected = $GUI_CHECKED Then
If StringInStr($LogFileLineItem, "Failed") > 0 Then $LogFileItem = GuiCtrlCreateListViewItem($Counter & "," & $LogFileLineItem, $LogFileList)
Else
EndIf
Endif
EndIf
Wend
GUICtrlSetColor($radio1, 0x00ff00)
FileClose ($LogFileName)
EndFunc

Func DeleteSelectedLog()
Send("{DEL}")
EndFunc

Func DeleteItem()
$SelectedItemFromListView = ControlListView("View Log File for Previously Tested Files.", "Open Log File", $LogFileList, "GetSelectedCount")
If $SelectedItemFromListView < 1 Then Return 0
If MsgBox(4096 + 4 + 32, "FC Logs","Delete Selected Item? Are you Sure?") = 6 Then
$SelectedItemFromListView = ControlListView("View Log File for Previously Tested Files.", "Open Log File", $LogFileList, "GetSelected")
$SelectedFromListView = ControlListView("View Log File for Previously Tested Files.", "Open Log File", $LogFileList, "GetText",$SelectedItemFromListView,0)
_ArrayDelete($File_Array, $SelectedFromListView-1)
_FileWriteFromArray($LogFileName,$File_Array)
Call("ShowLog")
EndIf
EndFunc

Func OpenFile()
ShellExecute($LogFileName)
WinFlash("View Log File for Previously Tested Files.", "Open Log File", 3, 500)
EndFunc

Func ExitLog()
HotKeySet("{DEL}")
GUIDelete ($LogWindow)
GUISwitch ($MainWindow)
Return 0
EndFunc

Func ExitButton()
MsgBox(4096 + 64, "FC Utility", "Exiting...")
Exit
EndFunc

Func OnAutoItStart()
If WinExists("File Compare Utility") Then
WinActivate("File Compare Utility")
Exit
Else
DllCall("kernel32.dll", "int", "Wow64DisableWow64FsRedirection", "int", 1)
EndIf
EndFunc

;User Defined Functions
Func SetFileType($ParamType)
Dim $FileType
Select
Case StringUpper(StringRight($ParamType,3)) = "TXT"
$FileType = "Text File"
Case StringUpper(StringRight($ParamType,3)) = "CSV"
$FileType = "Comma Separed Value"
Case Else
$FileType = "Unknown File"
EndSelect
Return $FileType
EndFunc

Func GetFileName($FileNameWithPath)
$PathFileName = ""
For $Ctr = StringLen($FileNameWithPath) to 1 step -1
$Character = StringMid($FileNameWithPath,$Ctr,1)
If $Character <> "\" Then
$PathFileName = $Character & $PathFileName
Else
ExitLoop
EndIf
Next
Return $PathFileName
EndFunc

Func CheckFileExtensionIsTXTorCSV($FileNameWithPath)
$PathFileName = ""
For $Ctr = StringLen($FileNameWithPath) to 1 step -1
$Character = StringMid($FileNameWithPath,$Ctr,1)
If $Character <> "\" Then
$PathFileName = $Character & $PathFileName
Else
ExitLoop
EndIf
Next
If StringUpper(StringRight($PathFileName,3)) <> "CSV" And StringUpper(StringRight($PathFileName,3)) <> "TXT" Then
Return 0
Else
Return 1
EndIf
EndFunc

Func CheckIfFileAlreadyCompared($CheckFile1,$CheckFile2)
$Opened_LogFile = FileOpen ($LogFileName,0)
If @error Then
; MsgBox(4096,"","No File(s) chosen")
Else
While 1
$LogFileItem = FileReadLine($Opened_LogFile)
if StringInStr($LogFileItem,$CheckFile1) > 0 Then
If StringInStr($LogFileItem,$CheckFile2) > 0 Then
$DateCompared = StringMid($LogFileItem,StringLen($CheckFile1 & "," & $CheckFile2)+2,10)
If StringRight($DateCompared,1) = "," Then $DateCompared = StringMid($DateCompared,1,StringLen($DateCompared)-1)
$ComparingResult = StringRight($LogFileItem,6)
Msgbox (4096 + 64,"Warning:","Files Selected already compared last " & $DateCompared & "." & @CRLF & "File Compare Result " & StringUpper($ComparingResult) & "!")
Return 1
EndIf
Endif
If $LogFileItem = "" Or $LogFileItem = - 1 Then ExitLoop
Wend
EndIf
Return 0
EndFunc

Turbo C - Simple Checkers Game

#include
#include
#include
#include
#include
#include

/* INITIALIZE ARRAY */
int Status[8][8]={{1,5,1,5,1,5,1,5},{5,1,5,1,5,1,5,1},{1,5,1,5,1,5,1,5},{5,0,5,0,5,0,5,0},{0,5,0,5,0,5,0,5},{5,3,5,3,5,3,5,3},{3,5,3,5,3,5,3,5},{5,3,5,3,5,3,5,3}};

/* DRAW DAMA BOARD */
void DAMABOARD ()
{
cleardevice();
setcolor(14); settextstyle(SANS_SERIF_FONT,HORIZ_DIR,3);
outtextxy(335,70 ," LET'S PLAY CHECKERS!");
setcolor(10); settextstyle(DEFAULT_FONT,HORIZ_DIR,2);
outtextxy(320,100," ÉÍËÍËÍËÍËÍËÍËÍËÍ»");
outtextxy(320,115,"0º º º º º º º º º");
outtextxy(320,130," ÌÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍ¹");
outtextxy(320,145,"1º º º º º º º º º");
outtextxy(320,160," ÌÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍ¹");
outtextxy(320,175,"2º º º º º º º º º");
outtextxy(320,190," ÌÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍ¹");
outtextxy(320,205,"3º º º º º º º º º");
outtextxy(320,220," ÌÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍ¹");
outtextxy(320,235,"4º º º º º º º º º");
outtextxy(320,250," ÌÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍ¹");
outtextxy(320,265,"5º º º º º º º º º");
outtextxy(320,280," ÌÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍ¹");
outtextxy(320,295,"6º º º º º º º º º");
outtextxy(320,310," ÌÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍ¹");
outtextxy(320,325,"7º º º º º º º º º");
outtextxy(320,340," ÈÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍ¼");
outtextxy(320,355," 0 1 2 3 4 5 6 7 ");

setcolor(11); settextstyle(SMALL_FONT,HORIZ_DIR,5);
outtextxy(5,380," Direction:");
outtextxy(5,400," Press a number from 0 to 7, to get the row and column value.");
outtextxy(5,420," Press to quit.");
}

/* ADJUST ROW VALUE */
int AdjX(int X)
{ return (30 * X) + 113; }

/* ADJUST COLUMN VALUE */
int AdjY(int Y)
{ return (32 * Y) + 352; }

/* DRAW BLOCKS AND GAME STATUS TAKEN FROM THE ARRAY */
void DRAWBOARD()
{
int X,Y; int XO,YO;
for(Y=0; Y<8; Y++)
{
for(X=0; X<8; X++)
{
XO = AdjX(X); YO = AdjY(Y);
settextstyle(DEFAULT_FONT,HORIZ_DIR,2);
/* FIELD IS EMPTY */
if(Status[X][Y] == 0) { setcolor(0); outtextxy(YO,XO," "); }
/* FIELD IS OCCUPIED BY PLAYER 1 PIECE */
if(Status[X][Y] == 1) { setcolor(4); outtextxy(YO,XO,""); }
/* FIELD IS OCCUPIED BY PLAYER 1 PIECE WITH CROWN */
if(Status[X][Y] == 2) { setcolor(6); outtextxy(YO,XO,""); }
/* FIELD IS OCCUPIED BY PLAYER 2 PIECE */
if(Status[X][Y] == 3) { setcolor(9); outtextxy(YO,XO,""); }
/* FIELD IS OCCUPIED BY PLAYER 2 PIECE WITH CROWN */
if(Status[X][Y] == 4) { setcolor(11); outtextxy(YO,XO,""); }
/* FIELD IS FOR BLOCKS */
if(Status[X][Y] == 5) { setcolor(10); outtextxy(YO,XO,"±"); }
}
}
}

/* CHECK IF PLAYER 1 WINS */
int Check01win()
{
int X01,Y01;
int win = 0;
for(X01=0; X01<8; X01++)
{ for(Y01=0; Y01<8; Y01++)
/* CHECK IF PLAYER 2 STILL HAS A PIECE */
{ if(Status[X01][Y01] == 3 || Status[X01][Y01] == 4)
{ win = 1; break; }
} if(win == 1) { break; }
}
return win;
}

/* CHECK IF PLAYER 2 WINS */
int Check02win()
{
int X02,Y02;
int win = 0;
for(X02=0; X02<8; X02++)
{ for(Y02=0; Y02<8; Y02++)
/* CHECK IF PLAYER 1 STILL HAS A PIECE */
{ if(Status[X02][Y02] == 1 || Status[X02][Y02] == 2)
{ win = 1; break; }
} if(win == 1) { break; }
}
return win;
}

/* DRAW PLAYER WINS */
void DRAWWINS()
{
setfillstyle(SOLID_FILL,0); bar(1,295,312,325);
setcolor(11); settextstyle(DEFAULT_FONT,HORIZ_DIR,1);
outtextxy(1,295,"ð ð ð ð ð ð ð ð ð ð ð ð ð ð ð ð ð ð ð");
outtextxy(1,303,"ð ð");
outtextxy(1,311,"ð ð");
outtextxy(1,318,"ð ð");
outtextxy(1,325,"ð ð");
outtextxy(1,332,"ð ð");
outtextxy(1,339,"ð ð ð ð ð ð ð ð ð ð ð ð ð ð ð ð ð ð ð");
setcolor(10); settextstyle(TRIPLEX_FONT,HORIZ_DIR,4);
outtextxy(30,305,"PLAYER WINS!");
}

/* RETURNS SIGN OF NUMBERS
If Number is Positive SGN returns 1
If Number is Negative SGN returns -1
If Number is Zero SGN returns 0
*/
int SGN(int Num)
{
int SGN_Val;
if(Num < 0) { SGN_Val = -1; }
if(Num > 0) { SGN_Val = 1; }
if(Num == 0) { SGN_Val = 0; }
return SGN_Val;
}

/* GET'S INPUT FROM PLAYERS */
char GetInput()
{
char Ans='N';
int NumericVal=-1;
NumericVal = getch();
do
{
switch(NumericVal)
{
case 27:
/* IF PLAYER PRESS ... CONFIRM THE EXIT... */
goto Eksit;
default:
/* CONVERTS THE ASCII VALUE FROM GETCH() KEYPRESS TO NUMERIC VALUE */
NumericVal = NumericVal - 48;
if(NumericVal >= 0 && NumericVal <= 7)
{ printf("%d",NumericVal); }
else
{ NumericVal = getch(); }
}
} while(NumericVal <> 7);
return NumericVal;

Eksit:
setfillstyle(SOLID_FILL,0); bar(1,295,312,325);
setfillstyle(SOLID_FILL,3); bar(1,295,312,325);
setcolor(11); settextstyle(DEFAULT_FONT,HORIZ_DIR,1);
outtextxy(1,295,"ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿");
outtextxy(1,303,"³ ³");
outtextxy(1,311,"³ ³");
outtextxy(1,319,"ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ");
setcolor(14); settextstyle(SMALL_FONT,HORIZ_DIR,5);
outtextxy(10,303,"Are you sure you want to exit? [Y/N]:");

gotoxy(38,20); scanf("%c",&Ans);
if(toupper(Ans) != 'Y' && toupper(Ans) != 'N')
{ goto Eksit; }
else
{
if(toupper(Ans) == 'Y')
/* QUIT PROGRAM */
{ closegraph();
exit(1);
}
else
/* CLEAR THE CONFIRMATION FIELD AND RETURN GETTING INPUT */
{ setfillstyle(SOLID_FILL,0); bar(1,295,312,325);
GetInput();
}
}
}

int main()
{
char Tapos = 'N';
int FR01row,FR01col,TO01row,TO01col;
int FR02row,FR02col,TO02row,TO02col;
int gdriver=DETECT,gmode;
initgraph(&gdriver,&gmode,"");
while(Tapos == 'N')
{
Play:
DAMABOARD();
DRAWBOARD();

Play01Moves:
/* PLAYER 1 MOVES, GIVING [FROM AND TO] ROW-COLUMN VALUE */
setfillstyle(SOLID_FILL,15); bar(4,39,271,81);
setfillstyle(SOLID_FILL,2); bar(5,40,270,80);
settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
setcolor(4); outtextxy(10,50,"");
settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(15); outtextxy(40,50,"Player's turn to move");

setfillstyle(SOLID_FILL,0); bar(5,100,270,200);
settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
setcolor(4); outtextxy(10,105,"");
settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(15); outtextxy(40,105,"from row : ");

/* LET "FR01row" THE VALID KEYPRESS VALUE FOR [FROM-ROW] */
gotoxy(22,8); FR01row = GetInput();

settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
setcolor(4); outtextxy(10,135,"");
settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(15); outtextxy(40,135,"from col : ");

/* LET "FR01col" THE VALID KEYPRESS VALUE FOR [FROM-COLUMN] */
gotoxy(22,10); FR01col = GetInput();

/* CHECK IF FROM [ROW-COLUMN] FIELD IS A PIECE OF PLAYER 1 */
if(Status[FR01row][FR01col] != 1 && Status[FR01row][FR01col] != 2)
{ goto Play01Moves; }
/* DISPLAY THE STATUS OF THE FIELD FROM ROW-COLUMN VALUE FOR PLAYER 1 */
settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
if(Status[FR01row][FR01col] == 1)
{ setcolor(4); outtextxy(40,250,""); }
if(Status[FR01row][FR01col] == 2)
{ setcolor(6); outtextxy(40,250,""); }

/* DISPLAY THE VALID ROW-COLUMN VALUE FOR PLAYER 1 */
settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(11); outtextxy(80,250,"From ( )");
gotoxy(20,17); printf("%d,%d",FR01row,FR01col);

setfillstyle(SOLID_FILL,0); bar(5,100,270,200);
settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
if(Status[FR01row][FR01col] == 1)
{ setcolor(4); outtextxy(10,105,""); }
if(Status[FR01row][FR01col] == 2)
{ setcolor(6); outtextxy(10,105,""); }

settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(15); outtextxy(40,105,"to row : ");

/* LET "TO01row" THE VALID KEYPRESS VALUE FOR [TO-ROW] */
gotoxy(22,8); TO01row = GetInput();

settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
setcolor(4); outtextxy(10,135,"");
settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(15); outtextxy(40,135,"to col : ");

/* LET "TO01col" THE VALID KEYPRESS VALUE FOR [TO-COLUMN] */
gotoxy(22,10); TO01col = GetInput();

/* CHECK IF DESTINATION [ROW-COLUMN] FIELD IS NOT EMPTY */
if(Status[TO01row][TO01col] != 0)
{ goto Play01Moves; }
/* CHECK IF DESTINATION TO-ROW OR TO-COLUMN IS NOT
ON THE SAME FROM-ROW OR FROM-COLUMN POSITION */
if(TO01row == FR01row || TO01col == FR01col)
{ goto Play01Moves; }
/* CHECK IF DESTINATION TO-ROW OR TO-COLUMN IS AN EQUAL ROW-COLUMN VALUE */
if(abs(TO01col - FR01col) != abs(TO01row - FR01row))
{ goto Play01Moves; }
/* CHECK IF PLAYER 1 PIECE MOVES BACKWARD AND IS NOT A CROWNED PIECE */
if(SGN(TO01row - FR01row) == -1 && Status[FR01row][FR01col] != 2 && abs(TO01row - FR01row) == 1)
{ goto Play01Moves; }
/* ONLY DESTINATION ROW-COLUMN NOT MORE THAN 2 IS VALID */
if(abs(TO01col - FR01col) > 2)
{ goto Play01Moves; }

/* IF PLAYER 1 PIECE CONQUERS A PLAYER 2 PIECE
EMPTY THE FIELD OF PLAYER 2 PIECE */
if(abs(TO01col - FR01col) == 2)
{
if(SGN(TO01col - FR01col) == 1)
{
if(SGN(TO01row - FR01row) == -1)
{
if(Status[FR01row - 1][FR01col + 1] == 3 || Status[FR01row - 1][FR01col + 1] == 4)
{ Status[FR01row - 1][FR01col + 1] = 0; }
else
{ goto Play01Moves; }
}
if(SGN(TO01row - FR01row) == 1)
{
if(Status[FR01row + 1][FR01col + 1] == 3 || Status[FR01row + 1][FR01col + 1] == 4)
{ Status[FR01row + 1][FR01col + 1] = 0; }
else
{ goto Play01Moves; }
}
}
if(SGN(TO01col - FR01col) == -1)
{
if(SGN(TO01row - FR01row) == -1)
{
if(Status[FR01row - 1][FR01col - 1] == 3 || Status[FR01row - 1][FR01col - 1] == 4)
{ Status[FR01row - 1][FR01col - 1] = 0; }
else
{ goto Play01Moves; }
}
if(SGN(TO01row - FR01row) == 1)
{
if(Status[FR01row + 1][FR01col - 1] == 3 || Status[FR01row + 1][FR01col - 1] == 4)
{ Status[FR01row + 1][FR01col - 1] = 0; }
else
{ goto Play01Moves; }
}
}
}

/* IF PLAYER 1 GETS A CROWN, CHANGE ITS STATUS ON THE FIELD TO 2 */
if(TO01row == 7) { Status[FR01row][FR01col] = 2; }
/* TRANSFER THE PIECE TO ITS DESTINATION FIELD */
Status[TO01row][TO01col] = Status[FR01row][FR01col];
/* EMPTY THE FROM ROW-COLUMN FIELD */
Status[FR01row][FR01col] = 0;
DAMABOARD();
DRAWBOARD();
/* CHECK IF PLAYER 1 WINS. IF RETURNED VALUE IS ZERO, PLAYER 1 WINS! */
if(Check01win() == 0){ Tapos = 'Y'; goto Gana01; }

Play02Moves:
/* PLAYER 2 MOVES, GIVING [FROM AND TO] ROW-COLUMN VALUE */
setfillstyle(SOLID_FILL,15); bar(4,39,271,81);
setfillstyle(SOLID_FILL,2); bar(5,40,270,80);
settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
setcolor(9); outtextxy(10,50,"");
settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(15); outtextxy(40,50,"Player's turn to move");

setfillstyle(SOLID_FILL,0); bar(5,100,270,200);
settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
setcolor(9); outtextxy(10,105,"");
settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(15); outtextxy(40,105,"from row : ");

/* LET "FR02row" THE VALID KEYPRESS VALUE FOR [FROM-ROW] */
gotoxy(22,8); FR02row = GetInput();

settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
setcolor(9); outtextxy(10,135,"");
settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(15); outtextxy(40,135,"from col : ");

/* LET "FR02col" THE VALID KEYPRESS VALUE FOR [FROM-COLUMN] */
gotoxy(22,10); FR02col = GetInput();

/* CHECK IF FROM [ROW-COLUMN] FIELD IS A PIECE OF PLAYER 2 */
if(Status[FR02row][FR02col] != 3 && Status[FR02row][FR02col] != 4)
{ goto Play02Moves; }
/* DISPLAY THE STATUS OF THE FIELD FROM ROW-COLUMN VALUE FOR PLAYER 2 */
settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
if(Status[FR02row][FR02col] == 3)
{ setcolor(9); outtextxy(40,250,""); }
if(Status[FR02row][FR02col] == 4)
{ setcolor(11); outtextxy(40,250,""); }

/* DISPLAY THE VALID ROW-COLUMN VALUE FOR PLAYER 2 */
settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(11); outtextxy(80,250,"From ( )");
gotoxy(20,17); printf("%d,%d",FR02row,FR02col);

setfillstyle(SOLID_FILL,0); bar(5,100,270,200);
settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
if(Status[FR02row][FR02col] == 3)
{ setcolor(9); outtextxy(10,105,""); }
if(Status[FR02row][FR02col] == 4)
{ setcolor(11); outtextxy(10,105,""); }

settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(15); outtextxy(40,105,"to row : ");

/* LET "TO02row" THE VALID KEYPRESS VALUE FOR [TO-ROW] */
gotoxy(22,8); TO02row = GetInput();

settextstyle(DEFAULT_FONT,HORIZ_DIR,3);
setcolor(9); outtextxy(10,135,"");
settextstyle(TRIPLEX_FONT,HORIZ_DIR,2);
setcolor(15); outtextxy(40,135,"to col : ");

/* LET "TO02col" THE VALID KEYPRESS VALUE FOR [TO-COLUMN] */
gotoxy(22,10); TO02col = GetInput();

/* CHECK IF DESTINATION [ROW-COLUMN] FIELD IS NOT EMPTY */
if(Status[TO02row][TO02col] != 0)
{ goto Play02Moves; }
/* CHECK IF DESTINATION TO-ROW OR TO-COLUMN IS NOT
ON THE SAME FROM-ROW OR FROM-COLUMN POSITION */
if(TO02row == FR02row || TO02col == FR02col)
{ goto Play02Moves; }
/* CHECK IF DESTINATION TO-ROW OR TO-COLUMN IS AN EQUAL ROW-COLUMN VALUE */
if(abs(TO02col - FR02col) != abs(TO02row - FR02row))
{ goto Play02Moves; }
/* CHECK IF PLAYER 2 PIECE MOVES BACKWARD AND IS NOT A CROWNED PIECE */
if(SGN(TO02row - FR02row) == 1 && Status[FR01row][FR01col] != 4 && abs(TO02row - FR02row) == 1)
{ goto Play02Moves; }
/* ONLY DESTINATION ROW-COLUMN NOT MORE THAN 2 IS VALID */
if(abs(TO02col - FR02col) > 2)
{ goto Play02Moves; }

/* IF PLAYER 2 PIECE CONQUERS A PLAYER 1 PIECE
EMPTY THE FIELD OF PLAYER 1 PIECE */
if(abs(TO02col - FR02col) == 2)
{
if(SGN(TO02col - FR02col) == 1)
{
if(SGN(TO02row - FR02row) == -1)
{
if(Status[FR02row - 1][FR02col + 1] == 1 || Status[FR02row - 1][FR02col + 1] == 2)
{ Status[FR02row - 1][FR02col + 1] = 0; }
else
{ goto Play02Moves; }
}
if(SGN(TO02row - FR02row) == 1)
{
if(Status[FR02row + 1][FR02col + 1] == 1 || Status[FR02row + 1][FR02col + 1] == 2)
{ Status[FR02row + 1][FR02col + 1] = 0; }
else
{ goto Play02Moves; }
}
}
if(SGN(TO02col - FR02col) == -1)
{
if(SGN(TO02row - FR02row) == -1)
{
if(Status[FR02row - 1][FR02col - 1] == 1 || Status[FR02row - 1][FR02col - 1] == 2)
{ Status[FR02row - 1][FR02col - 1] = 0; }
else
{ goto Play02Moves; }
}
if(SGN(TO02row - FR02row) == 1)
{
if(Status[FR02row + 1][FR02col - 1] == 1 || Status[FR02row + 1][FR02col - 1] == 2)
{ Status[FR02row + 1][FR02col - 1] = 0; }
else
{ goto Play02Moves; }
}
}
}
/* IF PLAYER 2 GETS A CROWN, CHANGE ITS STATUS ON THE FIELD TO 4 */
if(TO02row == 0) { Status[FR02row][FR02col] = 4; }
/* TRANSFER THE PIECE TO ITS DESTINATION FIELD */
Status[TO02row][TO02col] = Status[FR02row][FR02col];
/* EMPTY THE FROM ROW-COLUMN FIELD */
Status[FR02row][FR02col] = 0;
DRAWBOARD();
/* CHECK IF PLAYER 2 WINS. IF RETURNED VALUE IS ZERO, PLAYER 2 WINS! */
if(Check02win() == 0) { Tapos = 'Y'; goto Gana02; }

/* IF NO ONE WINS, CONTINUE PLAYING... */
if(Tapos == 'N') { goto Play; }

Gana01:
/* DISPLAYS A WINNING MESSAGE FOR PLAYER 1
AND EXITS THE SYSTEM */
DRAWWINS();
setcolor(4); settextstyle(DEFAULT_FONT,HORIZ_DIR,4);
outtextxy(155,305,"");
getch();
closegraph();
exit(0);

Gana02:
/* DISPLAYS A WINNING MESSAGE FOR PLAYER 2
AND EXITS THE SYSTEM */
DRAWWINS();
setcolor(9); settextstyle(DEFAULT_FONT,HORIZ_DIR,4);
outtextxy(155,305,"");
getch();
closegraph();
exit(0);
}
}

VB 6.0 Simple Checkers Game

'FORM2.FRM - WINDOW FOR DAMA GAMES
'THE MAIN MODULE OF THIS GAME IS WHEN THE PLAYER CLICKS AT THE DAMA BOARD

'PROCEDURE FORM_LOAD
'YOU CAN DECLARE STATEMENTS IN THIS PROCEDURE WHICH WILL EXECUTE EVERYTIME THE FORM LOADS
Private Sub Form_Load()
'SHOWS THE FORM 1 MODALLY... (MODALLY MEANS YOU CANNOT USE ANY FORM WITHOUT EXITING THE MODALLED FORM
'FORM1 IS THE LOGIN FORM FOR PLAYER NAMES
Form1.Show vbModal
'CALLS GAME_START MODULE
Call GAME_START
End Sub

'GAME START MODULE
'THESE MODULE INITIALIZES THE LABELS SHOWING PLAYER NAMES
'INITIALIZES PLAYER TURNS
'INITIALIZES DAMA BOARD AND DISPLAY BOARD
Sub GAME_START()
'SET LABEL CAPTIONS TO GLOBAL VARIABLES PLAYER 1 AND PLAYER 2
labPlayer1.Caption = PLAYER_1
labPlayer2.Caption = PLAYER_2
'SET VALUE FOR GLOBAL VARIABLE PLAYERS_TURN. WHERE 1 MEANS PLAYER 2'S TURN
PLAYERS_TURN = 1
'CALLS INITIALIZE_DAMA_BOARD PROCEDURE FROM MODULE1.BAS
'THIS MODULE INITIALIZES THE PICTURES OF DAMA_BOARD PICTURE BOX FROM INDEX 0 TO 63 WITH BOX1 AND BOX2 PICTURE BOX.PICTURE
Module1.INITIALIZE_DAMA_BOARD
'CALLS DISPLAY_DAMA_BOARD PROCEDURE FROM MODULE1.BAS
'THIS MODULE DISPLAYS THE PICTURES OF DAMA_BOARD PICTURE BOX FROM INDEX 0 TO 63 WITH ITS PLAYER1 AND PLAYER PICTURE BOX.PICTURE
Module1.DISPLAY_DAMA_BOARD
End Sub

Private Sub DAMA_BOARD_Click(Index As Integer)
'DECLARES VARIABLES WITH TYPE AS TAPON
Dim DAMA_BOX1 As TAPON
Dim DAMA_BOX2 As TAPON
Dim DAMA_BOX3 As TAPON

'DECLARES VARIABLES FOR ROW AND COLUMN AS BYTE
Dim BOX_ROW As Byte
Dim BOX_COLUMN As Byte

'DECLARES ANOTHER VARIABLES FOR ROW AND COLUMN AS BYTE
Dim CURRENT_COLUMN As Integer
Dim CURRENT_ROW As Integer

'DECLARES ANOTHER VARIABLE AS BYTE FOR CONVERTING DAMA_BOX INDEX TO BYTE
Dim INDEX_BYTE As Byte
'DECLARES PLAYER_MOVES VARIABLE WITH TYPE AS HIRO_KANG_TAPON
Dim PLAYER_MOVES() As HIRO_KANG_TAPON

'CONVERT INDEX WHICH IS INTERGER TO BYTE
INDEX_BYTE = CByte(Index)

'CHECK CONDITION IF SELECTED_BOX IS SELECTING A PIECE TO MOVE OR MOVING A PIECE OR TAKING A PIECE
If SELECTED_BOX = BOX_SELECTED Then
'PLAYER IS SELECTING

'CALLS CONVERT_ROW_COLUMN MODULE FOR CONVERTING DAMA_BOX INDEXES TO ROW_COLUMN VALUE
Module1.CONVERT_ROW_COLUMN INDEX_BYTE, BOX_COLUMN, BOX_ROW
'CALLS CHECK_DAMA_BOX_STATUS FUNCTION MODULE AND ASSIGNS IT TO DAMA_BOX1 VARIABLE WITH TYPE AS TAPON
DAMA_BOX1 = CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD)

'IF DAMA_BOX DOESNT HAVE A PIECE THEN EXIT THIS PROCEDURE
If DAMA_BOX1.IS_BOX = 0 Then
Exit Sub
End If
'IF DAMA_BOX IS OCCUPIED BY ANOTHER PIECE THEN EXIT THIS PROCEDURE
If DAMA_BOX1.OKUPADO = 0 Then
Exit Sub
End If
'ASSIGN INDEX_BYTE VALUE TO VARIABLE SELECTED_BOX
SELECTED_BOX = INDEX_BYTE
'CALLS DISPLAY_DAMA_BOARD PROCEDURE FROM MODULE1.BAS WITH ITS NEW VALUES
Module1.DISPLAY_DAMA_BOARD
Else
'PLAYER IS MOVING A PIECE

'CALLS CONVERT_ROW_COLUMN MODULE FOR CONVERTING DAMA_BOX INDEXES TO ROW_COLUMN VALUE
Module1.CONVERT_ROW_COLUMN SELECTED_BOX, BOX_COLUMN, BOX_ROW
'CALLS CHECK_DAMA_BOX_STATUS FUNCTION MODULE AND ASSIGNS IT TO DAMA_BOX1 VARIABLE WITH TYPE AS TAPON
DAMA_BOX1 = CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD)

'IF SELECTED_BOX IS SAME AS INDEX_BYTE THEN PLAYER HAS CLICK SAME PIECE AS SELECTED
If SELECTED_BOX = INDEX_BYTE Then
'EXITING PROCEDURE RETURNING DEFAUL VALUES
GoTo EXIT_MOVES
End If

'IF DAMA_BOX1.PLAYER VALUE IS NOT EQUAL TO PLAYERS TURN THEN PLAYER HAS CLICK AN INVALID PIECE
If Not DAMA_BOX1.PLAYER = PLAYERS_TURN Then
'EXITING PROCEDURE RETURNING DEFAUL VALUES
GoTo EXIT_MOVES
End If

'CALLS CONVERT_ROW_COLUMN MODULE FOR CONVERTING DAMA_BOX INDEXES TO ROW_COLUMN VALUE
Module1.CONVERT_ROW_COLUMN INDEX_BYTE, BOX_COLUMN, BOX_ROW
'CALLS CHECK_DAMA_BOX_STATUS FUNCTION MODULE AND ASSIGNS IT TO DAMA_BOX2 VARIABLE WITH TYPE AS TAPON
DAMA_BOX2 = CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD)

'IF DAMA_BOX2.IS_BOX VALUE IS EQUAL TO ZERO (OR HAS NO PIECE) - TAKING A PIECE IS DONE BY CLICKING PLAYERS PIECE THEN PLAYER HAS CLICK AN INVALID DAMA_BOX
If DAMA_BOX2.IS_BOX = 0 Then
'EXITING PROCEDURE RETURNING DEFAUL VALUES
GoTo EXIT_MOVES
End If

'IF DAMA_BOX2.OKUPADO = 0 <-- MEANS PLAYER HAS CLICK AN OCCUPIED PIECE BY ANOTHER PLAYER
If DAMA_BOX2.OKUPADO = 0 Then
'PLAYER IS MOVING A PIECE BY TAKING ANOTHER PLAYERS PIECE
'ASSIGN DAMA_BOX2 VALUES TO CURREN ROW-COLUMN VALUES CHECKING IF THE BOX TO LAND FROM PIECE TO BE CAPTURE IS FREE
CURRENT_COLUMN = CInt(DAMA_BOX2.BOX_COLUMN) - CInt(DAMA_BOX1.BOX_COLUMN)
CURRENT_ROW = CInt(DAMA_BOX2.BOX_ROW) - CInt(DAMA_BOX1.BOX_ROW)

'CHECK CURRENT VALUES IF VALID
If Not (Abs(CURRENT_COLUMN) = 1 And Abs(CURRENT_ROW) = 1) Then
'VALUES IS INVALID
'EXITING PROCEDURE RETURNING DEFAUL VALUES
GoTo EXIT_MOVES
End If

'IF DAMA_BOX1 VALUE IS DAMA NA EQUALS DAE_PA
If Not DAMA_BOX1.DAMA_NA = 1 Then
'IF DAMA_BOX1 VALUE PLAYER IS PLAYER 1 THEN
If DAMA_BOX1.PLAYER = 0 Then
'IF CURRENT_ROW VALUE IS NEGATIVE THEN
If CURRENT_ROW = -1 Then
'VALUES IS INVALID
'EXITING PROCEDURE RETURNING DEFAUL VALUES
GoTo EXIT_MOVES
End If
Else
'IF DAMA_BOX1 VALUE PLAYER IS PLAYER 2 THEN
'IF CURRENT_ROW VALUE IS POSITIVE THEN
If CURRENT_ROW = 1 Then
'VALUES IS INVALID
'EXITING PROCEDURE RETURNING DEFAUL VALUES
GoTo EXIT_MOVES
End If
End If
End If
'AFTER CHECKING ALL ROW, COLUMN VALUES

'ASSIGN PLAYER_MOVES VALUES <--- WITH TYPE HIRO_KANG_TAPON
ReDim PLAYER_MOVES(1)
'DAMA_BOARD CAPTURED WILL BE CLEARED
PLAYER_MOVES(1).REMOVE_LAOG = BOX_SELECTED
'DAMA_BOARD INDEX FROM WILL BE ASSIGNED AS SELECTED BOX
PLAYER_MOVES(1).FROM_INDEX = SELECTED_BOX
'DAMA_BOARD INDEX TO ASSIGNED AS INDEX_BYTE VALUE
PLAYER_MOVES(1).TO_INDEX = INDEX_BYTE

'CHECK IF ROW FOR PLAYERS MAKES THEM DAMA_NA
'IF DAMA_BOX1.PLAYER IS PLAYER 1 THEN
If DAMA_BOX1.PLAYER = 0 Then
'DAMA_BOX2.ROW IS ROW 8 ---> BECAUSE PLAYER 1 IS GOING UP
If DAMA_BOX2.BOX_ROW = 8 Then
'SET VALUE FOR DAMA_BOX1.PLAYERS PIECE AS DAMA_NA
CURRENT_DAMA_BOARD.PYESA(DAMA_BOX1.PLAYER_NUMBER).DAMA_NA = 1
End If
Else
'DAMA_BOX1.PLAYER IS PLAYER 2
'DAMA_BOX2.ROW IS ROW 1 ---> BECAURE PLAYER 2 IS GOING DOWN
If DAMA_BOX2.BOX_ROW = 1 Then
CURRENT_DAMA_BOARD.PYESA(DAMA_BOX1.PLAYER_NUMBER).DAMA_NA = 1
End If
End If
'REVERSE PLAYERS TURN BY CALLING THE FUNCTION (REVERS PLAYERS_TURN FROM MODULE1.BAS)
PLAYERS_TURN = REVERSE_PLAYERS_TURN(PLAYERS_TURN)
'SET HIRO_KANG_TAPOS VALUES
Module1.HIRO_KANG_TAPON PLAYER_MOVES, CURRENT_DAMA_BOARD
Else
'PLAYER IS JUST MOVING A PIECE
If DAMA_BOX2.PLAYER = DAMA_BOX1.PLAYER Then
'IF SELECTED_BOX IS SAME AS INDEX_BYTE THEN PLAYER HAS CLICK SAME PIECE AS SELECTED '
SELECTED_BOX = INDEX_BYTE
'CALLS DISPLAY_DAMA_BOARD PROCEDURE FROM MODULE1.BAS THEN EXIT THIS PROCEDURE
Module1.DISPLAY_DAMA_BOARD
Exit Sub
End If

'ASSIGN DAMA_BOX2 VALUES TO CURREN ROW-COLUMN VALUES CHECKING IF THE BOX TO LAND FROM PIECE TO BE CAPTURE IS FREE
CURRENT_COLUMN = (CInt(DAMA_BOX1.BOX_COLUMN) - CInt(DAMA_BOX2.BOX_COLUMN))
CURRENT_ROW = (CInt(DAMA_BOX1.BOX_ROW) - CInt(DAMA_BOX2.BOX_ROW))

'CHECK CURRENT VALUES IF VALID
If Not (Abs(CURRENT_COLUMN) = 1 And Abs(CURRENT_ROW) = 1) Then
'IF SELECTED_BOX IS SAME AS INDEX_BYTE THEN PLAYER HAS CLICK SAME PIECE AS SELECTED '
SELECTED_BOX = BOX_SELECTED
'CALLS DISPLAY_DAMA_BOARD PROCEDURE FROM MODULE1.BAS THEN EXIT THIS PROCEDURE
Module1.DISPLAY_DAMA_BOARD
Exit Sub
End If

'CHECK IF ROW FOR PLAYERS MAKES THEM DAMA_NA
If Not DAMA_BOX1.DAMA_NA = 1 Then
'IF DAMA_BOX1.PLAYER IS PLAYER 1 THEN
If DAMA_BOX1.PLAYER = 0 Then
'IF CURRENT_ROW VALUE IS POSITIVE THEN
'VALUE IS INVALID ---> EXITING RESULTING DEFAULTS
If CURRENT_ROW = 1 Then GoTo EXIT_MOVES
Else
'IF CURRENT_ROW VALUE IS NEGATIVE THEN
'VALUE IS INVALID ---> EXITING RESULTING DEFAULTS
If CURRENT_ROW = -1 Then GoTo EXIT_MOVES
End If
End If

'ASSIGN NEW VALUES FOR BOX ROW AND COLUMN
BOX_COLUMN = (CInt(DAMA_BOX2.BOX_COLUMN) - CInt(DAMA_BOX1.BOX_COLUMN)) + DAMA_BOX2.BOX_COLUMN
BOX_ROW = (CInt(DAMA_BOX2.BOX_ROW) - CInt(DAMA_BOX1.BOX_ROW)) + DAMA_BOX2.BOX_ROW

'CALLS CHECK_DAMA_BOX_STATUS FUNCTION MODULE AND ASSIGNS IT TO DAMA_BOX3 VARIABLE WITH TYPE AS TAPON
DAMA_BOX3 = CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD)

'CHECK IF VALUES ASSIGNED FOR DAMA_BOX3 IS ALL VALID
If DAMA_BOX3.IS_BOX = 0 Or DAMA_BOX3.OKUPADO = 1 Then
Exit Sub
End If

'ASSIGN PLAYER_MOVES VALUES <--- WITH TYPE HIRO_KANG_TAPON
ReDim PLAYER_MOVES(1)
'DAMA_BOARD CAPTURED WILL BE CLEARED
PLAYER_MOVES(1).REMOVE_LAOG = INDEX_BYTE
'DAMA_BOARD INDEX FROM WILL BE ASSIGNED AS SELECTED BOX
PLAYER_MOVES(1).FROM_INDEX = SELECTED_BOX
'DAMA_BOARD INDEX TO ASSIGNED AS INDEX_BYTE VALUE
PLAYER_MOVES(1).TO_INDEX = Module1.CONVERT_WHEN_SELECTED(BOX_COLUMN, BOX_ROW)

'CHECK IF PLAYERS IS DAMA NA
'CHECK IF DAMA_BOX1.PLAYER IS PLAYER 1
If DAMA_BOX1.PLAYER = 0 Then
'IF ROW EQUALS 8 THEN DAMA NA SINCE PLAYER 1 IF GOING UP
If DAMA_BOX3.BOX_ROW = 8 Then CURRENT_DAMA_BOARD.PYESA(DAMA_BOX1.PLAYER_NUMBER).DAMA_NA = 1
Else
'DAMA_BOX1.PLAYER IS PLAYER 2
'IF ROW EQUALS 8 THEN DAMA NA SINCE PLAYER 2 IF GOING UP
If DAMA_BOX3.BOX_ROW = 1 Then CURRENT_DAMA_BOARD.PYESA(DAMA_BOX1.PLAYER_NUMBER).DAMA_NA = 1
End If
'REVERSE PLAYERS TURN BY CALLING THE FUNCTION (REVERS PLAYERS_TURN FROM MODULE1.BAS)
PLAYERS_TURN = REVERSE_PLAYERS_TURN(PLAYERS_TURN)
'SET HIRO_KANG_TAPOS VALUES
Module1.HIRO_KANG_TAPON PLAYER_MOVES, CURRENT_DAMA_BOARD
End If
End If
Exit Sub

'EXITING PROCEDURE RETURNING DEFAULT VALUES
EXIT_MOVES:
SELECTED_BOX = BOX_SELECTED
Module1.DISPLAY_DAMA_BOARD
End Sub

'COMMAND QUIT
Private Sub cmdQuit_Click()
'CLOSING FORM2 AND END PROGRAM
End
End Sub

'MODULE1.BAS - ADVANCE MODULES FOR DAMA GAME SIMULATION

'Option Explicit

'DECLARES A PUBLIC VARIABLE TAPON AS TYPE
'WITH ITS PARAMATERS TO BE USE...
Public Type TAPON
BOX_COLUMN As Byte
BOX_ROW As Byte
Index As Byte
PLAYER As Byte
DAMA_NA As Byte
OKUPADO As Byte
PLAYER_NUMBER As Byte
IS_BOX As Byte
End Type

'DECLARES A PUBLIC VARIABLE DAMA_BOARD_STATUS AS TYPE
'WITH ITS PARAMATERS AS TAPON WHICH IS ANOTHER VARIABLE TYPE...
Public Type DAMA_BOARD_STATUS
PYESA(23) As TAPON
End Type

'DECLARES A PUBLIC VARIABLE HIRO_KANG_TAPON AS TYPE
Public Type HIRO_KANG_TAPON
REMOVE_LAOG As Byte
FROM_INDEX As Byte
TO_INDEX As Byte
End Type

'DECLARES A GLOBAL VARIABLE WITH TYPE AS DAMA_BOARD_STATUS
Global CURRENT_DAMA_BOARD As DAMA_BOARD_STATUS

'DECLARES OTHER GLOBAL VARIABLES

Global PLAYERS_TURN As Byte
Global SELECTED_BOX As Byte
Global PLAYER_1 As String
Global PLAYER_2 As String

Public Const BOX_SELECTED = 65

'PROCEDURE FOR INITIALIZING DAMA BOARDS WHICH IS THE PICTURE BOX WITH INDEX 0 TO 63
Sub INITIALIZE_DAMA_BOARD()
'DECLARES 2 INTEGER VARIABLES AS COUNTERS
Dim varINIT1 As Integer
Dim varINIT2 As Integer

'DECLARES BOX & ROW VARIABLES AS INTEGER
Dim BOX_COLUMN As Integer
Dim BOX_ROW As Integer

varINIT1 = 0
'LOOP FROM 0 TO 11
For varINIT2 = 0 To 11
varINIT1 = ((varINIT2 + 1) * 2) - 1
If varINIT2 > 3 And varINIT2 < 8 Then
varINIT1 = varINIT1 - 1
End If
'SET CLEAR VALUES FOR ITS BOXES
CURRENT_DAMA_BOARD.PYESA(varINIT2).OKUPADO = 1
CURRENT_DAMA_BOARD.PYESA(varINIT2).DAMA_NA = 0
CURRENT_DAMA_BOARD.PYESA(varINIT2).PLAYER = 0
CURRENT_DAMA_BOARD.PYESA(varINIT2).BOX_COLUMN = (varINIT1 Mod 8) + 1
CURRENT_DAMA_BOARD.PYESA(varINIT2).BOX_ROW = ((varINIT1 - (varINIT1 Mod 8)) / 8) + 1
Next varINIT2

varINIT1 = 0
'LOOP FROM 12 TO 23
For varINIT2 = 12 To 23
varINIT1 = ((varINIT2 - 11) * 2) - 1
If varINIT2 >= 16 And varINIT2 < 20 Then
varINIT1 = varINIT1 - 1
End If
varINIT1 = 63 - varINIT1
'SET CLEAR VALUES FOR ITS BOXES
CURRENT_DAMA_BOARD.PYESA(varINIT2).OKUPADO = 1
CURRENT_DAMA_BOARD.PYESA(varINIT2).DAMA_NA = 0
CURRENT_DAMA_BOARD.PYESA(varINIT2).PLAYER = 1
CURRENT_DAMA_BOARD.PYESA(varINIT2).BOX_COLUMN = (varINIT1 Mod 8) + 1
CURRENT_DAMA_BOARD.PYESA(varINIT2).BOX_ROW = ((varINIT1 - (varINIT1 Mod 8)) / 8) + 1
Next varINIT2
'SET SELECTED_BOX VALUE AS BOX_SELECTED
SELECTED_BOX = BOX_SELECTED
End Sub

'MAIN PROCEDURE OF DAMA GAME
'THIS PROCEDURE DISPLAY ANY CHANGES ON VALUES FOR DAMA_BOARD PICTURE BOX FROM 0 TO 63
Sub DISPLAY_DAMA_BOARD()
'DECRALER VARIABLES AS LONG ---> USE HERE AS COUNTERS
Dim varINIT1 As Long
Dim varINIT2 As Long
'DECRALER VARIABLES AS LONG ---> USE HERE AS INDEX VARIABLES FOR DAMA_BOARDS
Dim varINDEX1 As Long
Dim varINDEX2 As Long

Dim NEW_DAMA_BOARD(0 To 63) As Long

Static NEXT_DAMA_BOARD(0 To 63) As Long
Static BOX_COLUMN As Byte
Static BOX_ROW As Byte

'INITIALIZING VARIABLE varINIT1 FROM 0 TO 63 AS VALUE -3
For varINIT1 = 0 To 63
NEXT_DAMA_BOARD(varINIT1) = -3
Next varINIT1

'INITIALIZING VARIABLE varINIT1 FROM 0 TO 63 AS VALUE - 1
'MUST LOOP TWICE TO ENSURE CLEARING OF ALL BOX VALUES
For varINIT1 = 0 To 63
NEW_DAMA_BOARD(varINIT1) = -1
Next varINIT1

'INITIALIZING varINIT1 VALUES
For varINIT1 = 0 To 23
'SET varINDEX2 VALUE AS THE CONVERTED SELECTED VALUE RETURNED BY CONVER_WHEN_SELECTED FUNCTION
varINDEX2 = Module1.CONVERT_WHEN_SELECTED(CURRENT_DAMA_BOARD.PYESA(varINIT1).BOX_COLUMN, CURRENT_DAMA_BOARD.PYESA(varINIT1).BOX_ROW)
'CHECK IF DAMA BOX IS OCCUPIED
If CURRENT_DAMA_BOARD.PYESA(varINIT1).OKUPADO = 1 Then
NEW_DAMA_BOARD(varINDEX2) = varINIT1
End If
Next

'CHECK IF
If Not SELECTED_BOX = BOX_SELECTED Then
NEW_DAMA_BOARD(SELECTED_BOX) = -2
End If

'LOOP FOR varINIT1 SETTING PICTURES FOR DAMA BOXES
For varINIT1 = 0 To 63
varINIT2 = varINIT1
If NEXT_DAMA_BOARD(varINIT1) <> NEW_DAMA_BOARD(varINIT1) Then
Select Case NEW_DAMA_BOARD(varINIT1)
'-1 VALUE IS FOR EMPTY BOX
Case -1
Module1.CONVERT_ROW_COLUMN CByte(varINIT1), BOX_COLUMN, BOX_ROW
If BOX_COLUMN Mod 2 <> BOX_ROW Mod 2 Then
'SET PICTURE FOR DAMA BOARD AS BOX2.PICTURE
Form2.DAMA_BOARD(varINIT2).Picture = Form2.Box2.Picture
Else
'SET PICTURE FOR DAMA BOARD AS BOX1.PICTURE
Form2.DAMA_BOARD(varINIT2).Picture = Form2.Box1.Picture
End If
'-2 VALUE IS FOR SELECTED PIECE
Case -2
Module1.CONVERT_ROW_COLUMN CByte(varINIT1), BOX_COLUMN, BOX_ROW
'CHECK DAMA_BOX PLAYER
Select Case CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD).PLAYER
'PLAYER IS PLAYER 1
Case Is = 0
'CHECK IF PLAYER 1 IS DAMA_NA (0 AS DAE PA) (1 AS DAMA NA)
If CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD).DAMA_NA = 0 Then
'SET PICTURE FOR PLAYER 1 AS THE NORMAL PLAYER 1 PICTURE
Form2.DAMA_BOARD(varINIT2).Picture = Form2.Player1_Selected.Picture
End If
If CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD).DAMA_NA = 1 Then
'SET PICTURE FOR PLAYER 1 AS THE NORMAL PLAYER 2 PICTURE
Form2.DAMA_BOARD(varINIT2).Picture = Form2.Player1_Dama_Selected.Picture
End If
'PLAYER IS PLAYER 2
Case Is = 1
'CHECK IF PLAYER 1 IS DAMA_NA (0 AS DAE PA) (1 AS DAMA NA)
If CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD).DAMA_NA = 0 Then
'SET PICTURE FOR PLAYER 1 AS THE NORMAL PLAYER 1 PICTURE
Form2.DAMA_BOARD(varINIT2).Picture = Form2.Player2_Selected.Picture
End If
If CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD).DAMA_NA = 1 Then
'SET PICTURE FOR PLAYER 1 AS THE NORMAL PLAYER 2 PICTURE
Form2.DAMA_BOARD(varINIT2).Picture = Form2.Player2_Dama_Selected.Picture
End If
End Select
Case Else
'-3 VALUE IS FOR MOVING PIECE
Select Case CURRENT_DAMA_BOARD.PYESA(NEW_DAMA_BOARD(varINIT1)).PLAYER
Case Is = 0
'CHECK IF PLAYER 1 IS DAMA_NA (0 AS DAE PA) (1 AS DAMA NA)
If CURRENT_DAMA_BOARD.PYESA(NEW_DAMA_BOARD(varINIT1)).DAMA_NA = 0 Then
'SET PICTURE FOR PLAYER 1 AS THE NORMAL PLAYER 1 PICTURE
Form2.DAMA_BOARD(varINIT2).Picture = Form2.Player1.Picture
End If
If CURRENT_DAMA_BOARD.PYESA(NEW_DAMA_BOARD(varINIT1)).DAMA_NA = 1 Then
'SET PICTURE FOR PLAYER 1 AS THE NORMAL PLAYER 2 PICTURE
Form2.DAMA_BOARD(varINIT2).Picture = Form2.Player1_Dama.Picture
End If
Case Is = 1
'CHECK IF PLAYER 1 IS DAMA_NA (0 AS DAE PA) (1 AS DAMA NA)
If CURRENT_DAMA_BOARD.PYESA(NEW_DAMA_BOARD(varINIT1)).DAMA_NA = 0 Then
'SET PICTURE FOR PLAYER 1 AS THE NORMAL PLAYER 1 PICTURE
Form2.DAMA_BOARD(varINIT2).Picture = Form2.Player2.Picture
End If
If CURRENT_DAMA_BOARD.PYESA(NEW_DAMA_BOARD(varINIT1)).DAMA_NA = 1 Then
'SET PICTURE FOR PLAYER 1 AS THE NORMAL PLAYER 2 PICTURE
Form2.DAMA_BOARD(varINIT2).Picture = Form2.Player2_Dama.Picture
End If
End Select
End Select
End If
Next
For varINIT1 = 0 To 63
NEXT_DAMA_BOARD(varINIT1) = NEW_DAMA_BOARD(varINIT1)
Next varINIT1

'CHECK GAME STATUS - IF EITHER OF THE PLAYER WINS OR GAME CONTINUES...
Dim varBOXES As Byte
Dim PYESA_PLAYER_NUMBER(0 To 1) As Byte
Dim CHECK_GAME_STATUS As String

'LOOP ON ALL BOXES SETTING PLAYER NUMBER FOR NOT EMPTY BOXES FOUND
For varBOXES = 0 To 23
'CHECKS IF DAMA_BOX IS OCCUPIED
If CURRENT_DAMA_BOARD.PYESA(varBOXES).OKUPADO Then
'SET PLAYER NUMBERS
PYESA_PLAYER_NUMBER(CURRENT_DAMA_BOARD.PYESA(varBOXES).PLAYER) = PYESA_PLAYER_NUMBER(CURRENT_DAMA_BOARD.PYESA(varBOXES).PLAYER) + 1
End If
Next varBOXES

'CHECK IF PLAYER 1 PIECE IS ZERO
If PYESA_PLAYER_NUMBER(0) = 0 Then
'IF ZERO - CHECK IF PLAYER 1 PIECE IS ZERO
If PYESA_PLAYER_NUMBER(1) > 0 Then
'IF PLAYER 2 PIECE IS GREATER THAN ZERO THEN
'PLAYER 2 HAS CAPTURED ALL PIECES OF PLAYER 1 AND WINS!
MsgBox UCase(PLAYER_0) & " WINS...", vbInformation, "Congrats!..."
'ASK IF WANT ANOTHER GAME
If MsgBox("Play Another?", vbQuestion + vbYesNo, "Revenge...") = vbYes Then
'IF PLAYERS WANTS ANOTHER - CALLS FORM2.GAME_START PROCEDURE
Form2.GAME_START
Else
End
End If
End If
'CHECK IF PLAYER 1 PIECE IS ZERO
ElseIf PYESA_PLAYER_NUMBER(1) = 0 Then
'IF ZERO - CHECK IF PLAYER 1 PIECE IS ZERO
If PYESA_PLAYER_NUMBER(0) > 0 Then
'IF PLAYER 1 PIECE IS GREATER THAN ZERO THEN
'PLAYER 1 HAS CAPTURED ALL PIECES OF PLAYER 2 AND WINS!
MsgBox UCase(PLAYER_2) & " WINS...", vbInformation, "Congrats!..."
'ASK IF WANT ANOTHER GAME
If MsgBox("Play Another?", vbQuestion + vbYesNo, "Revenge...") = vbYes Then
'IF PLAYERS WANTS ANOTHER - CALLS FORM2.GAME_START PROCEDURE
Form2.GAME_START
Else
End
End If
End If
Else
End If
End Sub

'CHECKS DAMA_BOX (ROW AND COLUMN) STATUS
Public Function CHECK_DAMA_BOX_STATUS(BOX_COLUMN As Byte, BOX_ROW As Byte, CURRENT_DAMA_BOARD As DAMA_BOARD_STATUS) As TAPON
'CHECKS IF ROW COLUMN IS VALID
If BOX_COLUMN > 8 Or BOX_ROW > 8 Or BOX_COLUMN < 1 Or BOX_ROW < 1 Then
'BOX IS INVALID
'FUNCTIONS RETURNS VALUE AS ZERO
CHECK_DAMA_BOX_STATUS.IS_BOX = 0
Exit Function
End If
'CHECKS IF ROW COLUMN IS VALID
If BOX_COLUMN Mod 2 = BOX_ROW Mod 2 Then
'BOX IS INVALID
'FUNCTIONS RETURNS VALUE AS ZERO
CHECK_DAMA_BOX_STATUS.IS_BOX = 0
Exit Function
End If

Dim TAPON_NUMBER As Byte
'LOOP FOR PLAYER NUMBER SETTING TAPON_NUMBER AS DAMA_BOX PLAYER NUMBER
For TAPON_NUMBER = 0 To 23
'CHECK IF OCCUPIED
If CURRENT_DAMA_BOARD.PYESA(TAPON_NUMBER).OKUPADO Then
If CURRENT_DAMA_BOARD.PYESA(TAPON_NUMBER).BOX_COLUMN = BOX_COLUMN Then
If CURRENT_DAMA_BOARD.PYESA(TAPON_NUMBER).BOX_ROW = BOX_ROW Then
'SET DAMA_BOX VALUES
CHECK_DAMA_BOX_STATUS.DAMA_NA = CURRENT_DAMA_BOARD.PYESA(TAPON_NUMBER).DAMA_NA
CHECK_DAMA_BOX_STATUS.OKUPADO = 1
CHECK_DAMA_BOX_STATUS.PLAYER = CURRENT_DAMA_BOARD.PYESA(TAPON_NUMBER).PLAYER
CHECK_DAMA_BOX_STATUS.PLAYER_NUMBER = TAPON_NUMBER
'EXIT LOOP
Exit For
End If
End If
End If
Next TAPON_NUMBER

'SET CURRENT_DAMA_BOX_STATUS VALUES
CHECK_DAMA_BOX_STATUS.BOX_COLUMN = BOX_COLUMN
CHECK_DAMA_BOX_STATUS.BOX_ROW = BOX_ROW
CHECK_DAMA_BOX_STATUS.Index = ((BOX_ROW - 1) * 8) + BOX_COLUMN
CHECK_DAMA_BOX_STATUS.IS_BOX = 1
End Function

Sub HIRO_KANG_TAPON(PLAYER_MOVES() As HIRO_KANG_TAPON, ByRef CURRENT_DAMA_BOARD As DAMA_BOARD_STATUS)
'DECLARE VARIABLES AS BYTE
Dim varINIT1 As Byte
Dim varINIT2 As Byte

'DECLARE ROW COLUMN VALUE AS BYTE
Dim BOX_COLUMN As Byte
Dim BOX_ROW As Byte

'DECLARE DAMA_BOX VARIABLES WITH TYPE AS TAPON
Dim DAMA_BOX1 As TAPON
Dim DAMA_BOX2 As TAPON
Dim DAMA_BOX3 As TAPON

'SET VARINIT1 VALUE AS THE PARAMETERED PLAYER_MOVES PASSED IN THIS PROCEDURE
varINIT1 = UBound(PLAYER_MOVES)

If varINIT1 < 1 Then
Exit Sub
End If

'LOOP FOR VALUES VARINIT2 - 1 TO VARINIT1 (PLAYER_MOVES)
For varINIT2 = 1 To varINIT1
With PLAYER_MOVES(varINIT2)
If Not .FROM_INDEX = BOX_SELECTED And Not .TO_INDEX = BOX_SELECTED Then
'CALLS PROCEDURE CONVERT_ROW_COLUM
Module1.CONVERT_ROW_COLUMN .FROM_INDEX, BOX_COLUMN, BOX_ROW
'CALLS CHECK_DAMA_BOX_STATUS FUNCTION MODULE AND ASSIGNS IT TO DAMA_BOX3 VARIABLE WITH TYPE AS TAPON
DAMA_BOX1 = CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD)

'CHECK IF OCCUPIED
If DAMA_BOX1.OKUPADO = 1 Then
'ASSIGN VALUES
SELECTED_BOX = .FROM_INDEX
'CALLS DISPLAY_DAMA_BOARD PROCEDURE
Module1.DISPLAY_DAMA_BOARD
'PASS VALUE OF BOX_SELECTED TO SELECTED_BOX
SELECTED_BOX = BOX_SELECTED

If Not .REMOVE_LAOG = BOX_SELECTED Then
Module1.CONVERT_ROW_COLUMN .REMOVE_LAOG, BOX_COLUMN, BOX_ROW
'CALLS CHECK_DAMA_BOX_STATUS FUNCTION MODULE AND ASSIGNS IT TO DAMA_BOX3 VARIABLE WITH TYPE AS TAPON
DAMA_BOX3 = CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD)
'CHECK IF OCCUPIED
If DAMA_BOX3.OKUPADO = 1 Then CURRENT_DAMA_BOARD.PYESA(DAMA_BOX3.PLAYER_NUMBER).OKUPADO = 0
End If
'CALLS CONVERT_ROW_COLUM PROCEDURE
Module1.CONVERT_ROW_COLUMN .TO_INDEX, BOX_COLUMN, BOX_ROW
'SET CURRENT_DAMA_BOARD_PYESA VALUES
'WHERE BOX_COLUMN EQUALS BOX_COLUMN VALUE
CURRENT_DAMA_BOARD.PYESA(DAMA_BOX1.PLAYER_NUMBER).BOX_COLUMN = BOX_COLUMN
'WHERE BOX_ROW EQUALS BOX_ROW VALUE
CURRENT_DAMA_BOARD.PYESA(DAMA_BOX1.PLAYER_NUMBER).BOX_ROW = BOX_ROW

'ASSIGN VALUES
SELECTED_BOX = .TO_INDEX
'CALL DISPLAY DAMA_BOARD PROCEDURE
Module1.DISPLAY_DAMA_BOARD

'ASSIGN VALUES
SELECTED_BOX = BOX_SELECTED
'CALL DISPLAY DAMA_BOARD PROCEDURE
Module1.DISPLAY_DAMA_BOARD
End If
Else
If Not .REMOVE_LAOG = BOX_SELECTED Then
'CALLS CONVERT_ROW_COLUMN PROCEDURE
Module1.CONVERT_ROW_COLUMN .REMOVE_LAOG, BOX_COLUMN, BOX_ROW
'CALLS CHECK_DAMA_BOX_STATUS FUNCTION MODULE AND ASSIGNS IT TO DAMA_BOX3 VARIABLE WITH TYPE AS TAPON
DAMA_BOX3 = CHECK_DAMA_BOX_STATUS(BOX_COLUMN, BOX_ROW, CURRENT_DAMA_BOARD)
'CHECK IF OCCUPIED
If DAMA_BOX3.OKUPADO = 1 Then CURRENT_DAMA_BOARD.PYESA(DAMA_BOX3.PLAYER_NUMBER).OKUPADO = 0
End If
End If
End With
Next varINIT2
End Sub

'FUNCTION FOR CONVERTING SELECTED INDEX TO ROW COLUMN VALUES
Public Function CONVERT_WHEN_SELECTED(BOX_COLUMN As Byte, BOX_ROW As Byte) As Byte
'CHECK IF BOX - ROW COLUMN VALUS IS OUT RANGE
If BOX_COLUMN > 8 Or BOX_COLUMN <> 8 Or BOX_ROW < 1 Then
'VALUE IS INVALID ---> PROCEDURE RETURNS THE VALUE AS BOX_SELECTED (BOX_SELECTED --> PREVIOUS BOX VALUE)
CONVERT_WHEN_SELECTED = BOX_SELECTED
Else
'BOX IS VALID ---> FUNCTION RETURNS CONVERTED VALUE
CONVERT_WHEN_SELECTED = ((BOX_ROW - 1) * 8) + BOX_COLUMN - 1
End If
End Function

'PROCEDURE FOR CONVERTING BOX INDEXES TO ROW COLUMN VALUES
Public Sub CONVERT_ROW_COLUMN(SELECTED_BOX_INDEX As Byte, ByRef BOX_COLUMN As Byte, ByRef BOX_ROW As Byte)
'CHECK IF INDEX IS VALID
If SELECTED_BOX_INDEX > 63 Or SELECTED_BOX_INDEX < 0 Then
'INDEX IS OUT OF RANGE --> PROCEDURE RETURNS ZERO (0) VALUES
BOX_COLUMN = 0
BOX_ROW = 0
Else
'INDEX IS VALID... PROCEDURE CONVERT VALUES
BOX_ROW = ((SELECTED_BOX_INDEX - (SELECTED_BOX_INDEX Mod 8)) / 8) + 1
BOX_COLUMN = (SELECTED_BOX_INDEX Mod 8) + 1
End If
End Sub

'FUNCTION FOR REVERSING PLAYER TURN
Public Function REVERSE_PLAYERS_TURN(ByRef TURN_NUMBER As Byte) As Byte
If TURN_NUMBER = 0 Then REVERSE_PLAYERS_TURN = 1
End Function

wizweirdo's Source Code