home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d5 / SGSCAN.ZIP / MultiTWAIN.pas < prev    next >
Pascal/Delphi Source File  |  1998-07-15  |  12KB  |  282 lines
  1. unit MultiTWAIN;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, CommDlg;
  8.  
  9. // Some of the functions in EZTWAIN require unsigned integers.  However,
  10. // it was not until the recent release of Delphi 4 that Inprise implemented
  11. // this; they did so with LongWord/Cardinal.  As far as D2 and D3 go, this
  12. // unit will attempt to substitute an Integer instead.  I don't know if it'll
  13. // work though!
  14.  
  15. type
  16. {$IFDEF VER100}
  17.    UnsignedInt32 = Cardinal;
  18. {$ELSE}
  19.    UnsignedInt32 = Integer;
  20. {$ENDIF}
  21.    hDibCallbackProc = procedure(curdib: THandle; n: Integer); stdcall;
  22.  
  23. const
  24.    TWAIN_BW=1;      { 1-bit per pixel, B&W      (== TWPT_BW) }
  25.    TWAIN_GRAY=2;      { 1,4, or 8-bit grayscale  (== TWPT_GRAY) }
  26.    TWAIN_RGB=4;      { 24-bit RGB color         (== TWPT_RGB) }
  27.    TWAIN_PALETTE=8; { 1,4, or 8-bit palette    (== TWPT_PALETTE) }
  28.    TWAIN_ANYTYPE=0; { any of the above }
  29.  
  30.    TWAIN_PRESESSION=1;        {    source manager not loaded }
  31.    TWAIN_SM_LOADED=2;          { source manager loaded }
  32.    TWAIN_SM_OPEN=3;           { source manager open }
  33.    TWAIN_SOURCE_OPEN=4;       { source open but not enabled }
  34.    TWAIN_SOURCE_ENABLED=5;    { source enabled to acquire }
  35.    TWAIN_TRANSFER_READY=6;    { image ready to transfer }
  36.    TWAIN_TRANSFERRING=7;      { image in transit }
  37.  
  38.    TWUN_INCHES=0;
  39.    TWUN_CENTIMETERS=1;
  40.    TWUN_PICAS=2;
  41.    TWUN_POINTS=3;
  42.    TWUN_TWIPS=4;
  43.    TWUN_PIXELS=5;
  44.  
  45. {$L eztwain.obj}
  46. function TWAIN_SelectImageSource(hwnd: HWND): Integer; stdcall; external;
  47. function TWAIN_AcquireNative(hwnd: HWND; pixmask: Integer): HBitmap; stdcall; external;
  48. procedure TWAIN_FreeNative(hDIB: HBitmap); stdcall external;
  49. function TWAIN_AcquireToClipboard(hwndApp: HWND; wPixTypes: UnsignedInt32): Integer; stdcall; external;
  50. function TWAIN_AcquireToFilename(hWndApp: HWND; pszFile: PChar): Integer; stdcall; external;
  51. function TWAIN_IsAvailable: Integer; stdcall; external;
  52. function TWAIN_EasyVersion: Integer; stdcall; external;
  53. function TWAIN_State: Integer; stdcall; external;
  54.  
  55. // Added by DSN 7/98, this allows the user to specify an
  56. // optional callback function to be called each time a new image comes
  57. // in.  This can be a potentially powerful way to increase the primary
  58. // application's efficiency, because upon receipt of an hdib the app
  59. // could start a background thread to begin processing the images as
  60. // needed.  Why bother with this?  Because on my Pentium 150, the Windows
  61. // NT task monitor indicates that when I download images at 112kbps that
  62. // I'm only using 15% of the processor's power, and the remaining 85% of
  63. // the time it is idle!  It's silly to wait to begin processing because
  64. // there's so much untapped processing capacity here.
  65.  
  66. procedure TWAIN_RegisterCallback(fxn: hDibCallbackProc); stdcall; external;
  67. procedure TWAIN_UnRegisterCallback; stdcall; external;
  68. // the next three functions were added by DSN to manage acquisition of multiple
  69. // images.  The first, TWAIN_CleadDibList, is called automatically by
  70. // TWAIN_AcquireNative (and, hence, the other Acquire functions).
  71. // TWAIN_GetNumDibs returns the number of images available.
  72. // Finally, TWAIN_GetDib retrieves a specific dib from the list.  Note that
  73. // the first dib corresponds to n = 0.
  74. // ALSO NOTE: the maximum number of dibs that can be scanned in is 999
  75. // This value may easily be expanded by changing the MAX_IMAGES constant
  76. // in the C code.
  77.  
  78. procedure TWAIN_ClearDibList; stdcall; external;
  79. function TWAIN_GetNumDibs: Integer; stdcall; external;
  80. function TWAIN_GetDib(n: Integer): THandle; stdcall; external;
  81.  
  82. function TWAIN_DibDepth(hDib: HBitmap): Integer; stdcall; external;
  83. function TWAIN_DibWidth(hDib: HBitmap): Integer; stdcall; external;
  84. function TWAIN_DibHeight(hDib: HBitmap): Integer; stdcall; external;
  85. function TWAIN_DibNumColors(hDib: HBitmap): Integer; stdcall; external;
  86. function TWAIN_CreateDibPalette(hdib: HBitmap): Integer; stdcall; external;  // HANDLE & HPALETTE, respectively
  87. procedure TWAIN_DrawDibToDC(
  88.         hDC: HDC;
  89.         dx, dy, w, h: Integer;
  90.         hDib: HBitmap;
  91.         sx, sy: Integer
  92.         ); stdcall; external;
  93. function TWAIN_WriteNativeToFilename(hdib: hBitmap; pszFile: PChar): Integer;  stdcall; external;
  94. function TWAIN_WriteNativeToFile(hdib: HBitmap; fh: Integer): Integer; stdcall; external;
  95. function TWAIN_LoadNativeFromFilename(pszFile: PChar): HBitmap; stdcall; external;
  96. function TWAIN_LoadNativeFromFile(fh: Integer): HBitmap;  stdcall; external;
  97. procedure TWAIN_RegisterApp( nMajorNum,nMinorNum: integer;
  98.                              nLanguage: integer;
  99.                              nCountry: integer;
  100.                              lpszVersion: PChar;
  101.                              lpszMfg: PChar;
  102.                              lpszFamily: PChar;
  103.                              lpszProduct: PChar); stdcall; external;
  104. procedure TWAIN_SetHideUI(fHide: Integer); stdcall; external;
  105. function TWAIN_GetHideUI: Integer; stdcall; external;
  106. function TWAIN_GetResultCode: UnsignedInt32; stdcall; external;
  107. function TWAIN_GetConditionCode: UnsignedInt32; stdcall; external;
  108. function TWAIN_LoadSourceManager: Integer; stdcall; external;
  109. function TWAIN_OpenSourceManager(hwnd: HWND): Integer; stdcall; external;
  110. function TWAIN_OpenDefaultSource: Integer; stdcall; external;
  111. function TWAIN_EnableSource(hwnd: hWnd): Integer; stdcall; external;
  112. function TWAIN_DisableSource: Integer; stdcall; external;
  113. function TWAIN_CloseSource: Integer; stdcall; external;
  114. function TWAIN_CloseSourceManager(hWnd: HWND): Integer; stdcall; external;
  115. function TWAIN_UnloadSourceManager: Integer; stdcall; external;
  116. function TWAIN_MessageHook(lpmsg: PMSG): Integer; stdcall; external;
  117. procedure TWAIN_ModalEventLoop; stdcall; external;
  118. procedure TWAIN_NativeXferGetAll(psmg: PMSG); stdcall; external; // for multiple xfers
  119. function TWAIN_AbortAllPendingXfers: Integer; stdcall; external;
  120. function TWAIN_WriteDibToFile(lpDIB: PBITMAPINFOHEADER; fh: Integer): Integer; stdcall; external;
  121. function TWAIN_NegotiateXferCount(nXfers: Integer): Integer; stdcall; external;
  122. function TWAIN_NegotiatePixelTypes(wPixTypes: UnsignedInt32): Integer; stdcall; external;
  123. function TWAIN_GetCurrentUnits: Integer; stdcall; external;
  124. function TWAIN_SetCurrentUnits(nUnits: Integer): Integer; stdcall; external;
  125. function TWAIN_GetBitDepth: Integer; stdcall; external;
  126. function TWAIN_SetBitDepth(nBits: Integer): Integer; stdcall; external;
  127. function TWAIN_GetPixelType: Integer; stdcall; external;
  128. function TWAIN_SetCurrentPixelType(nPixType: Integer): Integer; stdcall; external;
  129. function TWAIN_GetCurrentResolution: double;   // implemented below
  130. function TWAIN_SetCurrentResolution(dRes: double): Integer;  // implemented below
  131. function TWAIN_SetCapOneValue(Cap: UnsignedInt32; ItemType: UnsignedInt32; ItemVal: LongInt): Integer; stdcall; external;
  132. function TWAIN_GetCapCurrent(Cap: UnsignedInt32; ItemType: UnsignedInt32; pVal: Pointer): Integer; stdcall; external;
  133. function TWAIN_DS(DG: LongInt; DAT: UnsignedInt32; MSG: UnsignedInt32; pData: Pointer): Integer; stdcall; external;
  134. function TWAIN_Mgr(DG: LongInt; DAT: UnsignedInt32; MSG: UnsignedInt32; pData: Pointer): Integer; stdcall; external;
  135.  
  136. procedure CopyDIBIntoImage(hDIB: THandle; Image: TImage);
  137.  
  138. implementation
  139.  
  140. { The procedures implemented below are the ones which use floating point numbers }
  141.  
  142. const
  143.    ICAP_XRESOLUTION = $1118;
  144.    ICAP_PIXELTYPE = $0101;
  145.    TWTY_FIX32 = $0007;
  146.    TWTY_UINT16 = $0004;
  147.  
  148. type
  149.    TW_FIX32 = record
  150.       Whole: SmallInt;
  151.       Frac: Word;
  152.    end;
  153.  
  154. function ToFix32(r: Double): UnsignedInt32;
  155. var
  156.    fix: TW_FIX32;
  157.    v: Integer;
  158. begin
  159.    v := Round(r * 65536.0 + 0.5);
  160.    fix.Whole := ShortInt(V shr 16);
  161.    fix.Frac := Word (v and $ffff);
  162.    ToFix32 := UnsignedInt32(fix);
  163. end;
  164.  
  165. function Fix32ToFloat(fix: TW_FIX32): double;
  166. var
  167.    v: Integer;
  168. begin
  169.    v := (Integer(fix.Whole) shl 16) or (UnsignedInt32(fix.frac) and $ffff);
  170.    Fix32ToFloat := v / 65536.0;
  171. end;
  172.  
  173. function TWAIN_GetCurrentResolution: double;
  174. var
  175.    res: TW_FIX32;
  176. begin
  177.    TWAIN_GetCapCurrent(ICAP_XRESOLUTION, TWTY_FIX32, @res);
  178.    TWAIN_GetCurrentResolution := Fix32ToFloat(res);
  179. end;
  180.  
  181. function TWAIN_SetCurrentResolution(dRes: double): Integer;
  182. begin
  183.    TWAIN_SetCurrentResolution := TWAIN_SetCapOneValue(ICAP_XRESOLUTION, TWTY_FIX32, ToFix32(dRes));
  184. end;
  185.  
  186. (*************************************************)
  187.  
  188. procedure CopyDIBIntoImage(hDIB: THandle; Image: TImage);
  189. var
  190.    DibW, DibH, oldw, oldh: integer;
  191. begin
  192.    Oldw := Image.Width;
  193.    Oldh := Image.Height;
  194.    DibW := TWAIN_DibWidth(hDib);
  195.    DibH := TWAIN_DibHeight(hDib);
  196.    Image.Width := DibW;  // temporarily enlarge image to ensure the whole
  197.    Image.Height := DibH; // DIB gets copied
  198.    TWAIN_DrawDibToDC(Image.Canvas.Handle, 0, 0, DibW, DibH, hDIB, 0, 0);
  199.    Image.Width := oldw;
  200.    Image.Height := oldh;
  201. end;
  202.  
  203. {   The function below was adapted from code on www.codeguru.com.  After
  204.    I translated it from C++ I realized I wouldn't need it; however, I've
  205.    left it in here in case anyone else finds it useful.  NOTE: I never
  206.    tested to make sure my translation was accurate, so be careful! -- DSN 7/98
  207.  
  208. function DIBToDDB(hDIB: THandle): HBitmap;
  209. var
  210.    lpbi: PBitmapInfoHeader;
  211.    hbm: HBitmap;
  212.    Pal, OldPal: HPalette;
  213.    dc: HDC;
  214.    nSize: UnsignedInt32;
  215.    pLP: PLogPalette;
  216.    nColors, i: Integer;
  217.    lpDIBBits: Pointer;
  218.    bmInfo: PBitmapInfo;
  219.  
  220.    bmicoloraddr: PChar;
  221.    bmisum: PChar;
  222.    bmisumncolor: PChar;
  223.  
  224. begin
  225.    if (hDIB = 0) then
  226.       begin
  227.          DIBToDDB := 0;
  228.          exit;
  229.       end;
  230.    dc := GetDC(0);
  231.    pal := 0;
  232.  
  233.    lpbi := PBitmapInfoHeader(hDIB);
  234.    if (lpbi^.biClrUsed > 0) then
  235.       nColors := lpbi^.biClrUsed
  236.    else nColors := 1 shl lpbi^.biBitCount;
  237.  
  238.    bmicoloraddr := PChar(@(bmInfo^.bmiColors));
  239.    bmiSum := bmiColorAddr + (bmInfo^.bmiHeader.biClrUsed * sizeof(DWORD));
  240.    if bmInfo^.bmiHeader.biCompression = BI_BITFIELDS then
  241.       bmiSum := bmiSum + (3 * sizeof(DWORD));
  242.    bmisumncolor := bmiColorAddr + (nColors * sizeof(DWORD));
  243.  
  244.    if bmInfo^.bmiHeader.biBitCount > 8 then
  245.       lpDIBBits := Pointer(bmiSum)
  246.    else lpDIBBits := Pointer(bmisumncolor);
  247.  
  248.    if (nColors <= 256 and (GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE)) then
  249.       begin    // Create and select a logical palette if needed
  250.          nSize := sizeof(TLogPalette) + (sizeof(TPaletteEntry) * nColors);
  251.          GetMem(pLP, nSize);
  252.          pLP^.palVersion := $0300;
  253.          pLP^.palNumEntries := ncolors;
  254.          for i := 0 to nColors do
  255.             begin
  256.                pLP^.palPalEntry[i].peRed := bmInfo.bmiColors[i].rgbRed;
  257.                pLP^.palPalEntry[i].peGreen := bmInfo.bmiColors[i].rgbGreen;
  258.                pLP^.palPalEntry[i].peBlue := bmInfo.bmiColors[i].rgbBlue;
  259.                pLP^.palPalEntry[i].peFlags := 0;
  260.             end;
  261.          pal := CreatePalette(pLP^);
  262.          FreeMem(pLP);
  263.          OldPal := SelectPalette(dc, pal, False);// select and realize the palette
  264.          RealizePalette(dc);
  265.       end;
  266.    hbm := CreateDIBitmap(dc,
  267.                          (PBitmapInfoHeader(lpbi))^,
  268.                          LongInt(CBM_INIT),
  269.                          lpDIBBits,
  270.                          (PBitmapInfo(lpbi))^,
  271.                          DIB_RGB_COLORS);
  272.    if pal <> 0 then
  273.       SelectPalette(dc, Oldpal, False);
  274.    ReleaseDC(0, dc);
  275.    DIBToDDB := hbm;
  276. end;}
  277.  
  278. end.
  279.  
  280.  
  281.  
  282.