I have written a general purpose DLL application in Delphi for capturing webcam images in other applications. It usually works fine but on a Chuwi Windows 11 tablet it doesn't work. The camera doesn't initialize properly and the camera form freezes. I have compiled the DLL in Delphi 12 under Windows 10. What I would like to know is if have I implemented the DLL code correctly. I am calling the DLL from a larger Delphi VCL application. I have also found that when I use the Windows LoadLibrary and FreeLibrary functions I get errors when freeing the library but if use normal DLL loading in Delphi it works.
Here is the code for the DLL form:
unit CameraForm;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Media,
FMX.Platform, FMX.Objects, System.Permissions, FMX.Controls.Presentation,
FMX.Edit, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.StdCtrls;
type TScanCallback = procedure(sender : Pointer; image : PByteArray; size : LongWord); stdcall;
type
TfrmCamera = class(TForm)
Camera: TCameraComponent;
Image: TImage;
Panel1: TPanel;
btnSnapShot: TButton;
procedure FormCreate(Sender: TObject);
procedure CameraSampleBufferReady(Sender: TObject; const ATime: TMediaTime);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnSnapShotClick(Sender: TObject);
private
fPermissionCamera : String;
fScanCallback : TScanCallback;
procedure CameraPermissionRequestResult(Sender: TObject;
const APermissions: TClassicStringDynArray;
const AGrantResults: TClassicPermissionStatusDynArray);
procedure ExplainReason(Sender: TObject;
const APermissions: TClassicStringDynArray;
const APostRationaleProc: TProc);
public
procedure StartCamera;
procedure StopCamera;
property ScanProc : TScanCallback read fScanCallback write fScanCallback;
end;
implementation
{$R *.fmx}
{$R *.Windows.fmx MSWINDOWS}
uses FMX.DialogService, FMX.Surfaces;
procedure TfrmCamera.CameraSampleBufferReady(Sender: TObject;
const ATime: TMediaTime);
begin
Camera.SampleBufferToBitmap(Image.Bitmap, True);
end;
procedure TfrmCamera.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
StopCamera;
end;
procedure TfrmCamera.FormCreate(Sender: TObject);
begin
fScanCallback := nil;
end;
procedure TfrmCamera.btnSnapShotClick(Sender: TObject);
var outstr : AnsiString;
mstream : TMemoryStream;
Surface : TBitmapSurface;
begin
StopCamera;
if Assigned(fScanCallback) then
begin
mstream := TMemoryStream.Create;
try
Surface := TBitmapSurface.Create;
try
Surface.Assign(Image.Bitmap);
TBitmapCodecManager.SaveToStream(mstream, Surface, '.bmp');
finally
Surface.Free;
end;
mstream.Position := 0;
SetLength(outstr,mstream.Size);
mstream.Read(outstr[1],mstream.Size);
fScanCallback(self,@outstr[1],mstream.Size);
finally
mstream.Free;
end;
end;
end;
procedure TfrmCamera.CameraPermissionRequestResult(Sender: TObject;
const APermissions: TClassicStringDynArray;
const AGrantResults: TClassicPermissionStatusDynArray);
begin
if (Length(AGrantResults) = 1) and
(AGrantResults[0] = TPermissionStatus.Granted) then
begin
Camera.Quality := FMX.Media.TVideoCaptureQuality.MediumQuality;
Camera.Kind := FMX.Media.TCameraKind.BackCamera;
Camera.FocusMode := FMX.Media.TFocusMode.ContinuousAutoFocus;
Camera.Active := True;
end
else
TDialogService.ShowMessage
('Cannot use the camera because the required permissions is not granted')
end;
procedure TfrmCamera.ExplainReason(Sender: TObject;
const APermissions: TClassicStringDynArray; const APostRationaleProc: TProc);
begin
TDialogService.ShowMessage
('The app needs to access the camera...',
procedure(const AResult: TModalResult)
begin
APostRationaleProc;
end)
end;
procedure TfrmCamera.StartCamera;
begin
if not camera.Active then
PermissionsService.RequestPermissions([fPermissionCamera],
CameraPermissionRequestResult, ExplainReason);
end;
procedure TfrmCamera.StopCamera;
begin
if camera.Active then
Camera.Active := false;
end;
Here is the code for the DLL project:
library Camera;
uses
System.SysUtils,
System.Classes,
System.UITypes,
FMX.Forms,
CameraForm in 'CameraForm.pas' {frmCamera};
{$R *.res}
function CreateCamera(aScanProc : TScanCallback): Pointer; stdcall;
begin
Result := TfrmCamera.Create(nil);
TfrmCamera(Result).ScanProc := aScanProc;
end;
procedure ShowCamera(pviewer : Pointer); stdcall;
begin
if pviewer <> nil then
begin
TfrmCamera(pviewer).Show;
TfrmCamera(pviewer).WindowState := TWindowState.wsNormal;
end;
end;
procedure HideCamera(pviewer : Pointer); stdcall;
begin
if pviewer <> nil then
TfrmCamera(pviewer).Hide;
end;
procedure FreeCamera(pviewer : Pointer); stdcall;
begin
if pviewer <> nil then
TfrmCamera(pviewer).Free;
end;
procedure StartCamera(pviewer : Pointer); stdcall;
begin
if pviewer <> nil then
TfrmCamera(pviewer).StartCamera;
end;
procedure StopCamera(pviewer : Pointer); stdcall;
begin
if pviewer <> nil then
TfrmCamera(pviewer).StopCamera;
end;
exports CreateCamera,
ShowCamera,
HideCamera,
FreeCamera,
StartCamera,
StopCamera;
begin
end.
Here is the code I use in Delphi applications that use the DLL:
unit CameraDLL;
interface
uses Windows;
function CreateCamera(aScanProc : Pointer): Pointer; stdcall;
procedure ShowCamera(pviewer : Pointer); stdcall;
procedure HideCamera(pviewer : Pointer); stdcall;
procedure FreeCamera(pviewer : Pointer); stdcall;
procedure StartCamera(pviewer : Pointer); stdcall;
procedure StopCamera(pviewer : Pointer); stdcall;
implementation
uses Winapi.GDIPOBJ; // This is needed to initialize GDI+ for VCL applications
const Camera_DLL = 'Camera.dll';
function CreateCamera(aScanProc : Pointer): Pointer; external Camera_DLL;
procedure ShowCamera(pviewer : Pointer); external Camera_DLL;
procedure HideCamera(pviewer : Pointer); external Camera_DLL;
procedure FreeCamera(pviewer : Pointer); external Camera_DLL;
procedure StartCamera(pviewer : Pointer); external Camera_DLL;
procedure StopCamera(pviewer : Pointer); external Camera_DLL;
end.