Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Прочее";
Текущий архив: 2007.09.09;
Скачать: [xml.tar.bz2];

Вниз

Процедурку не оцените?   Найти похожие ветки 

 
sergeyst ©   (2007-08-13 08:02) [0]

function CompStr(Text1, Text2: string): Integer;
type
 TState = (Dgtl, Strg, Punc);
 TType = (Dig,Str);
 TRec = record
   case tp: TType of
     Dig: (st  : string[9]);
     Str: (int : string[9]);
 end;
 TMRec = array of TRec;

 function ParsStr(Text: string): TMRec;
 var
   i: Integer;
   State: TState;
   CurrStr: string;
   CurrInt: string;
   Ch: Char;
 begin
   CurrStr := "";
   CurrInt := "";
   State := Strg;
   SetLength(Result, 1);

   for i := 1 to Length(Text) do
   begin
     Ch := Text[i];
     case State of
       Strg:
         if (Ch <> "x") and (Ch <> "&#245;") and
          ( (Ch in ["A".."z"] ) or (Ch in ["&#192;".."&#255;"] ) ) then
           CurrStr := CurrStr + Ch

         else if (Ch = "x") or (Ch = "&#245;") or (Ch = "-") or (Ch = ".")  then
         begin
           Result[Pred( Length(Result) )].tp := Str;
           Result[Pred( Length(Result) )].st := CurrStr;
           CurrStr := "";
           State := Punc;
         end

         else if (Ch in ["0".."9"]) then
         begin
           State := Dgtl;
           if CurrStr <> "" then
           begin
             Result[Pred( Length(Result) )].tp := Str;
             Result[Pred( Length(Result) )].st := CurrStr;
             CurrStr := "";
             CurrInt := CurrInt + Ch;
             SetLength(Result, Length(Result) + 1);
           end
           else
             CurrInt := CurrInt + Ch;
         end;

       Dgtl:
         if (Ch <> "x") and (Ch <> "&#245;") and
          ( (Ch in ["A".."z"] ) or (Ch in ["&#192;".."&#255;"] ) ) then
         begin
           State := Strg;
           CurrStr := CurrStr + Ch;
           if CurrInt <> "" then
           begin
             Result[Pred( Length(Result) )].tp := Dig;
             Result[Pred( Length(Result) )].int := CurrInt;
             CurrInt := "";
             SetLength(Result, Length(Result) + 1);
           end;
         end

         else if (Ch = "x") or (Ch = "&#245;") or (Ch = "-") or (Ch = ".")  then
         begin
           State := Punc;
           Result[Pred( Length(Result) )].tp := Dig;
           Result[Pred( Length(Result) )].int := CurrInt;
           CurrInt := "";
         end

         else if (Ch in ["0".."9"]) then
         begin
           CurrInt := CurrInt + Ch;
         end;

       Punc:
         if (Ch <> "x") and (Ch <> "&#245;") and
          ( (Ch in ["A".."z"] ) or (Ch in ["&#192;".."&#255;"] ) ) then
         begin
           CurrStr := CurrStr + Ch;
           State := Strg;
           SetLength(Result, Length(Result) + 1);
         end

         else if (Ch = "x") or (Ch = "&#245;") or (Ch = "-") or (Ch = ".")  then
         begin
           ShowMessage("asfd");
         end

         else if (Ch in ["0".."9"]) then
         begin
           CurrInt := CurrInt + Ch;
           State := Dgtl;
           SetLength(Result, Length(Result) + 1);
         end;
     end;
   end;//}

   if CurrStr <> "" then
   begin
     Result[Pred( Length(Result) )].tp := Str;
     Result[Pred( Length(Result) )].st := CurrStr;
   end;
   if (CurrInt <> "") then
   begin
     Result[Pred( Length(Result) )].tp := Dig;
     Result[Pred( Length(Result) )].int := CurrInt;
   end;
 end;

var
 mass1, mass2: TMRec;
 i, Len: Integer;
begin
 Result := 0;
 mass1 := ParsStr(Text1);
 mass2 := ParsStr(Text2);

 if Length(mass1) > Length(mass2) then
   Len := Length(mass2) - 1
 else
   Len := Length(mass1) - 1;

 for i := 0 to Len do
   if (mass1[i].tp = Str) or (mass2[i].tp = Str) then
   begin
     Result := AnsiCompareStr(mass1[i].st, mass2[i].st);
     if Result <> 0 then
       Break;
   end
   else begin
     if StrToInt(mass1[i].int) > StrToInt(mass2[i].int) then
     begin
       Result := 1;
       Break;
     end
     else if StrToInt(mass1[i].int) < StrToInt(mass2[i].int) then
     begin
       Result := -1;
       Break;
     end;
   end;
 SetLength(mass1, 0);
 SetLength(mass2, 0);  
end;


 
Сергей М. ©   (2007-08-13 08:26) [1]

И что это за чудо программерской мысли ?


 
Ega23 ©   (2007-08-13 08:46) [2]

IncDay гораздо интереснее


 
sergeyst ©   (2007-08-13 08:46) [3]

Берет 2 строки, разбивает на цифры(числа) и буквы(строки) и сравнивает строки - как строки, числа - как числа. Собственно, я задавал вопрос, можно ли это сделать как-то в запросе.
http://delphimaster.net/view/2-1185436670/


 
sergeyst ©   (2007-08-13 08:47) [4]


> IncDay гораздо интереснее

Что это?


 
Сергей М. ©   (2007-08-13 08:54) [5]


> sergeyst ©   (13.08.07 08:46) [3]


Мда ..


> разбивает на цифры(числа) и буквы(строки)


TRegExp чем не устроил ?


>  SetLength(mass1, 0);
>  SetLength(mass2, 0);  


Это зачем ?


 
sergeyst ©   (2007-08-13 09:01) [6]


> TRegExp чем не устроил ?

Не знаю, что это такое. Можно объяснить?

> Это зачем ?

Ну, я читал, что динамические массивы надо освобождать. Правда, кажется, это было для D5. Для D7 - не надо?


 
Ega23 ©   (2007-08-13 09:02) [7]


> sergeyst ©   (13.08.07 08:47) [4]
>
> > IncDay гораздо интереснее
>
> Что это?


Это - классика.


function TfmMain.IncDay(const DateTime: TDateTime;  NumberOfDays: Integer): TDateTime;
{Функция предназначена для изменения даты (DateTime) путем добавления  количества дней (NumberOfDays). Значение NumberOfDays может быть отрицательным.}
var
 Y, M, D, CountDays: Word;
 N: Integer;
 Sign, NoBreak: Boolean;
begin
 Sign := NumberOfDays >= 0;
 DecodeDate(DateTime, Y, M, D);
 N := NumberOfDays;
 NoBreak := True;
 if Sign then   //Прибавить
 begin
   while(NoBreak) do
   begin //Количество дней в месяце
     CountDays := MonthDays[IsLeapYear(Y), M];
     if (N + D) <= CountDays then //Если в пределах данного месяца
     begin
       Inc(D, N);
       NoBreak := False;
     end
     else
     begin
       if M < 12 then
         Inc(M, 1)
       else
       begin
         M := 1;
         Inc(Y, 1);
       end;
       N := N - (CountDays - D);
       D := 0;
     end;
   end;
 end
 else  //Отнять
 begin
   N := -N;
   while(NoBreak) do
   begin
     if D > N then  //Если в пределах данного месяца
     begin
       Dec(D, N);
       NoBreak := False;
     end
     else
     begin
       if M > 1 then
         Dec(M, 1)
       else
       begin
         M := 12;
         Dec(Y, 1);
       end;
       //Количество дней в месяце
       CountDays := MonthDays[IsLeapYear(Y), M];
       N := N - D;
       D := CountDays;
     end;
   end;  
 end;
 Result := EncodeDate(Y, M, D);
 //Установить время из старой даты
 ReplaceTime(Result, DateTime);
end;


 
Сергей М. ©   (2007-08-13 09:27) [8]


> sergeyst ©   (13.08.07 09:01) [6]


> что это такое


Класс для работы с регулярными выражениями.


> Для D7 - не надо?


Не надо.


 
sergeyst ©   (2007-08-13 09:28) [9]


> Класс для работы с регулярными выражениями.

А... спасибо, буду знать. Ну, хоть потренировался.



Страницы: 1 вся ветка

Форум: "Прочее";
Текущий архив: 2007.09.09;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.038 c
3-1179235032
DelphiLexx
2007-05-15 17:17
2007.09.09
Заставить DBGridEh перерисовать Footer


15-1186739819
Jeer
2007-08-10 13:56
2007.09.09
Старые песни


2-1186574595
Zebra
2007-08-08 16:03
2007.09.09
вопрос по массиву


2-1187585590
fERO
2007-08-20 08:53
2007.09.09
TIdHTTP отключение сообщений о ошибках


2-1187039106
Roman_Kesh
2007-08-14 01:05
2007.09.09
Помогите кто знает! Проблема с SaveDialog!





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский