Controlling a digital camera with Delphi (part 3). How to shoot a picture

The following Delphi code can be used to shoot a picture. The camera must support the command, otherwise nothing happens. Note that the code needs better error checking but it should work.

procedure TMainForm.ShootPicture;
var
aPortableDevManager: IPortableDeviceManager;
deviceIDs: TArrayPWideChar;
countDeviceIDs: Cardinal;
res: HResult;
aPortableDevice: IPortableDevice;
aPortableDevValues: IPortableDeviceValues;
key: _tagpropertykey;
aCmdPortableDevValues, aCmdPortableDevValuesResult: IPortableDeviceValues;
aCmdGUID: TGUID;
begin
//for info see: http://msdn.microsoft.com/en-us/library/dd319331%28v=VS.85%29.aspx
aPortableDevManager := CoPortableDeviceManager.Create;
if VarIsClear(aPortableDevManager) then exit;
//get number of devices
countDeviceIDs := 0;
res := aPortableDevManager.GetDevices(nil, countDeviceIDs);
if (res < 0) or (countDeviceIDs = 0) then exit; //failed
//get all devices:
setLength(deviceIDs, countDeviceIDs);
res := aPortableDevManager.GetDevices(@deviceIDs[0], countDeviceIDs);
if res < 0 then exit; //failed
//get properties of the first device:
//create device:
aPortableDevice := CoPortableDevice.Create;
if VarIsClear(aPortableDevice) then exit;
//create device values:
aPortableDevValues := CreateComObject(CLASS_PortableDeviceValues) as IPortableDeviceValues;
if VarIsClear(aPortableDevValues) then exit;
//open the device (assume the camera is the first device):
res := aPortableDevice.Open(deviceIDs[0], aPortableDevValues);
if res < 0 then exit; //failed
//Note: when FAILED, we should Release the interfaces. (not implemented yet)
//shoot a picture:
//assume the camera supports this command, otherwise nothing happens.
//create device values:
aCmdPortableDevValues := CreateComObject(CLASS_PortableDeviceValues) as IPortableDeviceValues;
if VarIsClear(aCmdPortableDevValues) then exit;

key.fmtid := WPD_CATEGORY_COMMON;
key.pid := WPD_PROPERTY_COMMON_COMMAND_CATEGORY;
aCmdGUID := WPD_CATEGORY_STILL_IMAGE_CAPTURE;
res := aCmdPortableDevValues.SetGuidValue(key, aCmdGUID);
if res < 0 then exit; //failed

key.fmtid := WPD_CATEGORY_COMMON;
key.pid := WPD_PROPERTY_COMMON_COMMAND_ID;
res := aCmdPortableDevValues.SetUnsignedIntegerValue(key, WPD_COMMAND_STILL_IMAGE_CAPTURE_INITIATE);
if res < 0 then exit; //failed

//Shoot:
res := aPortableDevice.SendCommand(0, aCmdPortableDevValues, aCmdPortableDevValuesResult);
if res < 0 then exit; //failed
//I do not care about result:
aCmdPortableDevValuesResult := nil;
aCmdPortableDevValues := nil;
end;

Controlling a digital camera with Delphi (part 2)

As described in my previous post, I started coding with the Windows Portable Device (WPD) library. To do this in Delphi, you first need to create a TLB.PAS file that contains the declarations and other info from the library. I am using Delphi 2009, so the steps for this version are (assuming you have your project open):

1. menu: ‘Component -> Import Component…’
2. ‘Import a Type Library’, then click ‘Next’
3. From the list select: ‘PortableDeviceApi 1.0 Type Library’, then click ‘Next’
4. In the ‘Unit Dir Name’ box, enter the directory where you want the unit to be created, then click ‘Next’
5. Select ‘Create Unit’, then click ‘Finish’.
You should see the new Unit in Delphi. Add the unit to your project.

The library contains most of the information you need, but there are a few things we need to modify. First of all, add the following in the const declarations at the beginning of the unit (not necessary, but useful):

CLASS_PortableDeviceValues: TGUID = '{0c15d503-d017-47ce-9016-7b3f978721cc}';

Then, change the declarations for the following functions, which are not properly defined (I wasted a few days until I figured this out):
For ‘IEnumPortableDeviceObjectIDs’, change the ‘Next’ function to:

function Next(cObjects: LongWord;
              pObjIDs: Pointer;
              var pcFetched: LongWord): HResult; stdcall;

For ‘IPortableDeviceManager’, change the ‘GetDevices’ and ‘GetDeviceFriendlyName’ to:

function GetDevices(pPnPDeviceIDs: Pointer;
                    var pcPnPDeviceIDs: LongWord): HResult; stdcall;
function GetDeviceFriendlyName(pszPnPDeviceID: PWideChar;
                               pDeviceFriendlyName: Pointer;
                               var pcchDeviceFriendlyName: LongWord): HResult; stdcall;

There may be other functions that need editing but these are the ones I have discovered so far.
In addition, it is a good idea to define some constants, to make your life easier, especially when translating from c code. I created a new unit (named WPD) and added a long list of constants and some useful functions. I will post a link to the file once I clean it up a bit, so be patient for now. Most of the info can be found in the h files that are included in the Microsoft Windows Software Development Kit for Windows 7. This can be freely downloaded from the Microsoft web site. Also, be sure to visit and carefully study the Microsoft site for portable devices which contains examples of c code, upon which I based my implementation.

To end today’s post, here is code to look for wpd devices connected to your computer and list their names and device Ids to a Memo component:

procedure TMainForm.ListDevices;
var
 aPortableDevManager: IPortableDeviceManager;
 countDeviceIDs: Cardinal;
 res: HResult;
 deviceIDs: TArrayPWideChar;
 i: integer;
 pcchDeviceFriendlyName: Cardinal;
 DeviceFriendlyName: PWideChar;
begin
aPortableDevManager := CoPortableDeviceManager.Create;
 if VarIsClear(aPortableDevManager) then exit;
 //get number of devices
 countDeviceIDs := 0;
 res := aPortableDevManager.GetDevices(nil, countDeviceIDs);
 Memo1.Lines.Add('Devices found: ' + inttostr(countDeviceIDs));
 if (res < 0) or (countDeviceIDs = 0) then exit;
 //get all devices:
 setLength(deviceIDs, countDeviceIDs);
 res := aPortableDevManager.GetDevices(@deviceIDs[0], countDeviceIDs);
 if res < 0 then exit; //failed
 for i := 0 to countDeviceIDs - 1 do //enumerate the devices:
  begin
   Memo1.Lines.Add(deviceIDs[i]);
   //get length of friendly name:
   pcchDeviceFriendlyName := 0;
   aPortableDevManager.GetDeviceFriendlyName(deviceIDs[i],
                                             nil,
                                             pcchDeviceFriendlyName);
   DeviceFriendlyName := PWideChar(StringOfChar(' ', pcchDeviceFriendlyName));
   //get name:
   aPortableDevManager.GetDeviceFriendlyName(deviceIDs[i],
                                             @DeviceFriendlyName[0],
                                             pcchDeviceFriendlyName);
   Memo1.Lines.Add(DeviceFriendlyName);
  end;
end;

You will need these in your ‘uses’ list: Windows, ComObj, ActiveX, PortableDeviceApiLib_TLB, Variants, Classes
TArrayPWideChar was defined as:

type
 pArrayPWideChar = ^TArrayPWideChar;
 TArrayPWideChar = array of PWideChar;

In my next post I hope to show you how to shoot a picture.

Controlling a digital camera with Delphi

I want to create an application that will control a digital camera using Delphi, so that I can take pictures by issuing commands from the computer and then transfer them to my hard disk, all through the USB connection. I thought this would be relatively easy, but I managed to get lost pretty quickly.
First of all, I tried to implement the Picture Transfer Protocol (PTP), which is a relatively low level interface. I tried code by Miguel Lucero (http://www.delphi3000.com/articles/article_4077.asp) and Mike Heydon (http://www.delphi3000.com/articles/article_4841.asp) and managed to get the device name of the camera from the registry. Then I tried to communicate with it through the USB interface using the CreateFile and WriteFile/ReadFile functions. The CreateFile function seemed to work fine, returning what appeared as a valid handle:

For an example see http://members.fortunecity.com/sanya_k/oly/registry.htm, and the same code in Delphi:

hcamIN := CreateFile(PWideChar(pipeIn),
                GENERIC_READ,
                FILE_SHARE_READ,
                nil, // no SECURITY_ATTRIBUTES structure
                OPEN_EXISTING, // No special create flags
                0, // No special attributes
                0); // No template file

The problem was with the ReadFile and WriteFile functions, which always returned a “Request is not supported” error (error 50), no matter what I tried. Then I tried the DeviceIoControl function, but this also failed. I do not know what the problem is. I am running Delphi 2009 on Windows 7. I tried running the application in administrator mode, but that did not work any better. I thought that perhaps the camera (a Nikon D70) does not support PTP or USB commands, but this is not true, because the Nikon Camera Control Pro software works perfectly and I could see the USB commands going through, with the help of a USB sniffer program (I tried SnoopyPro and USBlyzer). Finally, I gave up, after almost a week of trying. Perhaps it is Delphi’s fault. I would appreciate any suggestions. If anyone has had a similar experience, please let me know.

After abandoning the USB low-level path, I decided to use the Windows Image Acquisition library (WIA), but soon realized that it is deprecated and that Windows Portable Devices interface (WPD) has taken its place. So, I started to code some basic stuff using WPD. I have made some progress and will report on it soon (I hope).

Update of StickyButton

In my previous entry I gave code to create a TButton descendant that emulates a TSpeedButton, but can accept 32 bit images from TImageLists (as TButtons do in Delphi 2009, but in contrast to TSpeedButtons). I mentioned that the new component does not automatically change state according to its Action's Checked property (if it is indeed associated with an Action). It turns out that this can be very easily corrected. Just add the following two procedures:

function TdhStickyButton.GetChecked: Boolean;
begin
 Result := Down;
end;

procedure TdhStickyButton.SetChecked(Value: Boolean);
begin
 Down := Value;
end;

The declaration section now becomes:

type
 TdhStickyButton = class(TButton)
 private
  FDDown: Boolean;
  FJustKilledWhenDown: Boolean;
  procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  procedure SetDownState(Value: Boolean);
 protected
  function GetChecked: Boolean; override;
  procedure SetChecked(Value: Boolean); override;
 public
  constructor Create(AOwner: TComponent); override;
 published
  property Down: Boolean read FDDown write SetDownState default false;
 end;

Delphi 2009

Installed Delphi 2009 a week ago and have been trying to update my code. The big change is Unicode support. All strings are now Unicode strings by default so there are a lot of instances that need reassigning to AnsiString. That was not too difficult.

My next attempt was to use 32 bit images in an ImageList. Not as easy as expected. I tried to load PNG images but the transparency did not come out very well. There was a faint grey border around the images, as if the semi-transparent pixels were grey instead of semi-transparent (fully transparent pixels were OK). After many hours of experimenting I found out that 32 bit bitmaps work perfectly. So now I use Inkscape to draw the icons, export to a PNG file, then use Pixelformer to convert from PNG to 32 bit BMP (using A8R8G8B8 format), then load the BMPs into the TImageList (which is set to 32 bits) and assign clNone as the transparent color. Pixelformer is a nice painting program that handles transparency very well and is perfect for this job.

The alpha-channel images can be used on TButtons as well. Unfortunately, they do not work on TSpeedButtons. So I thought of changing all TSpeedButtons to TButtons, but TButtons do not have a Down state. I searched the web and found out I could use the BN_SETSTATE message to make a button seem depressed. The problem is, the button does not stay depressed: as soon as you move the focus away, the button pops up again. This strange phenomenon was partly explained by Dennis Martin in this web page. It seems that a Click event is fired when the button looses focus. Dennis has a solution, but I wanted to create a component to emulate a TSpeedButton. I came up with a different way. Here is the code (feel free to use and share):

//TdhStickyButton, stays down when Down is true.
//intercepts Kill_Focus message to set a flag that shows
//  that it is down and was just killed (lost focus).
//intercepts WM_Command, which receives a Click message,
//  and only sends it along if it was not just killed in a down state.
//  also, resets temporary flag and sets the Down state appropriately
//  (otherwise it reverts automatically).
type
  TdhStickyButton = class(TButton)
  private
   FDDown: Boolean;
   FJustKilledWhenDown: Boolean;
   procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
   procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
   procedure SetDownState(Value: Boolean);
  protected
  public
   constructor Create(AOwner: TComponent); override;
  published
   property Down: Boolean read FDDown write SetDownState default false;
  end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Additional', [TdhStickyButton]);
end;

constructor TdhStickyButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FDDown := false;
end;

procedure TdhStickyButton.WMKillFocus(var Message: TWMKillFocus);
begin
 if FDDown then FJustKilledWhenDown := true else FJustKilledWhenDown := false;
 inherited;
end;

procedure TdhStickyButton.CNCommand(var Message: TWMCommand);
begin
 if (Message.NotifyCode = BN_CLICKED) and not(FJustKilledWhenDown) then Click;
 SendMessage(self.Handle, BM_SETSTATE, Longint(FDDown), 0);
 FJustKilledWhenDown := false;
end;

procedure TdhStickyButton.SetDownState(Value: Boolean);
begin
 FDDown := Value;
 SendMessage(self.Handle, BM_SETSTATE, Longint(FDDown), 0);
end;

A StickyButton is used like a regular button. If you want to show it down, just set its 'Down' property to true. The button will not toggle between down and up automatically, you have to do it with code. Also, if you attach an Action to the button, it will not toggle together with the Action's 'checked' property, as SpeedButtons do; again, you have to do it with code.

How to Set the Language in a PowerPoint presentation

To change the language of all text in all slides (including the Notes of the slides), use the following macro:

Sub SetLangUK()
'set language to UK for all slides and notes:
Dim scount, j, k, fcount
scount = ActivePresentation.Slides.Count
For j = 1 To scount
fcount = ActivePresentation.Slides(j).Shapes.Count
For k = 1 To fcount 'change all shapes:
If ActivePresentation.Slides(j).Shapes(k).HasTextFrame Then
ActivePresentation.Slides(j).Shapes(k).TextFrame _
.TextRange.LanguageID = msoLanguageIDEnglishUK
End If
Next k
'change notes:
fcount = ActivePresentation.Slides(j).NotesPage.Shapes.Count
For k = 1 To fcount 'change all shapes:
If ActivePresentation.Slides(j).NotesPage.Shapes(k).HasTextFrame Then
ActivePresentation.Slides(j).NotesPage.Shapes(k).TextFrame _
.TextRange.LanguageID = msoLanguageIDEnglishUK
End If
Next k
Next j
End Sub

I got half of this code from Antonín Otáhal and added the part about the NotesPage.

Upgrading to Delphi 2007 Update 1

Why should seemingly simple things induce so much frustration? I attempted to update my Delphi 2007 and lost more than 5 hours in the process and I haven’t finished yet. The InstallAware wizard is still installing. Everything started normally when I received a notification that Update 1 was available. So I downloaded the setup program and started the process. It seems that the setup program first uninstalls the whole of Delphi 2007 and then installs the updated copy. However, after uninstalling, it displayed a message saying that “Extraction of installation data downloaded from the web has failed. What would you like to do? Download a fresh copy of the installation data. Try to extract the existing download data again”. None of the options had any effect (I tried both many times) so the only choice was to quit the installer, leaving me with a computer without Delphi on it anymore! After googling a bit, I logged into Borland and downloaded the ‘Full download zip file (757MB)’ from CodeGear. However, installing from this file also seemed to produce exactly the same strange behaviour. Even though downloading from the web seemed to work fine, ‘extraction of data’ failed and nothing worked. I found the solution by luck: when the message appears, first select ‘Download a fresh copy’, then quit the installer and restart it. The installer will now properly extract the previously received file, but may fail on a subsequent one. Do the same thing for each file. This may require that you restart the installer many times, but eventually things work out OK.

Vista troubles

As anyone with even a tiny experience in upgrading from one OS to another would expect, going from Windows XP to Vista is not a trivial task. I installed Vista on one computer so that I could use it as a test-bed for upgrading my software ‘Viewbox’. Installation went fine except for the very frustrating fact that Vista Home Premium cannot be installed as an upgrade to XP Professional. You will need Vista Business or Ultimate to do that. So a clean install was done, requiring re-installation of a large number of software afterwards.
Then came the task of making Viewbox run on Vista (I already knew that Viewbox aborted on loading). I installed Delphi 2007 Professional and recompiled but the problem still persisted, flagging the error: ‘the computer does not have HTML Help support’. I knew this was not possible, because HTML Help support is built into Internet Explorer and depends on ‘hhctrl.ocx’, which is installed with Vista. The problem was that Viewbox could not find the ocx file. After a bit of googling, I found out that the file has changed location. If you want to find it, you should not rely on the registry entry, but you should look into the Windows folder. See the web page of The Helpware Group for more info.
However, even after solving this problem, Viewbox would not load. The problem was that I was using a TImageList component with a width of zero. Apparently, Windows XP has no problems with that, but Vista cannot tolerate it and shuts down the offending software. Fixing this was easy. Of course, you may ask why I was using a TImageList of zero width. That is another story.
After these changes, Viewbox seems to be running just fine under Vista. However, new security measures have been implemented in Vista. They include the User Account Control (UAC) system (for a detailed explanation, try this doc from Microsoft: WindowsVistaUACDevReqs.doc). The UAC does not allow writing of files in the C:\Program Files folder. This is a problem, because Viewbox saves its various settings in the Program Files\Viewbox folder as an INI file. I am not going to explain the details of the UAC (read the doc mentioned above). What you should know if you are programming in Delphi 2007, is that the XPManifest now includes an entry for the security level, as follows:
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
<security>
<requestedPrivileges>
<requestedExecutionLevel
level="asInvoker"
uiAccess="false"/>
</requestedPrivileges>
</security>
</trustInfo>
Setting ‘level’ equal to ‘asInvoker’ tells Vista not to implement virtualizing, so if your software tries to write to C:\Program Files\ it will fail. I have not figured out how to make Delphi change the Manifest contents so that virtualizing of files is possible.

TListBox bug

Another one of those bugs that make our life difficult. I have been trying to make a list box with variable item height. I wanted the height of each item to vary, depending on the item, so I thought I would associate a dummy object with each string of the list box, using code like this:

MyListBox.AddItem(aStr, Pointer(theHeight));

Then I would use an OnMeasureItem event to set the height:

procedure MyForm.MyListBoxMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
begin
Height := integer(MyListBox.Items.Objects[Index]);
end;

However, this does not work. The reason is rather interesting. When the AddItem procedure is called, the string is first added to the list box, then Delphi triggers the OnMeasureItem event, BEFORE the object has been added, so the event finds no object in the Items.Objects collection.
My workaround was to add the height as the first character of the string:

MyListBox.Items.Add(Char(theHeight) + aStr);

Then, in the OnMeasureItem procedure, I strip the character and convert it to an integer value:

Height := byte(MyListBox.Items[Index][1]);

Note that this will only work if the variable stored in the first character of the string is not zero, otherwise it will be mistaken as a string termination character and a null string will be added to the list box.

One year with the Prius

One year has passed since I got my Toyota Prius. I have been keeping a record of kilometres travelled and gas consumed. The average consumption over approximately 13000 Km has been about 5 lt/100 km. I have an Excel file here, which contains a graph of ‘lt/100 km’. During the past year I have tried to let the tank empty as much as possible and then fill it up with 20 Euros. However, sometimes this was not possible, so you will see some spikes in the graph; these are artefacts of the recording procedure. The true average consumption is calculated as the total amount of litres over the whole year divided by the number of kilometres travelled.
Overall, I am still very pleased with this car. The only problem is limited visibility, especially towards the back.