Главная страница
    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.043 c
2-1187084180
DagOT-R
2007-08-14 13:36
2007.09.09
Таймер - WTF??? Помогите разобраться с проблемой:


15-1186810759
Cyrax
2007-08-11 09:39
2007.09.09
MySQL5: выполнение произвольного числа запросов без процедур...


15-1186570167
Reindeer Moss Eater
2007-08-08 14:49
2007.09.09
Эксель и счет


6-1169014151
Ravil
2007-01-17 09:09
2007.09.09
Компоненты на вкладке Client in Delphi 7


2-1186652202
shtam
2007-08-09 13:36
2007.09.09
chm





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский