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

Вниз

столбцов в StringGrid   Найти похожие ветки 

 
XfroSt   (2005-10-05 10:09) [0]

Пишу вот такой код для сортировки столбцов в стринггрид. В идеале хочу получить что то типа нажимаем на заголовок столбца и таблица сортируется.

procedure Tsresult.GridSort(StrGrid: TStringGrid; NoColumn: Integer);
Var
Line,
PosActual: Integer;
Row     :       TStrings;
Renglon :       TStringList;
begin
 Renglon := TStringList.Create;
 For Line := 1 to StrGrid.RowCount-1 do
 Begin
   PosActual := Line;
   Row.Assign(TStringlist(StrGrid.Rows[PosActual]));
   While True do
   Begin
     If (PosActual = 0) Or (StrToInt(Row.Strings[NoColumn-1]) >=
         StrToInt(StrGrid.Cells[NoColumn-1,PosActual-1])) then
       Break;
     StrGrid.Rows[PosActual] := StrGrid.Rows[PosActual-1];
     Dec(PosActual);
   End;
   If StrToInt(Row.Strings[NoColumn-1]) < StrToInt(StrGrid.Cells[NoColumn-1,PosActual]) then
     StrGrid.Rows[PosActual] := Row;
 End;
 Renglon.Free;
end;

но при проходжении
Row.Assign(TStringlist(StrGrid.Rows[PosActual]));
вылетает ошибка AccesVialation ни как не могу понять в чем дело...
Поможите?
Или может есть уже готовые компоненты СтрингГрид с такими функциями?


 
Leonid Troyanovsky ©   (2005-10-05 10:19) [1]


> XfroSt   (05.10.05 10:09)  

> Или может есть уже готовые компоненты СтрингГрид с такими
> функциями?


Можно и самому приготовить

http://groups.google.com/group/fido7.ru.delphi/msg/8c27f707490716b2

--
Regards, LVT.


 
XfroSt   (2005-10-05 10:46) [2]

idx.Sort(@fCompare);
в этом месте пишет
variable required...


 
sniknik ©   (2005-10-05 11:51) [3]

"забей" на StringGrid, пользуйся ClientDataSet/ADODataSet-ом для хранения данных там и функционал побольше (сортировка есть) и работает побыстрее (на порядки).
к базе подключать не обязательно, CreateDataSet делает "оторванный" набор в памяти.


 
XfroSt   (2005-10-05 12:14) [4]

счас попробую...


 
XfroSt   (2005-10-05 12:21) [5]

с бд довольно гимморно, нашел компонент POwerGrid тут http://downloads.ru/win/1955.hts но чтт то там какая то байда с добавлением строк и функциями а-ля colWidth....


 
Seg   (2005-10-05 12:40) [6]

ошибка AccesVialation
Вылетает, если компонент не найден.
Надо использовать FindComponent


 
XfroSt   (2005-10-05 12:45) [7]

Спасибо, но вот код который  очень быстро и грамотно все делает:

procedure SortStringGrid(var GenStrGrid: TStringGrid; ThatCol: Integer);
const
  // Define the Separator
 TheSeparator = "@";
var
  CountItem, I, J, K, ThePosition: integer;
  MyList: TStringList;
  MyString, TempString: string;
begin
  // Give the number of rows in the StringGrid
 CountItem := GenStrGrid.RowCount;
  //Create the List
 MyList        := TStringList.Create;
  MyList.Sorted := False;
  try
    begin
      for I := 1 to (CountItem - 1) do
        MyList.Add(GenStrGrid.Rows[I].Strings[ThatCol] + TheSeparator +
          GenStrGrid.Rows[I].Text);
      //Sort the List
     Mylist.Sort;

      for K := 1 to Mylist.Count do
      begin
        //Take the String of the line (K – 1)
       MyString := MyList.Strings[(K - 1)];
        //Find the position of the Separator in the String
       ThePosition := Pos(TheSeparator, MyString);
        TempString  := "";
        {Eliminate the Text of the column on which we have sorted the StringGrid}
        TempString := Copy(MyString, (ThePosition + 1), Length(MyString));
        MyList.Strings[(K - 1)] := "";
        MyList.Strings[(K - 1)] := TempString;
      end;

      // Refill the StringGrid
     for J := 1 to (CountItem - 1) do
        GenStrGrid.Rows[J].Text := MyList.Strings[(J - 1)];
    end;
  finally
    //Free the List
   MyList.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Sort the StringGrid1 on the second Column
 // StringGrid1 nach der 1. Spalte sortieren
 SortStringGrid(StringGrid1, 1);
end;


Может еще комунить пригодится....


 
XfroSt   (2005-10-05 12:54) [8]

соответсвенно еще вопрос: А как пехватить клик на заголовке колонки ? или обязательно вставлять кнопку в ячейку?


 
Leonid Troyanovsky ©   (2005-10-05 12:58) [9]


> XfroSt   (05.10.05 10:46) [2]
> idx.Sort(@fCompare);
> в этом месте пишет
> variable required...


Возможно, что fCompare у тебя метод (формы).
Кроме того, со времен D3 изменилась декларация OnDrawCell,
т.е., нужно ACol, ARow instead Col, Row.

--
Regards, LVT.


 
sniknik ©   (2005-10-05 13:44) [10]

> с бд довольно гимморно
не особо. когда разберешся.

> но вот код который  очень быстро и грамотно все делает:
насколько быстро? миллион записей за 2-3 сек? а если по нескольким полям сортировка? в обратном порядке (DESC)? по выражению? сортировка фильтрованного?

если хоть чтото из упомянутого предполагается, то подумай все же о бд. проще счас разобраться чем потом переделывать.


 
XfroSt   (2005-10-05 14:35) [11]

Да вы правы при бд больше место для маневров больше, обязательно изучу, но пока нужно просто и быстро....

Так не подскажите как отловить клик мышки на ячейках нулевых строк (заголовке колонок). ?


 
Leonid Troyanovsky ©   (2005-10-05 14:37) [12]


> XfroSt   (05.10.05 14:35) [11]

> Так не подскажите как отловить клик мышки на ячейках нулевых
> строк (заголовке колонок). ?


http://groups.google.com/group/borland.public.delphi.vcl.components.using/msg/9dc5e0ee1124be68

--
Regards, LVT.


 
sniknik ©   (2005-10-05 15:05) [13]

> обязательно изучу, но пока нужно просто и быстро....
с бд так и есть. очень просто. а уж как быстро... (сравни со своим кодом сортировки в стринггриде)

для примера
Unit1.Pas
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, DB, Grids, DBGrids, ADODB, Math, StdCtrls;

type
 TForm1 = class(TForm)
   DSet: TADODataSet;
   DBGrid: TDBGrid;
   DSetID: TIntegerField;
   DSetName: TStringField;
   DSetFlSum: TFloatField;
   DSource: TDataSource;
   Zap_Label: TLabel;
   Edit1: TEdit;
   Button1: TButton;
   Time_Label: TLabel;
   procedure FormCreate(Sender: TObject);
   procedure DBGridTitleClick(Column: TColumn);
   procedure Button1Click(Sender: TObject);
 private
 public
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 DSet.CreateDataSet;
 Randomize;
end;

procedure TForm1.DBGridTitleClick(Column: TColumn);
var
 OldTime: TDateTime;
 st: string;
begin
 Screen.Cursor:= crHourGlass;
 try
   OldTime:= Now;
   DSet.Sort:= Column.FieldName;
   DateTimeToString(st, "n:ss:zzz", Now() - OldTime);
   Time_Label.Caption:= "Время выполнения : "+st;
 finally
   Screen.Cursor:= crDefault;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 i, n: integer;
 OldTime: TDateTime;
 st: string;
begin
 DSet.DisableControls;
 Screen.Cursor:= crHourGlass;
 try
   OldTime:= Now;
   if DSet.RecordCount > 0 then begin
     DSet.Close;
     DSet.CreateDataSet;
   end;

   for i:= 0 to StrToIntDef(Edit1.Text, 10) do begin
     n:= Random(1000);

     DSet.Append;
     DSetID.AsInteger:= n;
     DSetName.AsString:= "Name for "+IntToStr(n);
     DSetFlSum.AsFloat:= RoundTo(Random*1000, -2);
   end;
   DSet.Post;

   DSet.First;

   DateTimeToString(st, "n:ss:zzz", Now() - OldTime);
   Time_Label.Caption:= "Время выполнения : "+st;
 finally
   Screen.Cursor:= crDefault;
   DSet.EnableControls;
 end;
end;

end.


Unit1.Dmf
object Form1: TForm1
 Left = 222
 Top = 107
 Width = 639
 Height = 474
 Caption = "Form1"
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "MS Sans Serif"
 Font.Style = []
 OldCreateOrder = False
 OnCreate = FormCreate
 DesignSize = (
   631
   447)
 PixelsPerInch = 96
 TextHeight = 13
 object Zap_Label: TLabel
   Left = 409
   Top = 14
   Width = 49
   Height = 13
   Caption = "Записей :"
 end
 object Time_Label: TLabel
   Left = 8
   Top = 16
   Width = 107
   Height = 13
   Caption = "Время выполнения : "
 end
 object DBGrid: TDBGrid
   Left = 8
   Top = 40
   Width = 609
   Height = 401
   Anchors = [akLeft, akTop, akRight, akBottom]
   DataSource = DSource
   TabOrder = 0
   TitleFont.Charset = DEFAULT_CHARSET
   TitleFont.Color = clWindowText
   TitleFont.Height = -11
   TitleFont.Name = "MS Sans Serif"
   TitleFont.Style = []
   OnTitleClick = DBGridTitleClick
 end
 object Button1: TButton
   Left = 528
   Top = 8
   Width = 91
   Height = 25
   Anchors = [akTop, akRight]
   Caption = "Заполнение"
   TabOrder = 1
   OnClick = Button1Click
 end
 object Edit1: TEdit
   Left = 464
   Top = 10
   Width = 57
   Height = 21
   Anchors = [akTop, akRight]
   MaxLength = 7
   TabOrder = 2
   Text = "10000"
 end
 object DSet: TADODataSet
   Parameters = <>
   Left = 16
   Top = 88
   object DSetID: TIntegerField
     DisplayLabel = "Номер"
     FieldName = "ID"
   end
   object DSetName: TStringField
     DisplayLabel = "Имя"
     FieldName = "Name"
     Size = 30
   end
   object DSetFlSum: TFloatField
     DisplayLabel = "Сумма"
     FieldName = "FlSum"
   end
 end
 object DSource: TDataSource
   DataSet = DSet
   Left = 48
   Top = 88
 end
end


обрати внимание, весь код в основном впомагательный, всю "работу"/сортировку делает строка DSet.Sort:= Column.FieldName;
ну разве это не просто? проще по моему не бывает.



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

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

Наверх




Память: 0.5 MB
Время: 0.042 c
14-1128577811
MVVD
2005-10-06 09:50
2005.10.30
Принтер и быстродействие


1-1128196844
bva
2005-10-02 00:00
2005.10.30
Создание таблицы в Excel


14-1128679524
КаПиБаРа
2005-10-07 14:05
2005.10.30
Какие мысли вас посещают, когда


14-1128671022
Andry
2005-10-07 11:43
2005.10.30
Web-сервер


14-1128852460
jack128
2005-10-09 14:07
2005.10.30
Еще одна задачка на синтаксис :-)





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