I have this class to handle my webcam and want know how can stop the webcam started in a separated thread. Camera.Destroy not is working and the camera keep on.
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Panel1: TPanel;
Image1: TImage; // To load camera Bitmap from stream
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TCameraThread = class(TThread)
protected
procedure Execute; override;
end;
var
Form1: TForm1;
implementation
uses
Webcam;
{$R *.dfm}
procedure TCameraThread.Execute;
begin
Camera := TCamera.Create(Form1.Panel1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
mCamera: TCameraThread;
begin
mCamera := TCameraThread.Create(False);
mCamera.Resume;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if Assigned(Camera) then
Camera.Destroy;
end;
end.
Related
I'm new at SO, so forgive me if my question isn't in the right place or been answered before.
The questions is about multi-threading with Delphi 10.4.
I'm getting Access Violation error on my app, here is a very simple example:
type
myThread = class(TThread)
protected
procedure Execute; override;
end;
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
mySideTask : myThread;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
with mySideTask.Create do
FreeOnTerminate:=True
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if mySideTask<>nil then
begin
mySideTask.Terminate;
mySideTask.WaitFor;
FreeAndNil(mySideTask);
end;
end;
{ myThread }
procedure myThread.Execute;
begin
Synchronize(
procedure
begin
Form1.Memo1.Lines.Add('running my side task')
end);
end;
No error if I don't create an instance of the thread (which is confusing me):
procedure TForm1.Button1Click(Sender: TObject);
begin
myThread.Create
end;
Can you please let me know what am I missing.
The code in Button1Click() is wrong. You are calling Create() as an instance method on your mySideTask variable, but it is not pointing at a valid object instance. You need to instead call Create() as a constructor on the class type itself.
Try this instead:
procedure TForm1.Button1Click(Sender: TObject);
begin
mySideTask := myThread.Create(False{True});
//mySideTask.FreeOnTerminate := True;
//mySideTask.Start;
end;
Notice I commented out the handling of FreeOnTerminate=True. The reason for that is because that setting is meant for create-and-forget type of threads. The thread will destroy itself after its Execute() method exits. So it is not safe to call WaitFor() or Free() on a thread that could destroy itself at any moment.
If you want to use FreeOnTerminate=True, then the code should look more like this instead:
type
myThread = class(TThread)
protected
procedure Execute; override;
end;
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
mySideTask : myThread;
procedure SideTaskTerminated(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
mySideTask := myThread.Create(True);
mySideTask.FreeOnTerminate := True;
mySideTask.OnTerminated := SideTaskTerminated;
mySideTask.Start;
end;
procedure TForm1.SideTaskTerminated(Sender: TObject);
begin
mySideTask := nil;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if mySideTask <> nil then
begin
mySideTask.FreeOnTerminate := False;
mySideTask.Terminate;
mySideTask.WaitFor;
FreeAndNil(mySideTask);
end;
end;
{ myThread }
procedure myThread.Execute;
begin
Synchronize(
procedure
begin
Form1.Memo1.Lines.Add('running my side task')
end);
end;
I made simple clicker game and i want to show my speed of clicking, in graph.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, TeEngine, Series, TeeProcs, Chart;
type
TForm2 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Timer1: TTimer;
Chart1: TChart;
Series1: TLineSeries;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
clicks_total,i: integer;
implementation
{$R *.dfm}
procedure TForm2.FormShow(Sender: TObject);
begin
Timer1.Enabled:=true;
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
clicks_total:=clicks_total+1;
Label2.Caption:=IntToStr(clicks_total);
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
clicks_total:=0;
i:=1;
end;
procedure TForm2.Timer1Timer(Sender: TObject);
var clicks_total_support:integer;
begin
i:=i+1;
clicks_total_support:=clicks_total;
Chart1.Series[1].AddXY(i,clicks_total_support,'Hello',clBlue);
clicks_total_support:=1;
end;
end.
I want to make every second a point in graph where X will be only 1 greater and Y (height of point) will be that clicks user made in one second. But after 1 second running the code, it will crash with error that's in name of this question. Someone help?
I have a TDBGrid component. I need to catch the event triggered when I'm resizing a column of the grid.
the only place to get an events seems to be overriding ColWidthChanged...
type
TDBgrid=Class(DBGrids.TDBGrid)
private
FColResize:TNotifyEvent;
procedure ColWidthsChanged; override;
protected
Property OnColResize:TNotifyEvent read FColResize Write FColResize;
End;
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
DBGrid1: TDBGrid;
ADODataSet1: TADODataSet;
DataSource1: TDataSource;
procedure FormCreate(Sender: TObject);
private
procedure ColResize(Sender: TObject);
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TDBgrid }
procedure TDBgrid.ColWidthsChanged;
begin
inherited;
if Assigned(FColResize) then FColResize(self);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DBgrid1.OnColResize := ColResize;
end;
procedure TForm1.ColResize(Sender:TObject);
begin
Caption := FormatDateTime('nn:zzz',now) ;
end;
you need to create a descendent of TDBGrid and implement the event by yourself. Something like this:
unit MyDBGrid;
interface
type
TMyDBGrid = class(TDBGrid)
private
FOnColResize: TNotifyEvent;
protected
procedure ColWidthsChanged; override;
public
published
property OnColResize: TNotifyEvent read FOnColResize write FOnColResize;
end;
implementation
{ TMyDBGrid }
procedure TMyDBGrid.ColWidthsChanged;
begin
inherited;
if (Datalink.Active or (Columns.State = csCustomized)) and
AcquireLayoutLock and Assigned(FOnColResize) then
FOnColResize(Self);
end;
end.
this should work, I don't have time now to test it.
Is it possible to get a bitmap from a video file by DsPack components?
In this case I'm using this code; but It can't take a screenshot Image:
type
TForm4 = class(TForm)
FilterGraph1: TFilterGraph;
VideoWindow1: TVideoWindow;
btnPlay: TButton;
SampleGrabber1: TSampleGrabber;
btnTakePicture: TButton;
Image1: TImage;
procedure btnPlayClick(Sender: TObject);
procedure btnTakePictureClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
...
procedure TForm4.btnPlayClick(Sender: TObject);
begin
SampleGrabber1.FilterGraph := FilterGraph1;
VideoWindow1.FilterGraph := FilterGraph1;
FilterGraph1.Active := true;
FilterGraph1.RenderFile('C:\TEMP\1.mp4');
FilterGraph1.Play;
end;
procedure TForm4.btnTakePictureClick(Sender: TObject);
begin
SampleGrabber1.GetBitmap(Image1.Picture.Bitmap);
end;
Is it possible to Fix This code?
after a while I found a sample for solving this problem:
we can use "SnapShot.dpr". this is a sample which distributed with DsPack Components.
Why does the code below return TRUE in Delphi 7 and FALSE in Delphi 2010? TBitBtn is a descendant of TButton.
type
TForm1 = class(TForm)
Button1: TButton;
BitBtn1: TBitBtn;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TestControl( aControl: TControl);
begin
if (aControl is TButton) then showmessage('TRUE') else showmessage('FALSE');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TestControl(BitBtn1);
end;
is did not change. TBitBtn is a subtype of TCustomButton, not TButton, as you state.