Добрый день,
хочу поделиться процедурой, склоняющей русские ФИО. Портировал скрипт одного из программистов
1C. Надеюсь, что не наделал много ошибок
пожелания и предложения приветствуются!
Code:
*&---------------------------------------------------------------------*
*& Report ZZZ
*&---------------------------------------------------------------------*
REPORT ZZZ.
data: test type char1024,
result type char1024,
object type i,
gender,
fname type fieldname.
field-SYMBOLS <fs> type any.
SELECTION-SCREEN begin of block main WITH FRAME title padegt.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) pt1 for FIELD p1.
PARAMETERS p1 type char128.
SELECTION-SCREEN end of line.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) pt2 for FIELD p2.
PARAMETERS p2 type char128.
SELECTION-SCREEN end of line.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) pt3 for FIELD p3.
PARAMETERS p3 type char128.
SELECTION-SCREEN end of line.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) pt4 for FIELD p4.
PARAMETERS p4 type char128.
SELECTION-SCREEN end of line.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) pt5 for FIELD p5.
PARAMETERS p5 type char128.
SELECTION-SCREEN end of line.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) pt6 for FIELD p6.
PARAMETERS p6 type char128.
SELECTION-SCREEN end of line.
selection-screen end of block main.
selection-screen begin of block obje WITH FRAME TITLE objet.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) rt1 for FIELD r1.
PARAMETERS r1 RADIOBUTTON GROUP obje DEFAULT 'X' USER-COMMAND bibi.
SELECTION-SCREEN end of line.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) rt2 for FIELD r2.
PARAMETERS r2 RADIOBUTTON GROUP obje.
SELECTION-SCREEN end of line.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) rt3 for FIELD r3.
PARAMETERS r3 RADIOBUTTON GROUP obje.
SELECTION-SCREEN end of line.
selection-screen end of block obje.
selection-screen begin of block sex WITH FRAME TITLE sext.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) st1 for FIELD s1.
PARAMETERS s1 RADIOBUTTON GROUP sex default 'X' USER-COMMAND bebe.
SELECTION-SCREEN end of line.
SELECTION-SCREEN begin of line.
SELECTION-SCREEN COMMENT 1(31) st2 for FIELD s2.
PARAMETERS s2 RADIOBUTTON GROUP sex.
SELECTION-SCREEN end of line.
selection-screen end of block sex.
INITIALIZATION.
sext = 'Пол'.
objet = 'Склонять как...'.
padegt = 'Падежи'.
pt1 = 'Именительный'.
pt2 = 'Родительный'.
pt3 = 'Дательный'.
pt4 = 'Винительный'.
pt5 = 'Творительный'.
pt6 = 'Предложный'.
rt1 = 'Фамилию'.
rt2 = 'Имя'.
rt3 = 'Отчество'.
st1 = 'Мужской'.
st2 = 'Женский'.
at SELECTION-SCREEN output.
loop at screen.
check screen-name(1) = 'P' and
screen-name+1(1) co '1234567890'.
check screen-name+1(1) > 1.
screen-INPUT = 0.
modify screen.
endloop.
*
do 5 times.
add 1 to sy-index.
clear fname.
fname+0(1) = 'P'.
write sy-index to fname+1(1).
ASSIGN (fname) to <fs>.
check sy-subrc eq 0.
test = p1.
if r1 ne space.
object = 1.
elseif r2 ne space.
object = 2.
else.
object = 3.
endif.
if s1 ne space.
gender = 'ч'.
else.
gender = '2'.
endif.
PERFORM padej_s using test sy-index gender object CHANGING result.
<fs> = result.
enddo.
*&---------------------------------------------------------------------*
*& Form padej_s
*&---------------------------------------------------------------------*
* ported version of routine "Padeg" v56:
* http://www.superjur.narod.ru/padeg.htm
* another interesting routine is here:
* http://www.foxclub.ru/sol/solution571.php
*----------------------------------------------------------------------*
* -->Z1 слово
* -->Z2 № падежа
* -->Z3 пол
* -->Z4 1-склонять как фамилию, 2-имя, 3-отчество
*----------------------------------------------------------------------*
form padej_s using z1 type char1024
z2 type i
z3 type c
z4 type i
CHANGING xx type char1024.
data: z5 type i,
z6 like z1,
z7(3),
z8(2),
z9(1),
za type i,
zb type i,
zc type i,
zd type i,
ze type i,
zf like z1,
t1 like z1,
t2(4),
t3 type i,
t4 like z1,
t5 type i,
t6,
t7 like z1,
t8 type i,
t9(2),
ta like z1,
tb type i,
dummy.
clear: z5, z6, z7, z8, z9, za, zb, zc, zd, ze, zf,
t1, t2 ,t3, t4, t5, t6, t7, t8, t9, ta, tb.
check strlen( z1 ) > 0.
* 1: z5=Найти(z1,"-");
find '-' in z1 match offset z5.
* 2: z6=?(z5=0,"","-"+ПадежС(Сред(z1,z5+1,СтрДлина(z1)-z5+1),z2,z3,z4));
if z5 = 0.
z6 = space.
else.
z5 = z5 + 1.
t1 = z1+z5.
perform padej_s using t1 z2 z3 z4
CHANGING z6.
z5 = z5 - 1.
endif.
* 3: z1=НРег(?(z5=0,z1,Лев(z1,z5-1)));
if z5 ne 0.
z1 = z1(z5).
endif.
TRANSLATE z1 to LOWER CASE.
* 4: z7=Прав(z1,3);z8=Прав(z7,2);z9=Прав(z8,1);
shift z1 RIGHT DELETING TRAILING space.
t2 = z1+1020(4).
z7 = z1+1021(3).
z8 = z1+1022(2).
z9 = z1+1023(1).
SHIFT z1 LEFT DELETING LEADING space.
* 5: z5=СтрДлина(z1);
z5 = strlen( z1 ).
* 6: za=Найти("ая ия ел ок яц ий па да ца ша ба та га ка",z8);
find z8 in 'ая ия ел ок яц ий па да ца ша ба та га ка' MATCH OFFSET za.
if sy-subrc eq 0. add 1 to za. endif.
* 7: zb=Найти("аеёийоуэюяжнгхкчшщ",Лев(z7,1));
find z7(1) in 'аеёийоуэюяжнгхкчшщ' MATCH OFFSET zb.
if sy-subrc eq 0. add 1 to zb. endif.
* 8: zc=Макс(z2,-z2);
zc = abs( z2 ).
* 9: zd=?(za=4,5,Найти("айяь",z9));
if za = 4.
zd = 5.
else.
find z9 in 'айяь' MATCH OFFSET zd.
if sy-subrc eq 0. add 1 to zd. endif.
endif.
* 10: zd=?((zc=1)или
* (z9=".")или
* ((z4=2)и(Найти("оиеу"+?(z3="ч"
* ,""
* ,"бвгджзклмнпрстфхцчшщъ"),z9)>0))или
* ((z4=1)и(Найти("мия мяэ лия кия жая лея",z7)>0))
* ,9
* ,?((zd=4)и(z3="ч")
* ,2
* ,?(z4=1
* ,?(Найти("оеиую",z9)+Найти("их ых аа еа ёа иа оа уа ыа эа юа яа",z8)>0
* ,9
* ,?(z3<>"ч"
* ,?(za=1
* ,7
* ,?(z9="а"
* ,?(za>18,1,6)
* ,9))
* ,?(((Найти("ой ый",z8)>0)и(z5>4)и(Прав(z1,4)<>"опой"))или((zb>10)и(za=16))
* ,8
* ,zd)))
* ,zd)));
if zc = 1 or
z9 = '.' or
( z4 = 2 and ( ( z3 = 'ч' and 'оиеу' cs z9 ) or
( z3 <> 'ч' and 'оиеубвгджзклмнпрстфхцчшщъ' cs z9 ) ) ) or
( z4 = 1 and 'мия мяэ лия кия жая лея' cs z7 ).
zd = 9.
else.
if zd = 4 and z3 = 'ч'.
zd = 2.
else.
if z4 = 1.
if 'оеиуюы' cs z9 or " фамилии на Ы вроде тоже не склоняются
'их ых аа еа ёа иа оа уа ыа эа юа яа' cs z8.
zd = 9.
else.
if z3 <> 'ч'.
if za = 1.
zd = 7.
else.
if z9 = 'а'.
if za > 18. zd = 1. else. zd = 6. endif.
else.
zd = 9.
endif.
endif.
else.
if ( 'ой ый' cs z8 and z5 > 4 and t2 ne 'опой' ) or
( zb > 10 and za = 16 ).
zd = 8.
endif.
endif.
endif.
endif.
endif.
endif.
* 11: ze=Найти("лец вей бей дец пец мец нец рец вец аец иец ыец бер",z7);
find z7 in 'лец вей бей дец пец мец нец рец вец аец иец ыец бер лий лия' MATCH OFFSET ze.
if sy-subrc eq 0. add 1 to ze. endif.
* 12: zf=?((zd=8)и(zc<>5)
* ,?((zb>15)или(Найти("жий ний",z7)>0)
* ,"е"
* ,"о")
* ,?(z1="лев"
* ,"ьв"
* ,?((Найти("аеёийоуэюя",Сред(z1,z5-3 ,1))=0)и((zb>11)или(zb=0))и(ze<>45)
* ,""
* ,?(za=7
* ,"л"
* ,?(za=10
* ,"к"
* ,?(za=13
* ,"йц"
* ,?(ze=0
* ,""
* ,?(ze<12
* ,"ь"+?(ze=1
* ,"ц"
* ,"")
* ,?(ze<37
* ,"ц"
* ,?(ze<49
* ,"йц"
* ,"р"))))))))));
if zd = 8 and zc <> 5.
if zb > 15 or 'жий ний' cs z7.
zf = 'е'.
else.
zf = 'о'.
endif.
else.
if z1 = 'лев'.
zf = 'ьв'.
else.
if z5 > 2.
t3 = z5 - 3.
if 'аеёийоуэюя' cs z1+t3(1) and ( zb > 11 or zb = 0 ) and ze <> 45.
zf = space.
else.
if za = 7.
zf = 'л'.
elseif za = 10.
zf = 'к'.
elseif za = 13.
zf = 'йц'.
else.
if ze = 0.
zf = space.
else.
if ze < 12.
if ze = 1.
zf = 'ьц'.
else.
zf = 'ь'.
endif.
else.
if ze < 37.
zf = 'ц'.
elseif ze < 49.
zf = 'йц'.
elseif ze < 53.
zf = 'р'.
endif.
endif.
endif.
endif.
endif.
endif.
endif.
endif.
* 13: zf=?((zd=9)или((z4=3)и(Прав(z1,1)="ы"))
" ,z1
" ,Лев(z1,z5-?((zd>6)или(zf<>"")
" ,2
" ,?(zd>0,1,0)))
" +zf
" +СокрП(
" Сред("а у а "
" +Сред("оыые",Найти("внч",z9)+1,1)
" +"ме "
" +?(Найти("гжкхш",Лев(z8,1))>0
" ,"и"
" ,"ы")
" +" е у ойе я ю я ем"
" +?(za=16
" ,"и"
" ,"е")
" +" и е ю ейе и и ь ьюи и и ю ейи ойойу ойойойойуюойойгомуго"
" +?((zf="е")или(za=16)или((zb>12)и(zb<16))
" ,"и"
" ,"ы")
" +"мм",10*zd+2*zc-3,2)));
if zd = 9 or
( z4 = 3 and z9 = 'ы' ).
ta = z1.
else.
if zd > 6 or
zf ne space .
tb = 2.
elseif zd > 0.
tb = 1.
else.
tb = 0.
endif.
tb = z5 - tb.
ta = z1(tb).
endif.
t4 = 'а у а'.
* слабая часть алгоритма {
find z9 in 'внч' MATCH OFFSET t5.
if sy-subrc eq 0. add 1 to t5. endif.
if 'ауюя' cs z8(1). t5 = 0. endif. " Колдун, Яцун, Цикун, Мкртчян
* }
t7 = 'оыые'. t6 = t7+t5(1).
CONCATENATE t4 t6 into t4 separated by space.
CONCATENATE t4 'ме' into t4.
if 'гжкхш' cs z8+0(1).
CONCATENATE t4 'и' into t4 SEPARATED BY space.
else.
CONCATENATE t4 'ы' into t4 SEPARATED BY space.
endif.
CONCATENATE t4 'е у ойе я ю я ем' into t4 SEPARATED BY space.
if za = 16.
CONCATENATE t4 'и' into t4.
else.
CONCATENATE t4 'е' into t4.
endif.
CONCATENATE t4 'и е ю ейе и и ь ьюи и и ю ейи ойойу ойойойойуюойойгомуго'
into t4 SEPARATED BY space.
if zf = 'е' or za = 16 or ( zb > 12 and zb < 16 ).
CONCATENATE t4 'и' into t4.
else.
CONCATENATE t4 'ы' into t4.
endif.
CONCATENATE t4 'мм' into t4.
t8 = 10 * zd + 2 * zc - 4.
t9 = t4+t8(2).
CONCATENATE ta zf t9 into zf.
* 14: Возврат ?(""=z1
* ,""
* ,?(z4>0
* ,ВРег(Лев(zf,1))+?((z2<0)и(z4>1)
* ,"."
* ,Сред(zf,2))
* ,zf)
* +z6);
clear xx.
if z1 = space.
xx = space.
else.
if z4 > 0.
xx = zf+0(1).
if z2 < 0 and z4 > 1.
CONCATENATE xx '.' into xx.
else.
CONCATENATE xx zf+1 into xx.
endif.
TRANSLATE xx+0(1) TO UPPER CASE.
else.
xx = zf.
endif.
endif.
if z6 ne space.
CONCATENATE xx z6 into xx SEPARATED BY '-'.
endif.
endform. "padej_s