最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

delphi - Video Camera DLL using FMX TCameraComponent - Stack Overflow

programmeradmin1浏览0评论

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.
发布评论

评论列表(0)

  1. 暂无评论