ANTICHAT - Показать сообщение отдельно - Студентам с лабораторными сюда

Цитата:

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

Помогите пожалуйста в Delphi : Дан фрагмент текста. Если пользователь при введении текста ошибся и текст содержит предложения, которые начинаются с маленькой буквы, сформировать и вывести в другой текстовый редактор исправленный текст. Не знаю как отличить большую букву от маленькой да еще и в начале предложения... Надо сделать с помошью TMemo

Без обид)) но исходник специально не стала выкладывать, чтобы Вы сами хоть немного потрудились, а не я все за Вас сделала в 5 утра))), удачного оформления кода!!!

PHP код:


		
			
//ваша программа



unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    Memo1: TMemo;

    Button1: TButton;

    Memo2: TMemo;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;



var

  Form1: TForm1;



implementation



uses StrUtils;



{$R *.dfm}

function Sha_SpaceCompress(const s: string): string;

var   p, q, t: pchar; ch: char;

label rt;

begin; p := pointer(s); q := nil;

  if p <> nil then begin; t := p + (pinteger(p - 4))^;

  if p < t then begin; repeat; dec(t);

  if p > t then goto rt; until (t^ > ' ');

  SetString(Result, nil, (t - p) + 1);

  q := pchar(pointer(Result)); repeat;

  repeat; ch := p^; inc(p); until ch > ' ';

  repeat; q^ := ch; ch := p^; inc(q); inc(p);

  until ch <= ' '; q^ := ' '; inc(q); until p > t;

  end; end; rt: if q <> nil then begin; dec(q); q^ := #0;

  (pinteger(pchar(pointer(Result)) - 4))^ := q - pointer(Result);

  end else Result := '';

end;



function CntRecurrences(substr, str: string): integer;

var cnt, p: integer;

begin cnt := 0; while str <> '' do begin

  p := Pos(substr, str); if p > 0 then inc(cnt)

  else p := 1; Delete(str, 1, (p + Length(substr) - 1));

  end; Result := cnt;

end;



function SearchString(const FindStr, SourceString: string; Num: Integer):

  Integer;

var FirstSym: PChar;

  function MyPos(const FindStr, SourceString: PChar; Num: Integer): PChar;

  begin Result := AnsiStrPos(SourceString, FindStr);

  if (Result = nil) then Exit; Inc(Result); if Num = 1 then Exit;

    if num > 1 then Result := MyPos(FindStr, Result, num - 1);

  end; begin FirstSym := PChar(SourceString);

  Result := MyPos(PChar(FindStr), PChar(SourceString), Num) - FirstSym;

  if Result < 0 then Result := 0;

end;



function UpCase(ch: char): char; begin if (ch in ['a'..'z', 'а'..'я'])

then result := chr(ord(ch) - 32) else result := ch; end;



//аналогична той что выше но только для English символов.

//function UpCaseRus(ch: Char): Char;

//asm

//  CMP   AL,'a'

//  JB    @@exit

//  CMP   AL,'z'

//  JA    @@yo

//  SUB   AL,'a' - 'A'

//  RET

//@@yo:

//  CMP   AL,'?'

//  JNE   @@exit

//  MOV   AL,'?'

//@@exit:

//end;



procedure TForm1.Button1Click(Sender: TObject);

var i,j,z,c:integer; s,t:string;

begin Memo2.Lines.Clear; for i:=0 to Memo1.Lines.Count-1 do

  begin s:=Memo1.Lines[i]; s:=Sha_SpaceCompress(s);

  s:=UpCase(s[1])+RightStr(s,Length(s)-1); j:=CntRecurrences('. ', s);

  for z:=1 to j do begin c:=SearchString('. ', s, z);

  t:=LeftStr(s,c+1)+UpCase(s[c+2])+RightStr(s,Length(s)-c-2);

  s:=t; end; Memo2.Lines.Add(s); end;

end;



end.