home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d5 / SGSCAN.ZIP / SGScan.pas < prev    next >
Pascal/Delphi Source File  |  2000-12-08  |  2KB  |  80 lines
  1. unit SGScan;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, extctrls, Forms, MultiTwain;
  7.  
  8. type
  9.   TSGScan = class(TComponent)
  10.   private
  11.     // property
  12.     FImage : TImage;
  13.  
  14.   protected
  15.     { Protected declarations }
  16.   public
  17.     constructor Create(AnOwner : TComponent); override;
  18.     destructor Destroy; override;
  19.     procedure Scan;
  20.   published
  21.     property Image : TImage read FImage write FImage;
  22.   end;
  23.  
  24. procedure CallbackFxn(CurDib: THandle; index: Integer); stdcall; forward;
  25. procedure Register;
  26.  
  27. implementation
  28.  
  29. constructor TSGScan.Create(AnOwner : TComponent);
  30. begin
  31.   inherited Create(AnOwner);
  32.   TWAIN_RegisterCallback(CallbackFxn);  
  33.   FImage := nil;
  34. end;
  35.  
  36. destructor TSGScan.Destroy;
  37. begin
  38.   inherited;
  39. end;
  40.  
  41. procedure TSGScan.Scan;
  42. var
  43.   lhdib, ltestdib: hbitmap;
  44.   lw, lh: integer;
  45.   ln: Integer;
  46. begin
  47.   if not Assigned(FImage) then
  48.     EXIT;
  49.     
  50.   TWAIN_SelectImageSource(0);
  51.   lhdib := TWAIN_AcquireNative(0, 0);
  52.   ln := TWAIN_GetNumDibs;
  53.   if ln >= 1 then
  54.   begin
  55.     lTestDib := TWAIN_GetDib(0);
  56.     CopyDibIntoImage(lTestDib, FImage);
  57.     TWAIN_FreeNative(lTestDib);
  58.     lTestDib := 0;
  59.   end;
  60.   if ln = 2 then
  61.   begin
  62.     lTestDib := TWAIN_GetDib(1);
  63.     CopyDibIntoImage(lTestDib, FImage);
  64.     TWAIN_FreeNative(lTestDib);
  65.     lTestDib := 0;
  66.   end;
  67. end;
  68.  
  69. procedure CallbackFxn(CurDib: THandle; index: Integer); stdcall;
  70. begin
  71.    MessageBox(0, 'Called back!', 'CallbackFxn', mb_ok);
  72. end;
  73.  
  74. procedure Register;
  75. begin
  76.   RegisterComponents('Scanning', [TSGScan]);
  77. end;
  78.  
  79. end.
  80.