Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 02.07.2008, 04:30   #1
Rumus
Новичок
Джуниор
 
Регистрация: 25.06.2008
Сообщений: 2
По умолчанию Помогите пожалуйста исправить подправить процедуру (строки)

Вобщем по условию нужно сделать так чтобы предлоги (без, в, до, для, за, из, к, на, над, о, об, от, по, под, пред, при, про, с, у, через) начинались с большой буквы...я вроде как сделали все работает...но проблема в том что когде в слове встречаются эти сочетания букв они тоже начинаются с большой буквы...например безграничный - Безграничный или профессиональный - профессиоНальный...подскажите как это исправить

Вот то что я написал:
Код:
procedure TForm1.PageControl1Change(Sender: TObject);
var
s,a:string;
i:longint;
b:integer;
begin
S:=memo1.Text;
memo2.Text:='';
for i:=1 to length(s) do
if (((s[i]='в') or (s[i]='В') or (s[i]='к') or (s[i]='К') or (s[i]='о') or (s[i]='О')
   or (s[i]='с') or (s[i]='C') or (s[i]='у') or (s[i]='У')) and not (s[i+1] in ['a'..'z','A'..'Z','а'..'я','А'..'Я']) and not (s[i-1] in ['a'..'z','A'..'Z','а'..'я','А'..'Я']))
or ((((s[i]='д') or (s[i]='Д')) and ((s[i+1]='о') or (s[i+1]='О')))
or (((s[i]='з') or (s[i]='З')) and ((s[i+1]='а') or (s[i+1]='А')))
or (((s[i]='и') or (s[i]='И')) and ((s[i+1]='з') or (s[i+1]='З')))
or (((s[i]='н') or (s[i]='Н')) and ((s[i+1]='а') or (s[i+1]='А')))
or (((s[i]='о') or (s[i]='О')) and ((s[i+1]='б') or (s[i+1]='Б')))
or (((s[i]='о') or (s[i]='О')) and ((s[i+1]='т') or (s[i+1]='Т')))
or (((s[i]='п') or (s[i]='П')) and ((s[i+1]='о') or (s[i+1]='О')))
   and not (s[i-1] in ['a'..'z','A'..'Z','а'..'я','А'..'Я']) and not (s[i+2] in ['a'..'z','A'..'Z','а'..'я','А'..'Я']))
or ((((s[i]='б') or (s[i]='Б')) and ((s[i+1]='е') or (s[i+1]='Е')) and ((s[i+2]='з') or (s[i+2]='З')))
or (((s[i]='д') or (s[i]='Д')) and ((s[i+1]='л') or (s[i+1]='Л')) and ((s[i+2]='я') or (s[i+2]='Я')))
or (((s[i]='н') or (s[i]='Н')) and ((s[i+1]='а') or (s[i+1]='А')) and ((s[i+2]='д') or (s[i+2]='Д')))
or (((s[i]='п') or (s[i]='П')) and ((s[i+1]='о') or (s[i+1]='О')) and ((s[i+2]='д') or (s[i+2]='Д')))
or (((s[i]='п') or (s[i]='П')) and ((s[i+1]='р') or (s[i+1]='Р')) and ((s[i+2]='и') or (s[i+2]='И')))
or (((s[i]='п') or (s[i]='П')) and ((s[i+1]='р') or (s[i+1]='Р')) and ((s[i+2]='о') or (s[i+2]='О')))
   and not (s[i-1] in ['a'..'z','A'..'Z','а'..'я','А'..'Я']) and not (s[i+3] in ['a'..'z','A'..'Z','а'..'я','А'..'Я']))
or ((((s[i]='п') or (s[i]='П')) and ((s[i+1]='р') or (s[i+1]='Р')) and ((s[i+2]='е') or (s[i+2]='Е')) and ((s[i+3]='д') or (s[i+3]='Д')))
   and not (s[i-1] in ['a'..'z','A'..'Z','а'..'я','А'..'Я']) and not (s[i+4] in ['a'..'z','A'..'Z','а'..'я','А'..'Я']))
or ((((s[i]='ч') or (s[i]='Ч')) and ((s[i+1]='е') or (s[i+1]='Е')) and ((s[i+2]='р') or (s[i+2]='Р')) and ((s[i+3]='е') or (s[i+3]='Е')) and ((s[i+4]='з') or (s[i+4]='З')))
   and not (s[i-1] in ['a'..'z','A'..'Z','а'..'я','А'..'Я']) and not (s[i+5] in ['a'..'z','A'..'Z','а'..'я','А'..'Я']))
then memo2.text:=memo2.text+ansiuppercase(s[i])
else memo2.Text:=memo2.Text+s[i];
end;

Последний раз редактировалось Stilet; 02.07.2008 в 08:07.
Rumus вне форума Ответить с цитированием
Старый 02.07.2008, 05:23   #2
Aristarh Dark
Форумчанин
 
Регистрация: 07.08.2007
Сообщений: 154
По умолчанию

Жесть... И не лень это писать было?
Не проще ли выбрать слово, сравнить с набором предлогов и если попадает в набор заменить первую букву?
Aristarh Dark вне форума Ответить с цитированием
Старый 02.07.2008, 08:16   #3
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Цитата:
Rumus
Анализируемое слово преобразовывай в нижний регистр, иши функой pos твои предлоги, и найденное преобразуй в верхний регистр.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 02.07.2008, 11:18   #4
B_N
Новичок
Джуниор
 
Регистрация: 18.01.2008
Сообщений: 1,720
По умолчанию

Хм.... надо же такого наворочать.....
Код:
unit Unit1;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, IniFiles, StdCtrls;

type

TForm1 = class(TForm)
        Memo1: TMemo;
        Memo2: TMemo;
        Button1: TButton;
        procedure FormCreate(Sender: TObject);
        procedure Button1Click(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    protected
        hsl : THashedStringList;
        function FindNextWord(str : string; start : integer) : integer;
        function IsDelimiter(c : char) : boolean;
end;

var
    Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.IsDelimiter(c : char) : boolean;
begin
    result := (c in [' ', ',', ';', ',']);
end;

function TForm1.FindNextWord(str : string; start : integer) : integer;
var
    i : cardinal;
begin
    i := start;
    if (i <= length(str)) AND (NOT IsDelimiter (str[i]) ) then begin
        result := i;
        exit;
    end;
    while (i < length(str)) do begin
        if IsDelimiter (str[i]) then begin
            inc (i);
        end
        else begin
            result := i;
            exit;
        end
    end;
    result := -1;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i : integer;
begin
    self.hsl := THashedStringList.Create();
    self.hsl.CaseSensitive := false;
    self.hsl.AddStrings(self.Memo1.Lines);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    WordIdx : integer;
    WordLen : integer;
    memotext: string;
    teststr : string;
    testidx : integer;
    i       : integer;
begin
    memotext := Memo2.Text;
    WordIdx := FindNextWord(memotext, 1);
    while WordIdx <> -1 do begin
        teststr := '';
        testidx := WordIdx;
        while (testidx <= length(memotext)) AND ( NOT IsDelimiter (memotext[testidx]) ) do begin
            teststr := teststr + memotext[testidx];
            inc(testidx);
        end;
        if hsl.IndexOf(teststr) >= 0 then begin
            for i := WordIdx to testidx - 1 do begin
                memotext[i] := AnsiUpperCase(memotext[i])[1];
            end;
        end;
        WordIdx := FindNextWord(memotext, testidx);
    end;
    Memo2.Text := memotext;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    hsl.Free;
end;

end.
В Memo1 - список предлогов (забит в дизайн-тайме, одно слово - одна строка), в Memo2 - модифицируемый текст. Оптимизацию оставляю топикстартеру.

Было:
Цитата:
Вобщем по условию нужно сделать так чтобы предлоги (без, в, до, для, за, из, к, на, над, о, об, от, по, под, пред, при, про, с, у, через) начинались с большой буквы...я вроде как сделали все работает...но проблема в том что когде в слове встречаются эти сочетания букв они тоже начинаются с большой буквы...например безграничный - Безграничный или профессиональный - профессиоНальный...подскажите как это исправить
Стало:
Цитата:
Вобщем ПО условию нужно сделать так чтобы предлоги (БЕЗ, В, ДО, ДЛЯ, ЗА, ИЗ, К, НА, НАД, О, ОБ, ОТ, ПО, ПОД, ПРЕД, ПРИ, ПРО, С, У, ЧЕРЕЗ) начинались С большой буквы...я вроде как сделали все работает...но проблема В том что когде В слове встречаются эти сочетания букв они тоже начинаются С большой буквы...например безграничный - Безграничный или профессиональный - профессиоНальный...подскажите как это исправить
B_N вне форума Ответить с цитированием
Старый 02.07.2008, 11:57   #5
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

А мне кажется так лучше
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var    t:TStringList;
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
t:=TStringList.Create;
t.Delimiter:=' ';
t.DelimitedText:='без в до для за из к на над о об от по под пред при про с у через';
end;

procedure TForm1.Memo1Change(Sender: TObject);
var i2,i:integer;e,s:string;c:string[1];
begin
s:=Memo1.Text;
//********* FOR ******************
for i :=1  to length(s) do
begin
 if (s[i] in [' ',',',';']) then begin
  e:=AnsiLowerCase(copy(s,i+1,5));
  //********* FOR ******************
  i2 :=length(e);
  while i2>=1  do
  begin
     if t.IndexOf(e)<>-1 then begin
      c:=AnsiUpperCase(s[i+1]);
      s[i+1]:=c[1];
      i2:=0;
     end else begin
       delete(e,length(e),1);
     end;
     dec(i2);
  end;
  //******* END FOR ****************{}
 end;
end;
//******* END FOR ****************{}
ListBox1.Items.Text:=s;
end;

end.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 02.07.2008, 16:50   #6
Rumus
Новичок
Джуниор
 
Регистрация: 25.06.2008
Сообщений: 2
По умолчанию

спасибо большое всем кто откликнулся...
а как сделать чтобы при табуляции программа тоже отличала предлоги?
Rumus вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите пожалуйста найти и исправить ошибку Sam04 Паскаль, Turbo Pascal, PascalABC.NET 4 10.06.2008 08:28
помогите пожалуйста исправить задачу kardan Помощь студентам 2 12.04.2008 10:16
Пожалуйста помогите исправить несколько задач Shatyn Помощь студентам 5 25.06.2007 20:20
Помогите,пожалуйста,исправить задачу... Загадка Паскаль, Turbo Pascal, PascalABC.NET 1 21.12.2006 00:42