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

Вниз

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

 
Ivolg   (2003-07-20 11:46) [0]

Привет! Я Вано с зделал программу для пройгрывания музыки. Я не знаю какой код ме нужен для управления громкость с помошью Trackbar , Scrollbar. У меня Delphi 6.
ПОМОГИТЕ МНЕ ПОЖАЙЛУСТА я уже 2 месяца не могу найти такой код. Если у вас еть такой код просьба прислать мне на ящик в интернете: Vanototo@mail.ru
но если вы не можете прислать просто так этот код, давайте тогда обменяемся кодами. У меня есть код : закрытия и открытия дисковода есть код времени и код который
открывает любой файл с помощью свойства: Shellapi. БОЛЬШОЕ СПАСИБО!!!


 
Романов Р.В.   (2003-07-20 11:51) [1]

Увлечения / хобби
Программирование


Сборка программ из процедур :)))


 
Marser   (2003-07-20 11:57) [2]

В "Орешник"!!!


 
Immortal_Death   (2003-07-20 12:44) [3]

вот тебе от меня програмка управления громкостью... правда там баланс колонок оставляет желать лудьшего, может в 98(у меня ХР) и нормально было, а может и нет :), давно писано не помню... но громкость работает как надо, только-что проверил, все кампелируеться(у меня D7).


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
TrackBar1: TTrackBar;
TrackBar2: TTrackBar;
Label1: TLabel;
Label2: TLabel;
Image2: TImage;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure SetVolume(Left,Right:integer);
procedure GetVolume(var Left,Right:integer);
end;

var
Form1: TForm1;

implementation

uses MMSystem;

{$R *.DFM}

procedure TForm1.SetVolume(Left,Right:integer);
var
SetLeft,SetRight,Volume:integer;
begin
if (ABS(Left) <=100)and(ABS(Right) <=100) then
begin
SetLeft:=Trunc(65535*Left/100);
SetRight:=Trunc(65535*Right/100);
Volume:=SetLeft+65536*SetRight;
WaveOutSetVolume(0,Volume);
end;
end;

procedure TForm1.GetVolume(var Left,Right:integer);
var
Volume:real;
Vol:integer;
GetLeft,GetRight:real;
begin
WaveOutGetVolume(0,@Vol);
if Vol < 0 then Volume:=exp(32*ln(2))+Vol
else Volume:=Vol;
GetLeft:=Trunc(Volume/65536);
GetRight:=Volume-GetLeft*65536;
Left:=Trunc(GetLeft*100/65536);
Right:=Trunc(GetRight*100/65536);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
Left,Right:integer;
Volume,Balance:integer;
begin
GetVolume(Left,Right);
Balance:=Trunc((Left-Right)/12);
if Balance <0 then Volume:=-Right
else Volume:=-Left;
form1.TrackBar1.Position := Volume;
form1.TrackBar2.Position := Balance;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
var
Volume,Balance:integer;
Left,Right:integer;
begin
Volume:= form1.TrackBar1.Position;
Balance:= form1.TrackBar2.Position;
if Balance >0 then
begin
Right:=Volume;
Left:=Volume+Balance*12;
end;
if Balance <0 then
begin
Left:=Volume;
Right:=Volume-Balance*12;
end;
if Balance = 0 then
begin
Right:=Volume;
Left:=Volume;
end;
if Right >0 then Right:=0;
if Left >0 then Left:=0;
Right:=-Right;
Left:=-Left;
SetVolume(Left,Right);
end;

end.


Во втором TrackBar-е событию OnChenge привоишь событие OnChange первого TrackBar-а.


 
alxx   (2003-07-20 14:21) [4]

Музыка-то проигрывается через TMediaPlayer наверное? :-)


 
SergP   (2003-07-20 14:29) [5]


> У меня есть код : закрытия и открытия дисковода есть код
> времени ...


Это как?


 
Ivolg   (2003-07-20 15:28) [6]

вот они обещанные коды: для времени
просто ставишь на форму label и timer
нажимаешь на таймер 2 раза и вставляешь этот
код:Label1.caption := TimeToStr(Now);
для дисковода:ставишь на форму две кнопки
на одну из них нажми 2 раза потом вставь код: mciSendString("Set cdaudio door open wait", nil, 0, handle);
это для открытия.Теперь для закрытия на вторую нажми 2 раза потом вставь код:
mciSendString("Set cdaudio door closed wait", nil, 0, handle);
потом вставь в uses:MMSystem,
это всё ра ботает нормально.


 
Kair   (2003-07-20 15:44) [7]


> Ivolg ©


Подозрительный ты какой-то... :?


 
Marconi   (2003-07-20 15:50) [8]

точно в орешник


 
Palladin   (2003-07-20 16:07) [9]

походу опять разводят


 
Kair   (2003-07-20 16:15) [10]

А почему "Орешник", а не "Арбузник"?


 
SergP   (2003-07-20 16:27) [11]

Код времени - как круто названо..... :)

Кстати ни у кого нет кода открывающего и закрывающего FDD? :)


 
Anatoly Podgoretsky   (2003-07-20 17:00) [12]

Kair © (20.07.03 16:15)
В арбузе семечки, а тут орехи


 
zzet   (2003-07-20 17:13) [13]

А может у тебя есть и код как иконку в трей спрятать!!??


 
SPeller   (2003-07-20 17:47) [14]

Да уж, бывают же орехи!
:-)))


 
ferrik   (2003-07-20 18:15) [15]

Приколисты может на сайте завелись?


 
SergP   (2003-07-20 20:24) [16]

Может это Князь Мышкин снова балуется?


 
Marser   (2003-07-20 22:05) [17]


> Может это Князь Мышкин снова балуется?

Не-а, ***t в тематические форумы не захаживает.
> Kair © (20.07.03 16:15)
> А почему "Орешник", а не "Арбузник"?

На "Королевстве Делфи" есть королевская клюква. А это, так сказать, местный аналог. :-))



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

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

Наверх





Память: 0.48 MB
Время: 0.008 c
14-20666
Rouse_
2003-07-21 01:41
2003.08.07
Мастера улыбаются - 4


14-20701
Воробьёв
2003-07-22 13:14
2003.08.07
MPEG-4


14-20691
VJack
2003-07-23 11:28
2003.08.07
Компоненты шифрования


3-20424
Nevermind
2003-07-16 17:24
2003.08.07
IXMLNode


14-20674
Igit
2003-07-22 21:48
2003.08.07
Защита программ Delphi





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