Модератор: Модераторы
AlphaBlend писал(а): когда прочитаешь готовый код - все так просто кажется ))) Видимо , я не те учебники читаю ))
Или создать TEdit с новыми свойствами и методами ) Такой расширенный ) AlphaBlend писал(а):Или создать TEdit с новыми свойствами и методами )
Лекс Айрин писал(а):тогда уж не TEdit, а их набор с автоматическим переходом между ними
AlphaBlend писал(а):в смысле (Component as TEditMoney) или (Component as TEditCard) ? ) примерно так ? )
AlphaBlend писал(а):пока вот такая вот реализация )))
Лекс Айрин писал(а):Безусловно. Я лишь привел пример. Насчет оптимизации я бы послушал внимательно...
AlphaBlend писал(а):Представьте , когда проверяемых строк будет десять тысяч , а символов в строке - 255 ? )
AlphaBlend писал(а): Конечно , при таких объемах необходимо использовать потоки , но все же )
Код: Выделить всё
Application.ProcessMessages;
AlphaBlend писал(а):Надо учитывать разную аппаратную конфигурацию ) Может программа будет где-нибудь на мало-мальски работающем компьютере , который еле-еле удовлетворяет требованиям XP ?)
Лекс Айрин писал(а):Насчет оптимизации я бы послушал внимательно...
Код: Выделить всё
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes
{ you can add units after this };
Type
OnOff=boolean;
TTag=record
Str:String;
// verify:OnOff;
tags:boolean;
end;
function FirstTag (var Str:String):TTag;
Var
Start, Finish:boolean;
StrTag:String;
Begin
If Str='' then
begin
Result.Str:='';//отсев ошибочного использования
end else
begin
Start:=False; // инициализация переменных.
Finish:=False;
Result.Str:='';
Result.tags:=true;
StrTag:='';
while Finish=false do //
begin
if Str='' then
Begin
Finish:=True;//выход из цикла по исчерпанию строки. условия выхода могут быть любые
Result.tags:=false;
End else
Begin
StrTag:=Copy(Str,1,1);
case StrTag of
'<':
Begin
if Start=true then
Begin //это второй символ '<'
Finish:=True; // штатный выход если это все же не тег.
Result.tags:=false;
end else //это первый символ '<'.
begin // начинаем копировать предположительно тег в строку
if Result.Str='' then
begin
Start:=True;
Result.Str:=Result.Str+StrTag;
Delete(Str, 1, 1);
end else
begin // результат -- все, что до символа '<' НЕ тег
Finish:=True;
result.tags:=false;
end;
end
end;
'>':
Begin
Result.Str:=Result.Str+StrTag;
Delete(Str, 1, 1);
if Start=true then
begin
Finish:=True;// штатный выход если тег
result.tags:=true;
end else
begin
Finish:=True;// штатный выход если НЕ тег
result.tags:=false;
end;
end;
else Begin
Result.Str:=Result.Str+StrTag; // обычный символ
Delete (Str, 1, 1);
End;
end;
end;
end;
end;
end;
function FirstTag2 (const Str:String):TTag;
var
i, k, L: integer;
begin
i := 0;
L := Length(Str);
repeat
Inc(i);
if Str[i] = '<' then
begin
k := i;
repeat
Inc(k);
if Str[k] = '>' then
begin
Result.Str := Copy(Str, Succ(i), Pred(k - i));
Result.tags := Length(Result.Str) > 0;
exit;
end;
until k = L;
end;
until i = L;
Result.Str := '';
Result.tags := false;
end;
{function TestTag (Str:TTag):Boolean;
Var
TempStr:string;
Begin
TempStr:=Copy(Str.Str,0,4);//больше 4 вряд ли потребуется
{
теги после которых строка переводится:
<bp> </h1 <h2 <h3 </p> </di </ta </tr </th </tb </li
во всех остальных случаях нет!}
//showMessage ('function TestTag -- TempStr='+TempStr);
case TempStr of
'<bp>', '</h1', '<h2', '<h3', '</p>', '</di', '</ta', '</tr', '</th', '</tb', '</li'
:begin
result:=true;
end;}
function BoolToStr(B: boolean): string;
begin
if B then
Result := 'true' else
Result := 'false';
end;
Var
TempStr:string;
begin
writeln('TempStr');
TempStr := '_12<first>asdasd<dasdas><qweqwe>asdasd';
writeln(sLineBreak + TempStr);
writeln(BoolToStr(FirstTag(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);
writeln(sLineBreak + sLineBreak + 'TempStr2');
TempStr := '<first>asdasd<dasdas><qweqwe>asdasd';
writeln(sLineBreak + TempStr);
writeln(BoolToStr(FirstTag2(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);
TempStr := '_12<first>asdasd<dasdas><qweqwe>asdasd';
writeln(sLineBreak + TempStr);
writeln(BoolToStr(FirstTag2(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);
TempStr := 'first>asdasd<dasdas><qweqwe>asdasd';
writeln(sLineBreak + TempStr);
writeln(BoolToStr(FirstTag2(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);
TempStr := '_12<firstasdasd<dasdas<qweqweasdasd';
writeln(sLineBreak + TempStr);
writeln(BoolToStr(FirstTag2(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);
TempStr := '_12first>asdasddasdas>qweqwe>asdasd';
writeln(sLineBreak + TempStr);
writeln(BoolToStr(FirstTag2(TempStr).tags) + ': ' + FirstTag2(TempStr).Str);
readln;
end.