/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 1127
от 20.04.2008, 20:05

Вопрос № 132.197

Здравствуйте! Подскажите как отсортировать данные в ListBox. Есть список такого вида, который нужно сортировать по номеру: (Символ номера + номер <далее пробел> и далее некоторые данные, не имеет значения какие) ----------------------- №1 12.12.05 Авб №2 12.12.05 Йцукен №4 12.12.05 Фывапр №3 12.12.05 Ячсмит ... №115 12.12.05 Qwerty №123 12.12.05 Asdfgh №116 12.12.05 Zxcvbn №117 12.12.05 Poiuyt ... и т.д. --------------------------- Стандартный способ или нагугленные процедуры сортируют так: №103 12.12.05 Asdfgh №1231 12.12.05 Zxcvbn №115 12.12.05 Zxcvbn №1151 12.12.05 Zxcvbn Получаемый список даже читать трудно. А нужно вот так (т.е. нормально по номеру все отсортировать, сверху вниз): №115 12.12.05 Zxcvbn №123 12.12.05 Asdfgh №1151 12.12.05 Zxcvbn №1231 12.12.05 Zxcvbn Подскажите какой-нибудь подходящий способ сортировки. Имею ввиду конкретную программу.

Отправлен: 14.04.2008, 20:02 Вопрос задал: Upgrader (статус: 7-ой класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Drbear Здравствуйте, Upgrader! При уникальных номерах попробуйте такую процедуру (в приложении). Использовался список строк: №1 12.12.05 Авб №500 12.12.05 Poiuyt №118 12.12.05 Poiuyt №1151 12.12.05 Йцукен №81 12.12.05 Poiuyt №4 12.12.05 Фывапр №67 12.12.05 Poiuyt №3 12.12.05 Ячсмит №115 12.12.05 Qwerty №47 12.12.05 Poiuyt №123 12.12.05 Asdfgh №1231 12.12.05 Asdfgh №5 12.12.05 Ячсмит №211 12.12.05 Poiuyt №116 12.12.05 Zxcvbn №6 12.12.05 Ячсмит №15 12.12.05 Poiuyt №117 12.12.05 Poiuyt №7 12.12.05 Ячсмит результат: №1 12.12.05 Авб №2 12.12.05 Йцукен №3 12.12.05 Ячсмит №4 12.12.05 Фывапр №5 12.12.05 Ячсмит №6 12.12.05 Ячсмит №7 12.12.05 Ячсмит №15 12.12.05 Poiuyt №47 12.12.05 Poiuyt №67 12.12.05 Poiuyt №81 12.12.05 Poiuyt №115 12.12.05 Qwerty №116 12.12.05 Zxcvbn №117 12.12.05 Poiuyt №118 12.12.05 Poiuyt №123 12.12.05 Asdfgh №211 12.12.05 Poiuyt №500 12.12.05 Poiuyt результат №1 12.12.05 Авб №3 12.12.05 Ячсмит №4 12.12.05 Фывапр №5 12.12.05 Ячсмит №6 12.12.05 Ячсмит №7 12.12.05 Ячсмит №15 12.12.05 Poiuyt №47 12.12.05 Poiuyt №67 12.12.05 Poiuyt №81 12.12.05 Poiuyt №115 12.12.05 Qwerty №116 12.12.05 Zxcvbn №117 12.12.05 Poiuyt №118 12.12.05 Poiuyt №123 12.12.05 Asdfgh №211 12.12.05 Poiuyt №500 12.12.05 Poiuyt №1151 12.12.05 Йцукен №1231 12.12.05 Asdfgh Надеюсь, помог Вам. Приложение: procedure obmen(var x, y: Integer); var t: Integer; begin t := x; x := y; y := t end; procedure TForm1.Button4Click(Sender: TObject); var iArr: Array of Integer; i, j: Integer; s: String; strl: TStringList; begin if ListBox3.Items.Count = 0 then Exit; SetLength(iArr, ListBox3.Items.Count); try for i := 0 to ListBox3.Items.Count - 1 do begin s := trim(copy( ListBox3.Items[i], pos('№', ListBox3.Items[i]) + 1, pos(' ', ListBox3.Items[i]) - pos('№', ListBox3.Items[i]))); iArr[i] := StrToInt(s); end; except ShowMessage('Неверное значение номера'); end; // сортировка вставками for j := 1 to length(iArr) - 1 do begin i := j; while iArr[i] < iArr[i - 1] do begin obmen(iArr[i], iArr[i - 1]); i := i - 1 end; end; strl := TStringList.Create; try strl.Clear; for i := 0 to length(iArr) - 1 do begin s := '№' + IntToStr(iArr[i]) + ' '; for j := 0 to ListBox3.Items.Count - 1 do if pos(s, ListBox3.Items[j]) > 0 then strl.Add(ListBox3.Items[j]); end; ListBox3.Items.Clear; for i := 0 to strl.Count - 1 do ListBox3.Items.Add(strl[i]); finally strl.Free; end; end;

Ответ отправил: Drbear (статус: 9-ый класс) Ответ отправлен: 14.04.2008, 21:09 Оценка за ответ: 4

Отвечает: PavelGM Здравствуйте, Upgrader! Можно предложить вот такой вариант. Но если список большой тогда его лучше сразу считывать в StringList, сортировать, а уже потом в ListBox. P.S. Если в одинаковых номерах нужна внутренняя сортировка по другим полям, то это можно реализовать там где result := 0 (т.е. при равенстве i1 и i2 учитывать дополнительные условия). Приложение: function LSCompare(List: TStringList; Index1, Index2: Integer): Integer; var i1, i2 : Integer; begin i1 := StrToInt(trim(copy(List[Index1], pos('¹', List[Index1]) + 1, pos(' ', List[Index1]) - pos('¹', List[Index1])))); i2 := StrToInt(trim(copy(List[Index2], pos('¹', List[Index2]) + 1, pos(' ', List[Index2]) - pos('¹', List[Index2])))); if i1 > i2 then Result := 1 else if i1 < i2 then Result := -1 else Result := 0; end; procedure TForm1.Button4Click(Sender: TObject); var LS : TStringList; begin LS := TStringList.Create; LS.Assign(LB.Items); LS.CustomSort(LSCompare); LB.Items.Assign(LS); LS.Free; end;

Ответ отправил: PavelGM (статус: Студент) Ответ отправлен: 16.04.2008, 10:26 Оценка за ответ: 5 Комментарий оценки: Спасибо, помогло! Как это оказывается просто можно сделать :) Наконец-то сортировка заработала нормально! Хотелось бы за ваш ответ поставить 10 :)

Вопрос № 132.220

Я пишу мр3-плеер на Delphi. Как реализовать регулятор громкости? За ранее спасибо.

Отправлен: 14.04.2008, 23:30 Вопрос задал: Бикметов Иршат Ринатович (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Лысенков Антон Анатольевич Здравствуйте, Бикметов Иршат Ринатович! 1. В приложении находится код который изменяет по щелчку на Button1 убавляет громкость наполовину не меняя общий системный уровень звука. 2. Если требуется менять общий уровень тогда так: procedure TForm1.TrackBar1Change(Sender: TObject); begin volume := 6500* (TrackBar1.Max - TrackBar1.Position); volume := volume + (volume shl 16); waveOutSetVolume(WAVE_MAPPER,volume); end; Приложение: uses MPlayer, MMSystem; const MCI_SETAUDIO = $0873; MCI_DGV_SETAUDIO_VOLUME = $4002; MCI_DGV_SETAUDIO_ITEM = $00800000; MCI_DGV_SETAUDIO_VALUE = $01000000; MCI_DGV_STATUS_VOLUME = $4019; type MCI_DGV_SETAUDIO_PARMS = record dwCallback: DWORD; dwItem: DWORD; dwValue: DWORD; dwOver: DWORD; lpstrAlgorithm: PChar; lpstrQuality: PChar; end; type MCI_STATUS_PARMS = record dwCallback: DWORD; dwReturn: DWORD; dwItem: DWORD; dwTrack: DWORD; end; procedure SetMPVolume(MP: TMediaPlayer; Volume: Integer); { Volume: 0 - 1000 } var p: MCI_DGV_SETAUDIO_PARMS; begin { Volume: 0 - 1000 } p.dwCallback := 0; p.dwItem := MCI_DGV_SETAUDIO_VOLUME; p.dwValue := Volume; p.dwOver := 0; p.lpstrAlgorithm := nil; p.lpstrQuality := nil; mciSendCommand(MP.DeviceID, MCI_SETAUDIO, MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM, Cardinal(@p)); end; function GetMPVolume(MP: TMediaPlayer): Integer; var p: MCI_STATUS_PARMS; begin p.dwCallback := 0; p.dwItem := MCI_DGV_STATUS_VOLUME; mciSendCommand(MP.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Cardinal(@p)); Result := p.dwReturn; { Volume: 0 - 1000 } end; // Example, Beispiel: procedure TForm1.Button1Click(Sender: TObject); begin SetMPVolume(MediaPlayer1, 500); end;

Ответ отправил: Лысенков Антон Анатольевич (статус: Студент) Ответ отправлен: 15.04.2008, 08:48

Отвечает: Gladiator Здравствуйте, Бикметов Иршат Ринатович! Вот один из способов реализации вашей задачи. Для этого необходим заголовочный файл AMixer.pas, который вы можете взять отсюда http://depositfiles.com/files/4754311. Приложение: uses ..., AMixer; type TPlayerForm = class(TForm) ImgVolume: TImage; ProgressBar1: TProgressBar; Panel2: TPanel; procedure FormCreate(Sender: TObject); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); private procedure SetImage(NameRes: string); procedure MixerLineChange(Sender: TObject; MixerH: HMixer; ID: Integer); procedure MixerControlChange(Sender: TObject; MixerH: HMixer; ID: Integer); public end; var PlayerForm: TPlayerForm; var SoundVolume: integer; MasterVolume: record Ar: integer; Br: integer; Cr: integer; end; Mixer: TAudioMixer; // Установить громкость procedure setVolume(const Value:integer); var MCD: TMixerControlDetails; Cntrl: PMixerControl; begin //Установка уровня звука with MasterVolume do Cntrl:=Mixer.Destinations[Br].Controls[Ar]; MCD.cbStruct:=SizeOf(TMixerControlDetails); MCD.dwControlID:=Cntrl.dwControlID; MCD.cChannels:=1; MCD.cMultipleItems:=0; MCD.cbDetails:=SizeOf(Integer); MCD.paDetails:=@Value; mixerSetControlDetails(Mixer.MixerHandle, @MCD, MIXER_GETCONTROLDETAILSF_VALUE); end; // Узнать уровень громкости function getVolume: integer; var MCD: TMixerControlDetails; Cntrl: PMixerControl; begin //Получение уровня звука with MasterVolume do Cntrl:=Mixer.Destinations[Br].Controls[Ar]; MCD.cbStruct:=SizeOf(TMixerControlDetails); MCD.dwControlID:=Cntrl.dwControlID; MCD.cChannels:=1; MCD.cMultipleItems:=0; MCD.cbDetails:=SizeOf(Integer); MCD.paDetails:=@Result; mixerGetControlDetails (Mixer.MixerHandle, @MCD, MIXER_GETCONTROLDETAILSF_VALUE); end; //Включить/выключить звук procedure setMute(const Value: boolean); begin with MasterVolume do Mixer.SetMute(Br, Cr, Value, MIXERCONTROL_CONTROLTYPE_MUTE); end; //Включен или выключен звук? function getMute: boolean; begin with MasterVolume do Mixer.GetMute(Br, Cr, Result, MIXERCONTROL_CONTROLTYPE_MUTE); end; procedure TPlayerForm.SetImage(NameRes: string); begin ImgVolume.Picture.Bitmap.Handle:=LoadBitmap(hInstance,PChar(NameRes)); end; procedure TPlayerForm.MixerLineChange(Sender: TObject; MixerH: HMixer; ID: Integer); begin if ID = -65536 then case getMute of TRUE : SetImage('NoVolume'); FALSE : SetImage('Volume'); end; end; procedure TPlayerForm.MixerControlChange(Sender: TObject; MixerH: HMixer; ID: Integer); begin if ID = 1 then begin ProgressBar1.Position := getVolume; Panel2.Caption:=IntToStr(Trunc(ProgressBar1.Position / 655.35))+' %'; end; end; procedure TPlayerForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); begin if SoundVolume > 65535 then begin SoundVolume:=65535; Exit; end; if SoundVolume < 0 then begin SoundVolume:=0; Exit; end; SoundVolume:=SoundVolume+Trunc(WheelDelta*6.55); ProgressBar1.Position:=SoundVolume; setVolume(ProgressBar1.Position); Panel2.Caption:=IntToStr(Trunc(ProgressBar1.Position / 655.35))+' %'; if ProgressBar1.Position = 0 then begin setMute(True); ImgVolume.Tag:=1; SetImage('NoVolume'); end else begin setMute(False); ImgVolume.Tag:=0; SetImage('Volume'); end; end; procedure TPlayerForm.FormCreate(Sender: TObject); begin ProgressBar1.Max := 65535; ProgressBar1.Position := 0; Mixer := TAudioMixer.Create (Self); if not Assigned(Mixer) then Exit; Mixer.OnLineChange := MixerLineChange; Mixer.OnControlChange := MixerControlChange; if Mixer.MixerCount>0 then begin MasterVolume.Ar := 0; MasterVolume.Br := 0; MasterVolume.Cr := -1; SoundVolume := ProgressBar1.Position := getVolume; if getMute then SetImage('NoVolume') else SetImage('Volume'); end; end;

Ответ отправил: Gladiator (статус: Студент) Ответ отправлен: 15.04.2008, 08:50

Отвечает: Genia007 Здравствуйте, Бикметов Иршат Ринатович! Попробуйте использовать следующий код: uses mmsystem; function GetWaveVolume: DWord; var Woc: TWAVEOUTCAPS; Volume: DWord; begin result := 0; if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then begin WaveOutGetVolume(WAVE_MAPPER, @Volume); Result := Volume; end; end; procedure SetWaveVolume(const AVolume: DWord); var Woc: TWAVEOUTCAPS; begin if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then WaveOutSetVolume(WAVE_MAPPER, AVolume); end; procedure TForm1.TrackBar1Change(Sender: TObject); var LeftVolume: Word; RightVolume: Word; begin LeftVolume := TrackBar1.Position; RightVolume := TrackBar2.Position; SetWaveVolume(MakeLong(LeftVolume, RightVolume)); end; procedure TForm1.TrackBar2Change(Sender: TObject); var LeftVolume: Word; RightVolume: Word; begin LeftVolume := TrackBar1.Position; RightVolume := TrackBar2.Position; SetWaveVolume(MakeLong(LeftVolume, RightVolume)); end; procedure TForm1.Button3Click(Sender: TObject); begin Caption := IntToStr(GetWaveVolume); end; Поставте трэкбары - максимум 50000, позицию в 25000.

Ответ отправил: Genia007 (статус: 7-ой класс) Ответ отправлен: 15.04.2008, 12:02

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 4.91 pre 5.0 RC1 от 13.04.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru