Система оптичного розпізнавання образів

{$ENDIF}

ProtocolMajor:= TWON_PROTOCOLMAJOR;

ProtocolMinor:= TWON_PROTOCOLMINOR;

SupportedGroups:= DG_IMAGE or DG_CONTROL;

lstrcpy(Manufacturer, 'KDTU');

lstrcpy(ProductFamily, 'Kirovograd');

{$IFDEF WIN32}

lstrcpy(ProductName, 'SCAN-Read 32 App');

{$ELSE}

lstrcpy(ProductName, 'SCAN-Read 16 App');

{$ENDIF}

end;

SetMessageLevel(ML_ERROR);

MsgError.Checked:= True;

end;

procedure TMainForm.ShowHint(Sender: TObject);

begin

StatusLine.Caption:= Application.Hint;

end; { End TMainForm.ShowHint. }

procedure TMainForm.CreateMDIChild(Name: string;

hWinBmp: HBitmap;

w, h: integer);

var Child: TMDIChild;

begin

{ create a new MDI child window }

if (hWinBmp <> 0) or FileExists(Name) or True

then begin

Child:= TMDIChild.Create(Application);

Child.Caption:= Name;

Child.Color:= clWhite;

if (hWinBmp <> 0)

then begin

Child.ClientWidth:= w;

Child.ClientHeight:= h;

Child.Bitmap.Width:= w;

Child.Bitmap.Height:= h;

Child.Bitmap.Handle:= hWinBmp;

{ Child.Image1.Picture.Bitmap.Handle:= hWinBmp; }

end

else begin

Name:= UpperCase(Name);

if (Pos('.BMP', Name) <> 0)

then Child.Bitmap.LoadFromFile(Name);

{$IFNDEF VER90}

if (Pos('.JPG', Name) <> 0)

then begin

JPEGImage:= TJPEGImage.Create;

JPEGImage.Performance:= jpBestQuality;

JPEGImage.LoadFromFile(Name);

Child.Bitmap.Width:= JPEGImage.Width;

Child.Bitmap.Height:= JPEGImage.Height;

Child.Bitmap.Canvas.Draw(0, 0, JPEGImage);

JPEGImage.Free;

end;

{$ENDIF}

{$IFDEF INCTIFF}

if (Pos('.TIF', Name) <> 0)

then LoadTIFFToBitmap(PChar(Name), Child.Bitmap);

{$ENDIF}

Child.ClientWidth:= Child.Bitmap.Width;

Child.ClientHeight:= Child.Bitmap.Height;

end;

Child.HorzScrollBar.Range:= w;

Child.VertScrollBar.Range:= h;

Child.Show;

end;

end; { End TMainForm.CreateMDIChild. }

procedure TMainForm.FileOpenItemClick(Sender: TObject);

begin

OpenDialog.Filter:= 'Bitmap|*.BMP';

{$IFNDEF VER90}

OpenDialog.Filter:= OpenDialog.Filter + '|JPEG|*.JPG';

{$ENDIF}

{$IFDEF INCTIFF}

OpenDialog.Filter:= OpenDialog.Filter + '|TIFF 5.0|*.TIF';

{$ENDIF}

case OpenDialog.FilterIndex of

1: OpenDialog.FileName:= '*.BMP';

2: OpenDialog.FileName:= '*.JPG';

3: OpenDialog.FileName:= '*.TIF';

end;

if OpenDialog.Execute

then CreateMDIChild(Lowercase(OpenDialog.FileName), 0, 0, 0);

end; { End TMainForm.FileOpenItemClick. }

procedure TMainForm.FileCloseItemClick(Sender: TObject);

begin

if (ActiveMDIChild <> nil)

then ActiveMDIChild.Close;

end; { End TMainForm.FileCloseItemClick. }

procedure TMainForm.FileSaveItemClick(Sender: TObject);

begin

{ save current file (ActiveMDIChild points to the window) }

if (ActiveMDIChild <> nil)

then begin

SaveDialog.Filter:= 'Bitmap|*.BMP';

{$IFNDEF VER90}

SaveDialog.Filter:= SaveDialog.Filter + '|JPEG|*.JPG';

{$ENDIF}

{$IFDEF INCTIFF}

SaveDialog.Filter:= SaveDialog.Filter + '|TIFF 5.0|*.TIF';

{$ENDIF}

case SaveDialog.FilterIndex of

1: SaveDialog.FileName:= '*.BMP';

2: SaveDialog.FileName:= '*.JPG';

3: SaveDialog.FileName:= '*.TIF';

end;

TMDIChild(ActiveMDIChild).Caption:=

UpperCase(TMDIChild(ActiveMDIChild).Caption);

if (Pos('.BMP', TMDIChild(ActiveMDIChild).Caption) <> 0)

then begin

SaveDialog.FilterIndex:= 1;

SaveDialog.FileName:= '*.BMP';

end;

if (Pos('.JPG', TMDIChild(ActiveMDIChild).Caption) <> 0)

then begin

SaveDialog.FilterIndex:= 2;

SaveDialog.FileName:= '*.JPG';

end;

if (Pos('.TIF', TMDIChild(ActiveMDIChild).Caption) <> 0)

then begin

SaveDialog.FilterIndex:= 3;

SaveDialog.FileName:= '*.TIF';

end;

if SaveDialog.Execute

then begin

if (Pos('.', SaveDialog.FileName) > 0)

then SaveDialog.FileName:= Copy(SaveDialog.FileName, 1, Pos('.',

SaveDialog.FileName)

- 1);

case SaveDialog.FilterIndex of

1: SaveDialog.FileName:= SaveDialog.FileName + '.BMP';

2: SaveDialog.FileName:= SaveDialog.FileName + '.JPG';

3: SaveDialog.FileName:= SaveDialog.FileName + '.TIF';

end;

TMDIChild(ActiveMDIChild).Caption:= lowerCase(SaveDialog.FileName);

if (Pos('.BMP', Uppercase(SaveDialog.FileName)) <> 0)

then

TMDIChild(ActiveMDIChild).Bitmap.SaveToFile(SaveDialog.FileName);

{$IFNDEF VER90}

if (Pos('.JPG', Uppercase(SaveDialog.FileName)) <> 0)

then begin

JPEGImage:= TJPEGImage.Create;

with TMDIChild(ActiveMDIChild)

do begin

JPEGImage.Assign(Bitmap);

if (Bitmap.PixelFormat <> pf24bit)

then JPEGImage.PixelFormat:= jf24bit;

end;

JPEGImage.Scale:= jsFullSize;

{ Dont compress JPEG image, ie. set quality to 100. }

JPEGImage.CompressionQuality:= 100;

JPEGImage.ProgressiveEncoding:= True;

JPEGImage.SaveToFile(SaveDialog.FileName);

JPEGImage.Free;

end;

{$ENDIF}

{$IFDEF INCTIFF}

if (Pos('.TIF', SaveDialog.FileName) <> 0)

then SaveTIFFToBitmap(PChar(SaveDialog.FileName),

TMDIChild(ActiveMDIChild).Bitmap);

{$ENDIF}

end;

end;

end; { End TMainForm.FileSaveItemClick. }

procedure TMainForm.FileSaveAsItemClick(Sender: TObject);

begin

{ save current file under new name }

end; { End TMainForm.FileSaveAsItemClick. }

procedure TMainForm.FileExitItemClick(Sender: TObject);

begin

Close;

end; { End TMainForm.FileExitItemClick. }

procedure TMainForm.WindowCascadeItemClick(Sender: TObject);

begin

Cascade;

end; { End TMainForm.WindowCascadeItemClick. }

procedure TMainForm.WindowTileItemClick(Sender: TObject);

begin

Tile;

end; { End TMainForm.WindowTileItemClick. }

procedure TMainForm.WindowArrangeItemClick(Sender: TObject);

begin

ArrangeIcons;

end; { End TMainForm.WindowArrangeItemClick. }

procedure TMainForm.WindowMinimizeItemClick(Sender: TObject);

var i: integer;

begin

{ Must be done backwards through the MDIChildren array }

for i:= MDIChildCount - 1 downto 0

do MDIChildren[i].WindowState:= wsMinimized;

end; { End TMainForm.WindowMinimizeItemClick. }

procedure TMainForm.UpdateMenuItems(Sender: TObject);

var EnableMenu: boolean;

begin

EnableMenu:= MDIChildCount > 0;

FileSaveItem.Enabled:= EnableMenu;

CutItem.Enabled:= EnableMenu;

CopyItem.Enabled:= EnableMenu;

PasteItem.Enabled:= EnableMenu;

SaveBtn.Enabled:= EnableMenu;

CutBtn.Enabled:= EnableMenu;

CopyBtn.Enabled:= EnableMenu;

PasteBtn.Enabled:= EnableMenu;

WindowCascadeItem.Enabled:= EnableMenu;

WindowTileItem.Enabled:= EnableMenu;

WindowArrangeItem.Enabled:= EnableMenu;

WindowMinimizeItem.Enabled:= EnableMenu;

end; { End TMainForm.UpdateMenuItems. }

procedure TMainForm.FormDestroy(Sender: TObject);

begin

{ TWAIN }

TWTerminate(0);

Screen.OnActiveFormChange:= nil;

end; { End TMainForm.FormDestroy. }

procedure TMainForm.TWAIN_MessageHook;

var Msg: TMsg;

begin

while GetMessage(msg, 0, 0, 0) and TWIsDSOpen

do begin

if Not(ProcessTWMessage(PMSG(@Msg), Handle))

then begin

TranslateMessage(Msg);

DispatchMessage(Msg);

end;

end;

end; { End TMainForm..TWAIN_MessageHook. }

{------------------------------------------------------------------------------}

{ This is where the image is returned from the TWAIN driver. }

{------------------------------------------------------------------------------}

procedure TMainForm.PMXferDone(var Msg: TMessage);

type LongType = record

case Word of

0: (Ptr: Pointer);

1: (Long: Longint);

2: (Lo: Word;

Hi: Word);

end;

ta = array[0..8000] of byte;

pa = ^ta;

var OldCursor: hCursor;

ScreenDC: HDC;

Count: Longint;

StartS: LongType;

ToAddrS: LongType;

BitsS: LongType;

StartT: LongType;

ToAddrT: LongType;

BitsT: LongType;

hTmpBmp: THandle;

MemFlags: longint;

hMem: THandle;

hBmp: THandle;

hBmpInfo: THandle;

hWinBmp: HBitmap;

pMem: pointer;

pBmp: pointer;

pBmpInfo: PBitmapInfo;

pBmpInfoHeader: pBitmapInfoHeader;

pBmpih: pBitmapInfoHeader;

pBmpch: pBitmapCoreHeader;

PalSize: longint;

RGBPalOfs: longint;

NoBits: word;

HeaderSize: longint;

SizeImage: longint;

LongWidth: longint;

BmpWidth: longint;

BmpHeight: longint;

ErrorStr: string;

a: pa;

begin

OldCursor:= SetCursor(LoadCursor(0, idc_Wait));

{$IFDEF TWAIN32}

LogMessage('PM_XFERDONE');

{$ENDIF}

{ TWAIN }

{ Scanned image was transfered through memory. }

{ NOTE: This version always provides images in memory. }

if (Msg.wParam <> 0)

then begin

hBmp:= 0;

hBmpinfo:= 0;

BmpWidth:= 0;

BmpHeight:= 0;

hMem:= THandle(Msg.wParam);

{ Convert the hMem handle to hBmp & hBmpInfo. }

pMem:= GlobalLock(hMem);

if (pMem <> Nil)

then begin

PalSize:= 0;

pBmp:= pMem;

pBmpInfoHeader:= pBmp;

{ Get palette size. }

pBmpih:= pBitmapInfoHeader(pBmpInfoHeader);

pBmpch:= pBitmapCoreHeader(pBmpInfoHeader);

{ Get number of bit per pixel. }

if (pBmpih^.biSize <> SizeOf(TBitmapCoreHeader))

then NoBits:= pBmpih^.biBitCount * pBmpih^.biPlanes

else NoBits:= pBmpch^.bcBitCount;

{ Determind Palette size. }

RGBPalOfs:= 0;

case NoBits of

1: PalSize:= 2;

4: PalSize:= 16;

8: PalSize:= 256;

24: begin

PalSize:= 0;

if (pBmpInfoHeader^.biClrUsed > 0)

then RGBPalOfs:= 4 * pBmpInfoHeader^.biClrUsed;

pBmpInfoHeader^.biClrUsed:= 0;

end;

else PalSize:= 0;

end;

{ Calc. Btimap header size. }

HeaderSize:= SizeOf(TBitmapInfoHeader) + PalSize * SizeOf(TRGBQuad);

{ Create & lock Bitmap Info. }

hBmpInfo:= GlobalAlloc(gmem_Moveable or gmem_Zeroinit, HeaderSize);

pBmpInfo:= GlobalLock(hBmpInfo);

{ Copy Bitmap info. }

{$IFDEF WIN32}

CopyMemory(pBmpInfo, pBmp, HeaderSize);

{$ELSE}

hmemcpy(pBmpInfo, pBmp, HeaderSize);

{$ENDIF}

with pBmpInfo^.bmiHeader

do begin

biClrUsed:= 0;

{ Ensure proper information. }

if (biXPelsPerMeter <= 0)

then if (biYPelsPerMeter > 0)

then biXPelsPerMeter:= biYPelsPerMeter

else biXPelsPerMeter:= round(30000.0 / 2.54);

if (biYPelsPerMeter <= 0)

then if (biXPelsPerMeter > 0)

then biYPelsPerMeter:= biXPelsPerMeter

else biYPelsPerMeter:= round(30000.0 / 2.54);

{ Calc. Long Width of Line. }

LongWidth:= (((biWidth * biBitCount) + 31) div 32) * 4;

if (biSizeImage = 0)

then biSizeImage:= LongWidth * biHeight;

SizeImage:= biSizeImage;

end;

{ Set window size indirectly. }

BmpWidth:= pBmpInfo^.bmiHeader.biWidth;

BmpHeight:= pBmpInfo^.bmiHeader.biHeight;

{ Unlock Bitmap Info. }

GlobalUnlock(hBmpInfo);

{ Move bitmap to top of memory array.}

Count:= SizeImage;

StartS.Long:= 0;

StartT.Long:= 0;

BitsS.Ptr:= pMem;

BitsT.Ptr:= pBmp;

inc(StartS.Long, HeaderSize);

inc(StartS.Long, RGBPalOfs);

if (BitsT.Ptr <> nil) and (BitsS.Ptr <> nil)

then begin

while (Count > 0)

do begin

{ Move one line at a time. }

if (Count > LongWidth)

then Count:= LongWidth;

{$IFDEF WIN32}

{ 32 Bit code. }

ToAddrS.Long:= BitsS.Long + StartS.Long;

ToAddrT.Long:= BitsT.Long + StartT.Long;

CopyMemory(ToAddrT.Ptr, ToAddrS.Ptr, Count);

{$ELSE}

{ 16 Bit code. }

ToAddrS.Hi:= BitsS.Hi + (StartS.Hi * Ofs(AHIncr));

ToAddrS.Lo:= StartS.Lo;

ToAddrT.Hi:= BitsT.Hi + (StartT.Hi * Ofs(AHIncr));

ToAddrT.Lo:= StartT.Lo;

{ Move bytes in picture. }

hmemcpy(ToAddrT.Ptr, ToAddrS.Ptr, Count);

{$ENDIF}

StartS.Long:= StartS.Long + Count;

StartT.Long:= StartT.Long + Count;

Count:= SizeImage - StartT.Long;

end;

end;

{ Unlock returned bitmap handle. }

GlobalUnlock(hMem);

{ Down size the hMem to only hold the actual pixels in the bitmap. }

MemFlags:= GlobalFlags(hMem);

hTmpBmp:= GlobalReAlloc(hMem, SizeImage + 16, LoWord(MemFlags));

if (hTmpBmp <> 0)

then begin

hBmp:= hTmpBmp;

end

else begin

ErrorStr:= Format('hMem resize error: %d', [GetLastError]);

MessageDlg(ErrorStr, mtInformation, [mbOK], 0);

hBmp:= hMem;

end;

{ If one of the memory handles doesn't contain a proper }

{ handle then discharge it all. }

if (hBmp = 0) or

(hBmpInfo = 0)

then begin

if (hBmp <> 0)

then GlobalFree(hBmp);

if (hBmpInfo <> 0)

then GlobalFree(hBmpInfo);

hBmp:= 0;

hBmpInfo:= 0;

end;

end

else begin

GlobalFree(hMem);

hMem:= 0;

end;

{ Create a MDI window. }

if (hBmp <> 0) and (hBmpInfo <> 0)

then begin

{ Create a DIBitmap that the canvas can show. }

ScreenDC:= GetDC(0);

pBmp:= GlobalLock(hBmp);

pBmpInfo:= GlobalLock(hBmpInfo);

hWinBmp:= CreateDIBitmap(ScreenDC,

pBmpInfo^.bmiHeader,

CBM_INIT,

pBmp,

pBmpInfo^,

DIB_RGB_Colors);

a:= globallock(hWinBmp);

globalunlock(hWinBmp);

GlobalUnlock(hBmp);

GlobalUnlock(hBmpInfo);

WinProcs.ReleaseDC(0, ScreenDC);

CreateMDIChild('', hWinBmp, BmpWidth, BmpHeight);

end;

if (hBmp <> 0)

then GlobalFree(hBmp);

if (hBmpInfo <> 0)

then GlobalFree(hBmpInfo);

Msg.wParam:= 0;

end;

SetCursor(OldCursor);

Msg.Result:= 0;

end; { End TMainForm.PMXferDone. }

procedure TMainForm.AcquireClick(Sender: TObject);

var OldCursor: hCursor;

Flag: integer;

ShowUI: bool;

TransType: integer;

begin

OldCursor:= SetCursor(LoadCursor(0, idc_Wait));

{ Flag = 0 Do Not Accept MSG_XFERREADY. }

{ 1 Disable/CloseDS/CloseDSM }

{ 2 Disable Only }

{ 3 Do Not Disable - only if ShowUI=True }

if FileShowUI.Checked

then begin

ShowUI:= True;

if FileDisable.Checked

then Flag:= 1

else Flag:= 3;

end

else begin

ShowUI:= False;

Flag:= 2;

end;

if MemoryXfer.Checked

then TransType:= 1

else if FileXfer.Checked

then TransType:= 2

else TransType:= 0;

TWAcquire(Handle, ShowUI, Flag, TransType);

TWAIN_MessageHook;

SetCursor(OldCursor);

end; { End TMainForm.AcquireClick. }

procedure TMainForm.SourceClick(Sender: TObject);

var OldCursor: hCursor;

begin

OldCursor:= SetCursor(LoadCursor(0, idc_Wait));

{ TWAIN }

{ SM userselect, or standard SM based user interface to Source's }

{ - open dsm }

{ - show user the data sources found by the SM }

{ allow user to pick a particular Source }

{ - close the SM }

if TWOpenDSM

then begin

TWSelectDS;

TWCloseDSM(0);

end;

SetCursor(OldCursor);

end; { End TMainForm.SourceClick. }

procedure TMainForm.NativeXferClick(Sender: TObject);

begin

NativeXfer.Checked:= False;

FileXfer.Checked:= False;

MemoryXfer.Checked:= False;

TMenuItem(Sender).Checked:= True;

end; { End TMainForm.NativeXferClick. }

procedure TMainForm.FileXferClick(Sender: TObject);

begin

NativeXfer.Checked:= False;

FileXfer.Checked:= False;

MemoryXfer.Checked:= False;

TMenuItem(Sender).Checked:= True;

end; { End TMainForm.FileXferClick. }

procedure TMainForm.MemoryXferClick(Sender: TObject);

begin

NativeXfer.Checked:= False;

FileXfer.Checked:= False;

MemoryXfer.Checked:= False;

TMenuItem(Sender).Checked:= True;

end; { End TMainForm.MemoryXferClick. }

procedure TMainForm.MsgNoneClick(Sender: TObject);

begin

MsgNone.Checked:= False;

MsgError.Checked:= False;

MsgInformation.Checked:= False;

MsgFull.Checked:= False;

TMenuItem(Sender).Checked:= True;

SetMessageLevel(ML_NONE);

end; { End TMainForm.MsgNoneClick. }

procedure TMainForm.MsgErrorClick(Sender: TObject);

begin

MsgNone.Checked:= False;

MsgError.Checked:= False;

MsgInformation.Checked:= False;

MsgFull.Checked:= False;

TMenuItem(Sender).Checked:= True;

SetMessageLevel(ML_ERROR);

end; { End TMainForm.MsgErrorClick. }

procedure TMainForm.MsgInformationClick(Sender: TObject);

begin

MsgNone.Checked:= False;

MsgError.Checked:= False;

MsgInformation.Checked:= False;

MsgFull.Checked:= False;

TMenuItem(Sender).Checked:= True;

SetMessageLevel(ML_INFO);

end; { End TMainForm.MsgInformationClick. }

procedure TMainForm.MsgFullClick(Sender: TObject);

begin

MsgNone.Checked:= False;

MsgError.Checked:= False;

MsgInformation.Checked:= False;

MsgFull.Checked:= False;

TMenuItem(Sender).Checked:= True;

SetMessageLevel(ML_FULL);

end; { End TMainForm.MsgFullClick. }

procedure TMainForm.AutomaticFeedingClick(Sender: TObject);

begin

if TMenuItem(Sender).Checked

then TMenuItem(Sender).Checked:= False

else TMenuItem(Sender).Checked:= True;

end; { End TMainForm.AutomaticFeedingClick. }

procedure TMainForm.FileShowUIClick(Sender: TObject);

begin

if TMenuItem(Sender).Checked

then TMenuItem(Sender).Checked:= False

else TMenuItem(Sender).Checked:= True;

end; { End TMainForm.FileShowUIClick. }

procedure TMainForm.FileDisableClick(Sender: TObject);

begin

if TMenuItem(Sender).Checked

then TMenuItem(Sender).Checked:= False

else TMenuItem(Sender).Checked:= True;

end; { End TMainForm.FileDisableClick. }

procedure TMainForm.HelpAboutItemClick(Sender: TObject);

begin

FormAbout:= TFormAbout.Create(Application);

FormAbout.ShowModal;

FormAbout.Close;

end; { End TMainForm.HelpAboutItemClick. }

end. { End Main. }

{------------------------------------------------------------------------------}

{ TWAIN source code: }

{------------------------------------------------------------------------------}

unit twa_acq;

interface

{ Needed for windows definitions. }

{ Needed for TWAIN sample resource definintions. }

uses WinTypes, WinProcs, Messages,

twain, twa_apph;

const PM_XFERDONE = wm_User + 0;

function TWAcquire (hTmpWnd: hWnd;

ShowUI: Bool;

Flag: TW_INT16;

Trans: TW_INT16): Bool;

function ProcessTWMessage (lpMsg: PMSG;

hTmpWnd: hWnd): bool;

procedure TWTransferImage (hTmpWnd: hWnd);

procedure LogMessage (Msg: PChar);

procedure SetAcqFlag (Flag: TW_INT16);

function IsSampleSourceActive: bool;

{ Only included to Forward declare. }

procedure DoNativeTransfer (hTmpWnd: hWnd);

procedure DoMemTransfer (hTmpWnd: hWnd);

procedure DoFileTransfer (hTmpWnd: hWnd);

procedure FlipBitMap (hTmpWnd: hWnd;

hBmp: THandle;

PixType: TW_INT16);

procedure CloseConnection (hBmp: THandle);

var TWAINFileName: TW_STR255; { Filename renamed to

TWAINFileName. }

AcqFlag: TW_INT16;

ADone: bool; { MCM, Done renamed to ADone. }

TransType: integer;

implementation

uses twa_glue, twa_CapT, twa_Auth,

SysUtils, Dialogs;

{------------------------------------------------------------------------------}

{ Needed to handle large bitmaps. }

{------------------------------------------------------------------------------}

{$IFNDEF WIN32}

procedure AHIncr; far; external 'KERNEL' index 114;

{$ENDIF}

{------------------------------------------------------------------------------}

procedure CreateFileName(TmpName, TmpExt: PChar);

var i, j: integer;

TmpFile: File;

begin

{$IFDEF WIN32}

if (GetTempPath(SizeOf(TmpName), TmpName) = 0)

then GetLastError;

{$ELSE}

GetTempFileName(GetTempDrive(Ch), 'TWN', word(0), TmpName);

{$ENDIF}

Assign(TmpFile, TmpName);

Reset(TmpFile);

Close(TmpFile);

Erase(TmpFile);

i:= 0;

j:= lstrlen(TmpName);

while (TmpName[i] <> '.') and (i < j)

do inc(i);

TmpName[i+1]:= #0;

lstrcat(TmpName, TmpExt);

end; { End CreateFileName. }

{------------------------------------------------------------------------------}

{ CheckSpecialMenu - Checks the item in the specials main window menu }

{ corresponding to the current state. }

{ }

{ ARGS: The Menu Item to check on the Special Menu }

{ All others will be unchecked }

{ }

{ RETURNS: VOID }

{------------------------------------------------------------------------------}

procedure CheckSpecialMenu(hWndofApp: hWnd; CkMenu: TW_INT16);

// var hMainMenu: hMenu;

begin

{ hMainMenu:= GetMenu(hWndofApp);

CheckMenuItem(hMainMenu, TW_APP_OPENSM, MF_BYCOMMAND

or MF_UNCHECKED);

CheckMenuItem(hMainMenu, TW_APP_OPENDS, MF_BYCOMMAND

or MF_UNCHECKED);

CheckMenuItem(hMainMenu, TW_APP_SEND, MF_BYCOMMAND or

MF_UNCHECKED);

CheckMenuItem(hMainMenu, TW_APP_ENABLE, MF_BYCOMMAND

or MF_UNCHECKED);

CheckMenuItem(hMainMenu, TW_APP_TRANSFER,

MF_BYCOMMAND or MF_UNCHECKED);

CheckMenuItem(hMainMenu, TW_APP_DISABLE, MF_BYCOMMAND

or MF_UNCHECKED);

CheckMenuItem(hMainMenu, TW_APP_CLOSEDS, MF_BYCOMMAND

or MF_UNCHECKED);

CheckMenuItem(hMainMenu, TW_APP_CLOSESM, MF_BYCOMMAND

or MF_UNCHECKED);

CheckMenuItem(hMainMenu, CkMenu, MF_BYCOMMAND or

MF_CHECKED);

}

end; { End CheckSpecialMenu. }

{------------------------------------------------------------------------------}

{ FUNCTION: SetAcqFlag }

{ }

{ ARGS: None }

{ RETURNS: None }

{ }

{ AcqFlag = 0 Do Not Accept MSG_XFERREADY }

{ 1 Disable/CloseDS/CloseDSM }

{ 2 Disable Only }

{ 3 Do Not Disable - only if ShowUI=True }

{ }

{------------------------------------------------------------------------------}

procedure SetAcqFlag(Flag: TW_INT16);

begin

AcqFlag:= Flag;

end; { End SetAcqFlag. }

{------------------------------------------------------------------------------}

{ FUNCTION: TWAcquire }

{ }

{ ARGS: None }

{ RETURNS: None }

{ }

{ NOTES: - opendsm, open the Source Manager }

{ - opends, open the Source }

{ - enable Source }

{ - wait for a message from Source (usually XFERREADY) }

{ }

{ Flag = 0 Do Not Accept MSG_XFERREADY }

{ 1 Disable/CloseDS/CloseDSM }

{ 2 Disable Only }

{ 3 Do Not Disable - only if ShowUI=True }

{ }

{ Trans = 0 Native Transfer. }

{ 1 Memory Transfer. }

{ 2 File Transfer. }

{

function TWAcquire(hTmpWnd: hWnd;

ShowUI: Bool;

Flag: TW_INT16;

Trans: TW_INT16): Bool;

{$IFDEF VER70}

var Result: boolean;

{$ENDIF}

begin

Result:= True;

AcqFlag:= 0; { Not ready to transfer yet. }

TransType:= Trans;

LogMessage('TWAcquire entry');

if TWOpenDSM

then begin

if TWOpenDS

then begin

if (TWXferMech(hGlobalWnd, TransType) = TWRC_SUCCESS)

then begin

if (TWAutofeedMenu(hGlobalWnd) = TWRC_SUCCESS)

then begin

if Not(TWIsDSEnabled)

then begin

Result:= TWEnableDS(TW_BOOL(ShowUI));

AcqFlag:= Flag;

{ AcqFlag = 0 Do Not Accept MSG_XFERREADY }

{ 1 Disable/CloseDS/CloseDSM }

{ 2 Disable Only }

{ 3 Do Not Disable - only if ShowUI=True }

end;

end;

end

else Result:= False;

end

else begin { OpenDS failed -- TWAcquire. }

LogMessage('OpenDS failed -- TWAcquire');

TWCloseDSM(0);

Result:= False;

end;

if Not(Result)

then begin

if TWDisableDS

then begin

if TWCloseDS

then begin

if TWCloseDSM(0)

then begin

{ CheckSpecialMenu(hGlobalWnd, TW_APP_CLOSESM); }

AcqFlag:= 0;

end

else; { CheckSpecialMenu(hGlobalWnd, TW_APP_CLOSEDS); }

end

else; {CheckSpecialMenu(hGlobalWnd, TW_APP_DISABLE); }

end;

end;

end

else Result:= False;

TWAcquire:= Result;

end; { End TWAcquire. }

{------------------------------------------------------------------------------}

{ FUNCTION: ProcessTWMessage }

{ }

{ ARGS: lpMsg Pointer to Windows msg retrieved by GetMessage }

{ hWnd Application's main window handle }

{ }

{ RETURNS: True if application should process message as usual }

{ False if application should skip processing of this message }

{ }

{ NOTES: 1). be sure both Source Manager and Source are open }

{ 2). two way message traffic: }

{ - relay windows messages down to Source's modeless dialog }

{ - retrieve TWAIN messages from the Source }

{ }

{ COMMENT: ProcessSourceMessage is designed for applications that can

only }

{ have one Source open at a time. If you wish your application to have

more}

{ than one Source open at a time please consult the TWAIN ToolKit for }

{ event handling instructions. }

{------------------------------------------------------------------------------}

function ProcessTWMessage(lpMsg: PMSG; hTmpWnd: hWnd): bool;

var twRC: TW_UINT16;

twEvent: TW_EVENT;

begin

twRC:= TWRC_NOTDSEVENT;

{ Only ask Source Manager to process event if there is a Source connected. }

if (TWIsDSMOpen and TWIsDSOpen)

then begin

{ A Source provides a modeless dialog box as its user interface. }

{ The following call relays Windows messages down to the Source's }

{ UI that were intended for its dialog box. It also retrieves TWAIN }

{ messages sent from the Source to our Application. }

twEvent.pEvent:= TW_MEMREF(lpMsg);

twRC:= lpDSM_Entry(@appID, @dsID,

DG_CONTROL,

DAT_EVENT,

MSG_PROCESSEVENT,

TW_MEMREF(@twEvent));

case twEvent.TWMessage of

MSG_XFERREADY: begin { If AcqFlag > 0 then we are in state 5. }

if (AcqFlag > 0)

then TWTransferImage(hTmpWnd)

else if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 0, 0, 0,

'Received while not in state 5',

'MSG_XFERREADY');

end;

MSG_CLOSEDSREQ: begin { Disable, CloseDS, CloseDSM. }

LogMessage('CloseDSReq');

if TWDisableDS

then begin

if TWCloseDS

then begin

if TWCloseDSM(0)

then {CheckSpecialMenu(hTmpWnd, TW_APP_CLOSESM) }

else; {CheckSpecialMenu(hTmpWnd, TW_APP_CLOSEDS); }

end

else; {CheckSpecialMenu(hTmpWnd, TW_APP_DISABLE); }

end;

end;

MSG_NULL: begin { No message from the Source to the App. }

end;

else begin { Possible new message. }

end;

end; { End of Message switch. }

end; { end of if DCDSMOpen. }

{ Tell the caller what happened. }

if (twRC = TWRC_DSEVENT)

then ProcessTWMessage:= True

else ProcessTWMessage:= False;

end; { End ProcessTWMessage. }

{------------------------------------------------------------------------------}

{ FUNCTION: TWTransferImage }

{ }

{ ARGS: hWnd }

{ }

{ RETURNS: none }

{ }

{ NOTES: 1). delete any bit maps laying around }

{ 2). mention those who do not want Native need CAP nego.

ICAP_XFERMECH }

{ 3). get a little information about image, for form, I do not use it. }

{ 4). set up a for form loop to pull image(s) from the Source. }

{ 5). call for GetCompleteImage from Source. }

{ 6). be sure to send a MSG_ENDXFER as a seperator between images. }

{ 7). after the images are transfered I like to shut down the Source. }

{ }

{ COMMENTS: Setup for a transfer in the routine called as a response to }

{ XFERREADY. Then has a nested loop do/while on the routine which }

{ actually pulls in the image or GetCompleteImage. The

GetCompleteImage}

{ routine also deals with the cancel, xferdone, success messages from }

{ Source. }

procedure TWTransferImage(hTmpWnd: hWnd);

//var twPendingXfer: TW_PENDINGXFERS;

// twRC: TW_UINT16;

begin

{ Tell the Source what type of transfer you want. }

case TransType of

1: DoMemTransfer(hTmpWnd);

2: DoFileTransfer(hTmpWnd);

else DoNativeTransfer(hTmpWnd);

end;

case AcqFlag of

1: begin { Disable, CloseDS, CloseDSM. }

if (TWDisableDS)

then begin

if (TWCloseDS)

then begin

if TWCloseDSM(0)

then begin { SUCCESS. }

{ CheckSpecialMenu(hTmpWnd, TW_APP_CLOSESM); }

AcqFlag:= 0;

end

else begin

{ CheckSpecialMenu(hTmpWnd, TW_APP_CLOSEDS); }

AcqFlag:= 0;

end;

end

else begin

AcqFlag:= 0;

{ CheckSpecialMenu(hTmpWnd, TW_APP_DISABLE); }

end;

end;

end;

2: begin { Only Disable for Special...Transfer. }

if (TWDisableDS)

then begin

{ CheckSpecialMenu(hTmpWnd, TW_APP_DISABLE); }

AcqFlag:= 0;

end;

end;

3: begin { Do not Disable. }

{ CheckSpecialMenu(hTmpWnd, TW_APP_TRANSFER); }

end;

end;

end; { End TWTransferImage. }

{------------------------------------------------------------------------------}

{ DoNativeTransfer - }

{------------------------------------------------------------------------------}

procedure DoNativeTransfer(hTmpWnd: hWnd);

var twPendingXfer: TW_PENDINGXFERS;

twRC: TW_UINT16;

twRC2: TW_UINT16;

hBmp: TW_UINT32;

hbm_acq: THandle; { handle to bitmap from Source to ret to App }

buffer: array[0..64] of char;

lpDib: PBitmapInfoHeader;

begin

{ Do until there are no more pending transfers }

{ explicitly initialize the our flags }

twPendingXfer.Count:= 0;

repeat

if (MessageLevel >= ML_INFO)

then begin

ShowImageInfo(hTmpWnd);

ShowImageLayout(hTmpWnd);

ShowCapability(hTmpWnd, ICAP_PIXELFLAVOR);

ShowCapability(hTmpWnd, ICAP_PIXELTYPE);

end;

if (AutoFeedOn)

then TagAT.ADFRunning:= True;

{ Initiate Native Transfer. }

twRC:= lpDSM_Entry(@appID,

@dsID,

DG_IMAGE,

DAT_IMAGENATIVEXFER,

MSG_GET,

TW_MEMREF(@hBmp));

case twRC of

TWRC_XFERDONE: begin { Session is in State 7 }

if (MessageLevel >= ML_FULL)

then ShowRC_CC(hTmpWnd, 0, 0, 0,

'TWRC_XFERDONE',

'DG_IMAGE / DAT_IMAGENATIVEXFER / MSG_GET');

hbm_acq:= hBmp;

{ Acknowledge the end of the transfer. }

{ and transition to state 6/5. }

twRC2:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_PENDINGXFERS,

MSG_ENDXFER,

TW_MEMREF(@twPendingXfer));

if (twRC2 <> TWRC_SUCCESS)

then if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC2, 1,

'',

'DG_CONTROL / DAT_PENDINGXFERS / MSG_ENDXFER');

StrFmt(Buffer, 'Pending Xfers = %d', [twPendingXfer.Count]);

LogMessage(buffer);

{ close the DSM and DS. }

if (twPendingXfer.Count = 0)

then begin

lpDib:= PBitmapInfoHeader(GlobalLock(hbm_acq));

if (lpDib <> Nil)

then begin

CloseConnection(hbm_acq);

GlobalUnlock(hbm_acq);

end;

end;

{ MCM, Maybe SendMessage should be replaced by }

{ PostMessage. }

if (hbm_acq >= THANDLE(VALID_HANDLE))

then SendMessage(hTmpWnd, PM_XFERDONE, hbm_acq, 0)

else SendMessage(hTmpWnd, PM_XFERDONE, 0, 0);

{ showRC_CC is a safe operation here since there }

{ will be no triplet calls generated }

if (MessageLevel >= ML_INFO)

then begin

StrFmt(Buffer, 'Images = %d', [twPendingXfer.Count]);

ShowRC_CC(0, 0, 0, 0, buffer, 'Pending Transfers');

end;

end;

{ the user canceled or wants to rescan the image something wrong, abort }

{ the transfer and delete the image pass a Nil ptr back to App. }

TWRC_CANCEL: begin { Session is in State 7 }

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 0, 0, 0,

'TWRC_CANCEL',

'DG_IMAGE/DAT_IMAGENATIVEXFER/MSG_GET');

{ Source (or User) Canceled Transfer }

{ transistion to state 6/5. }

twRC2:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_PENDINGXFERS,

MSG_ENDXFER,

TW_MEMREF(@twPendingXfer));

if (twRC2 <> TWRC_SUCCESS)

then if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC2, 1,

'',

'DG_CONTROL / DAT_PENDINGXFERS / MSG_ENDXFER');

{ close the DSM and DS. }

if (twPendingXfer.Count = 0)

then CloseConnection(0);

{ MCM, Maybe SendMessage should be replaced by }

{ PostMessage. }

SendMessage(hTmpWnd, PM_XFERDONE, 0, 0);

end;

TWRC_FAILURE: begin {Session is in State 6. }

{ The transfer failed. }

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, TWRC_FAILURE, 1,

'',

'DG_IMAGE/DAT_IMAGENATIVEXFER/MSG_GET');

{ Abort the image }

{ Enhancement: Check Condition Code and attempt }

{ recovery. }

twRC2:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_PENDINGXFERS,

MSG_ENDXFER,

TW_MEMREF(@twPendingXfer));

if (twRC2 <> TWRC_SUCCESS)

then if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC2, 1,

'',

'DG_CONTROL / DAT_PENDINGXFERS / MSG_ENDXFER');

{ close the DSM and DS. }

if (twPendingXfer.Count = 0)

then CloseConnection(0);

{ MCM, Maybe SendMessage should be replaced by }

{ PostMessage. }

SendMessage(hTmpWnd, PM_XFERDONE, 0, 0);

end;

else begin { Sources should never return any other RC. }

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 0, 0, 0,

'Unknown Return Code',

'DG_IMAGE/DAT_IMAGENATIVEXFER/MSG_GET');

{ Abort the image }

{ Enhancement: Check Condition Code and attempt }

{ recovery instead. }

twRC2:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_PENDINGXFERS,

MSG_ENDXFER,

TW_MEMREF(@twPendingXfer));

if (twRC2 <> TWRC_SUCCESS)

then if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC2, 1,

'',

'DG_CONTROL / DAT_PENDINGXFERS / MSG_ENDXFER');

{ close the DSM and DS. }

if (twPendingXfer.Count = 0)

then CloseConnection(0);

{ MCM, Maybe SendMessage should be replaced by }

{ PostMessage. }

SendMessage(hTmpWnd, PM_XFERDONE, 0, 0);

end;

end;

until (twPendingXfer.Count = 0);

if (TagAT.ADFRunning = True)

then begin

LogMessage('End of DoNative - ADF Running ');

TagAT.ADFRunning:= False;

ADone:= True;

InvalidateRect(0, Nil, True);

end;

AcqFlag:= 0;

end; { End DoNativeTransfer. }

{------------------------------------------------------------------------------}

{ DoFileTransfer -- }

{------------------------------------------------------------------------------}

procedure DoFileTransfer(hTmpWnd: hWnd);

type TLongType = record

case Word of

0: (Ptr: Pointer);

1: (Long: Longint);

2: (Lo: Word;

Hi: Word);

end;

var twPendingXfer: TW_PENDINGXFERS;

twRC: TW_UINT16;

twRC2: TW_UINT16;

setup: TW_SETUPFILEXFER;

hbm_acq: THandle; { handle to bit map from Source to ret to App }

hAFile: HFILE;

Aof: TOFSTRUCT;

buffer: array[0..64] of char;

Header: TBitmapFileHeader;

Count: TW_UINT32;

Num: TW_UINT16; { Default value Num:= $8000. }

{ MCM, Variables needed to handle large bitmaps. }

Start: TLongType;

ToAddr: TLongType;

Bits: TLongType;

begin

{ Do until there are no more pending transfers. }

{ explicitly initialize the our flags }

twPendingXfer.Count:= 0;

repeat

if (MessageLevel >= ML_INFO)

then begin

ShowImageInfo(hTmpWnd);

ShowImageLayout(hTmpWnd);

ShowCapability(hTmpWnd, ICAP_PIXELFLAVOR);

ShowCapability(hTmpWnd, ICAP_PIXELTYPE);

end;

lstrcpyn(Setup.FileName, TWAINFilename, SizeOf(TWAINFilename));

Setup.Format:= TWFF_BMP;

Setup.VRefNum:= 0;

{ create the file and close. }

hAFile:= OpenFile(TWAINFilename, Aof, OF_CREATE);

if (integer(hAFile) = HFILE_ERROR)

then begin

twRC:= TWRC_FAILURE;

ShowRC_CC(hTmpWnd, 0, twRC, 0,

'Unable to create file for file transfer',

'Application Error');

end

else begin

_lclose(hAFile);

twRC:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_SETUPFILEXFER,

MSG_SET,

TW_MEMREF(@setup));

if (twRC <> TWRC_SUCCESS)

then begin

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC, 1, '',

'DG_CONTROL / DAT_SETUPFILEXFER / MSG_SET');

end

else begin

if AutoFeedOn

then TagAT.ADFRunning:= True;

{ Initiate File Transfer. }

twRC:= lpDSM_Entry(@appID,

@dsID,

DG_IMAGE,

DAT_IMAGEFILEXFER,

MSG_GET,

TW_MEMREF(Nil));

end;

end;

case twRC of

TWRC_XFERDONE: begin { Successful Transfer. }

if (MessageLevel >= ML_FULL)

then ShowRC_CC(hTmpWnd, 0, 0, 0,

'TWRC_XFERDONE',

'DG_IMAGE / DAT_IMAGEFILEXFER / MSG_GET');

{ read the bitmap header and verify the transfer is a }

{ valid bmp and create a handle to that bitmap }

hbm_acq:= 0;

{ $IFDEF WIN32}

{ $ELSE}

hAfile:= OpenFile(Setup.FileName, Aof, OF_READ);

if (hAfile <> -1)

then begin

_lread(hAfile, @Header, SizeOf(TBitmapFileHeader));

hbm_acq:= GlobalAlloc(GHND, Header.bfSize);

if (hbm_acq <> 0)

then begin

Bits.Ptr:= GlobalLock(hbm_acq);

{ MCM, added to handle large bitmaps. }

Start.Long:= 0;

Count:= Header.bfSize - SizeOf(TBitmapFileHeader);

while (Count > 0)

do begin

{$IFDEF WIN32}

{ 32 Bit code. }

ToAddr.Long:= Bits.Long + Start.Long;

{$ELSE}

ToAddr.Hi:= Bits.Hi + (Start.Hi * Ofs(AHIncr));

ToAddr.Lo:= Start.Lo;

{$ENDIF}

Num:= $8000;

if (Count < Num)

then Num:= Count;

_lread(hAfile, PChar(ToAddr.Ptr), Num);

Count:= Count - Num;

Start.Long:= Start.Long + Num;

end;

GlobalUnlock(hbm_acq);

end;

_lclose(hAfile);

{ MCM, I'm just deleting the file. }

OpenFile(Setup.FileName, Aof, OF_DELETE);

end;

{ $ENDIF}

{ Acknowledge the end of the transfer and transition to }

{ state 6/5. }

twRC2:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_PENDINGXFERS,

MSG_ENDXFER,

TW_MEMREF(@twPendingXfer));

if (twRC2 <> TWRC_SUCCESS)

then if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC2, 1,

'',

'DG_CONTROL / DAT_PENDINGXFERS / MSG_ENDXFER');

{ close the DSM and DS. }

if (twPendingXfer.Count = 0)

then CloseConnection(0);

{ MCM, Maybe SendMessage should be replaced by }

{ PostMessage. }

SendMessage(hTmpWnd, PM_XFERDONE, hbm_acq, 0);

if Not(AutoFeedOn) and

TWIsDSMOpen and { MCM, Added to test if DS & DSM }

TWDSOpen { is open. Otherwise ? }

then AcqFlag:= 1;

{ showRC_CC is a safe operation here since there will }

{ be no triplet calls generated. }

if (MessageLevel >= ML_INFO)

then begin

StrFmt(Buffer, 'Images = %d', [twPendingXfer.Count]);

ShowRC_CC(0, 0, 0, 0, buffer, 'Pending Transfers');

end;

end;

{ the user canceled or wants to rescan the image something wrong, abort }

{ the transfer and delete the image pass a Nil ptr back to App. }

TWRC_CANCEL: begin

{ The Source is in state 7 transistion to state 6/5. }

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 0, 0, 0,

'TWRC_CANCEL',

'DG_IMAGE / DAT_IMAGEFILEXFER / MSG_GET');

twRC2:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_PENDINGXFERS,

MSG_ENDXFER,

TW_MEMREF(@twPendingXfer));

if (twRC2 <> TWRC_SUCCESS)

then if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC2, 1,

'',

'DG_CONTROL / DAT_PENDINGXFERS / MSG_ENDXFER');

{ close the DSM and DS. }

if (twPendingXfer.Count = 0)

then CloseConnection(0);

{ MCM, Maybe SendMessage should be replaced by }

{ PostMessage. }

SendMessage(hTmpWnd, PM_XFERDONE, 0, 0);

end;

TWRC_FAILURE: begin

{ The transfer failed. }

{ Determine Condition Code. }

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, TWRC_FAILURE, 1,

'',

'DG_IMAGE / DAT_IMAGEFILEXFER / MSG_GET');

{ Abort the image }

{ Enhancement: Check Condition Code and attempt }

{ recovery instead. }

twRC2:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_PENDINGXFERS,

MSG_ENDXFER,

TW_MEMREF(@twPendingXfer));

if (twRC2 <> TWRC_SUCCESS)

then if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC2, 1,

'',

'DG_CONTROL / DAT_PENDINGXFERS / MSG_ENDXFER');

{ close the DSM and DS. }

if (twPendingXfer.Count = 0)

then CloseConnection(0);

{ MCM, Maybe SendMessage should be replaced by }

{ PostMessage. }

SendMessage(hTmpWnd, PM_XFERDONE, 0, 0);

end;

else begin

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 0, 0, 0,

'Unknown Failure',

'DG_IMAGE / DAT_IMAGEFILEXFER / MSG_GET');

{ Abort the image. }

twRC2:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_PENDINGXFERS,

MSG_ENDXFER,

TW_MEMREF(@twPendingXfer));

if (twRC2 <> TWRC_SUCCESS)

then if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC2, 1,

'',

'DG_CONTROL / DAT_PENDINGXFERS / MSG_ENDXFER');

{ close the DSM and DS. }

if (twPendingXfer.Count = 0)

then CloseConnection(0);

{ MCM, Maybe SendMessage should be replaced by }

{ PostMessage. }

SendMessage(hTmpWnd, PM_XFERDONE, 0, 0);

{ showRC_CC is a safe operation here since there will }

{ be no triplet calls generated. }

if (MessageLevel >= ML_INFO)

then begin

StrFmt(Buffer, 'Images = %d', [twPendingXfer.Count]);

ShowRC_CC(0, 0, 0, 0, buffer, 'Pending Transfers');

end;

end;

end;

until (twPendingXfer.Count <= 0);

if (TagAT.ADFRunning = True)

then begin

TagAT.ADFRunning:= False;

ADone:= True;

InvalidateRect(0, Nil, True);

end;

end; { End DoFileTransfer. }

{------------------------------------------------------------------------------}

{ DoMemTransfer - }

{------------------------------------------------------------------------------}

procedure DoMemTransfer(hTmpWnd: hWnd);

type TLongType = record

case Word of

0: (Ptr: Pointer);

1: (Long: Longint);

2: (Lo: Word;

Hi: Word);

end;

var twPendingXfer: TW_PENDINGXFERS;

twRC2: TW_UINT16;

twRC: TW_UINT16;

hbm_acq: THandle; { handle to bit map from Source to ret to App }

xfer: TW_IMAGEMEMXFER;

setup: TW_SETUPMEMXFER;

info: TW_IMAGEINFO;

pal: TW_PALETTE8;

pDib: PBitmapInfo;

index: TW_UINT16;

Size: TW_UINT32;

cap: TW_CAPABILITY;

PixelFlavor: TW_UINT16;

pOneV: pTW_ONEVALUE;

Units: TW_UINT16;

XRes, YRes: real;

hWait: HCURSOR;

hReady: HCURSOR;

buffer: array[0..64] of char;

blocks: integer;

j: integer;

{ MCM, Variables needed to handle large bitmaps. }

NoColors: longint;

Start: TLongType;

ToAddr: TLongType;

Bits: TLongType;

begin

LogMessage('DoMemTransfer');

{ set the cursor to wait as a memory transfer may take a long time based on }

{ the size of the transfered chunks. Smaller buffers will produce very slow }

{ transfers, especially when thunking }

hWait:= LoadCursor(0, IDC_WAIT);

hReady:= LoadCursor(0, IDC_ARROW);

SetCursor(hWait);

{ Do until there are no more pending transfers explicitly initialize the our }

{ flags. }

twPendingXfer.Count:= 0;

repeat

if (MessageLevel >= ML_INFO)

then begin

ShowImageInfo(hTmpWnd);

ShowImageLayout(hTmpWnd);

ShowCapability(hTmpWnd, ICAP_PIXELFLAVOR);

ShowCapability(hTmpWnd, ICAP_PIXELTYPE);

end;

if AutoFeedOn

then TagAT.ADFRunning:= True;

twRC:= lpDSM_Entry(@appID,

@dsID,

DG_IMAGE,

DAT_IMAGEINFO,

MSG_GET,

TW_MEMREF(@Info));

if (twRC <> TWRC_SUCCESS)

then begin

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC, 1,

'Memory Transfer',

'DG_IMAGE/DAT_IMAGEINFO/MSG_GET');

end

else begin

{ Limited to 256 colors in Palette. }

Size:= (((longint(Info.ImageWidth * info.BitsPerPixel) + 31) div 32) * 4) *

Info.ImageLength;

if (Info.BitsPerPixel <= 8)

then NoColors:= 1 shl Info.BitsPerPixel

else NoColors:= 0;

{ make the size an integral of the preferred transfer size. }

twRC:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_SETUPMEMXFER,

MSG_GET,

TW_MEMREF(@Setup));

if (twRC = TWRC_SUCCESS) or True{ MCM ? }

then begin

blocks:= Size div Setup.Preferred;

Size:= (blocks + 1) * Setup.Preferred;

hbm_acq:= GlobalAlloc(GHND, Size +

SizeOf(TBitmapInfoHeader) +

NoColors * SizeOf(TRGBQUAD));

end

else hbm_acq:= 0;

if (hbm_acq = 0)

then begin { GlobalAlloc Failed. }

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 0, 0, 0,

'GlobalAlloc Failed in DoMemTransfer',

'Memory Error');

end

else begin { Lock the Memory. }

pDib:= PBitmapInfo(GlobalLock(hbm_acq));

{ fill in the image information. }

pDib^.bmiHeader.biSize:= SizeOf(TBITMAPINFOHEADER);

pDib^.bmiHeader.biWidth:= Info.ImageWidth;

pDib^.bmiHeader.biHeight:= Info.ImageLength;

{ Only 1 is supported. }

pDib^.bmiHeader.biPlanes:= 1;

pDib^.bmiHeader.biBitCount:= Info.BitsPerPixel;

{ This application does not support compression. }

pDib^.bmiHeader.biCompression:= BI_RGB;

pDib^.bmiHeader.biSizeImage:= (((longint(Info.ImageWidth * info.BitsPerPixel) + 31) div 32) * 4) * Info.ImageLength;

{Get Units and calculate PelsPerMeter. }

cap.Cap:= ICAP_UNITS;

cap.ConType:= TWON_DONTCARE16;

cap.hContainer:= 0;

twRC:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_CAPABILITY,

MSG_GETCURRENT,

TW_MEMREF(@cap));

if (twRC <> TWRC_SUCCESS)

then begin

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC, 1,

'ICAP_UNITS',

'DG_CONTROL/DAT_CAPABILITY/MSG_GETCURRENT');

pDib^.bmiHeader.biXPelsPerMeter:= 0;

pDib^.bmiHeader.biYPelsPerMeter:= 0;

end

else begin

pOneV:= pTW_ONEVALUE(GlobalLock(Cap.hContainer));

Units:= TW_UINT16(pOneV^.Item);

GlobalUnlock(Cap.hContainer);

GlobalFree(Cap.hContainer);

XRes:= FIX32ToFloat(Info.XResolution);

YRes:= FIX32ToFloat(Info.YResolution);

try

case Units of

TWUN_INCHES: with pDib^.bmiHeader

do begin

biXPelsPerMeter:= Round((XRes * 2.54) * 100.0);

biYPelsPerMeter:= Round((YRes * 2.54) * 100.0);

end;

TWUN_CENTIMETERS: with pDib^.bmiHeader

do begin

biXPelsPerMeter:= Round(XRes * 100);

biYPelsPerMeter:= Round(YRes * 100);

end;

{

TWUN_PICAS,

TWUN_POINTS,

TWUN_TWIPS,

TWUN_PIXELS,

}

else with pDib^.bmiHeader

do begin

biXPelsPerMeter:= Round(300.0 * 100.0 / 2.54);

biYPelsPerMeter:= Round(300.0 * 100.0 / 2.54);

end;

end;

except

On E:Exception

do begin

with pDib^.bmiHeader

do begin

biXPelsPerMeter:= Round(300.0 * 100.0 / 2.54);

biYPelsPerMeter:= Round(300.0 * 100.0 / 2.54);

end;

end;

end;

end;

{ Setup Palette -- if the palettes are B/W or shades of gray, }

{ the color table is built here. If the image is 8 bit color, }

{ a call to the source is made to retrieve the correct set of }

{ colors. If the call fails, the color table is constructed }

{ with 256 shades of gray inorder to provide some image }

{ reference }

case Info.PixelType of

TWPT_BW: begin

pDib^.bmiHeader.biClrUsed:= 2;

pDib^.bmiHeader.biClrImportant:= 0;

{ Get CAP_PIXELFLAVOR to determine colors fill }

{ in the palette information. }

cap.Cap:= ICAP_PIXELFLAVOR;

cap.ConType:= TWON_DONTCARE16;

cap.hContainer:= 0;

twRC:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_CAPABILITY,

MSG_GETCURRENT,

TW_MEMREF(@cap));

if (twRC <> TWRC_SUCCESS)

then begin

if (MessageLevel >= ML_INFO)

then ShowRC_CC(hTmpWnd, 1, twRC, 1,

'MSG_GET',

'ICAP_PIXELFLAVOR');

PixelFlavor:= TWPF_CHOCOLATE;

end

else begin

if (cap.ConType <> TWON_ONEVALUE)

then begin

PixelFlavor:= TWPF_CHOCOLATE;

end

else begin

pOneV:= pTW_ONEVALUE(GlobalLock(cap.hContainer));

PixelFlavor:= TW_UINT16(pOneV^.Item);

GlobalUnlock(cap.hContainer);

end;

GlobalFree(cap.hContainer);

end;

if (PixelFlavor = 0)

then begin { 0 = Black. }

pDib^.bmiColors[0].rgbGreen:= $0000;

pDib^.bmiColors[0].rgbBlue:= $0000;

pDib^.bmiColors[0].rgbReserved:= 0;

j:= 1;

pDib^.bmiColors[j].rgbRed:= $00FF;

pDib^.bmiColors[j].rgbGreen:= $00FF;

pDib^.bmiColors[j].rgbBlue:= $00FF;

pDib^.bmiColors[j].rgbReserved:= 0;

end

else begin { ICAP_PIXELFLAVOR = 1. }

{ 0 = White. }

pDib^.bmiColors[0].rgbRed:= $0000;

pDib^.bmiColors[0].rgbRed:= $00FF;

pDib^.bmiColors[0].rgbGreen:= $00FF;

pDib^.bmiColors[0].rgbBlue:= $00FF;

pDib^.bmiColors[0].rgbReserved:= 0;

j:= 1;

pDib^.bmiColors[j].rgbRed:= $0000;

pDib^.bmiColors[j].rgbGreen:= $0000;

pDib^.bmiColors[j].rgbBlue:= $0000;

pDib^.bmiColors[j].rgbReserved:= 0;

end;

end;

TWPT_GRAY: begin

pDib^.bmiHeader.biClrUsed:= 256;

for index:= 0 to 255

do begin

pDib^.bmiColors[index].rgbRed:= index;

pDib^.bmiColors[index].rgbGreen:= index;

pDib^.bmiColors[index].rgbBlue:= index;

pDib^.bmiColors[index].rgbReserved:= 0;

end;

end;

TWPT_RGB: begin

pDib^.bmiHeader.biClrUsed:= 0;

end;

{

TWPT_PALETTE

TWPT_CMY

TWPT_CMYK

TWPT_YUV

TWPT_YUVK

TWPT_CIEXYZ

}

else begin { fill in the palette information. }

twRC:= lpDSM_Entry(@appID,

@dsID,

DG_IMAGE,

DAT_PALETTE8,

MSG_GET,

TW_MEMREF(@pal));

if (twRC <> TWRC_SUCCESS)

then begin

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC, 1,

'',

'DG_IMAGE / DAT_PALETTE8 / MSG_GET -- defaulting to 256 gray

image palette');

pDib^.bmiHeader.biClrImportant:= 0;

pDib^.bmiHeader.biClrUsed:= 256;

for index:= 0 to (pal.NumColors - 1)

do begin

pDib^.bmiColors[index].rgbRed:= index;

pDib^.bmiColors[index].rgbGreen:= index;

pDib^.bmiColors[index].rgbBlue:= index;

pDib^.bmiColors[index].rgbReserved:= 0;

end;

end

else begin

pDib^.bmiHeader.biClrUsed:= pal.NumColors;

pDib^.bmiHeader.biClrImportant:= 0;

for index:= 0 to (pal.NumColors - 1)

do begin

pDib^.bmiColors[index].rgbRed:= pal.Colors[index].Channel1;

pDib^.bmiColors[index].rgbGreen:= pal.Colors[index].Channel2;

pDib^.bmiColors[index].rgbBlue:= pal.Colors[index].Channel3;

pDib^.bmiColors[index].rgbReserved:= 0;

end;

end;

end;

end; { end case (PixelType). }

{ locate the start of the bitmap data }

Bits.Ptr:= pDib;

Start.Long:= SizeOf(TBITMAPINFOHEADER);

Start.Long:= Start.Long + pDib^.bmiHeader.biClrUsed * SizeOf(TRGBQUAD);

{ determine the buffer size. }

twRC:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_SETUPMEMXFER,

MSG_GET,

TW_MEMREF(@Setup));

if (twRC <> TWRC_SUCCESS)

then begin

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC, 1,

'',

'DG_CONTROL / DAT_SETUPMEMXFER / MSG_GET');

end

else begin { we will use a pointer to shared memory. }

{$IFDEF WIN32}

ToAddr.Long:= Bits.Long + Start.Long;

{$ELSE}

ToAddr.Hi:= Bits.Hi + (Start.Hi * Ofs(AHIncr));

ToAddr.Lo:= Start.Lo;

{$ENDIF}

xfer.Memory.Flags:= TWMF_APPOWNS or TWMF_POINTER;

xfer.Memory.Length:= Setup.Preferred;

xfer.Memory.TheMem:= ToAddr.Ptr;

{ transfer the data -- loop until done or canceled. }

repeat

twRC:= lpDSM_Entry(@appID,

@dsID,

DG_IMAGE,

DAT_IMAGEMEMXFER,

MSG_GET,

TW_MEMREF(@xfer));

case twRC of

TWRC_SUCCESS: begin

{ MCM }

{$IFDEF WIN32}

Start.Long:= Start.Long + xfer.BytesWritten;

ToAddr.Long:= Bits.Long + Start.Long;

xfer.Memory.TheMem:= ToAddr.Ptr;

{$ELSE}

Start.Long:= Start.Long + xfer.BytesWritten;

ToAddr.Hi:= Bits.Hi + (Start.Hi * Ofs(AHIncr));

ToAddr.Lo:= Start.Lo;

xfer.Memory.TheMem:= ToAddr.Ptr;

{$ENDIF}

end;

TWRC_XFERDONE: begin { Successful Transfer. }

if (MessageLevel >= ML_FULL)

then ShowRC_CC(hTmpWnd, 0, 0, 0,

'TWRC_XFERDONE',

'DG_IMAGE / DAT_IMAGEMEMXFER / MSG_GET');

GlobalUnlock(hbm_acq);

if Not(IsSampleSourceActive)

then FlipBitmap(hTmpWnd, hbm_acq, Info.PixelType);

SetCursor(hReady);

{ Acknowledge the end of the transfer }

{ and transition to state 6/5 }

twRC2:= lpDSM_Entry(@appID,

@dsID,

DG_CONTROL,

DAT_PENDINGXFERS,

MSG_ENDXFER,

TW_MEMREF(@twPendingXfer));

if (twRC2 <> TWRC_SUCCESS)

then if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 1, twRC2, 1,

'',

'DG_CONTROL / DAT_PENDINGXFERS / MSG_ENDXFER');

{ close the DSM and DS. }

if (twPendingXfer.Count = 0)

then CloseConnection(0);

SendMessage(hTmpWnd, PM_XFERDONE, hbm_acq, 0);

{ showRC_CC is a safe operation here }

{ since there will be no triplet calls}

{ generated. }

if (MessageLevel >= ML_INFO)

then begin

StrFmt(Buffer, 'Images = %d', [twPendingXfer.Count]);

ShowRC_CC(0, 0, 0, 0, buffer, 'Pending Transfers');

end;

end;

TWRC_CANCEL: begin

SetCursor(hReady);

{ The Source is in state 7 }

{ transistion to state 6/5 }

if (MessageLevel >= ML_ERROR)

then ShowRC_CC(hTmpWnd, 0, 0, 0,

'TWRC_CANCEL',

'DG_IMAGE / DAT_IMAGEMEMXFER / MSG_GET');

twRC2:= lpDSM_Entry(@appID,

GlobalUnlock(hbm_acq);

GlobalFree(hbm_acq);