An interface to libgphoto2 for Free Pascal

gistfile1.txt

unit GPhoto2;

{$mode delphi}

interface

uses
  Classes, SysUtils;

type
  TGPContext = record end;
  PGPContext = ^TGPContext;
  TGPCamera = record end;
  PGPCamera = ^TGPCamera;
  TGPCameraWidgt = record end;
  PGPCameraWidget = ^TGPCameraWidgt;
  TGPCameraFile = record end;
  PGPCameraFile = ^TGPCameraFile;

  TGPCameraFilePath = record
    fileName: array[0..127] of Char;
    folder: array[0..1023] of Char;
  end;
  PGPCameraFilePath = ^TGPCameraFilePath;

const
  { Everything is OK.  }
  GP_OK = 0;
  { Generic Error. }
  GP_ERROR = -1;
  { Bad parameters passed. }
  GP_ERROR_BAD_PARAMETERS = -2;
  { Out of memory. }
  GP_ERROR_NO_MEMORY = -3;
  { Error in the camera driver. }
  GP_ERROR_LIBRARY = -4;
  { Unknown libgphoto2 port passed. }
  GP_ERROR_UNKNOWN_PORT = -5;
  { Functionality not supported. }
  GP_ERROR_NOT_SUPPORTED = -6;
  { Generic I/O error. }
  GP_ERROR_IO = -7;
  { Buffer overflow of internal structure. }
  GP_ERROR_FIXED_LIMIT_EXCEEDED = -8;
  { Operation timed out. }
  GP_ERROR_TIMEOUT = -10;
  { Serial ports not supported. }
  GP_ERROR_IO_SUPPORTED_SERIAL = -20;
  { USB ports not supported. }
  GP_ERROR_IO_SUPPORTED_USB = -21;
  { Error initialising I/O. }
  GP_ERROR_IO_INIT = -31;
  { I/O during read. }
  GP_ERROR_IO_READ = -34;
  { I/O during write. }
  GP_ERROR_IO_WRITE = -35;
  { I/O during update of settings. }
  GP_ERROR_IO_UPDATE = -37;
  { Specified serial speed not possible. }
  GP_ERROR_IO_SERIAL_SPEED = -41;
  { Error during USB Clear HALT. }
  GP_ERROR_IO_USB_CLEAR_HALT = -51;
  { Error when trying to find USB device. }
  GP_ERROR_IO_USB_FIND = -52;
  { Error when trying to claim the USB device. }
  GP_ERROR_IO_USB_CLAIM = -53;
  { Error when trying to lock the device. }
  GP_ERROR_IO_LOCK = -60;
  { Unspecified error when talking to HAL. }
  GP_ERROR_HAL = -70;

  { Window widget This is the toplevel configuration widget. }
  GP_WIDGET_WINDOW = 0;
  { Section widget (think Tab) }
  GP_WIDGET_SECTION = 1;
  { Text widget. }
  GP_WIDGET_TEXT = 2;
  { Slider widget. }
  GP_WIDGET_RANGE = 3;
  { Toggle widget (think check box) }
  GP_WIDGET_TOGGLE = 4;
  { Radio button widget. }
  GP_WIDGET_RADIO = 5;
  { Menu widget (same as RADIO). }
  GP_WIDGET_MENU = 6;
  { Button press widget. }
  GP_WIDGET_BUTTON = 7;
  { Date entering widget. }
  GP_WIDGET_DATE = 8;

  { Capture an image. }
  GP_CAPTURE_IMAGE = 0;
  { Capture a movie. }
  GP_CAPTURE_MOVIE = 1;
  { Capture audio. }
  GP_CAPTURE_SOUND = 2;

  GP_FILE_TYPE_PREVIEW = 0;
  GP_FILE_TYPE_NORMAL = 1;
  GP_FILE_TYPE_RAW = 2;
  GP_FILE_TYPE_AUDIO = 3;
  GP_FILE_TYPE_EXIF = 4;
  GP_FILE_TYPE_METADATA = 5;

const
  libgphoto2 = 'gphoto2';

function gp_context_new: PGPContext; cdecl; external libgphoto2;
procedure gp_context_unref(ctx: PGPContext); cdecl; external libgphoto2;
function gp_camera_new(out cam: PGPCamera): Integer; cdecl; external libgphoto2;
function gp_camera_unref(cam: PGPCamera): Integer; cdecl; external libgphoto2;
function gp_camera_init(cam: PGPCamera; ctx: PGPContext): Integer; cdecl; external libgphoto2;
function gp_camera_get_summary(cam: PGPCamera; summary: PChar; ctx: PGPContext): Integer; cdecl; external libgphoto2;
function gp_camera_get_manual(cam: PGPCamera; summary: PChar; ctx: PGPContext): Integer; cdecl; external libgphoto2;
function gp_camera_get_about(cam: PGPCamera; summary: PChar; ctx: PGPContext): Integer; cdecl; external libgphoto2;
function gp_camera_get_config(cam: PGPCamera; out widget: PGPCameraWidget; ctx: PGPContext): Integer; cdecl; external libgphoto2;
function gp_camera_set_config(cam: PGPCamera; widget: PGPCameraWidget; ctx: PGPContext): Integer; cdecl; external libgphoto2;
function gp_camera_capture(cam: PGPCamera; capturetype: Integer; out path: TGPCameraFilePath; ctx: PGPContext): Integer; cdecl; external libgphoto2;
function gp_camera_capture_preview(cam: PGPCamera; camfile: PGPCameraFile; ctx: PGPContext): Integer; cdecl; external libgphoto2;

type
  TCameraTimeoutFunc = function(cam: PGPCamera; ctx: PGPContext): Integer; cdecl;
  TCameraTimeoutStartFunc = function(cam: PGPCamera; timeout: LongWord; func: TCameraTimeoutFunc; data: Pointer): LongWord; cdecl;
  TCameraTimeoutStopFunc = procedure(cam: PGPCamera; id: LongWord; func: TCameraTimeoutFunc; data: Pointer); cdecl;

procedure gp_camera_set_timeout_funcs(cam: PGPCamera; start_func: TCameraTimeoutStartFunc; stop_func: TCameraTimeoutStopFunc; data: Pointer); cdecl; external libgphoto2;
function gp_camera_start_timeout(cam: PGPCamera; timeout: LongWord; func: TCameraTimeoutFunc): Integer; cdecl; external libgphoto2;
procedure gp_camera_stop_timeout(cam: PGPCamera; id: LongWord); cdecl; external libgphoto2;

function gp_widget_unref(widget: PGPCameraWidget): Integer; cdecl; external libgphoto2;
function gp_widget_count_children(widget: PGPCameraWidget): Integer; cdecl; external libgphoto2;
function gp_widget_get_child(widget: PGPCameraWidget; child_number: Integer; out child: PGPCameraWidget): Integer; cdecl; external libgphoto2;
function gp_widget_get_child_by_label(widget: PGPCameraWidget; _label: PChar; out child: PGPCameraWidget): Integer; cdecl; external libgphoto2;
function gp_widget_get_child_by_id(widget: PGPCameraWidget; id: Integer; out child: PGPCameraWidget): Integer; cdecl; external libgphoto2;
function gp_widget_get_child_by_name(widget: PGPCameraWidget; name: PChar; out child: PGPCameraWidget): Integer; cdecl; external libgphoto2;
function gp_widget_get_root(widget: PGPCameraWidget; out root: PGPCameraWidget): Integer; cdecl; external libgphoto2;
function gp_widget_get_parent(widget: PGPCameraWidget; out parent: PGPCameraWidget): Integer; cdecl; external libgphoto2;
function gp_widget_set_value(widget: PGPCameraWidget; value: Pointer): Integer; cdecl; external libgphoto2;
function gp_widget_get_value(widget: PGPCameraWidget; value: Pointer): Integer; cdecl; external libgphoto2;
function gp_widget_set_name(widget: PGPCameraWidget; name: PChar): Integer; cdecl; external libgphoto2;
function gp_widget_get_name(widget: PGPCameraWidget; out name: PChar): Integer; cdecl; external libgphoto2;
function gp_widget_set_info(widget: PGPCameraWidget; info: PChar): Integer; cdecl; external libgphoto2;
function gp_widget_get_info(widget: PGPCameraWidget; out info: PChar): Integer; cdecl; external libgphoto2;
function gp_widget_get_id(widget: PGPCameraWidget; out id: Integer): Integer; cdecl; external libgphoto2;
function gp_widget_get_type(widget: PGPCameraWidget; out _type: Integer): Integer; cdecl; external libgphoto2;
function gp_widget_get_label(widget: PGPCameraWidget; out _label: PChar): Integer; cdecl; external libgphoto2;
function gp_widget_set_range(range: PGPCameraWidget; min, max, increment: Single): Integer; cdecl; external libgphoto2;
function gp_widget_get_range(range: PGPCameraWidget; out min, max, increment: Single): Integer; cdecl; external libgphoto2;
function gp_widget_add_choice(widget: PGPCameraWidget; choice: PChar): Integer; cdecl; external libgphoto2;
function gp_widget_count_choices(widget: PGPCameraWidget): Integer; cdecl; external libgphoto2;
function gp_widget_get_choice(widget: PGPCameraWidget; choice_number: Integer; out choice: PChar): Integer; cdecl; external libgphoto2;
function gp_widget_changed(widget: PGPCameraWidget): Integer; cdecl; external libgphoto2;
function gp_widget_set_changed(widget: PGPCameraWidget; changed: Integer): Integer; cdecl; external libgphoto2;
function gp_widget_set_readonly(widget: PGPCameraWidget; readonly: Integer): Integer; cdecl; external libgphoto2;
function gp_widget_get_readonly(widget: PGPCameraWidget; out readonly: Integer): Integer; cdecl; external libgphoto2;
function gp_file_new(out camfile: PGPCameraFile): Integer; cdecl; external libgphoto2;
function gp_file_unref(camfile: PGPCameraFile): Integer; cdecl; external libgphoto2;
function gp_camera_file_get(cam: PGPCamera; folder, fileName: PChar; fileType: Integer; camfile: PGPCameraFile; ctx: PGPContext): Integer; cdecl; external libgphoto2;
function gp_camera_file_delete(cam: PGPCamera; folder, fileName: PChar; ctx: PGPContext): Integer; cdecl; external libgphoto2;
function gp_file_save(camfile: PGPCameraFile; filename: PChar): Integer; cdecl; external libgphoto2;

{ TCameraWidget }

type
  TCameraWidget = class
  private
    FParent: TCameraWidget;
    FWidget: PGPCameraWidget;
    FChildren: array of TCameraWidget;
    function GetChild(Index: Integer): TCameraWidget;
    function GetChildCount: Integer;
    function GetKind: Integer;
    function GetName: string;
    function GetValue: string;
    procedure SetValue(const AValue: string);
    procedure HandleAcquire(Handle: PGPCameraWidget);
    procedure HandleRelease;
  public
    destructor Destroy; override;
    procedure GetRange(out Min, Max, Increment: Single);
    procedure GetChoices(Strings: TStrings);
    property Parent: TCameraWidget read FParent;
    property Name: string read GetName;
    property Kind: Integer read GetKind;
    property Value: string read GetValue write SetValue;
    property ChildCount: Integer read GetChildCount;
    property Child[Index: Integer]: TCameraWidget read GetChild; default;
  end;

  TCamera = class
  private
    FContext: PGPContext;
    FCamera: PGPCamera;
    FWindow: TCameraWidget;
    FText: PChar;
    function GetConnected: Boolean;
    function GetAbout: string;
    function GetManual: string;
    function GetSummary: string;
  public
    constructor Create;
    destructor Destroy; override;
    function Connect: Boolean;
    procedure Disconnect;
    function ApplyChanges: Boolean;
    function CapturePhoto(const FileName: string): Boolean;
    property Window: TCameraWidget read FWindow;
    property Connected: Boolean read GetConnected;
    property About: string read GetAbout;
    property Manual: string read GetManual;
    property Summary: string read GetSummary;
  end;

implementation

{ TCameraWidget }

destructor TCameraWidget.Destroy;
begin
  HandleRelease;
  inherited Destroy;
end;

procedure TCameraWidget.GetRange(out Min, Max, Increment: Single);
begin
  Min := 0;
  Max := 0;
  Increment := 0;
  if Kind = GP_WIDGET_RANGE then
    gp_widget_get_range(FWidget, Min, Max, Increment);
end;

procedure TCameraWidget.GetChoices(Strings: TStrings);
var
  P: PChar;
  I: Integer;
begin
  Strings.BeginUpdate;
  try
    Strings.Clear;
    if Kind in [GP_WIDGET_RADIO..GP_WIDGET_MENU] then
      for I := 0 to gp_widget_count_choices(FWidget) - 1 do
        if gp_widget_get_choice(FWidget, I, P) = GP_OK then
            Strings.Add(P);
  finally
    Strings.EndUpdate;
  end;
end;

procedure TCameraWidget.HandleAcquire(Handle: PGPCameraWidget);
begin
  HandleRelease;
  FWidget := Handle;
end;

procedure TCameraWidget.HandleRelease;
var
  I: Integer;
begin
  if FWidget = nil then
    Exit;
  for I := Low(FChildren) to High(FChildren) do
    FChildren[I].Free;
  if FParent = nil then
    gp_widget_unref(FWidget);
  FChildren := nil;
  FWidget := nil;
end;

function TCameraWidget.GetChild(Index: Integer): TCameraWidget;
begin
  if (Index < 0) or (Index > Length(FChildren) - 1) then
    Result := nil
  else
    Result := FChildren[Index];
end;

function TCameraWidget.GetChildCount: Integer;
var
  C: TCameraWidget;
  W: PGPCameraWidget;
  I: Integer;
begin
  if FWidget = nil then
    Exit(0);
  Result := Length(FChildren);
  if Result = 0 then
  begin
    Result := gp_widget_count_children(FWidget);
    if Result < 1 then
      Exit(0);
    SetLength(FChildren, Result);
    for I := 0 to Result - 1 do
    begin
      C := TCameraWidget.Create;
      C.FParent := Self;
      if gp_widget_get_child(FWidget, I, W) = GP_OK then
        C.HandleAcquire(W);
      FChildren[I] := C;
    end;
  end;
end;

function TCameraWidget.GetName: string;
var
  N: PChar;
begin
  if FWidget = nil then
    Result := ''
  else
  begin
    if gp_widget_get_name(FWidget, N) = GP_OK then
      Result := StrPas(N)
    else
      Result := '';
  end;
end;

function TCameraWidget.GetValue: string;
var
  P: PChar;
  F: Single;
begin
  Result := '';
  case Kind of
    GP_WIDGET_TEXT,
    GP_WIDGET_RADIO,
    GP_WIDGET_DATE,
    GP_WIDGET_TOGGLE,
    GP_WIDGET_MENU:
      if gp_widget_get_value(FWidget, @P) = GP_OK then Result := StrPas(P);
    GP_WIDGET_RANGE:
      if gp_widget_get_value(FWidget, @F) = GP_OK then Result := FloatToStr(F);
  end;
end;

procedure TCameraWidget.SetValue(const AValue: string);
var
  F: Single;
begin
  if AValue = '' then
    Exit;
  case Kind of
    GP_WIDGET_TEXT,
    GP_WIDGET_RADIO,
    GP_WIDGET_DATE,
    GP_WIDGET_TOGGLE,
    GP_WIDGET_MENU:
      gp_widget_set_value(FWidget, PChar(AValue));
    GP_WIDGET_RANGE:
      begin
        F := StrToFloatDef(AValue, 0);
        gp_widget_set_value(FWidget, @F);
      end;
  end;
end;

function TCameraWidget.GetKind: Integer;
begin
  if FWidget = nil then
    Result := -1
  else if gp_widget_get_type(FWidget, Result) <> GP_OK then
    Result := -1;
end;

{ TCamera }

constructor TCamera.Create;
const
  TextSize = 1024 * 32;
begin
  inherited Create;
  FWindow := TCameraWidget.Create;
  GetMem(FText, TextSize);
end;

destructor TCamera.Destroy;
begin
  Disconnect;
  FreeMem(FText);
  FWindow.Free;
  inherited Destroy;
end;

function TCamera.ApplyChanges: Boolean;
begin
  if Connected then
    Result := gp_camera_set_config(FCamera, FWindow.FWidget, FContext) = GP_OK
  else
    Result := False;
end;

function TCamera.Connect: Boolean;
var
  W: PGPCameraWidget;
begin
  if Connected then
    Exit(True);
  FContext := gp_context_new;
  if FContext = nil then
    Exit(False);
  gp_camera_new(FCamera);
  Result := (gp_camera_init(FCamera, FContext) = GP_OK) and
   (gp_camera_get_config(FCamera, W, FContext) = GP_OK);
  if Result then
    FWindow.HandleAcquire(W)
  else
  begin
    gp_camera_unref(FCamera);
    gp_context_unref(FContext);
    FCamera := nil;
    FContext := nil;
  end;
end;

procedure TCamera.Disconnect;
begin
  if Connected then
  begin
    FWindow.HandleRelease;
    gp_camera_unref(FCamera);
    gp_context_unref(FContext);
    FWindow := nil;
    FCamera := nil;
    FContext := nil;
  end;
end;

function TCamera.CapturePhoto(const FileName: string): Boolean;
var
  Path: TGPCameraFilePath;
  CamFile: PGPCameraFile;
begin
  Result := False;
  if not Connected then
    Exit;
  if gp_camera_capture(FCamera, GP_CAPTURE_IMAGE, Path, FContext) <> GP_OK then
    Exit;
  if gp_file_new(CamFile) = GP_OK then
  try
    Result := (gp_camera_file_get(FCamera, Path.folder, Path.fileName, GP_FILE_TYPE_NORMAL, CamFile, FContext) = GP_OK) and
      (gp_file_save(CamFile, PChar(FileName)) = GP_OK) and
      (gp_camera_file_delete(FCamera, Path.folder, Path.fileName, FContext) = GP_OK);
  finally
    gp_file_unref(CamFile);
  end;
end;

function TCamera.GetConnected: Boolean;
begin
  Result := FContext <> nil;
end;

function TCamera.GetAbout: string;
begin
  if Connected and (gp_camera_get_about(FCamera, FText, FContext) = GP_OK) then
    Result := StrPas(FText)
  else
    Result := '';
end;

function TCamera.GetManual: string;
begin
  if Connected and (gp_camera_get_manual(FCamera, FText, FContext) = GP_OK) then
    Result := StrPas(FText)
  else
    Result := '';
end;

function TCamera.GetSummary: string;
begin
  if Connected and (gp_camera_get_summary(FCamera, FText, FContext) = GP_OK) then
    Result := StrPas(FText)
  else
    Result := '';
end;

end.