Сообщения без ответов | Активные темы


Список форумов » Специализированные форумы » Программирование

Часовой пояс: UTC + 3 часа




Начать новую тему Новая тема / Ответить на тему Ответить  Сообщений: 2317 • Страница 82 из 116 • <  1 ... 79  80  81  82  83  84  85 ... 116  >
  Пред. тема | След. тема 
В случае проблем с отображением форума, отключите блокировщик рекламы
Автор Сообщение
  _SGK

Member
Статус: Не в сети
Регистрация: 05.01.2005
Максим
Максим писал(а):
Кто-нибудь киньте исходником на Пасе, чтобы любое ФИО можно было преобразовать в любой падеж или хотя бы "кому" и "от кого".

Не встречал такого, правда и не искал.
Мдя, одни правила и оговорки – для одних так, для других иначе, для третьих (фамилий) вообще без изменения, опять же пол учитывать нужно.
Перефразируй :) - пропиши получатель и отправитель и будет тебе счастье. ;)
Получатель: Пупкин Вася
Отправитель: Пупкин Вася
Да и не парься ИМХО. :)
Реклама

Партнер
  Xupyp1

Member
Статус: Не в сети
Регистрация: 02.12.2004
_SGK
Если еще вспомнить наличие имен Саша, Женя и т.п. ...

Максим
Задание, имхо, сплошной геморрр.
Конечно если оно очень важно для тебя, то можно покумекать ;)
  _SGK

Member
Статус: Не в сети
Регистрация: 05.01.2005
Xupyp1
Xupyp1 писал(а):
Если еще вспомнить наличие имен Саша, Женя и т.п. ...

Да и про отчества ;) забывать не стоит.
Просто фамилии есть такие, которые не изменяются.
Пример: Саакашвили :), Шейко и т.д.
Xupyp1 писал(а):
Задание, имхо, сплошной геморрр.

ага :)
  Максим

Member
Статус: Не в сети
Регистрация: 05.01.2003
Откуда: Москва
Фото: 2
Xupyp1 _SGK
Да все очень легко. Просто для автоматической рассылки писем, SMS и прозвонки клиентов. Все для самой рассылки уже сделано и все работает, но так как часто клиенты оставляют неправильные координаты, то в итоге может дядька "робот" может наехать на человека, который не коим боком не касается той проблемы, о которой ему будут говорить.
Добавлено спустя 1 минуту, 37 секунд
_SGK
Ага, на фамилии, которые не склоняются уже нарвался. Пытался просто написать такое, думал, что легко, а оказалась проблема.

_________________
Устав традиций нужно соблюдать, Хоть и не раз ответят вам отказом: Конечно, баба может и не дать, Но предложить ты ей всегда обязан!

  Zеrg

Member
Статус: Не в сети
Регистрация: 03.01.2003
Откуда: Ростов-на-Дону
Максим

Есть у меня один исходничек:

1) КОМУ:

Код:

var pol: boolean;

function pfam(s: string): string;
begin
  if (s[length(s)] = 'к') or (s[length(s)] = 'ч') and (pol = true) then
    s := s + 'у';
  if s[length(s)] = 'в' then
    s := s + 'у';
  if s[length(s)] = 'а' then
  begin
    delete(s, length(s), 1);
    result := s + 'ой';
    exit;
  end;
  if s[length(s)] = 'н' then
    s := s + 'у';
  if s[length(s)] = 'й' then
  begin
    delete(s, length(s) - 1, 2);
    result := s + 'ому';
  end;
  if s[length(s)] = 'я' then
  begin
    delete(s, length(s) - 1, 2);
    result := s + 'ой';
    exit;
  end;
  result := s;
end;

function pnam(s: string): string;
begin
  pol := true;
  if s[length(s)] = 'й' then
  begin
    delete(s, length(s), 1);
    s := s + 'ю';
  end;
  if s[length(s)] = 'л' then
    s := s + 'у';
  if s[length(s)] = 'р' then
    s := s + 'у';
  if s[length(s)] = 'м' then
    s := s + 'у';
  if s[length(s)] = 'н' then
    s := s + 'у';
  if s[length(s)] = 'я' then
  begin
    pol := false;
    delete(s, length(s), 1);
    s := s + 'е';
  end;
  if s[length(s)] = 'а' then
  begin
    pol := false;
    delete(s, length(s), 1);
    s := s + 'е';
  end;
  result := s;
end;

function potch(s: string): string;
begin
  if s[length(s)] = 'а' then
  begin
    delete(s, length(s), 1);
    s := s + 'е';
  end;
  if s[length(s)] = 'ч' then
    s := s + 'у';
  result := s;
end;


function padeg(s: string): string;
var
  q: tstringlist;
  p: integer;
begin
  if s <> '' then
  begin
    q := tstringlist.Create;
    p := pos(' ', s);
    if p = 0 then
      p := pos('.', s);
    if p = 0 then
      q.Add(s)
    else
    begin
      q.Add(copy(s, 1, p - 1));
      delete(s, 1, p);
      p := pos(' ', s);
      if p = 0 then
        p := pos('.', s);
      if p = 0 then
        q.Add(s)
      else
      begin
        q.Add(copy(s, 1, p - 1));
        delete(s, 1, p);
        p := pos(' ', s);
        if p = 0 then
          p := pos('.', s);
        if p = 0 then
          q.Add(s)
        else
        begin
          q.Add(copy(s, 1, p - 1));
          delete(s, 1, p);
        end;
      end;
    end;
    if q.Count > 1 then
      result := result + ' ' + pnam(q[1]);
    if q.Count > 0 then
      result := pfam(q[0]) + result;
    if q.Count > 2 then
      result := result + ' ' + potch(q[2]);
    q.Free;
  end;
end;


2) ОТ КОГО

Код:
var pol: boolean;

function ofam(s: string): string;
begin
  if (s[length(s)] = 'к') or (s[length(s)] = 'ч') and (pol = true) then
    s := s + 'а';
  if s[length(s)] = 'а' then
  begin
    delete(s, length(s), 1);
    result := s + 'ой';
    exit;
  end;
  if s[length(s)] = 'в' then
    s := s + 'а';
  if s[length(s)] = 'н' then
    s := s + 'а';
  if s[length(s)] = 'й' then
  begin
    delete(s, length(s) - 1, 2);
    result := s + 'ова';
  end;
  if s[length(s)] = 'я' then
  begin
    delete(s, length(s) - 1, 2);
    result := s + 'ой';
    exit;
  end;
  result := s;
end;

function onam(s: string): string;
begin
  pol := true;
  if s[length(s)] = 'а' then
    if s[length(s) - 1] = 'г' then
    begin
      pol := false;
      delete(s, length(s), 1);
      s := s + 'и';
    end
    else
    begin
      pol := false;
      delete(s, length(s), 1);
      s := s + 'ы';
    end;
  if s[length(s)] = 'л' then
    s := s + 'а';
  if s[length(s)] = 'р' then
    s := s + 'а';
  if s[length(s)] = 'м' then
    s := s + 'а';
  if s[length(s)] = 'н' then
    s := s + 'а';
  if s[length(s)] = 'я' then
  begin
    pol := false;
    delete(s, length(s), 1);
    s := s + 'и';
  end;
  if s[length(s)] = 'й' then
  begin
    delete(s, length(s), 1);
    s := s + 'я';
  end;
  result := s;
end;

function ootch(s: string): string;
begin
  if s[length(s)] = 'а' then
  begin
    delete(s, length(s), 1);
    s := s + 'ы';
  end;
  if s[length(s)] = 'ч' then
    s := s + 'а';
  result := s;
end;


function padegot(s: string): string;
var
  q: tstringlist;
  p: integer;
begin
  if s <> '' then
  begin
    q := tstringlist.Create;
    p := pos(' ', s);
    if p = 0 then
      p := pos('.', s);
    if p = 0 then
      q.Add(s)
    else
    begin
      q.Add(copy(s, 1, p - 1));
      delete(s, 1, p);
      p := pos(' ', s);
      if p = 0 then
        p := pos('.', s);
      if p = 0 then
        q.Add(s)
      else
      begin
        q.Add(copy(s, 1, p - 1));
        delete(s, 1, p);
        p := pos(' ', s);
        if p = 0 then
          p := pos('.', s);
        if p = 0 then
          q.Add(s)
        else
        begin
          q.Add(copy(s, 1, p - 1));
          delete(s, 1, p);
        end;
      end;
    end;
    if q.Count > 1 then
      result := result + ' ' + onam(q[1]);
    if q.Count > 0 then
      result := ofam(q[0]) + result;
    if q.Count > 2 then
      result := result + ' ' + ootch(q[2]);
    q.Free;
  end;
end;


Не думаю конечно, что этот код идеальный, но это уже основа... Удачи :)

_________________
Just Zerg! Остановим деградацию русского языка, скажем нет удафкомовской лексике!!

  Максим

Member
Статус: Не в сети
Регистрация: 05.01.2003
Откуда: Москва
Фото: 2
Zеrg
если это код с DelphiWorld без модификаций, то уже пробовал. На очень большом количестве фамилий такую фигню выдает.
Добавлено спустя 54 минуты, 46 секунд
to all
Кстати есть еще такой вопрос - какие есть компоненты, за исключением стандартных в Дельфи 7, для работы с WebService и SOAP вообще. Просто есть проблемы со скоростью - бывает запускается любая процедура из сервиса 0.2-0.4 секунды, а бывает в ней же тормозит (выполнение процедуры около 10-15 секунд !!!). Причем при этом торможении специально смотрел - сама процедура отрабатывает всегда за 0.05 - 0.1 секунд, а остальное тратиться судя по всему на создание XML, отправки, потом стало быть сама работа, а потом уже создание и отправка в обратную сторону. Как это можно решить ? Проблем с сеткой точно нет.

_________________
Устав традиций нужно соблюдать, Хоть и не раз ответят вам отказом: Конечно, баба может и не дать, Но предложить ты ей всегда обязан!

  Xupyp1

Member
Статус: Не в сети
Регистрация: 02.12.2004
Народ, подскажите в чем трабл, плиз.

Вот я создаю компоненты во время выполнения программы:
Код:
    RegisterClasses([TPanel, TEdit, TLabel]);
    QArray[QCount]:=TPanel.Create(sbMiniTest);
    (QArray[QCount] as TPanel).Parent:=sbMiniTest;
    (QArray[QCount] as TPanel).Left:=0;
    (QArray[QCount] as TPanel).Top:=PanelTop;
    (QArray[QCount] as TPanel).Height:=57;
    (QArray[QCount] as TPanel).Width:=460;
    (QArray[QCount] as TPanel).Enabled:=true;
    (QArray[QCount] as TPanel).Visible:=true;

    LabelArray[QCount]:=TLabel.Create((QArray[QCount] as TPanel));
    (LabelArray[QCount] as TLabel).Parent:=(QArray[QCount] as TPanel);
    (LabelArray[QCount] as TLabel).Left:=24;
    (LabelArray[QCount] as TLabel).Top:=16;
    (LabelArray[QCount] as TLabel).Caption:='<Вопрос>';
    (LabelArray[QCount] as TLabel).Enabled:=true;
    (LabelArray[QCount] as TLabel).Visible:=true;

    EditArray[QCount]:=TEdit.Create((QArray[QCount] as TPanel));
    (EditArray[QCount] as TEdit).Parent:=(QArray[QCount] as TPanel);
    (EditArray[QCount] as TEdit).Left:=(LabelArray[QCount] as TLabel).Left+(LabelArray[QCount] as TLabel).Width+20;
    (EditArray[QCount] as TEdit).Top:=16;
    (EditArray[QCount] as TEdit).Text:='<Ответ>';
    (EditArray[QCount] as TEdit).Enabled:=true;
    (EditArray[QCount] as TEdit).Visible:=true;


QArray, LabelArray, EditArray, QCount - глобальные переменные.

Затем, по выходу из приложения, пытаюсь освободить память:
Код:
if QCount>0 then
  begin
    For i:=1 to QCount do
      begin
        QArray[i].Free;
        EditArray[i].Free;
        LabelArray[i].Free;
      end;
  end;

Почему освобождение памяти не удается?
Точнее цикл проходит один раз, а затем выдает "Invalid Point Operation"
  Zеrg

Member
Статус: Не в сети
Регистрация: 03.01.2003
Откуда: Ростов-на-Дону
Попробй так:

Код:
(QArray[i] as TPanel).Free;
(LabelArray[i] as TLabel).Free;
(EditArray[i] as TEdit).Free;


А вообще лично я грохаю всё это дело обычно следующей процедуркой, у меня в одной програмке динамически создавались Thread, вот только обычным Free убиваться они не хотели.

Код:
type
  PObject = ^TObject;

procedure FreeAndNil(Obj: PObject);
begin
  if Assigned(Obj) then
  begin
    Obj^.Free;
    Obj^ := nil;
  end;
end;

  var my_obj: Pobject;
Begin
For i:=1 to QCount do
  begin
  my_obj := (QArray[i] as TPanel).ClassInfo;
  FreeAndNil(my_obj);
  end;
end;

_________________
Just Zerg! Остановим деградацию русского языка, скажем нет удафкомовской лексике!!

  Xupyp1

Member
Статус: Не в сети
Регистрация: 02.12.2004
Zеrg
Код:
(QArray[i] as TPanel).Free;
(LabelArray[i] as TLabel).Free;
(EditArray[i] as TEdit).Free;

=> "Invalid Point Operation"

Использование твоей процедуры приводит к "Access violation":
Код:
For i:=1 to QCount do
      begin
        my_obj := (QArray[i] as TPanel).ClassInfo;
        FreeAndNil(my_obj);

        my_obj := (EditArray[i] as TEdit).ClassInfo;
        FreeAndNil(my_obj);

        my_obj := (LabelArray[i]as TLabel).ClassInfo;
        FreeAndNil(my_obj);
      end;
  Максим

Member
Статус: Не в сети
Регистрация: 05.01.2003
Откуда: Москва
Фото: 2
Xupyp1
Значит у тебя в каком-то элементе ничего нет, то есть nil
Код:
(LabelArray[i]as TLabel).ClassInfo

Если первая часть nil, то вторую никак не возьмешь.

Проверяй внимально как именно ты создаешь объекты. Может забываешь инкрементировать QCount

_________________
Устав традиций нужно соблюдать, Хоть и не раз ответят вам отказом: Конечно, баба может и не дать, Но предложить ты ей всегда обязан!

  Xupyp1

Member
Статус: Не в сети
Регистрация: 02.12.2004
Максим
Массивы компонентов статические и потому некоторые элементы массива представляют собой "nil"
Однако, цикл проходит лишь по использованным элементам.

Я так понимаю свойство ClassInfo возвращает указатель на объект?
Как в этом случае обрабатываются массивы компонентов?
  Максим

Member
Статус: Не в сети
Регистрация: 05.01.2003
Откуда: Москва
Фото: 2
Xupyp1
Ты бы на всякий случай сделал что-то типа:

Код:
If Assigned(QArray[i]) Then
Begin
        my_obj := (QArray[i] as TPanel).ClassInfo;
        FreeAndNil(my_obj);
End;

Добавлено спустя 3 минуты, 18 секунд
А так, вообще иногда надо пользоваться очень осторожно As. От него программа глючит достаточно хорошо, если с объектом часто какая-либо работа проводиться.
У меня такое было по полной, форма раз на 100 (или чуть больше) сваливается на Access Violation

_________________
Устав традиций нужно соблюдать, Хоть и не раз ответят вам отказом: Конечно, баба может и не дать, Но предложить ты ей всегда обязан!

  Xupyp1

Member
Статус: Не в сети
Регистрация: 02.12.2004
Максим
Блин Access Violation меня преследует...
Сейчас просто отключил освобождение памяти, но это не выход :(
Или особо без разницы?
  Максим

Member
Статус: Не в сети
Регистрация: 05.01.2003
Откуда: Москва
Фото: 2
Xupyp1
Как я предложил попробуй. А так, по идее все куча, при выходе из программы, автоматом пометиться как неиспользуемая. Но не очищать за собой "корзину" не есть хороший тон. Хотя я до сих пор с некоторыми по поводу Label и Goto готов поспорить, хоть и признаю что немного все-таки дурной тон, хотя для процессора что goto, что repeat .... while :)

_________________
Устав традиций нужно соблюдать, Хоть и не раз ответят вам отказом: Конечно, баба может и не дать, Но предложить ты ей всегда обязан!

  Koval

Member
Статус: Не в сети
Регистрация: 11.07.2004
Откуда: Воронеж
Xupyp1 писал(а):
Сейчас просто отключил освобождение памяти, но это не выход Sad Или особо без разницы?

Если ты освобождаешь память при закрытии формы и твоя программа не предусматривает возврат в начало ее выполнения, то без разницы, форма сама при закрытии прибьет все твои структуры.
на как заметили выше это
Цитата:
немного все-таки дурной тон

_________________
Удачи и мудрости.

  Xupyp1

Member
Статус: Не в сети
Регистрация: 02.12.2004
Максим
Дык я попробовал и пишу - "Блин Access Violation меня преследует..." :)
Придется видать использовать немного все-таки дурной тон :)

Хотя, ммм, пропробую сделать массивы из конкретных типов (TPanel, TEdit, TLabel), может тогда метод free будет работать
  Koval

Member
Статус: Не в сети
Регистрация: 11.07.2004
Откуда: Воронеж
Xupyp1 писал(а):
"Блин Access Violation меня преследует..." Smile

это значит обращение к несуществующему элементу.
Xupyp1 писал(а):
Массивы компонентов статические и потому некоторые элементы массива представляют собой "nil" Однако, цикл проходит лишь по использованным элементам.

Видимо задевает и не использованные, проверь всетаки детальнее шаг за шагом.... :)

_________________
Удачи и мудрости.

  Daemon

Member
Статус: Не в сети
Регистрация: 14.01.2004
Откуда: Киев, Украина
А Release использовать?

_________________
Ку ку

  Xupyp1

Member
Статус: Не в сети
Регистрация: 02.12.2004
Koval
Koval писал(а):
это значит обращение к несуществующему элементу

Знаем-знаем :)
Еще-бы причину узнать...
Koval писал(а):
Видимо задевает и не использованные, проверь всетаки детальнее шаг за шагом

А вот и нет, сваливается на первом-же проходе.

Daemon
Нашел в справке про него маленько, но как прикрутить не понял :oops:
Это насколько я понимаю WinAPI функция?
Добавлено спустя 6 минут, 35 секунд
Xupyp1 писал(а):
Хотя, ммм, пропробую сделать массивы из конкретных типов (TPanel, TEdit, TLabel), может тогда метод free будет работать

Ничего не получилось :(
"Invalid pointer operation"
  Zеrg

Member
Статус: Не в сети
Регистрация: 03.01.2003
Откуда: Ростов-на-Дону
Xupyp1 Ладно, в цикле пока не удаётся убить обьект, но скажи хотя бы один оно отрабатывает? Просто пропиши железно убить к примеру второй Edit.

Если отработает, значит в цикле проблема, в частном строчка

Цитата:
For i:=1 to QCount

Добавлено спустя 1 минуту, 7 секунд
Daemon Release тоже не всегда нормально отрабатывает, к сожалению...

_________________
Just Zerg! Остановим деградацию русского языка, скажем нет удафкомовской лексике!!

Показать сообщения за:  Поле сортировки  
Начать новую тему Новая тема / Ответить на тему Ответить  Сообщений: 2317 • Страница 82 из 116 • <  1 ... 79  80  81  82  83  84  85 ... 116  >
-

Список форумов » Специализированные форумы » Программирование

Часовой пояс: UTC + 3 часа


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2

Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group
Русская поддержка phpBB | Kolobok smiles © Aiwan