Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / FoxPro, Visual FoxPro Новый топик    Ответить
 Маска для паспортных данных  [new]
Pulsar_p
Member

Откуда: Потому, что я с севера, что ли...
Сообщений: 1908
Кто-нибудь составлял анкету, в которой есть паспортные данные граждан? С российскими паспортами все просто: 99 99 999999, но бывают свидетельства о рождении и старые советские паспорта, там серии уж больно мудрёные, не хотелось бы изобретать велосипед, может есть готовое решение для ввода серии и номера документа (маска, например)?
12 апр 13, 11:27    [14171627]     Ответить | Цитировать Сообщить модератору
 Re: Маска для паспортных данных  [new]
AndreTM
Member

Откуда: Где-то в вологодских лесах...
Сообщений: 6901
У налоговой в своё время был справочник видов документов, удостоверяющих личность, посмотрите...
12 апр 13, 12:53    [14172210]     Ответить | Цитировать Сообщить модератору
 Re: Маска для паспортных данных  [new]
GermanGM
Member

Откуда:
Сообщений: 256
Pulsar_p, вот довольно дуракоустойчивый "лисапед" (позволяет вводить серии старых паспортов без переключения раскладки или арабскими цифрами типа 5-ОД и исправляет некоторые огрехи операторов)

** в LostFocus контрола ввода серии (типа "V-ОД") **
if !empty(this.value)
 local lcStr,s1,s2,lnPos,Arabic
 store [] to s1,s2
 lcStr=UPPER(chrt(allt(this.value),[ ],[]))
 lnPos=at([-],lcStr)
 s1=IIF(lnPos=0,lcStr,left(lcStr,lnPos-1))
 s2=IIF(lnPos=0,[],subs(lcStr,lnPos+1))
 lcStr=s1
 Arabic=ArabicNumeralsOnly(lcStr)
 if !Arabic and chrt(lcStr,[0123456789I],[])==[]
 	lcStr = ToArabic(lcStr)
 	Arabic=.T.
 endif
 do case
  case inlist(m.Passport,[01],[03]) && старый паспорт (m.Passport - 2-значный код вида документа)
  lcStr = ToRoman(lcStr,Arabic)
  if chrtran(lcStr,[I],[])==[].and.len(lcStr)>4
   lcStr=RomanNumber(len(lcStr))
   else
   do case
    case Arabic
    lcStr=RomanNumber(int(val(lcStr)))
    case RomanNumeralsOnly(lcStr)
    lcStr=RomanNumber(ArabicNumber(lcStr)) && Испр.неправильного рим.числа
   endcase
  endif
  this.value=lcStr+IIF(lnPos=0,[],[-]+s2)
  otherwise
  *** ... (c) :)
 endcase
endif
***************************

* добавить в PRG
FUNCTION RomanNumeralsOnly
lparameters pStr
return chrt(pStr,[IVXCM ],[])==[]
FUNCTION ArabicNumeralsOnly
lparameters pStr
return chrt(pStr,[0123456789],[])==[]

FUNCTION  ArabicNumber
PARAMETER RZ
RZ = UPPER(RZ)
RZ = CHRTRAN(RZ,'С1ХМУ -','CIXMV')
PRIVATE Z, X, B1, B2, XX
Z = OCCURS('M',RZ)*1000+OCCURS('D',RZ)*500+OCCURS('XC',RZ)*90+OCCURS('XL',RZ)*40
RZ = STRTRAN(RZ,'XC','')
Z = Z+OCCURS('C',RZ)*100
RZ = STRTRAN(RZ,'XL','')
B2 = 'LXXX'
FOR XX = 4 TO 1 STEP -1
   B2 = LEFT(B2,XX)
   X = OCCURS(B2,RZ)*10*(4+XX)
   IF X>0
      Z = Z+X
      RZ = STRTRAN(RZ,(B2),'')
   ENDIF
ENDFOR
Z = Z+OCCURS('IX',RZ)*9
RZ = STRTRAN(RZ,'IX','')
B2 = 'XXX'
FOR XX = 3 TO 1 STEP -1
   B2 = LEFT(B2,XX)
   X = OCCURS(B2,RZ)*10*XX
   IF X>0
      Z = Z+X
      RZ = STRTRAN(RZ,(B2),'')
   ENDIF
ENDFOR
Z = Z+OCCURS('IV',RZ)*4
RZ = STRTRAN(RZ,'IV','')
Z = Z+OCCURS('V',RZ)*5+OCCURS('I',RZ)
RETURN Z

FUNCTION  RomanNumber
PARAMETER NN
PRIVATE Z, X, XX
IF NN<0
   Z = '-'
   NN = -NN
ELSE
   Z = ''
ENDIF
Z = Z+REPLICATE('M',INT(NN/1000))
X = MOD(NN,1000)
IF X>=500
   Z = Z+'D'
   X = X-500
ENDIF
Z = Z+REPLICATE('C',INT(X/100))
X = MOD(X,100)
IF X>=90
   Z = Z+'XC'
   X = X-90
ENDIF
FOR XX = 3 TO 0 STEP -1
   IF X>=50+XX*10
      Z = Z+'L'+REPLICATE('X',XX)
      X = X-50-XX*10
   ENDIF
ENDFOR
IF X>=40
   Z = Z+'XL'
   X = X-40
ENDIF
FOR XX = 3 TO 1 STEP -1
   IF X>=XX*10
      Z = Z+REPLICATE('X',XX)
      X = X-XX*10
   ENDIF
ENDFOR
IF X=9
   RETURN Z+'IX'
ENDIF
FOR XX = 3 TO 0 STEP -1
   IF X>=5+XX
      Z = Z+'V'+REPLICATE('I',XX)
      X = X-5-XX
   ENDIF
ENDFOR
IF X=4
   RETURN Z+'IV'
ELSE
   RETURN Z+REPLICATE('I',X)
ENDIF

FUNCTION ToRoman
lparameters pcStr,Arabic
pcStr=chrtran(pcStr,[УХМС]+IIF(Arabic,[],[1]),[VXMC]+IIF(Arabic,[],[I]))
pcStr=strtran(pcStr,[Ш],[III])
pcStr=strtran(pcStr,[Щ],[III])
pcStr=strtran(pcStr,[П],[II])
pcStr=strtran(pcStr,[Ц],[II])
return pcStr

FUNCTION ToArabic
lparameters pcStr
*pcStr=chrtran(pcStr,[УХМС]+IIF(Arabic,[],[1]),[VXMC]+IIF(Arabic,[],[I]))
pcStr=strtran(pcStr,[Ш],[111])
pcStr=strtran(pcStr,[Щ],[111])
pcStr=strtran(pcStr,[П],[11])
pcStr=strtran(pcStr,[Ц],[11])
pcStr=strtran(pcStr,[I],[1])
return pcStr
12 апр 13, 15:06    [14173421]     Ответить | Цитировать Сообщить модератору
 Re: Маска для паспортных данных  [new]
Pulsar_p
Member

Откуда: Потому, что я с севера, что ли...
Сообщений: 1908
Ребята, спасибо, буду разбираться.
13 апр 13, 06:43    [14175892]     Ответить | Цитировать Сообщить модератору
Все форумы / FoxPro, Visual FoxPro Ответить