Склонение фамилии

[Iskatel]

Проблема вот в чем.

Есть сотрудник Петров Петр Петрович. А нужно получить, к примеру: Принять на работу Петрова Петра Петровича.

Есть, что-нибудь стандартное для склонения? Уже готовое?

[TERRA]

Я делала выносом доп. поля в карточку сотрудника.
Потому как разность фамилий всех мастей и национальностей была ТАКАЯ, что ни о каком общем алгоритме - говорить не приходилось.
Так что под полей ФИО - сразу заполнялось поле "ФИО род.п."
Проще и с мЕньшими трудозатратами сделать, ИМХО, нельзя...

[Corleone]

Цитата:

Сообщение от Programmer

Проблема вот в чем.

Есть сотрудник Петров Петр Петрович. А нужно получить, к примеру: Принять на работу Петрова Петра Петровича.

Есть, что-нибудь стандартное для склонения? Уже готовое?

Стандартного нет даже в 1С. Формально склонять не надо.

Вход: Padezh R или D, соответственно родительный или дательный, остальное понятно.

[codebox]

Параметры
LastName Text 50
FirstName Text 50
MiddleName Text 50
Sex Option
Padezh Char
VAR ReturnLastName Text 50
VAR ReturnFirstName Text 50
VAR ReturnMiddleName Text 50

Переменные
L Text 32
Last1 Text 1
Last2 Text 2
Last3 Text 3
i Integer
Flag Boolean
LetterType Option
Roditel Text 50
Datel Text 50
RoditelName Text 50
DatelName Text 50
RoditelMiddle Text 50
DatelMiddle Text 50

L[1] := 'Б';
L[2] := 'В';
L[3] := 'Г';
L[4] := 'Д';
L[5] := 'Ж';
L[6] := 'З';
L[7] := 'К';
L[8] := 'Л';
L[9] := 'М';
L[10] := 'Н';
L[11] := 'П';
L[12] := 'Р';
L[13] := 'С';
L[14] := 'Т';
L[15] := 'Ф';
L[16] := 'Х';
L[17] := 'Ц';
L[18] := 'Ч';
L[19] := 'Ш';
L[20] := 'Щ';

//Гласные
L[21] := 'А';
L[22] := 'Е';
L[23] := 'И';
L[24] := 'Й';
L[25] := 'О';
L[26] := 'У';
L[27] := 'Ы';
L[28] := 'Э';
L[29] := 'Ю';
L[30] := 'Я';
L[31] := 'Ь';
L[32] := 'Ъ';

// Sex is not defined
IF (Sex <> 1) AND (Sex <> 2) THEN
EXIT(ReturnFIO);

// Padezh is not defined
IF (Padezh <> 'R') AND (Padezh <> 'D') THEN
EXIT(ReturnFIO);

LastName := UPPERCASE(LastName);

Last1 := COPYSTR(LastName, STRLEN(LastName), 1);
Last2 := COPYSTR(LastName, STRLEN(LastName)-1, 2);
Last3 := COPYSTR(LastName, STRLEN(LastName)-2, 3);

Flag := FALSE;

FOR i := 1 TO 32 DO
BEGIN
IF L[i] = Last1 THEN
BEGIN
IF i <= 20 THEN
LetterType := LetterType::SoGlas
ELSE
LetterType := LetterType::Glas;
END;
END;

// Исключения
IF STRLEN(LastName) <= 2 THEN //фамилии типа Ге, Че
BEGIN
Roditel := LastName;
Datel := LastName;
END;

//фамилии типа Туташхиа, Стуруа, украинские фамилии, сибирские фамилии
IF ((Last2 = 'ИХ') OR (Last2 = 'ЫХ') OR (Last2 = 'УА') OR (Last2 = 'ИА')) OR (Last1 = 'О') THEN
BEGIN
Roditel := LastName;
Datel := LastName;
END;

// женские фамилии типа Ганжа
IF (Last2 = 'ЖА') AND (Sex = Sex::Female) THEN
BEGIN
Roditel := LastName;
Datel := LastName;
END;

//грузинские фамилии типа Гогадзе, Габошвили
IF (Last3 = 'ДЗЕ') OR (Last3 = 'ИЛИ') THEN
BEGIN
Roditel := LastName;
Datel := LastName;
END;

//фамилии типа Цой
IF (Last2 = 'ОЙ') AND (Sex = Sex::Male) AND (STRLEN(LastName) = 3) THEN
BEGIN
Roditel := COPYSTR(LastName,1,STRLEN(LastName)-1) + 'я';
Datel := COPYSTR(LastName,1,STRLEN(LastName)-1) + 'ю';
Flag := TRUE;
END;

IF (Last2 = 'ОЙ') AND (Sex = Sex::Female) AND (STRLEN(LastName) = 3) THEN
BEGIN
Roditel := LastName;
Datel := LastName;
END;

IF (LetterType = LetterType::SoGlas) AND (Sex = Sex::Male) THEN
BEGIN
Roditel := LastName + 'а';
Datel := LastName + 'у';
Flag := TRUE;
END;
IF (LetterType = LetterType::SoGlas) AND (Sex = Sex::Female) THEN
BEGIN
Roditel := LastName;
Datel := LastName;
END;

IF (Sex = Sex::Female) AND (Last1 = 'А') THEN
BEGIN
Roditel := COPYSTR(LastName,1,STRLEN(LastName)-1) + 'у';
Datel := COPYSTR(LastName,1,STRLEN(LastName)-1) + 'ой';
Flag := TRUE;
END;

IF (Sex = Sex::Male) AND (Last1 = 'А') THEN //фам. типа Соткилава
BEGIN
Roditel := COPYSTR(LastName,1,STRLEN(LastName)-1) + 'у';
Datel := COPYSTR(LastName,1,STRLEN(LastName)-1) + 'е';
Flag := TRUE;
END;

IF (Sex = Sex::Male) AND (Last2 = 'ОЙ') AND (STRLEN(LastName) > 3) THEN
BEGIN
Roditel := COPYSTR(LastName,1,STRLEN(LastName)-1) + 'го';
Datel := COPYSTR(LastName,1,STRLEN(LastName)-1) + 'му';
Flag := TRUE;
END;

IF (Sex = Sex::Female) AND (Last2 = 'АЯ') AND (STRLEN(LastName) > 3) THEN
BEGIN
Roditel := COPYSTR(LastName,1,STRLEN(LastName)-1) + 'ую';
Datel := COPYSTR(LastName,1,STRLEN(LastName)-1) + 'ой';
Flag := TRUE;
END;

//если не сработало ни одно условие
IF NOT Flag THEN
BEGIN
Roditel := LastName;
Datel := LastName;
END;

//////////////склонение имени////////

FirstName := UPPERCASE(FirstName);
Last1 := COPYSTR(FirstName, STRLEN(FirstName), 1);
Last2 := COPYSTR(FirstName, STRLEN(FirstName)-1, 2);
Last3 := COPYSTR(FirstName, STRLEN(FirstName)-2, 3);

FOR i := 1 TO 32 DO
BEGIN
IF L[i] = Last1 THEN
BEGIN
IF i <= 20 THEN
LetterType := LetterType::SoGlas
ELSE
LetterType := LetterType::Glas;
END;
END;

Flag := FALSE;

IF (Sex = Sex::Male) AND (LetterType = LetterType::SoGlas) THEN //Иван, Петр и т.д.
BEGIN
RoditelName := FirstName + 'а';
DatelName := FirstName + 'у';
Flag := TRUE;
END;

IF (Sex = Sex::Male) AND (Last1 = 'Й') THEN //Сергей, Дмитрий и т.д.
BEGIN
RoditelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'я';
DatelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'ю';
Flag := TRUE;
END;

IF (Sex = Sex::Male) AND (Last1 = 'А') THEN //Фома
BEGIN
RoditelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'у';
DatelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'е';
Flag := TRUE;
END;

IF (Sex = Sex::Male) AND (Last1 = 'Я') THEN //Илья
BEGIN
RoditelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'ю';
DatelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'е';
Flag := TRUE;
END;

IF (Sex = Sex::Male) AND (Last1 = 'Ь') THEN //Игорь
BEGIN
RoditelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'я';
DatelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'ю';
Flag := TRUE;
END;

IF (Sex = Sex::Female) AND (Last1 = 'А') THEN //Татьяна, Людмила и т.д.
BEGIN
RoditelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'у';
DatelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'е';
Flag := TRUE;
END;

IF (Sex = Sex::Female) AND (Last1 = 'Я') THEN //Зоя, Наталья и т.д.
BEGIN
RoditelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'ю';
DatelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'е';
Flag := TRUE;
END;

IF (Sex = Sex::Female) AND (Last2 = 'ИЯ') THEN //Наталия,Виктория и т.д.
BEGIN
RoditelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'ю';
DatelName := COPYSTR(FirstName,1,STRLEN(FirstName)-1) + 'и';
Flag := TRUE;
END;

IF NOT Flag THEN
BEGIN
RoditelName := FirstName;
DatelName := FirstName;
END;

/////////склонение отчества///////
MiddleName := UPPERCASE(MiddleName);

IF (Sex = Sex::Male) THEN
BEGIN
RoditelMiddle := MiddleName + 'а';
DatelMiddle := MiddleName + 'у';
Flag := TRUE;
END;

IF (Sex = Sex::Female) THEN
BEGIN
RoditelMiddle := COPYSTR(MiddleName,1,STRLEN(MiddleName)-1) + 'у';
DatelMiddle := COPYSTR(MiddleName,1,STRLEN(MiddleName)-1) + 'е';
Flag := TRUE;
END;

IF Padezh = 'D' THEN
BEGIN
ReturnLastName := Datel;
ReturnFirstName := DatelName;
ReturnMiddleName := DatelMiddle;
END
ELSE IF Padezh = 'R' THEN
BEGIN
ReturnLastName := Roditel;
ReturnFirstName := RoditelName;
ReturnMiddleName := RoditelMiddle;
END;

ReturnLastName := UPPERCASE(FORMAT(ReturnLastName[1])) + COPYSTR(LOWERCASE(ReturnLastName),2, STRLEN(ReturnLastName)-1);
ReturnFirstName := UPPERCASE(FORMAT(ReturnFirstName[1])) + COPYSTR(LOWERCASE(ReturnFirstName),2, STRLEN(ReturnFirstName)-1);
ReturnMiddleName := UPPERCASE(FORMAT(ReturnMiddleName[1])) + COPYSTR(LOWERCASE(ReturnMiddleName),2, STRLEN(ReturnMiddleName)-1);
ReturnFIO := ReturnLastName + ' ' + ReturnFirstName + ' ' + ReturnMiddleName;
[/codebox]

[Iskatel]

Огромное спасибо за помощь! То что надо.

[konrad_imported]

Был или на этом форуме, или на мебузе кодеюнит. Года полтора назад.
Там пара функций. Передаешь в одну слово и падеж какой нужен. Возвращает склоненное слово. А в другую функцию сразу ФИО подаешь и склоненное получаешь.
Если не найдете - поищу у себя в заначке и выложу.

[konrad_imported]

Вот он - искомый кодеюнит.

[smoyk]

Искомый кодеюнит оказался таким глючным, как будто его писала команда микрософта... После получаса юзания и попыток победить многочисленные ошибки и неровности в работе пришел к выводу, что проще написать самому. Может быть такой же глючный, зато свой

[romeo]

А у нас по старинке склоняют ручками в карточке .. Алгоритм надежный.