newtofoxpro
Programmer
Code:
SET SAFETY OFF
xcolor ="RGB(0,0,0,255,255,255),RGB(0,0,0,255,255,255),RGB(0,0,0,170,190,223),RGB(0,0,0,170,190,223),RGB(0,0,0,170,190,223),RGB(0,0,0,170,190,223),RGB(240,240,240,40,72,72),RGB(0,0,0,0,0,0),RGB(0,0,0,170,190,223),RGB(0,0,0,255,255,255)"
define window xadd AT 0,0 SIZE 20,70 NAME xaddNAME font 'tahoma',10 color (xcolor)
activate window xadd nosho
move window xadd CENTER
WITH xaddNAME
.BorderStyle=1
.ControlBox=.T.
.Caption='Customer Information'
.Closable=.t.
ENDWITH
activate window xadd
CLOSE DATABASES
IF !FILE('Customer.dbf')
CREATE TABLE customer.dbf (Cname c(40), Cadd1 c(40), Cadd2 c(40), Cadd3 c(40), Cadd4 c(40))
USE
ENDIF
ERASE customer.cdx
USE customer.dbf ALIAS Cust IN 0
INDEX ON Cadd3 TAG one
@ 2 ,0 say 'Name :' pict '@J' size 1,11
@ 3.5,0 say 'Address :' pict '@J' size 1,11
@ 6.5,0 say 'City :' pict '@J' size 1,11
@ 8.0,0 say 'Phone :' pict '@J' size 1,11
DO WHILE LASTKEY()#27
@ 2.0,12 get CustName default SPACE(40) size 1,40 when get_Alp(2.0,12)
@ 3.5,12 get CustAdd1 default SPACE(40) size 1,40 when get_Alp(3.5,12)
@ 5.0,12 get CustAdd2 default SPACE(40) size 1,40 when get_Alp(5.0,12)
@ 6.5,12 get CustAdd3 default SPACE(40) size 1,40 when get_Alp(6.5,12)
@ 8.0,12 get CustAdd4 default SPACE(40) size 1,40 when get_Alp(8.0,12)
READ nomouse
IF INLIST(LASTKEY(),13,24)
INSERT INTO Cust (Cname,Cadd1,Cadd2,Cadd3,Cadd4) VALUES (UPPER(CustName),UPPER(CustAdd1),UPPER(CustAdd2),UPPER(CustAdd3),UPPER(CustAdd4))
RELEASE CustName,CustAdd1,CustAdd2,CustAdd3,CustAdd4
endif
ENDDO
RELEASE window xadd
SET RESOURCE TO foxuser.dbf
SET RESOURCE ON
RETURN
FUNCTION get_Alp
****************
PARAMETERS mro,mco
mvar=varread()
@ mro-.1,mco-.5 to mro+1.1,mco+LEN(&mvar)+.5 color RGB(0,0,0)
OutString=&mvar
@ mro,mco get just_temp defa LEFT(OutString,1) size 1,.1
StringBuffer=""
FOR Cnt=1 TO LEN(&mvar)
READ
key=LASTKEY()
IF (key=4 AND LEN(ALLTRIM(outstring))<=cnt)
OutString=ALLTRIM(OutString)+Stringbuffer
ENDIF
DO CASE
CASE (BETWEEN(key,33,122) AND key#39) OR (INLIST(key,32) AND cnt#1)
outstring=iif(cnt=1,space(LEN(&mvar)),outstring)
outstring=STUFF(outstring,cnt,iif(insm(),0,1),proper(chr(key)))
CASE INLIST(key,13,24)
_curobj=_curobj+1
EXIT
CASE INLIST(key,5,15) &&uparrow
_curobj=IIF(_curobj=1,1,_curobj-1)
EXIT
CASE INLIST(key,27)
CLEAR read
EXIT
CASE key=7 OR key=127 &&delete, backspace
outstring=STUFF(outstring,iif(key=7,cnt,cnt-1),1,"")
cnt=cnt-iif(key=7,1,2)
CASE key=1 &&home
cnt=0
CASE key=19 OR (key=4 AND LEN(ALLTRIM(outstring))>=cnt) &&left, right
cnt=cnt+IIF(key=19,-2,0)
OTHERWISE
cnt=cnt-1
ENDCASE
cnt=IIF(cnt<0,0,cnt)
OutString=PADR(outstring,LEN(&mvar))
@ mro,mco say PROPER(OutString) size 1,LEN(&mvar)
@ mro,mco+TXTWIDTH(LEFT(PROPER(outstring),cnt)) say '' size 1,.0
IF UPPER(mvar)=UPPER("Custadd3") AND !EMPTY(OutString) AND SEEK(UPPER(ALLTRIM(OutString)),'Cust','one')
@ mro,mco say PROPER(Cadd3) size 1,LEN(&mvar) color RGB(200,200,200)
@ mro,mco say ALLTRIM(PROPER(OutString))
@ mro,mco+TXTWIDTH(LEFT(PROPER(outstring),cnt)) say '' size 1,.0
StringBuffer=ALLTRIM(SUBSTR(Cadd3,LEN(ALLTRIM(OutString))+1,1))
ELSE
StringBuffer=""
ENDIF
store PROPER(outstring) to &mvar
ENDFOR
@ mro-.1,mco-.5 clear to mro+1.1,mco+LEN(&mvar)+.5
@ mro,mco say PROPER(OutString) size 1,LEN(&mvar)
RETURN
Save above code as customer.prg and RUN.
You will find Small close button. If I close, window disappear but vfp stop working. I want, when I click on <CLOSE> it should run <KEYBOARD CHR(27)>
Above customer.prg's functionality is simple
1) What ever type it appear in proper() format.
2) Use Enter,Uparrow,Dnarrow & ESC to quit
3) In city field if city already exist it appear in fade color and you can select by rightarrow key.
4) Black Box appear on input field.
I am new to VFP8 and trying to migrate my fpw application.
Thank you.