mainapp.pas

canon 相机SDK,非常难得

unit MainApp;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, cdEvent, cdError, cdType, cdAPI, ExtCtrls;

type
  TForm_Main = class(TForm)
    Button_CamConnect   :TButton;
    Button_GetThumb     :TButton;
    Button_GetPicture   :TButton;
    ListBox_ImageList   :TListBox;
    SaveDialog1         :TSaveDialog;
    Timer1              :TTimer;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button_CamConnectClick(Sender: TObject);
    procedure Button_GetThumbClick(Sender: TObject);
    procedure Button_GetPictureClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

    Function    doCamConnect():cdErr;
    Function    doCamDisconnect():cdErr;
    Function    GetImageItem():cdErr;
    Function    FindDCIMFolder(hVolume:cdHVolume; var hRetItem:cdHItem):cdErr;
    Procedure   GetImageData(GetType:Integer);

  private
    { Private }
    m_hSource           :cdHSource;
    m_bCamConnect       :Boolean;
    m_hCallbackFunction :cdHandle;
    m_hFunc             :cdHandle;

  public
    { Public }
    m_EventID           :cdEventID;

end;

var
  Form_Main: TForm_Main;

implementation

uses CamSelectDlg;

Const
    GET_DATA_TYPE_PICTURE   = 1;
    GET_DATA_TYPE_THUMBNAIL = 2;
    DEVICE_NOT_CHOICE       = $ffff;
    IMAGE_FIND_ERROR        = $ffff;

{$R *.dfm}


//------------------------------------------------------------------------
//------------------------------------------------------------------------
Function EventCallbackFunc(
            eventID     :cdEventID;
            pData       :cdUInt32;
            DataSize    :cdUInt32;
            Context     :pointer     ):cdErr;stdcall;
begin
    Form_Main.m_EventID :=eventID;
    Result:=cdOK;
end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
procedure TForm_Main.FormCreate(Sender: TObject);
var
    ver :cdVersionInfo;
    err :cdErr;
begin

    ver.MajorVersion :=6;
    ver.MinorVersion :=1;
    ver.Size :=SizeOf(ver);

    err := CDStartSDK(ver,0);
    if err <> cdOK then
        ShowMessage('error!');

    m_hSource := 0;
    m_hCallbackFunction := 0;

    Button_GetPicture.Enabled := False;
    Button_GetThumb.Enabled := False;

end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
procedure TForm_Main.FormDestroy(Sender: TObject);
var
    err:cdErr;
begin

    if m_bCamConnect = True then
        doCamDisconnect();

    err:=CDFinishSDK();
    if err <> cdOK then
        ShowMessage('error!');

end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
procedure TForm_Main.Button_CamConnectClick(Sender: TObject);
var
    err:cdErr;
begin
    ListBox_ImageList.Clear;

    if m_bCamConnect = False then
    begin
        err := doCamConnect();
        if err <> cdOK then Exit;

        err := GetImageItem();
        if err = cdOK then
        begin
            Button_CamConnect.Caption := 'Disconnect';
            Button_GetPicture.Enabled := True;
            Button_GetThumb.Enabled := True;
            Timer1.Enabled := True;
        end
        else
            doCamDisconnect()
    end
    else
    begin
        err := doCamDisconnect();
        if err = cdOK then
        begin
            Button_CamConnect.Caption := 'Connect';
            Button_GetPicture.Enabled := False;
            Button_GetThumb.Enabled := False;
            Timer1.Enabled := False;
        end;
    end

end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
procedure TForm_Main.Button_GetThumbClick(Sender: TObject);
begin
    GetImageData(GET_DATA_TYPE_THUMBNAIL);
end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
procedure TForm_Main.Button_GetPictureClick(Sender: TObject);
begin
    GetImageData(GET_DATA_TYPE_PICTURE);
end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
procedure TForm_Main.Timer1Timer(Sender: TObject);
begin

    case m_EventID and cdEVENT_SEVERITY_MASK of
        cdEVENT_SEVERITY_SHUTDOWN:
        begin
            Button_CamConnectClick(Sender);
            ShowMessage('Camera is no longer available.');
        end;

    end;
    m_EventID := 0;

end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
Function TForm_Main.doCamConnect():cdErr;
var
    err         :cdErr;
    CamSelectDlg:TForm_CamSelect;
    SourceInfo  :cdSourceInfo;
label
    ErrHandler;
begin

    CamSelectDlg:=TForm_CamSelect.Create(self);
    CamSelectDlg.ShowModal;
    SourceInfo := CamSelectDlg.m_SourceInfo;
    CamSelectDlg.Release;

    If SourceInfo.SurceType <> cdSRC_TYPE_CAMERA Then
    begin
        Result := DEVICE_NOT_CHOICE;
        Exit;
    end;

    err := CDOpenSource(SourceInfo, m_hSource);
    If err <> cdOK then goto ErrHandler;

    err := CDRegisterEventCallbackFunction(m_hSource, @EventCallbackFunc, 0, m_hFunc);
    If err <> cdOK then goto ErrHandler;

    m_bCamConnect := True;
    Result := cdOK;

    Exit;

ErrHandler:
    ShowMessage('error!');
    Result := err;

end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
Function TForm_Main.doCamDisconnect():cdErr;
var
    err:cdErr;
begin

    err := cdOK;
    Result:=cdOK;

    if m_bCamConnect = False then Exit;

    if m_hFunc <> 0 then
    begin
        err := CDUnregisterEventCallbackFunction(m_hSource, m_hFunc);
        m_hFunc := 0;
    end;

    if m_hSource <> 0 then
    begin
        CDCloseSource (m_hSource);
        m_hSource := 0;
    end;

    if err <> cdOK then ShowMessage('error!');

    m_bCamConnect := False;
    Result := err;

end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
Function TForm_Main.GetImageItem():cdErr;
var
    err         :cdErr;
    hEnumVol    :cdHEnum;
    hVol        :cdHVolume;
    hItem       :cdHItem;
    hEnumImage  :cdHEnum;
    hImage      :cdHImageItem;
    VolInfo     :cdVolumeInfo;
    iteminfo    :cdItemInfo;
    ImageNum    :cdUInt32;

label
    ErrHandler;

begin
    err         :=cdOK;
    hEnumVol    :=0;
    hVol        :=0;
    hItem       :=0;
    hEnumImage  :=0;
    hImage      :=0;
    ImageNum    :=0;


    err := CDLockUI(m_hSource);
    if err <> cdOK then goto ErrHandler;

    //Make a search for DCIM forder
    hItem := 0;
    err := CDEnumVolumeReset(m_hSource, hEnumVol);
    if err <> cdOK then goto ErrHandler;


    while CDEnumVolumeNext(hEnumVol, hVol) = cdOK do
    begin
        err := CDGetVolumeInfo(hVol, VolInfo);
        if err <> cdOK then goto ErrHandler;

        if VolInfo.TotalSpace <> 0 Then
        begin
            err := FindDCIMFolder(hVol, hItem);
            if err <> cdOK then goto ErrHandler;
        end;

        if hItem <> 0 Then Break;
    end;

    err := CDEnumVolumeRelease(hEnumVol);
    hEnumVol := 0;
    if err <> cdOK then goto ErrHandler;

    //In case of no memory card or no DCIM forder
    if (VolInfo.TotalSpace = 0) or (hItem = 0) then
    begin
        err := IMAGE_FIND_ERROR;
        goto ErrHandler;
    end;

    //Get image item from DCIM folder
    err := CDEnumImageItemReset(hItem, 2, cdENUM_HAS_THUMBNAIL, hEnumImage);
    if err <> cdOK then goto ErrHandler;

    err := CDGetImageItemCount(hEnumImage, ImageNum);
    if err <> cdOK then
    begin
        goto ErrHandler
    end
    else if ImageNum = 0 Then
    begin
        err := IMAGE_FIND_ERROR;
        goto ErrHandler;
    end;

    while CDEnumImageItemNext(hEnumImage, hImage) = cdOK do
    begin
        err := CDGetItemInfo(hImage, iteminfo);
        if err <> cdOK then goto ErrHandler;

        If iteminfo.ItemType = cdITEM_TYPE_IMAGE_ITEM Then
            ListBox_ImageList.Items.AddObject(string(@iteminfo.Name),TObject(hImage));
    end;
    ListBox_ImageList.ItemIndex := 0;

    err := CDEnumImageItemRelease(hEnumImage);
    hEnumImage := 0;
    if err <> cdOK then goto ErrHandler;

    err := CDUnlockUI(m_hSource);
    if err <> cdOK then goto ErrHandler;

    Result := cdOK;
    Exit;

ErrHandler:
    if hEnumImage <> 0 then
        CDEnumImageItemRelease (hEnumImage);

    if hEnumVol <> 0 then
        CDEnumVolumeRelease (hEnumVol);

    CDUnlockUI(m_hSource);

    if err = IMAGE_FIND_ERROR Then
        ListBox_ImageList.Items.AddObject('There are no images in the camera',TObject(0))
    else
        ShowMessage('Error!');

    Result := err;

end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
Function TForm_Main.FindDCIMFolder(hVolume:cdHVolume; var hRetItem:cdHItem):cdErr;
var
    err         :cdErr;
    hEnumItem   :cdHEnum;
    hItem       :cdHItem;
    iteminfo    :cdItemInfo;

label
    ErrHandler;

begin

    hRetItem := 0;
    err := CDEnumItemReset(hVolume, cdENUM_HAS_THUMBNAIL, hEnumItem);
    if err <> cdOK then goto ErrHandler;

    while CDEnumItemNext(hEnumItem, hItem) = cdOK do
    begin
        err := CDGetItemInfo(hItem, iteminfo);
        if err <> cdOK then goto ErrHandler;

        if AnsiStrIComp( PChar(@iteminfo.Name), 'DCIM' ) = 0 then
        begin
            hRetItem := hItem;
            Break;
        end;
    end;

    err := CDEnumItemRelease(hEnumItem);
    hEnumItem := 0;
    If err <> cdOK then goto ErrHandler;

    Result := cdOK;
    Exit;

ErrHandler:
    if hEnumItem <> 0 then
        CDEnumItemRelease (hEnumItem);

    Result := err;

end;


//------------------------------------------------------------------------
//------------------------------------------------------------------------
Procedure TForm_Main.GetImageData(GetType:Integer);
var
    err         :cdErr;
    hImgItem    :cdHImageItem;
    hImgData    :cdHImageData;
    myMedium    :cdStgMedium;
    iteminfo    :cdItemInfo;
label
    ErrHandler;

begin

    if ListBox_ImageList.ItemIndex = -1 then Exit;

    hImgItem := LongInt( ListBox_ImageList.Items.Objects[ListBox_ImageList.ItemIndex]);
    if hImgItem = 0 then Exit;

    err := CDLockUI(m_hSource);
    if err <> cdOK then goto ErrHandler;

    err := CDOpenImage(hImgItem);
    if err <> cdOK then goto ErrHandler;

    if GetType = GET_DATA_TYPE_PICTURE then
        err := CDGetPicture(hImgItem, hImgData)
    else if GetType = GET_DATA_TYPE_THUMBNAIL Then
        err := CDGetThumbnail(hImgItem, hImgData);

    if err <> cdOK then goto ErrHandler;

    err := CDGetItemInfo(hImgItem, iteminfo);
    if err <> cdOK then goto ErrHandler;

    SaveDialog1.FileName := iteminfo.Name;
    SaveDialog1.Filter := ' ALL Files (*.*)|*.* | JPEG Files (*.jpg)|*.jpg | RAW Files (*.crw)|*.crw' ;
    if SaveDialog1.Execute = false then goto ErrHandler;

    //Get image data
    myMedium.MemType := cdMEMTYPE_FILE;
    myMedium.u.lpszFileName :=SaveDialog1.FileName;

    err := CDGetImageData(hImgData, myMedium, 0, 0, 0);
    if err <> cdOK then goto ErrHandler;

    err := CDCloseImage(hImgItem);
    hImgItem := 0;
    if err <> cdOK then goto ErrHandler;

    err := CDUnlockUI(m_hSource);
    if err <> cdOK then goto ErrHandler;

    Exit;

ErrHandler:
    if hImgItem <> 0 then
    begin
        CDCloseImage(hImgItem);
        hImgItem := 0;
    end;

    CDUnlockUI(m_hSource);

    if err <> cdOK then
        ShowMessage('Error!');

end;


end.