Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Мультимедиа
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 24.03.2010, 15:34
tehnik tehnik вне форума
Прохожий
 
Регистрация: 24.03.2010
Сообщения: 0
Репутация: 10
По умолчанию Проигрыватель на Delphi

Доброго времени суток! Такой вопрос написал программу проигрыватель на Delphi с показом изображения при воспроизведении, но изображение показывается только один раз. А как можно сделать чтобы изображение циклировалось пока воспроизводится файл музыки.
Вот листинг программы:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
unit MainUnit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MPlayer, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    MediaPlayer1: TMediaPlayer;
    Panel1: TPanel;
    Image1: TImage;
    Timer1: TTimer;
    ColorDialog1: TColorDialog;
    ColorDialog2: TColorDialog;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MediaPlayer1Notify(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
 
 
  private
    { Private declarations }
  public
  procedure RandomCells;
  function NumOfCells(x,y:integer):integer;
  procedure DrawCells;
  end;
const
  XSize=40;
  YSize=25;
type
  TLifeCells=array [0..XSize - 1, 0.. YSize -1] of boolean;
var
  Form1: TForm1;
  A: TLifeCells;{ Public declarations }
 
implementation
 
uses Unit2, Unit3;
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
{if OpenDialog1.Execute then
    begin
    MediaPlayer1.FileName:=OpenDialog1.FileName;
    MediaPlayer1.Open;
    MediaPlayer1.DisplayRect:=Rect(0,0,Panel1.Width, Panel1.Height);
    MediaPlayer1.Play;
    if ExtractFileExt(MediaPlayer1.FileName)='.avi' then Image1.Visible:=false
    else begin
    image1.Visible:=true;
    randomcells;
    Timer1.Enabled:=true;
    end;
    end;}
end;
 
procedure TForm1.DrawCells;
var i,j:integer;
begin
with Form1.Image1.Canvas do
  begin
  Brush.Color:=Form1.ColorDialog1.Color;
  Pen.Color:=Brush.Color;
  Rectangle(0,0,XSize*10,YSize*10);
  Brush.Color:=Form1.ColorDialog2.Color;
  for i:=0 to Xsize-1 do
  for j:=0 to Ysize-1 do
  if A[i,j] then rectangle (i*10, j*10, i*10+10, j*10+10);
  end;
end;
 
function TForm1.NumOfCells(x, y: integer): integer;
var i,j,xx,yy:integer;
begin
result:=0;
for i:=-1 to 1 do
begin
  for j:=-1 to 1 do
    begin
    xx:=x+i;yy:=y+j;
    if xx=-1 then xx:=XSize-1;
    if yy=-1 then yy:=YSize-1;
    if xx=Xsize then xx:=0;
    if yy=Ysize then yy:=0;
    if A[xx,yy] then inc(Result);
    end;
  if A[x,y] then dec(Result);
end;
end;
 
procedure TForm1.RandomCells;
var i,j:integer;
begin
for i:=0 to XSize-1 do
  for j:=0 to YSize-1 do
    A[i,j]:=random<0.5;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var i,j: integer;
B:TLifeCells;
begin
for i:=0 to Xsize-1 do
for j:=0 to Ysize-1 do
case NumOfCells(i,j) of
2:B[i,j]:=A[i,j];
3:B[i,j]:=true;
else B[i,j]:=false;
end;
A:=B;
DrawCells;
 
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
{if MessageDlg('Изменить цвета?', mtConfirmation, [mbYes, mbNo],0)=mrNo then exit;
if form1.ColorDialog1.Execute then panel1.Color:=Colordialog1.Color;
MessageDlg('Теперь измените цвет клеток', mtInformation, [mbOk],0);
ColorDialog2.Execute;
DrawCells; }
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 Randomize;
 RandomCells;
end;
 
procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
if form2.SpeedButton5.Down then
with Form1.MediaPlayer1 do
if NotifyValue=nvSuccessful then
begin
Notify:=true;
Play;
end;
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Form3.SpeedButton1.Down then
A[X div 10, Y div 10] := not A[X div 10, Y div 10];
Form1.DrawCells;
end;
 
end.
Admin: Пользуемся тегами!

Подскажите пожалуйста!
Очень нужно.

Последний раз редактировалось Admin, 24.03.2010 в 15:42.
Ответить с цитированием
  #2  
Старый 24.03.2010, 17:17
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,096
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Делаешь список изображений. Далее, если в списке счетчик дошел до конца, то переключаешь на первое изображение.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 12:24.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025