Ответ нагуглил. Code: 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; Но не устраивает 1) Список в StringGrid берется не с 0 а с 1 строки. Т.к. при сортировке 0 строка остается на том же месте 2) Сортировка происходит по типу 1 14 2 23 3 и т.д., а мне надо чтобы числа шли по очереди 1 2 3 14 23
Сделайте все циклы не с 1, а с 0 Переводите строку в число (а в вашем случае строку во время), а потом уже сравнивайте
Как сделать так чтобы текст который введен в едит отображался в названии формы в средине старого названия? Form1.Caption:='Privet mir Edit1 -eto ya' примерно так только вместо едит1то что мы ввели в едит1.текст
PHP: Form1.Caption := 'Я лошара,'+Edit1.Text+' который нифига не знает о программировании...'; Вот как-то так.
Если сделать циклы с 0 то будет ошибку выдавать что мол невозможно начать с -1 позиции. Ну циклы переделал все норм. Но как в TStringList засунуть значения в Integer или в формате времени в их прямом типе... Ведь как их не суй все равно надо преобразовывать в String) И сортировка не измениться.
а что мешает использовать TList вместо TStringList? самое простое, что можно придумать в качестве примера: Code: function SortDate(Item1, Item2: Pointer): Integer; begin if PDateTime(Item1)^ < PDateTime(Item2)^ then Result:= -1 else if PDateTime(Item1)^ > PDateTime(Item2)^ then Result:= 1 else Result:= 0; end; procedure TMForm.BtnClick(Sender: TObject); var L: TList; i: Integer; pTime: PDateTime; begin L:= TList.Create; try new(pTime); pTime^:= StrToTime('00:25:35'); L.Add(pTime); new(pTime); pTime^:= StrToTime('03:55:35'); L.Add(pTime); new(pTime); pTime^:= StrToTime('02:25:45'); L.Add(pTime); new(pTime); pTime^:= StrToTime('14:23:35'); L.Add(pTime); new(pTime); pTime^:= StrToTime('01:55:45'); L.Add(pTime); new(pTime); pTime^:= StrToTime('10:25:35'); L.Add(pTime); new(pTime); pTime^:= StrToTime('03:55:37'); L.Add(pTime); new(pTime); pTime^:= StrToTime('12:45:55'); L.Add(pTime); new(pTime); pTime^:= StrToTime('14:23:35'); L.Add(pTime); new(pTime); pTime^:= StrToTime('01:25:45'); L.Add(pTime); L.Sort(SortDate); for i:= 0 to L.Count - 1 do begin StringGrid1.Rows[i+1].ValueFromIndex[0]:= TimeToStr(PDateTime(L.Items[i])^); Dispose(L.Items[i]); end; finally L.Free; end; end; ну и результат сортировки выглядит так:00:25:35 01:25:45 01:55:45 02:25:45 03:55:35 03:55:37 10:25:35 12:45:55 14:23:35 14:23:35
в Delphi 2009+ є TList<T>... Code: uses Generics.Collections; var YourList: TList<TYourTipe>; begin YourList:=TList<TYourTipe>.Create; YourList.Add(YourData); ... для використання TList<T>.Sort потрібно вказати функцію для сортування (Comparer) а взагалі якось тупо це все виглядає... може краще писати не ’час до’ а просто ’час події’ і посортувати за ним, а ’час до’ розраховувати перед виведенням?
Подскажите по предыдущим подсказкам написал процедуру. В общем есть StringGrid в котором 3 столбца. Первый из них фиксированный. Остальные начиная с 0 все редактируемые. 1) Время когда необходимо произвести звонок в формате чч:мм:сс 2) Имя Предмета 3) Время оставшееся до звонка в формате чч:мм:сс Необходимо сделать сортировку по 3 колонке. К примеру в 3 колонке 8 строк. 1) 0:23:31 2) 34:22:12 3) 2:35:3 4) 12:43:33 5) 23:31:44 6) 0:23:38 7) 3:25:18 8) 0:23:4 Задача расположить их в таком порядке 1) 0:23:4 2) 0:23:31 3) 0:23:38 4) 2:35:3 5) 3:25:18 6) 12:43:33 7) 23:31:44 8) 34:22:12 Так же в 3 колонке может ничего не быть на некоторых полях. Такие строки необходимо поставить в самый конец. Code: function SortDate(Item1, Item2: Pointer): Integer; begin if PDateTime(Item1)^ < PDateTime(Item2)^ then Result:= -1 else if PDateTime(Item1)^ > PDateTime(Item2)^ then Result:= 1 else Result:= 0; end; procedure SortStringGrid(var GenStrGrid: TStringGrid; ThatCol: Integer); var CountItem, i, J: integer; MyList: TList; pTime: PDateTime; begin // Give the number of rows in the StringGrid CountItem := GenStrGrid.RowCount; //Create the List MyList := TList.Create; try begin for J := 0 to (CountItem - 1) do begin if GenStrGrid.Rows[J+1].Strings[ThatCol]<>'' then begin new(pTime); pTime^:= StrToTime(GenStrGrid.Rows[J+1].Strings[ThatCol]); MyList.Add(pTime); end; end; //Sort the List Mylist.Sort(SortDate); // Refill the StringGrid for i:= 0 to MyList.Count - 1 do begin GenStrGrid.Rows[i+1].ValueFromIndex[ThatCol]:= TimeToStr(PDateTime(MyList.Items[i])^); Dispose(MyList.Items[i]); end; end; finally //Free the List MyList.Free; end; end; Почти все хорошо кроме 1) Сортировка происходит не с 0 поля а с 1. 2) Непонятно откуда береться знак = перед временем в 3 столбце 3) При сортировке сортируется только 3 столбец. А мне необходимо чтобы с сортировкой 3 столбца перемещались и первые 2.
cardons, исходя что данных не слишком много, то я бы сделал как то так: Code: // объявил свою структуру вида: PMyItem = ^TMyItem; TMyItem = record PredName: String; Time1: TTime; Time2: TTime; end; // функция сортировки тогда выглядела бы так: function SortDate(Item1, Item2: Pointer): Integer; begin if PMyItem(Item1)^.Time2 < PMyItem(Item2)^.Time2 then Result:= -1 else if PMyItem(Item1)^.Time2 > PMyItem(Item2)^.Time2 then Result:= 1 else Result:= 0; end; // ну и сам пример procedure TMForm.Button1Click(Sender: TObject); var L: TList; i: Integer; pTime: PMyItem; begin L:= TList.Create; try new(pTime); pTime^.PredName:= 'математика'; pTime^.Time1:= StrToTime('01:55:45'); pTime^.Time2:= StrToTime('00:23:31'); L.Add(pTime); new(pTime); pTime^.PredName:= 'история'; pTime^.Time1:= StrToTime('01:55:45'); pTime^.Time2:= StrToTime('14:22:12'); L.Add(pTime); new(pTime); pTime^.PredName:= 'химия'; pTime^.Time1:= StrToTime('01:55:45'); pTime^.Time2:= StrToTime('2:35:3'); L.Add(pTime); new(pTime); pTime^.PredName:= 'русский язык'; pTime^.Time1:= StrToTime('01:55:45'); pTime^.Time2:= StrToTime('12:43:33'); L.Add(pTime); new(pTime); pTime^.PredName:= 'математика'; pTime^.Time1:= StrToTime('01:55:45'); pTime^.Time2:= StrToTime('23:31:44'); L.Add(pTime); new(pTime); pTime^.PredName:= 'информатика'; pTime^.Time1:= StrToTime('01:55:45'); pTime^.Time2:= StrToTime('0:23:38'); L.Add(pTime); new(pTime); pTime^.PredName:= 'история'; pTime^.Time1:= StrToTime('01:55:45'); pTime^.Time2:= StrToTime('3:25:18'); L.Add(pTime); new(pTime); pTime^.PredName:= 'химия'; pTime^.Time1:= StrToTime('01:55:45'); pTime^.Time2:= StrToTime('0:23:4'); L.Add(pTime); L.Sort(SortDate); for i:= 0 to L.Count - 1 do begin StringGrid1.Rows[i].Strings[0]:= TimeToStr(PMyItem(L.Items[i])^.Time1); StringGrid1.Rows[i].Strings[1]:= PMyItem(L.Items[i])^.PredName; StringGrid1.Rows[i].Strings[2]:= TimeToStr(PMyItem(L.Items[i])^.Time2); Dispose(L.Items[i]); end; finally L.Free; end; end; ps равно вставляется при использовании ValueFromIndex и еще одно, если планируется использовать формат времени превышающий значения 23:59:59 (к примеру как указано выше "34:22:12"), то придется переписать функцию конвертации строки в TTime
если все даніе в таблице то можна так: только у меня первій столбец біл номером потому і не сортируетса... Code: procedure SortStringGrid(Grid: TStringGrid; const ACell: Integer; UpToDown: Boolean=false); overload; procedure TMainForm.SortStringGrid(Grid:TStringGrid; const ACell: Integer; UpToDown: Boolean); procedure obmin(const i1, i2, CollMax: Integer); var s: string; begin with Grid do begin S:=Rows[i1].Text; Rows[i1].Text:=Rows[i2].Text; Rows[i2].Text:=s; end; end; var I: Integer; J: Integer; CollMax:integer; begin with Grid do begin CollMax:=ColCount-1; if UpToDown then for I := 1 to RowCount - 1 do for J := I + 1 to RowCount - 1 do if Cells[ACell, I] < Cells[ACell, J] then obmin(I, J, CollMax) else else for I := 1 to RowCount - 1 do for J := I + 1 to RowCount - 1 do if Cells[ACell, I] > Cells[ACell, J] then obmin(I, J, CollMax); end; end; пример: Code: SortStringGrid(StringGrid1,2);
Спасибо очень помогли. Сделал все сортирует хорошо. Но есть несколько проблем. Вот код малоли кому понадобиться Code: function SortDate(Item1, Item2: Pointer): Integer; begin if PMyItem(Item1)^.Time2 < PMyItem(Item2)^.Time2 then Result:= -1 else if PMyItem(Item1)^.Time2 > PMyItem(Item2)^.Time2 then Result:= 1 else Result:= 0; end; procedure SortStringGrid(var GenStrGrid: TStringGrid); var L: TList; i,d,s: Integer; pTime: PMyItem; begin s:=GenStrGrid.RowCount; L:= TList.Create; try for d:= 0 to s - 1 do begin new(pTime); pTime^.PredName:= GenStrGrid.Cells[1,d]; if GenStrGrid.Cells[0,d]<>'' then pTime^.Time1:= StrToTime(GenStrGrid.Cells[0,d]) else pTime^.Time1:= StrToTime('23:59:59'); if GenStrGrid.Cells[2,d]<>'' then pTime^.Time2:= StrToTime(GenStrGrid.Cells[2,d]) else pTime^.Time2:= StrToTime('23:59:59'); L.Add(pTime); end; L.Sort(SortDate); for i:= 0 to L.Count - 1 do begin GenStrGrid.Rows[i].Strings[0]:= TimeToStr(PMyItem(L.Items[i])^.Time1); GenStrGrid.Rows[i].Strings[1]:= PMyItem(L.Items[i])^.PredName; GenStrGrid.Rows[i].Strings[2]:= TimeToStr(PMyItem(L.Items[i])^.Time2); Dispose(L.Items[i]); end; finally L.Free; end; end; 1) В колонке 0 и 2 может время не стоять напротив предмета. Я это решил с помощью добавления времени им 23:59:59 но как понимаете это не выход из положения. Хотелось бы чтобы они просто добавлялись в самый конец StringGrid'a с теми же пустыми строками. 2) Если 2 и более предмета в одно и тоже время то они постоянно скачут по StringGrid'у между собой т.к. сортировка происходит каждую секунду хотелось бы чтобы этого не было. Чтобы на своих местах стояли постоянно а не скакали между собой.
Code: //структурка для записи PMyItem = ^TMyItem; TMyItem = record index: Integer; PredName: String; Time1: TTime; Time2: TTime; end; // функция сортировки function SortDate(Item1, Item2: Pointer): Integer; begin // если оба параметра равны if (PMyItem(Item1)^.Time2 = PMyItem(Item2)^.Time2) then begin // то сортируем по индексу, что бы не прыгало if PMyItem(Item1)^.index < PMyItem(Item2)^.index then Result:= -1 else if PMyItem(Item1)^.index > PMyItem(Item2)^.index then Result:= 1 else Result:= 0; Exit; end; if (PMyItem(Item1)^.Time2 = -1) or (PMyItem(Item2)^.Time2 = -1) then begin if (PMyItem(Item1)^.Time2 = -1) then Result:= 1 else Result:= -1; Exit; end; if PMyItem(Item1)^.Time2 < PMyItem(Item2)^.Time2 then Result:= -1 else if PMyItem(Item1)^.Time2 > PMyItem(Item2)^.Time2 then Result:= 1 else Result:= 0; end; // если строка пустая то выставляем -1 function GetTimeStr(S: String): TDateTime; begin if (S <> '') then Result:= StrToTime(S) else Result:= -1; end; // если значение времени -1, то возвращаем пустую строку function GetStrTime(E: Extended): String; begin if (E <> -1) then Result:= TimeToStr(E) else Result:= ''; end; // сортировка procedure TMForm.bmSortClick(Sender: TObject); var L: TList; i: Integer; pTime: PMyItem; begin L:= TList.Create; try // заполняем список for i:= 0 to StringGrid1.RowCount - 1 do begin new(pTime); pTime^.index:= i; pTime^.Time1:= GetTimeStr(StringGrid1.Rows[i].Strings[0]); pTime^.PredName:= StringGrid1.Rows[i].Strings[1]; pTime^.Time2:= GetTimeStr(StringGrid1.Rows[i].Strings[2]); L.Add(pTime); end; // сортировка L.Sort(SortDate); // выводим результат for i:= 0 to L.Count - 1 do begin StringGrid1.Rows[i].Strings[0]:= GetStrTime(PMyItem(L.Items[i])^.Time1); StringGrid1.Rows[i].Strings[1]:= PMyItem(L.Items[i])^.PredName; StringGrid1.Rows[i].Strings[2]:= GetStrTime(PMyItem(L.Items[i])^.Time2); Dispose(L.Items[i]); end; finally L.Free; end; end; вот пример, вроде все условия выполняются =)
1) Ну может быть поле когда предмет и через сколько он будет может быть пустыми то есть ' ' :Химия: ' ' Вот хотелось бы чтобы они добавлялись в самый конец. Сейчас я сделал для того чтобы они добавлялись в TList без ошибки пришло установить этим пустым поля значения 23:59:59. 2) У вас не скачет потому что похоже вы 1 раз их добавили и все. А у меня формирование этого списка и сортировка происходит каждую секунду. Из-за чего 2 и более предмета с одним и тем же временем скачут между собой.
у мене можно добавлять предмети в конец списка и они посортируютса... а если єти даніе нужні не только на форме то если у тебе Delphi 2009+ то могу написать пример
Огромное спасибо! Пашет все на ура. Осталось только решить проблему со скачущими строками где время одинаково.
у мене можно добавлять предмети в конец списка и они посортируютса... а если єти даніе нужні не только на форме то если у тебе Delphi 2009+ то могу написать пример Code: ПС структура такая да? я не читал все коменті... TSortItem = record ACaption: string; //названия предмета ATime: TTime; //время собітия TimeLeft: TTime; //время до собітия end; только.... может нафиг TimeLeft? сортировку по ATime, а ’время до’ исчислять перед віводом на форму?
она решается легко, немного неправильно сделал сортировку надо так: Code: // функция сортировки function SortDate(Item1, Item2: Pointer): Integer; begin // если оба параметра равны if (PMyItem(Item1)^.Time2 = PMyItem(Item2)^.Time2) then begin // то сортируем по индексу, что бы не прыгало if PMyItem(Item1)^.index < PMyItem(Item2)^.index then Result:= -1 else if PMyItem(Item1)^.index > PMyItem(Item2)^.index then Result:= 1 else Result:= 0; Exit; end; if (PMyItem(Item1)^.Time2 = -1) or (PMyItem(Item2)^.Time2 = -1) then begin if (PMyItem(Item1)^.Time2 = -1) then Result:= 1 else Result:= -1; Exit; end; if PMyItem(Item1)^.Time2 < PMyItem(Item2)^.Time2 then Result:= -1 else if PMyItem(Item1)^.Time2 > PMyItem(Item2)^.Time2 then Result:= 1 else Result:= 0; end;
fd00ch, спагетти не спагетти-код, каждый пишет в том стиле, который ему более удобен к восприятию, и твое решение тоже не идеальное, оно примерно в 4 раза медленнее, так что компактность написания еще ничего не значит, это первое; а второе я никому не обязан писать оптимальный код, я лишь показал один из вариантов, дальше дело за спрашивающим - использовать\не использовать\оптимизировать или нет...
проблема с добавлением программы в автозапуск на Windows 7. Код: var reg:=TRegistry; begin reg:=TRegistry.Create; Reg.RootKey:=HKEY_CURRENT_USER; reg.OpenKey('Software',True); reg.OpenKey('Microsoft',True); reg.OpenKey('Windows',True); reg.OpenKey('CurrentVersion',True); reg.OpenKey('Run',True); reg.WriteString('MySoft','"'+Application.Exename+'"'); reg.Free; end; Также проблема с закрытием Пуска, почему-то панель задач закрывается, а сама кнопка пуска стоит и работает не пойму почему, код: var hTaskBar : THandle; begin hTaskbar := FindWindow('Shell_TrayWnd', Nil); ShowWindow(hTaskBar, SW_HIDE); end; И проблема с тем, что не могу заблокировать сочетание клавиш CTRL+ALT+DELETE (диспетчер задач), все равно работает, использую код: var b:=boolean; begin b:=false; SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@b,0) ; end; Может кто помочь с этим?
