procedure ade_pa
askpa=alert("เลือกการทำงาน",{"เพิ่มผู้ใช้","แก้ไขpassword","ลบผู้ใช้",;
"กลับเมนูหลัก"})
if askpa=1
do appass
elseif askpa=2
do editpass
elseif askpa=3
do delpass
else
return
endif
close all
return
//========================
//การเพิ่มจำนวนผู้ใช้
procedure appass
set color to w/bg+
cls
set color to w/b
@ 1,2 clear to 3,77
use user
ans=0;ans1=0
do while .t.
if lastkey()=27
return
use
endif
_use=space(20)
_password=space(5)
_priority=0
@ 2,28 say "[การเพิ่มจำนวนผู้ใช้]"
set color to w/g,/w
@ 10,15 say "ชื่อผู้ใช้ :" get _use
@ 12,15 say "password :" get _password
@ 14,15 say "สิทธิ :" get _priority
@ 22,5 clear to 22,75
@ 22,15 say "ต้องการบันทึกหรือไม่"
@ 22,50 prompt "[yes]"
@ 22,60 prompt "[no]"
read
menu to ans1
if ans1=1
append blank
repl user with _use,password with _password,priority with _priority
endif
@ 22,5 clear to 22,75
@ 22,15 say "ต้องการเพิ่มเติมต่อหรือไม่"
@ 22,50 prompt "[yes]"
@ 22,60 prompt "[no]"
menu to ans
if ans=1
loop
else
return
endif
enddo
use
inkey(1)
return
//===========================
//การแก้ไข password
procedure editpass
set color to w/bg+
cls
set color to w/b
@ 1,2 clear to 3,77
use user
ans=0
ans1=0
_user=user
@ 2,25 say "[การแก้ไข password ใหม่]"
set color to w/g,/w
@ 10,15 say "ชื่อผู้ใช้ :" get _user
read
locate for user=_user
if found()
_passw=space(5)
_pass=space(5)
@ 12,15 say "old password :"+password
@ 14,15 say "current password :" get _passw
@ 16,15 say "confirm password :" get _pass
read
@ 22,5 clear to 22,75
@ 22,15 say "ต้องการบันทึกหรือไม่"
@ 22,50 prompt "[yes]"
@22,60 prompt "[no]"
menu to ans1
if ans1=1
repl password with _pass
endif
endif
use
inkey(1)
return
//==============================
//การลบผู้ใช้
procedure delpass
set color to w/bg+
cls
set color to w/b
@ 1,2 clear to 3,77
use user
do while .t.
_u=space(20)
a=reccount()
ans=0
ans1=0
@ 2,28 say "[การลบผู้ใช้]"
set color to w/g,/w
@ 8,15 say "มีผู้ใช้จำนวน"+ltrim(str(a))+"คน"
@ 10,15 say "ชื่อผู้ใช้ :" get _u
read
locate for user=_u
if found()
delete
@ 12,15 say "password :"+password
@ 14,15 say "สิทธิ :"+str(priority)
@ 22,10 clear to 22,75
@ 22,10 say "ต้องการบันการลบหรือไม่"
@ 22,50 prompt "[Yes]"
@ 22,60 prompt "[No]"
menu to ans
if ans=1
pack
else
recall
endif
else
@ 11,10 clear to 18,65
@ 15,15 to 17,55
@ 16,20 say "ชื่อ"+rtrim(_u)+"ไม่พบในแฟ้มข้อมุล"
@ 22,10 clear to 22,75
endif
@ 22,10 clear to 22,75
@ 22,10 say "ต้องการลบผู้ใช้รายต่อไปหรือไม่"
@ 22,50 prompt "[Yes]"
@ 22,60 prompt "[No]"
menu to ans1
if ans1=1
@ 10,10 clear to 18,65
else
return
endif
enddo
use
inkey(1)
return
//===========================
PROCEDURE OS
cls
? "IF YOU WANT TO RETURN TO APPLICATION,TYPE EXIT."
? "==============================================="
INKEY(0)
RUN COMMAND
? "WELCOME TO APPLICATION"
? "======================"
//=========================
procedure see
do while lastkey() !=27
set color to w+/b,r/bg+,rb+
set color to "rb+/b"
set color to rb/b,r/bg+,w+
set color to "g/r"
@ 6,26 to 16,62 double
set color to "gr/b"
@ 12,30 prompt "1.รูปแบบที่ 1 "
@ 13,30 prompt "2.รูปแบบที่ 2 "
@ 14,30 prompt "3.กลับเมนู "
menu to opt
cls
do case
case opt=1
do s11
case opt=2
do s2
case opt=3
exit
endcase
enddo
return
close all
//====================
procedure s2
cls
set color to w/bg+,r/bg+,rb+
set color to "b/bg+"
@ 0,0 clear to 24,80
set color to "w/r"
@1,0 clear to 1,80
set color to "w/rb+"
@ 2,2 clear to 22,76
set color to "w/g"
@ 2,0 clear to 2,80
set color to "bg+/n"
@ 4,6 clear to 20,74
set color to "n/w"
@ 5,4 clear to 19,72
set color to "bg+/b"
@ 23,0 clear to 23,80
set color to "w/g"
@ 22,0 clear to 22,80
set color to "g/w"
l=30
for l=30 to 40
@ 10,l+1 say +chr(1);tone(100.00,5)
@ 11,l+1 say +chr(3);tone(200.00,1)
@ 12,l+1 say +chr(14);tone(300.00,5)
inkey(2)
l++
next
l++
return
//======================
//โปรแกรมเกี่ยวกับ source ของโปรแกรมต่างๆ
procedure sss
cls
set color to w/b,r/bg+,rb+
set color to "w/r+"
@ 1,0 clear to 1,77
set color to "g+/b"
@ 2,3 clear to 22,74
@ 2,30 say "ร้านขายอุปกรณ์ไฟฟ้านิรันดร์"
set color to "/gr+"
@ 23,2 clear to 23,74
set color to "/bg+"
@ 3,2 clear to 21,72
do while lastkey() !=27
@ 4,25 clear to 18,70
@ 4,25 to 18,70 double
@ 6,33 say "Source โปรแกรม"
@ 8,30 prompt[1.โปรแกรมเมนู ]
@ 9,30 prompt[2.โปรแกรมงานหลัก]
@ 10,30 prompt[3.โปรแกรมแสดงข้อมูล]
@ 11,30 prompt[4.โปรแกรมปรับปรุงแก้ไข]
@ 12,30 prompt[5.โปรแกรมรายงาน]
@ 13,30 prompt[6.โปรแกรมสรุปยอดรายงาน]
@ 14,30 prompt[7.โปรแกรมระบบ]
@ 15,30 prompt[8.กลับเมนูหลัก]
menu to op
cls
do case
case op=1
run e ffme.prg
case op=2
run e cash.prg
case op=3
run e display.prg
case op=4
run e cupdate.prg
case op=5
run e report1.prg
case op=6
run e sreport1.prg
case op=7
run e pass.prg
case op=8
exit
endcase
inkey(2)
enddo
cls
return
//===========================
//===========
procedure s11
setcolor("r+/BG+")
cls
setpos(5,10)
?? " Yonok "
scr1 = savescreen(5,10,5,24)
do while lastkey() !=27
x=mod(second()*1000,24)
y=mod(second()*1000,65)
restscreen(x,y,x,y+14,scr1)
inkey(0.1)
enddo
//===================
//การเปลี่ยนสีจอภาพ
procedure setsee
choice2=0
do while lastkey()!=27
set color to "gr/bg"
@ 9,50 say "การเปลี่ยนหน้าจอ "
set color to b/gr,/w
@10,50 prompt[ สีปกติ ]
@11,50 prompt[ สีหวานแหวว ]
@12,50 prompt[ สีสดใส ]
@13,50 prompt[ สีท้องทะเล ]
@14,50 prompt[ exit ]
menu to choice2
do case
case choice2=1
use see
replace s with "1"
shadow(1)
case choice2=2
use see
replace s with "2"
shadow(2)
case choice2=3
use see
replace s with "3"
shadow(3)
case choice2=4
use see
replace s with "4"
shadow(4)
case choice2=5
exit
end case
enddo
return
//================================
//เป็น function เปลี่ยนสีหน้าจอภาพ
function shadow(s)
do case
case s = 1
cls
set color to b/br
set color to R/GR
cls
@ 0,0 to 24,79
set color to "/BG+"
@5,7 clear to 23,74
set color to "GR+/RB+"
@4,5 clear to 22,72
@19,5 SAY PADC(" _Program By Nirundorn Jumrus ID. 3901189",50)
@18,10 TO 20,50 doub
@21,5 SAY PADC("Send A.Burin Rujjanapan",50)
@20,15 TO 22,45 doub
case s=2
cls
set color to n/br
set color to g/bg+
cls
@ 0,0 to 24,79
set color to "/BG+"
@5,7 clear to 23,74
set color to "b+/RB+"
@4,5 clear to 22,72
@19,5 SAY PADC(" _Program By Nirundorn Jumrus ID. 3901189",50)
@18,10 TO 20,50 doub
@21,5 SAY PADC("Send A.Burin Rujjanapan",50)
@20,15 TO 22,45 doub
case s=3
cls
set color to b/gr+
set color to w/g+
cls
@ 0,0 to 24,79
set color to "/bg+"
@5,7 clear to 23,74
set color to "GR+/w+"
@4,5 clear to 22,72
@19,5 SAY PADC(" _Program By Nirundorn Jumrus ID. 3901189",50)
@18,10 TO 20,50 doub
@21,5 SAY PADC("Send A.Burin Rujjanapan",50)
@20,15 TO 22,45 doub
case s=4
cls
set color to b/gr+
set color to w/GR
cls
@ 0,0 to 24,79
set color to "/BG+"
@5,7 clear to 23,74
set color to "bg/g+"
@4,5 clear to 22,72
@19,5 SAY PADC(" _Program By Nirundorn Jumrus ID. 3901189",50)
@18,10 TO 20,50 doub
@21,5 SAY PADC("Send A.Burin Rujjanapan",50)
@20,15 TO 22,45 doub
endcase
return
//==============================
|