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

Вниз

Сортировка в StringGrid   Найти похожие ветки 

 
DDDeN   (2005-01-11 11:56) [0]

Как отсортировать СтрингГрид по определенному полю (по возрастанию или убыванию) или по группе указанных полей?


 
P.N.P. ©   (2005-01-11 12:22) [1]


type TStringGridExSortType = (srtAlpha,srtInteger,srtDouble);

procedure GridSort(SG : TStringGrid; ByColNumber,FromRow,ToRow : integer;
                  SortType : TStringGridExSortType = srtAlpha);
var Temp : TStringList;

   function SortStr(Line : string) : string;
   var RetVar : string;
   begin
     case SortType of
          srtAlpha   : Retvar := Line;
          srtInteger : Retvar := FormatFloat("000000000",StrToIntDef(trim(Line),0));
          srtDouble  : try
                         Retvar := FormatFloat("000000000.000000",StrToFloat(trim(Line)));
                       except
                         RetVar  := "0.00";
                       end;
     end;

     Result := RetVar;
   end;

   // Ðåêóðñèâíûé QuickSort
   procedure QuickSort(Lo,Hi : integer; CC : TStrings);

       procedure Sort(l,r: integer);
       var  i,j : integer;
            x   : string;
       begin
         i := l; j := r;
         x := SortStr(CC[(l+r) DIV 2]);
         repeat
           while SortStr(CC[i]) < x do inc(i);
           while x < SortStr(CC[j]) do dec(j);
           if i <= j then begin
             Temp.Assign(SG.Rows[j]);      // &#204;&#229;&#237;&#255;&#229;&#236; &#236;&#229;&#241;&#242;&#224;&#236;&#232; 2 &#241;&#242;&#240;&#238;&#234;&#232;
             SG.Rows[j].Assign(SG.Rows[i]);
             SG.Rows[i].Assign(Temp);
             inc(i); dec(j);
           end;
         until i > j;
         if l < j then sort(l,j);
         if i < r then sort(i,r);
       end;

    begin {quicksort};
      Sort(Lo,Hi);
    end;

begin
 Temp := TStringList.Create;
 QuickSort(FromRow,ToRow,SG.Cols[ByColNumber]);
 Temp.Free;
end;


 
DDDeN   (2005-01-11 12:39) [2]

Ого!!!
Один комментарий непонятен ;)



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

Форум: "Основная";
Текущий архив: 2005.01.23;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.45 MB
Время: 0.041 c
14-1105115662
xman
2005-01-07 19:34
2005.01.23
Сеть не видит сеть


9-1097749181
Malefic
2004-10-14 14:19
2005.01.23
Как использовать AsphyreObjects?


3-1103272846
hawkins
2004-12-17 11:40
2005.01.23
Interbase6: список всех юзеров


14-1104827977
peypivo
2005-01-04 11:39
2005.01.23
GPRS и компьютер


3-1103633684
den_777
2004-12-21 15:54
2005.01.23
Частое изменение метаданных в INTERBASE





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