|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Проигрыватель на Delphi
Доброго времени суток! Такой вопрос написал программу проигрыватель на Delphi с показом изображения при воспроизведении, но изображение показывается только один раз. А как можно сделать чтобы изображение циклировалось пока воспроизводится файл музыки.
Вот листинг программы: Код:
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, 24.03.2010 в 15:42. |
#2
|
|||
|
|||
Делаешь список изображений. Далее, если в списке счетчик дошел до конца, то переключаешь на первое изображение.
|