Delphi7, repeat sounds using Tmediaplayer - delphi

i am using delphi7. I want put a song in my program, but i don't want it to end never. I tried using a timer, but it didn't play the music:
procedure TForm1.FormCreate(Sender: TObject);
begin
timer1.enabled:=true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var playsound,destination:string;
begin
destination:=paramstr(0);
playsound:=extractfilepath(destination)+'Soundtrack\play.wma';
mediaplayer1.FileName:=playsound;
mediaplayer1.Open;
mediaplayer1.Play; //USING TMEDIAPLAYER
end;
There are no syntax errors in this code, however the song is not running, perhaps the timer is not for that job. How should i do it? Thanks

The TMediaPlayer is a control, so you should naturally not use it unless you want precisely its GUI.
If you only want to play a audio file repeatedly, use the PlaySound function in MMSystem.pas:
PlaySound('test.wav', 0, SND_FILENAME or SND_NODEFAULT or SND_ASYNC or SND_LOOP)

Don't use a timer for this. Use the TMediaPlayer.OnNotify event instead:
procedure TForm1.FormCreate(Sender: TObject);
begin
mediaplayer1.FileName := extractfilepath(paramstr(0))+'Soundtrack\play.wma';
mediaplayer1.Notify := true;
mediaplayer1.Wait := false;
mediaplayer1.Open;
end;
procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
case mediaplayer1.Mode of
mpOpen, mpStopped: begin
if mediaplayer1.Error = 0 then begin
mediaplayer1.Notify := true;
mediaplayer1.Wait := false;
mediaplayer1.Play;
end;
end;
end;
end;

Related

Delayed execution in Delphi

Is it possible to start procedure delayed after the calling procedure will end?
procedure StartLoop;
begin
DoSomething;
end;
procedure FormCreate(...);
begin
if ParamStr(1)='start' then StartLoop;
end;
StartLoop will be called inside FormCreate, and FormCreate will be waiting, and block further execution not only the of FormCreate itself, but also further procedures executing after it (FormShow, etc.), and form will not show until StartLoop will end.
I need to wait until FormCreate will end, and run StartLoop after that (without using threads).
If you are using 10.2 Tokyo or later, you can use TThread.ForceQueue():
procedure TMyForm.FormCreate(Sender: TObject);
begin
if ParamStr(1) = 'start' then
TThread.ForceQueue(nil, StartLoop);
end;
Otherwise, you can use PostMessage() instead:
const
WM_STARTLOOP = WM_USER + 1;
procedure TMyForm.FormCreate(Sender: TObject);
begin
if ParamStr(1) = 'start' then
PostMessage(Handle, WM_STARTLOOP, 0, 0);
end;
procedure TMyForm.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_STARTLOOP then
StartLoop
else
inherited;
end;
The simplest way is using timer.
Let you create DelayTimer with needed period set and Enabled = False on the form in design time (you can also create it dynamically). Assign event handler for it:
procedure TFormXX.DelayTimerTimer(Sender: TObject);
begin
DelayTimer.Enabled := False; // works only once
StartLoop;
end;
in the form intialization routine start this timer:
procedure FormCreate(...);
begin
if ParamStr(1)='start' then
DelayTimer.Enabled := True;
end;
Perhaps you want to start the timer later, for example - in the OnShow, if your application performs some continuous actions during creation.
AN other solution could be wrapping your DoSomething method into a Task:
uses
System.Threading;
procedure TForm2.DoSomething;
begin
Sleep(2000);
Caption := 'Done';
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
if ParamStr(1) = 'start' then
TTask.Run(
procedure
begin
DoSomething
end);
end;

no refreshing FMX Controls

I have simple fmx form(Delphi 10.2 Tokyo):
in code I show Button2 for second:
procedure TForm6.FormCreate(Sender: TObject);
begin
Button2.Visible :=false;
end;
procedure TForm6.Button1Click(Sender: TObject);
begin
Button2.Visible := true;
TTask.Create(procedure
begin
Sleep(1000);
TThread.Synchronize(nil, procedure
begin
Button2.Visible := false;
//tries
//Button2.Repaint;
//Layout1.Repaint;
//Self.InvalidateRect(Self.Bounds);
//Application.ProcessMessages;
end);
end).Start;
end;
but after button2 hides, artefact appears. Its gone after manually form resize.
How to force it to refresh?
You need to use
ShadowEfect1.UpdateParentEffects;

Occasional stuck splash screen (win 7 embedded)

I have an application that restores windows on startup but this results in a potential flicker as each window is created and positioned.
To get around this I have the splash screen (stretched to the full size of the screen) set to "StayOnTop" and close it after the OnShow event using a TTask. The problem is that occasionally the splash screen gets stuck. If you click where buttons should be they redraw and show correctly.
I have tried to "invalidate" all WinControls but this problem still shows up.
I have never seen the problem in the debugger.
Are there any other tricks anyone can suggest to forcing a full repaint of the screen?
Here is my code to close the splash - This is in the OnShow of the main form.
aTask := TTask.Create(procedure()
begin
Sleep(800);
TThread.Synchronize(nil, procedure()
begin
fSplash.Close;
FreeAndNil(fSplash);
DoInvalidate(self);
end);
end);
aTask.Start;
Here is my attempt to invalidate everything...
Procedure DoInvalidate( aWinControl: TWInControl );
var
i: Integer;
ctrl: TControl;
begin
for i:= 0 to aWinControl.Controlcount-1 do
begin
ctrl:= aWinControl.Controls[i];
if ctrl Is TWinControl then
DoInvalidate( TWincontrol( ctrl ));
end;
aWinControl.Invalidate;
end;
Martin
You don't need to recursively invalidate everything, just invalidating the Form itself is sufficient.
If you upgrade to 10.2 Tokyo, you can now use TThread.ForceQueue() instead of TThread.Synchronize() in a TTask:
procedure TMainForm.FormShow(Sender: TObject);
begin
TThread.ForceQueue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end
);
end;
If you stick with TTask, you should at least use TThread.Queue() instead:
procedure TMainForm.FormShow(Sender: TObject);
begin
TTask.Create(procedure
begin
TThread.Queue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end;
end
).Start;
end;
Or, you could just use a short TTimer, like zdzichs suggested:
procedure TMainForm.FormShow(Sender: TObject);
begin
Timer1.Enabled := True;
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
FreeAndNil(fSplash);
Invalidate;
end;
Or, you could assign an OnClose event handler to the splash form to invalidate the MainForm, and then PostMessage() a WM_CLOSE message to the splash form:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnClose := SplashClosed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
PostMessage(fSplash.Handle, WM_CLOSE, 0, 0);
end;
procedure TMainForm.SplashClosed(Sender: TObject; var Action: TCloseAction);
begin
fSplash := nil;
Action := caFree;
Invalidate;
end;
Or, use the OnDestroy event instead:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnDestroy := SplashDestroyed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
fSplash.Release; // <-- delayed free
end;
procedure TMainForm.SplashDestroyed(Sender: TObject);
begin
fSplash := nil;
Invalidate;
end;

How to capture and save to file from webcam using DSPack and Delphi 5

right now I'm trying to make a program using Delphi 5 to take a photo from webcam.
I'm using delphi 5 and DSPack 2.3.1 because many people suggest it, and yes this is my first time programming multimedia with delphi.
I've been able to list and add camera that connect to my computer dynamically. I'm also able to display what the webcam "see", opening a video and capture it.
But now I can't capture a picture from the webcam.
I have a TImage which I named "Image", to check the picture is captured or not. When I use my code to open a video and capture it, it displayed in the TImage. But when I try to capture a webcam, it's just blank and not capturing anything. The file I saved also blank.
Could someone check which part of my code goes wrong?
Thanks before...
here's part of my code
var SysDev: TSysDevEnum;
FotoBitmap: TBitmap;
implementation
{$R *.DFM}
procedure Form1.FormCreate(Sender: TObject);
var
i: integer;
Device: TMenuItem;
begin
SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
if SysDev.CountFilters > 0 then
for i := 0 to SysDev.CountFilters - 1 do
begin
Device := TMenuItem.Create(Devices);
Device.Caption := SysDev.Filters[i].FriendlyName;
Device.Tag := i;
Device.OnClick := OnSelectDevice;
Devices.Add(Device);
end;
end;
procedure Form1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
SysDev.Free;
FilterGraph.ClearGraph;
FilterGraph.Active := false;
end;
procedureForm1.OnSelectDevice(sender: TObject);
var
CaptureGraph: ICaptureGraphBuilder2;
SourceFilter, DestFilter: IBaseFilter;
begin
FilterGraph.ClearGraph;
FilterGraph.Active := false;
Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
Filter.FilterGraph := FilterGraph;
FilterGraph.Active := true;
FilterGraph.QueryInterface(ICaptureGraphBuilder2, CaptureGraph);
Filter.QueryInterface(IBaseFilter, SourceFilter);
VideoWindow.QueryInterface(IBaseFilter, DestFilter);
if Filter.BaseFilter.DataLength > 0 then
CaptureGraph.RenderStream(nil, nil, SourceFilter, nil, DestFilter);
FilterGraph.Play;
CaptureGraph := nil;
SourceFilter := nil;
DestFilter := nil;
end;
procedure Form1.SnapshotClick(Sender: TObject);
var dir : String;
begin
if edt_nama_foto.Text <> '' then begin
dir := ExtractFilePath(Application.ExeName);
FotoBitmap := TBitmap.Create;
try
SampleGrabber.GetBitmap(FotoBitmap);
SampleGrabber.GetBitmap(Image.Picture.Bitmap);
showmessage(dir + 'Image\Foto\' + edt_nama_foto.Text + '.bmp');
FotoBitmap.SaveToFile(dir + 'Image\Foto\' + edt_nama_foto.Text + '.bmp');
finally
FotoBitmap.Free;
end;
end;
end;
procedure Form1.btn_batalClick(Sender: TObject);
begin
modalresult:=mrCancel;
end;
procedure Form1.btn_simpanClick(Sender: TObject);
begin
If CheckbeforeOK then
begin
ModalResult :=mrOK;
end else begin
ModalResult := mrNone;
end;
end;
function Form1.CheckbeforeOK:Boolean;
var flag:boolean;
MasterDataSet:TQuery;
begin
Flag:=True;
if flag and not(checkedit(nil, nil, edt_nama_foto, edt_nama_foto.Text, 'Nama Foto'))
then begin
flag := False;
end else begin
Snapshot.Click;
end;
Result := flag;
end;
procedure Form1.SampleGrabberBuffer(sender: TObject;
SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
begin
Image.Picture.Bitmap.Canvas.Lock;
try
SampleGrabber.GetBitmap(Image.Picture.Bitmap, pBuffer, BufferLen);
finally
Image.Picture.Bitmap.Canvas.UnLock;
end;
end;
end.
The object which "transfers" video frame into image object is SampleGrabber:
SampleGrabber.GetBitmap(Image.Picture.Bitmap, pBuffer, BufferLen);
However it needs to be inserted in to filter graph when you build it, and you are apparently not doing it in your OnSelectDevice: there is no mention of SampleGrabber there at all. You need to include it into RenderStream call or otherwise get it inserted there so that video is streamed through it and your callback is called copying data into TImage.

Reassigning a datasource at run-time

I did some searching and only found more unanswered questions. :)
Using D5pro.
I want to reassign the DataSource to a TDBGrid at run time. I have seven identical structured DataSets and depending on a button click I want the appropriate DataSet displayed in the grid.
I have tried everything and I cannot get it to show the next DataSet. It sticks with the first one assigned at start up. I am getting to overkill approaches and still nothing is working. Here's where I am at the moment.
procedure SetSource(var aSrc : TDataSource);
begin
aSrc.DataSet.Close;
dbgridShowData.DataSource:=aSrc;
aSrc.DataSet.Open;
aSrc.DataSet.First;
aSrc.DataSet.Refresh;
end;
Where am I going wrong?
Thanks
You can change the Dataset shown by a DBGrid quite easily at runtime quite easily. There two approaches:
1: use a single DataSource assigned to DBGrid.DataSource and change the DataSource.DataSet to the desired DataSet. Here is a simple example with all assignments made at runtime.
procedure TForm1.FormCreate(Sender: TObject);
begin
DBGrid1.DataSource := DataSource1;
DataSet1.Active := true;
DataSet2.Active := true;
DataSet3.Active := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DataSource1.DataSet := DataSet1;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DataSource1.DataSet := DataSet2;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
DataSource1.DataSet := DataSet3;
end;
2: use a DataSource for each DataSet and change DBGrid.DataSource to the desired DataSource. Here is a simple example with all assignments made at runtime.
procedure TForm1.FormCreate(Sender: TObject);
begin
DataSource1.DataSet := DataSet1;
DataSource2.DataSet := DataSet2;
DataSource3.DataSet := DataSet3;
DataSet1.Active := true;
DataSet2.Active := true;
DataSet3.Active := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DBGrid1.DataSource := DataSource1;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DBGrid1.DataSource := DataSource2;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
DBGrid1.DataSource := DataSource3;
end;
If you define the columns of the DBGrid, the structure of the DataSets will need to be the the same, or you will have to change the column definitions when you change the Dataset displayed.
I prefer using a DataSource per DataSet because it is more flexible.
You probably need to change the DataSource.DataSet instead:
procedure SetDataFromDataSet(const aDataSource: TDataSource;
const aNewDataSet: TDataSet);
begin
aDataSource.DataSet.Close;
aDataSource.DataSet := aNewDataSet;
if not aNewDataSet.Active then
aNewDataSet.Open;
end;
Sample use:
SetDataFromDataSet(DataSource1, CustomerQuery);
You may not want to close and open datasets globally like this, though. It's probably better to do that from the calling code. Of course, that would depend on what you need for your app.
Tested with Delphi5 pro.
procedure TForm1.setDataSourceDataSet(var newDataSource:TDataSource);
begin
if DBgrid1.DataSource = nil then begin
DBgrid1.DataSource:=newDataSource;
end else begin
if DBgrid1.DataSource.Name = newDataSource.Name then exit;
DBGrid1.DataSource.Enabled:=False;
DBgrid1.DataSource:=newDataSource;
end;
If DBgrid1.DataSource.DataSet.active=False then DBgrid1.DataSource.DataSet.active:=True;
DBGrid1.DataSource.Enabled:=True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
setDataSourceDataSet(DataSource1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
setDataSourceDataSet(DataSource2);
end;
The secret lies in:
DBGrid1.DataSource.Enabled:=False;
...making changes...
DBGrid1.DataSource.Enabled:=True;
Tested with D5Pro

Resources