Scanning a whole page with 150 DPI using a TWAIN scanner and not prompting the user.

Hello Experts!

I want to scan a whole page (150 dpi) with my TWAIN-compatible scanner using Delphi.

I know, the easiest way would be using the Kodak Windows Imaging OCR ActiveX control.
The problem is, one cannot set the scanner resolution in code - scanned images are always 75 dpi.
I searched for a long time and finally found a small TWAIN-wrapper unit supporting different resolutons and scan-areas.

Here is the entire unit, so you can test it for yourselfs (The two main procedures are TMyScan.Acquire and TMyScan.Save2File):

==========================Begin: MyScan.pas===========================
unit myscan;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  twain, syncobjs, stdctrls;

type
 TMyScan = class(TComponent)

  private
    function GotoState1 : boolean;
    function GotoState2 : boolean;
    function GotoState3 : boolean;
    function GotoState4 : boolean;
    function GotoState5 : boolean;
    function doubleToFIX32(d: double): TW_FIX32;
    procedure Save2File(top, left, bottom, right: double);
  public
    procedure Create;
    procedure Destroy;
    function GotoState(newState: integer) : boolean;
    function CapSetStandard : boolean;
    function CapSetUnitsInches : boolean;
    function CapSetXResolution(res: integer) : boolean;
    function CapSetYResolution(res: integer) : boolean;
    function CapSetBitDepth(dep: integer) : boolean;
    function CapSetGrayscale : boolean;
    function CapSetImageLayout(top, left, bottom, right: double) : boolean;
    function Acquire(top, left, bottom, right: double) : HBITMAP;
    function SelectSource: boolean;
    function GetState: Integer;
  end;

var
  appID        : TW_IDENTITY;      // Application
  DSM_Entry    : TDSMEntryProc;    // interface function for the twain dll
  state        : integer;          // The state of the Twain-protocol
  dsID         : TW_IDENTITY;      // Data source
  UI           : TW_USERINTERFACE; // User interface
  hNative      : HBITMAP;          // handle to scanned image
  dllHandle    : THandle;          // handle to Twain_32.dll

implementation

procedure TMyScan.Create;
{
  Called to create a MyScan object
}
begin
  {Set _required_ AppID properties}
  AppID.Id := 0;
  AppID.ProtocolMajor   := TWON_PROTOCOLMAJOR;
  AppID.ProtocolMinor   := TWON_PROTOCOLMINOR;
  AppID.SupportedGroups := DG_CONTROL or DG_IMAGE;

  {set User interface defaults}
  UI.hParent := application.handle;

  state := 1;
end;

procedure TMyScan.Destroy;
{
  Called to destroy a MyScan object
}
begin
  gotoState(1);
end;

function TMyScan.GotoState(newState: integer) : boolean;
{
  This function changes the state of the TWAIN protocol. First, it looks what
  state the protocol is currently in. The protocol is changed to all states
  between the current state and the new state.
}
begin
  result := false;
  if (state > newState) then
  begin
    if (state = 5) and (newState < 5) then
    begin
      result := GotoState4;
    end;
    if (state = 4) and (newState < 4) then
    begin
      result := GotoState3;
    end;
    if (state = 3) and (newState < 3) then
    begin
      result := GotoState2;
    end;
    if (state = 2) and (newState < 2) then
    begin
      result := GotoState1;
    end;
  end
  else
  begin
    if (state = 1) and (newState > 1) then
    begin
      result := GotoState2;
    end;
    if (state = 2) and (newState > 2) then
    begin
      result := GotoState3;
    end;
    if (state = 3) and (newState > 3) then
    begin
      result := GotoState4;
    end;
    if (state = 4) and (newState > 4) then
    begin
      result := GotoState5;
    end;
  end;
end;

function TMyScan.GotoState1 : boolean;
begin
  result := false;
  if state = 2 then
  begin
    FreeLibrary(dllHandle);
    state := 1;
    result := true;
  end;
end;

function TMyScan.GotoState2 : boolean;
begin
  result := false;
  if state = 1 then
  begin
    dllHandle := LoadLibrary('twain_32.dll');
    if dllHandle <> 0 then
    begin
      @DSM_Entry := GetProcAddress(dllHandle, 'DSM_Entry');
      state := 2;
      result := true;
    end;
  end;
  if state = 3 then
  begin
    if (DSM_Entry(@AppID, nil, DG_CONTROL, DAT_PARENT, MSG_CLOSEDSM,
        @(application.handle)) = TWRC_SUCCESS) then
    begin
      state := 2;
      result := true;
    end;
  end;
end;

function TMyScan.GotoState3 : boolean;
begin
  result := false;
  if state = 2 then
  begin
    AppID.Id := 0;
    if (DSM_Entry(@AppID, nil, DG_CONTROL, DAT_PARENT, MSG_OPENDSM,
        @(application.handle)) = TWRC_SUCCESS) then
    begin
      state := 3;
      result := true;
    end;
  end;
  if state = 4 then
  begin
    if (DSM_Entry(@AppID, nil, DG_CONTROL, DAT_IDENTITY, MSG_CLOSEDS, @dsID) =
      TWRC_SUCCESS) then
    begin
      state := 3;
      result := true;
    end;
  end;
end;

function TMyScan.GotoState4 : boolean;
begin
  result := false;
  if state = 3 then
  begin
    dsID.Id := 0;
    if (DSM_Entry(@AppID, nil, DG_CONTROL, DAT_IDENTITY, MSG_OPENDS, @dsID)
        = TWRC_SUCCESS) then
    begin
      state := 4;
      result := true;
    end;
  end;
  if state = 5 then
    if (DSM_Entry(@AppID, @dsID, DG_CONTROL, DAT_USERINTERFACE, MSG_DISABLEDS,
        @UI) = TWRC_SUCCESS) then
    begin
      state := 4;
      result := true;
    end;
end;

function TMyScan.GotoState5 : boolean;
begin
  result := false;
  UI.ShowUI := false;  // Disable UI from scanner
  if ( DSM_Entry(@AppID, @dsID, DG_CONTROL, DAT_USERINTERFACE, MSG_ENABLEDS,
       @UI) = TWRC_SUCCESS) then
  begin
    state := 5;
    result := true;
  end;
end;

function TMyScan.CapSetStandard : boolean;
begin
  result := true;
  result := result and CapSetUnitsInches;
  result := result and CapSetXResolution(150);
  result := result and CapSetYResolution(150);
  result := result and CapSetBitDepth(24);
  //result := result and CapSetGrayscale;
end;

function TMyScan.CapSetUnitsInches : boolean;
var
  twCap: TW_CAPABILITY;
  pval: pTW_ONEVALUE;
begin
  result := false;
  if (state = 4) then
  begin
    {Set units to inches}
    twcap.Cap        := ICAP_UNITS;
    twcap.ConType    := TWON_ONEVALUE;
    twcap.hContainer := GlobalAlloc(GMEM_MOVEABLE, sizeof(TW_ONEVALUE));
    pval := GlobalLock(twcap.hContainer);
    pval.ItemType := TWTY_UINT16;
    pval.Item := TW_UINT32(TWUN_INCHES);
    //pval.Item := TW_UINT32(TWUN_PIXELS);
    if DSM_Entry(@AppID, @dsID, DG_CONTROL, DAT_CAPABILITY, MSG_SET, @twcap)
       = TWRC_SUCCESS then
    begin
      result := true;
    end;
  end;
end;

function TMyScan.CapSetXResolution(res: integer) : boolean;
var
  twCap: TW_CAPABILITY;
  pval: pTW_ONEVALUE;
begin
  result := false;
  if (state = 4) then
  begin
    twcap.Cap        := ICAP_XRESOLUTION;
    twcap.ConType    := TWON_ONEVALUE;
    twcap.hContainer := GlobalAlloc(GMEM_MOVEABLE, sizeof(TW_ONEVALUE));
    pval := GlobalLock(twcap.hContainer);
    pval.ItemType := TWTY_FIX32;
    pval.Item := TW_UINT32(res);
    if DSM_Entry(@AppID, @dsID, DG_CONTROL, DAT_CAPABILITY, MSG_SET, @twcap)
       = TWRC_SUCCESS then
    begin
      result := true;
    end;
  end;
end;

function TMyScan.CapSetYResolution(res: integer) : boolean;
var
  twCap: TW_CAPABILITY;
  pval: pTW_ONEVALUE;
begin
  result := false;
  if (state = 4) then
  begin
    twcap.Cap        := ICAP_YRESOLUTION;
    twcap.ConType    := TWON_ONEVALUE;
    twcap.hContainer := GlobalAlloc(GMEM_MOVEABLE, sizeof(TW_ONEVALUE));
    pval := GlobalLock(twcap.hContainer);
    pval.ItemType := TWTY_FIX32;
    pval.Item := TW_UINT32(res);
    if DSM_Entry(@AppID, @dsID, DG_CONTROL, DAT_CAPABILITY, MSG_SET, @twcap)
       = TWRC_SUCCESS then
    begin
      result := true;
    end;
  end;
end;

function TMyScan.CapSetBitDepth(dep: integer) : boolean;
var
  twCap: TW_CAPABILITY;
  pval: pTW_ONEVALUE;
begin
  result := false;
  if (state = 4) then
  begin
    twcap.Cap        := ICAP_BITDEPTH;
    twcap.ConType    := TWON_ONEVALUE;
    twcap.hContainer := GlobalAlloc(GMEM_MOVEABLE, sizeof(TW_ONEVALUE));
    pval := GlobalLock(twcap.hContainer);
    pval.ItemType := TWTY_UINT16;
    pval.Item := TW_UINT32(dep);
    if DSM_Entry(@AppID, @dsID, DG_CONTROL, DAT_CAPABILITY, MSG_SET, @twcap)
       = TWRC_SUCCESS then
    begin
      result := true;
    end;
  end;
end;

function TMyScan.CapSetGrayscale : boolean;
var
  twCap: TW_CAPABILITY;
  pval: pTW_ONEVALUE;
begin
  result := false;
  if (state = 4) then
  begin
    twcap.Cap        := ICAP_PIXELTYPE;
    twcap.ConType    := TWON_ONEVALUE;
    twcap.hContainer := GlobalAlloc(GMEM_MOVEABLE, sizeof(TW_ONEVALUE));
    pval := GlobalLock(twcap.hContainer);
    pval.ItemType := TWTY_UINT16;
    pval.Item := TW_UINT32(TWPT_GRAY);
    if DSM_Entry(@AppID, @dsID, DG_CONTROL, DAT_CAPABILITY, MSG_SET, @twcap)
       = TWRC_SUCCESS then
    begin
      result := true;
    end;
  end;
end;

function TMyScan.CapSetImageLayout(top, left, bottom, right: double) : boolean;
var
  ImageLayout: TW_IMAGELAYOUT;
begin
  result := false;
  if (state = 4) then
  begin
    ImageLayout.Frame.Top    := doubleToFIX32(top);    {inches}
    ImageLayout.Frame.Left   := doubleToFIX32(left);   {inches}
    ImageLayout.Frame.Bottom := doubleToFIX32(bottom); {inches}
    ImageLayout.Frame.Right  := doubleToFIX32(right);  {inches}
    if DSM_Entry(@AppID, @dsID, DG_IMAGE, DAT_IMAGELAYOUT, MSG_SET,
                 @ImageLayout) = TWRC_SUCCESS then
    begin
      result := true;
    end;
  end;
end;

function TMyScan.doubleToFIX32(d: double): TW_FIX32;
{
  Called when a standard double needs to be converted to a TWAIN fixed32.
}
begin
  result.Whole := trunc(d);
  result.Frac := round((d - trunc(d)) * 65536);
end;

function TMyScan.Acquire(top, left, bottom, right: double) : HBITMAP;
begin
  if //GotoState(4) and  //uncommented because it is done by the main app
     //CapSetStandard and
     CapSetImageLayout(top, left, bottom, right) and
     GotoState(5) then
  begin
    DSM_Entry(@AppID, @dsID, DG_IMAGE, DAT_IMAGENATIVEXFER, MSG_GET, @hNative);
    result := hNative;
    Save2File(top, left, bottom, right);
  end
  else
    result := 0;
end;

procedure TMyScan.Save2File(top, left, bottom, right: double);
var
  f: TFileStream; // File where the bitmap is written to
  lpDib: PBitmapInfo; // Contains the bitmap info (bits per pixel, pixelflavor)
  BMF: TBitmapFileHeader; // Contains the bitmap header information
  hdrSize: DWORD; // Contains the size of the header
begin
  f := TFileStream.Create('test.bmp', fmCreate);
  lpDib := GlobalLock(hNative);
  try
    if lpDib.bmiHeader.biBitCount > 8 then
    begin
      hdrSize := SizeOf(TBitmapInfoHeader);
      if (lpDib.bmiHeader.biCompression and BI_BITFIELDS) <> 0 then
        Inc(hdrSize, 12);
      end else begin
        hdrSize := SizeOf(TBitmapInfoHeader) +
                  SizeOf(TRGBQuad) * (1 shl lpDib.bmiHeader.biBitCount);
    end;
    BMF.bfType := $4D42;
    BMF.bfSize := lpDib.bmiHeader.biSizeImage;
    BMF.bfOffBits := sizeof(BMF) + hdrSize;
    f.WriteBuffer(BMF, Sizeof(BMF));
    f.WriteBuffer(lpDib^, trunc(150*150*(right-left)*(bottom-top)));
  finally
    GlobalUnlock(hNative);
  end;
  f.Free;
end;

function TMyScan.SelectSource : boolean;
begin
  result := false;
  GotoState(3);
  if state = 3 then
  begin
    if DSM_Entry(@AppID, nil, DG_CONTROL, DAT_IDENTITY, MSG_USERSELECT, @dsID)
       = TWRC_SUCCESS then
      result := true
  end;
end;

function TMyScan.GetState: Integer;
begin
  Result := state;
end;

end.
==========================End: MyScan.pas===========================


My application is using the following lines of code to acquire an image:

[...]
var
  Form1: TForm1;
  scn: TMyScan;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 scn.GotoState(1);
 scn.GotoState(2);
 scn.GotoState(3);
 scn.GotoState(4);
 scn.CapSetStandard;
 //this should actually do the job, since a Bitmap-Pointer is returned
 Image1.Picture.Bitmap.Handle := scn.Acquire(0, 0, 11, 7);
 //since it doesn't we will load the image from file
 Image1.Picture.Bitmap.LoadFromFile('test.bmp');

 
{PROBLEM:

  Eventhou the correct area was scanned (A4 letter is about 11 inch high and 7 inch wide),
  the returned picture only contains half of the graphic: The first half of the page,
  from the top, is just black.
  And dumping the picture to the harddrive is not working either .. I tried using a
  MemoryStream instead of a FileStream, but only got more errors and exceptions :/

 }

end;

Please help  :´/

Thank you,
Jessica Smith