oopstwain.pas

控制扫描仪的组件 控制扫描仪的组件

  TW_CAPABILITY = packed record //DAT_CAPABILITY. Used by app to get/set capability from/in a data source.
        Cap,
        ConType    : TW_UINT16;
        hContainer : THandle;
     end;
  pTW_CAPABILITY = ^TW_CAPABILITY;

  TW_SETUPMEMXFER = packed record
       MinBufSize: TW_UINT32;
       MaxBufSize: TW_UINT32;
       Preferred: TW_UINT32;
     end;
  pTW_SETUPMEMXFER = ^TW_SETUPMEMXFER;

  TW_USERINTERFACE =  packed record
       ShowUI     : TW_BOOL;  // TRUE if DS should bring up its UI
       ModalUI    : TW_BOOL; // For Mac only - true if the DS's UI is modal
       hParent    : TW_HANDLE; // For windows only - App window handle
     end;
  pTW_USERINTERFACE = ^TW_USERINTERFACE;

  TW_EVENT      =  packed record
       pEvent     :TW_MEMREF;    // Windows pMSG or Mac pEvent.
       TWMessage  :TW_UINT16;    // TW msg from data source, e.g. MSG_XFERREADY
     end;
  pTW_EVENT = ^TW_EVENT;

  TW_PENDINGXFERS = packed record
       Count      :TW_UINT16;    // Number of additional "images" pending.
       Reserved   :TW_UINT32;
     end;
  pTW_PENDINGXFERS = ^TW_PENDINGXFERS;

  TW_ELEMENT8 = packed record
       Index: TW_UINT8;          // Value used to index into the color table.
       Channel1: TW_UINT8;       // First  tri-stimulus value (e.g Red)
       Channel2: TW_UINT8;       // Second tri-stimulus value (e.g Green)
       Channel3: TW_UINT8;       // Third  tri-stimulus value (e.g Blue)
     end;
  pTW_ELEMENT8 = ^TW_ELEMENT8;

  TW_PALETTE8 = packed record
       NumColors: TW_UINT16;     // Number of colors in the color table.
       PaletteType: TW_UINT16;   // TWPA_xxxx, specifies type of palette.
       Colors: array [0..255] of TW_ELEMENT8;  // TWPA_xxxx, specifies type of palette.
     end;
  pTW_PALETTE8 = ^TW_PALETTE8;

  TW_MEMORY = packed record
      Flags: TW_UINT32;          // Any combination of the TWMF_ constants.
      Length: TW_UINT32;         // Number of bytes stored in buffer TheMem.
      TheMem: TW_MEMREF;         // Pointer or handle to the allocated memory buffer.
    end;
  pTW_MEMORY = ^TW_MEMORY;

  TW_IMAGEMEMXFER = packed record
       Compression: TW_UINT16;   // How the data is compressed
       BytesPerRow: TW_UINT32;   // Number of bytes in a row of data
       Columns: TW_UINT32;       // How many columns
       Rows: TW_UINT32;          // How many rows
       XOffset: TW_UINT32;       // How far from the side of the image
       YOffset: TW_UINT32;       // How far from the top of the image
       BytesWritten: TW_UINT32;  // How many bytes written in Memory
       Memory: TW_MEMORY;        // Mem struct used to pass actual image data
     end;
  pTW_IMAGEMEMXFER = ^TW_IMAGEMEMXFER;

  TW_SETUPFILEXFER = packed record
       FileName: array [0..255] of Char;
       Format: TW_UINT16;            // Any TWFF_ constant
       VRefNum: TW_INT16;            // Used for Mac only
     end;
  pTW_SETUPFILEXFER = ^TW_SETUPFILEXFER;

  TW_ENUMERATION = packed record
       ItemType: TW_UINT16;
       NumItems: TW_UINT32;       // How many items in ItemList
       CurrentIndex: TW_UINT32;   // Current value is in ItemList[CurrentIndex]
       DefaultIndex: TW_UINT32;   // Powerup value is in ItemList[DefaultIndex]
       ItemList: array[0..0] of TW_UINT8; // Array of ItemType values starts here
     end;
  pTW_ENUMERATION = ^TW_ENUMERATION;

{**********************************************************************
 * Function: DSM_Entry, the only entry point into the Data Source Manager.
 * Parameters:
 *  pOrigin Identifies the source module of the message. This could
 *          identify an Application, a Source, or the Source Manager.
 *  pDest   Identifies the destination module for the message.
 *          This could identify an application or a data source.
 *          If this is NULL, the message goes to the Source Manager.
 *  DG      The Data Group.
 *          Example: DG_IMAGE.
 *  DAT     The Data Attribute Type.
 *          Example: DAT_IMAGEMEMXFER.
 *  MSG     The message.  Messages are interpreted by the destination module
 *          with respect to the Data Group and the Data Attribute Type.
 *          Example: MSG_GET.
 *  pData   A pointer to the data structure or variable identified
 *          by the Data Attribute Type.
 *          Example: (TW_MEMREF)&ImageMemXfer
 *                   where ImageMemXfer is a TW_IMAGEMEMXFER structure.
 * Returns:
 *  ReturnCode
 *         Example: TWRC_SUCCESS.
 ********************************************************************}

  DSM_Entry = function (pOrigin: pTW_IDENTITY; pDest: pTW_IDENTITY; DG: TW_UINT32;
                        DAT: TW_UINT16; MSG: TW_UINT16; pData: TW_MEMREF
                        ): TW_UINT16; stdcall;

  TOnTwMessage = procedure(Sender: TObject; Msg: string) of object;
  TOnCapture = procedure(Sender: TObject; bmp: TBitmap) of object;
  TOnFileNameNeeded = procedure(Sender: TObject; var FileName: string) of object;

  TtransferType = (doNativeTransfer, doFileTransfer, doMemTransfer);

  TOopsTwain = class(TComponent)
  private
    FAppID: TW_IDENTITY;
    FdsID: TW_IDENTITY;
    twUI: TW_USERINTERFACE;
    FHandle: HWND;
    FIsDSMOpen: Boolean;
    FIsDSOpen: Boolean;
    FIsDSEnabled: Boolean;
    FTransferType: TTransferType;
    hDSMDLL: THandle;
    lpDSM_Entry: DSM_Entry;
    OldWndProc: TFarProc;
    NewWndProc: Pointer;
    FHooked: Boolean;
    FAutoFeed: Boolean;
    FOnTwMessage: TOnTwMessage;
    FOnCapture: TOnCapture;
    FOnFileNameNeeded: TOnFileNameNeeded;
    procedure HookWin;
    procedure UnHookWin;
  protected
    function SelectDS: TW_UINT16;
    procedure WndProc(var Message: TMessage);
    function ProcessTWMessage(var aMsg: TMessage; TwhWnd: THandle): Boolean;
    function OpenDSM: TW_UINT16;       //  DSM
    function CloseDSM: TW_UINT16;
    function OpenDS: TW_UINT16;        //  DS
    function CloseDS: TW_UINT16;
    function XferMechDS: TW_UINT16;
    function AutoFeedDS: TW_UINT16;
    function EnableDS(Show: Boolean): TW_UINT16;  // UI
    function DisableDS: TW_UINT16;
    procedure TransferImage;
    procedure NativeTransfer;
    procedure FileTransfer;
    procedure MemoryTransfer;
    procedure DoXferDone(hDib: THandle);
    procedure DoTwMessage(Msg: string; TerminateDS: Boolean = True);
  public
    constructor Create(AOwner: TComponent);  override;
    destructor Destroy; override;
    function Acquire(Show: Boolean):TW_UINT16;
    function GetDSInfo(var DsID: TW_IDENTITY): TW_UINT16;
    function GetComponentInfo(var DsID: TW_IDENTITY): TW_UINT16;
    function SelectSource: TW_UINT16;
    procedure Terminate;
    property IsDSMOpen: Boolean read FIsDSMOpen;
    property IsDSOpen: Boolean read FIsDSOpen;
    property IsDSEnabled: Boolean read FIsDSEnabled;
  published
    property AutoFeed: Boolean read FAutoFeed write FAutoFeed;
    property TransferType: TtransferType read FTransferType write FTransferType;
    property OnCaptrue: TOnCapture read FOnCapture write FOnCapture;
    property OnErrorMessage: TOnTwMessage read FOnTwMessage write FOnTwMessage;
    property OnFileNameNeeded: TOnFileNameNeeded read FOnFileNameNeeded write FOnFileNameNeeded;
  end;

procedure Register;

implementation

function FIX32ToFloat(fix32: TW_FIX32): Double;
begin
  Result := fix32.Whole + (fix32.Frac / 65536.0);
end;

function DibNumColors(pv: Pointer): Word;
var
  Bits: integer;
begin
  if pBITMAPINFOHEADER(pv)^.biSize <> sizeof(BITMAPCOREHEADER) then begin
    if pBITMAPINFOHEADER(pv)^.biClrUsed <> 0 then begin
      Result := pBITMAPINFOHEADER(pv)^.biClrUsed;
      Exit;
    end;
    Bits := pBITMAPINFOHEADER(pv)^.biBitCount;
  end else Bits := pBITMAPCOREHEADER(pv)^.bcBitCount;
  case Bits of
   1: Result := 2;
   4: Result := 16;
   8: Result := 256;
  else Result := 0;
  end;
end;

function CreateBIPalette(lpbi: pBITMAPINFOHEADER): HPALETTE;
var
  pRgb: pRGBQUAD;
  nNumColors: Word;
  hPal: HGLOBAL;
  pPal: pLOGPALETTE;
  i: integer;
  Red, Green, Blue: Byte;
begin
  Result := 0;
  if lpbi=nil then Exit;
  if lpbi^.biSize <> sizeof(BITMAPINFOHEADER) then Exit;
  pRgb := pRGBQUAD(Longint(lpbi) + Word(lpbi^.biSize));
  nNumColors := DibNumColors(lpbi);
  if nNumColors<>0 then begin
    hPal := GlobalAlloc(GPTR, sizeof(LOGPALETTE) + nNumColors * sizeof(PALETTEENTRY));
    pPal := GlobalLock (hPal);
    if pPal=nil then Exit;
    pPal^.palNumEntries := nNumColors;
    pPal^.palVersion := $0300;
    for i:=0 to nNumColors-1 do begin
      pPal^.palPalEntry[i].peRed := pRGBQUAD(Longint(pRgb)+i)^.rgbRed;
      pPal^.palPalEntry[i].peGreen := pRGBQUAD(Longint(pRgb)+i)^.rgbGreen;
      pPal^.palPalEntry[i].peBlue := pRGBQUAD(Longint(pRgb)+i)^.rgbBlue;
      pPal^.palPalEntry[i].peFlags := 0;
    end;
    Result := CreatePalette(pPal^);
    GlobalUnlock(hPal);
    GlobalFree(hPal);
  end else if lpbi^.biBitCount = 24 then begin
    nNumColors := 256;
    hPal := GlobalAlloc(GPTR, sizeof(LOGPALETTE) + nNumColors * sizeof(PALETTEENTRY));
    pPal := GlobalLock (hPal);
    if pPal=nil then Exit;
    pPal^.palNumEntries := nNumColors;
    pPal^.palVersion := $0300;
    Red :=0;
    Green := 0;
    Blue := 0;
    for i:=0 to pPal^.palNumEntries-1 do begin
      pPal^.palPalEntry[i].peRed := Red;
      pPal^.palPalEntry[i].peGreen := Green;
      pPal^.palPalEntry[i].peBlue := Blue;
      pPal^.palPalEntry[i].peFlags := 0;
      Inc(Red, 32);
      if Red=0 then begin
        Inc(Green, 32);
        if Green=0 then Inc(Blue, 64);
      end;
    end;
    Result := CreatePalette(pPal^);
    GlobalUnlock(hPal);
    GlobalFree(hPal);
  end;
end;

procedure FlipBitMap(hWindow, hBM: THandle; PixType: TW_INT16);
var
  pDib: pByte;
  pbmi: pBITMAPINFO;
  bmpWidth, bmpHeight, Linelength: Longint;
  indexH, items, i: integer;
  SizeImage, ClrUsed, offset: DWord;
  BitCount: Word;
  temp: THandle;
  tempptr, tempptrsave, pbuffer: pByte;
  pixels: TW_UINT16;
  SaveRed, SaveBlue: Byte;
begin
  pDib := GlobalLock(hBM);
  pbmi := pBITMAPINFO(pDib);
  bmpWidth := pbmi^.bmiHeader.biWidth;
  bmpHeight := pbmi^.bmiHeader.biHeight;
  SizeImage := pbmi^.bmiHeader.biSizeImage;
  BitCount := pbmi^.bmiHeader.biBitCount;
  ClrUsed := pbmi^.bmiHeader.biClrUsed;
  temp := GlobalAlloc(GHND, SizeImage);
  if temp <> 0 then begin
    tempptr := GlobalLock(temp);
    tempptrsave := tempptr;
    // calculate offset to start of the bitmap data
    offset := Sizeof(BITMAPINFOHEADER);
    Inc(offset, ClrUsed * sizeof(RGBQUAD));
    Linelength := (((bmpWidth * BitCount + 31) div 32) * 4);
    //Goto Last line in bitmap
    Inc(offset, Linelength * (bmpHeight - 1));
    Inc(pDib, offset);      // pDib = pDib + offset - Linelength;
    Dec(pDib, Linelength);
    for indexH := 1 to bmpHeight - 1 do begin
      Move(pDib^, tempptr^, Linelength);
      Dec(pDib, Linelength);
      Inc(tempptr, Linelength);
    end;
    // Copy temp over hBM
    pbuffer := pByte(pbmi);
    Inc(pbuffer, Sizeof(BITMAPINFOHEADER));
    Inc(pbuffer, ClrUsed * Sizeof(RGBQUAD));
    Move(tempptrsave^, pbuffer^, SizeImage); // memcpy(pbuffer, tempptrsave, SizeImage);
    if PixType = TWPT_RGB then begin
      pbuffer := pByte(pbmi);
      Inc(pbuffer, sizeof(BITMAPINFOHEADER));
      Inc(pbuffer, ClrUsed * sizeof(RGBQUAD));
      pixels := pbmi^.bmiHeader.biWidth;
      for items:=0 to bmpHeight-1 do begin
        tempptr := pbuffer;
        for i:=0 to pixels-1 do begin
          //Switch Red byte and Blue byte
          SaveRed := Byte(tempptr^);
          SaveBlue := pByte(Longword(tempptr)+2)^;
          tempptr^ := SaveBlue;
          pByte(Longword(tempptr)+2)^ := SaveRed;
          Inc(tempptr, 3);
        end;
        Inc(pbuffer, Linelength);
      end;
    end;
    GlobalUnlock(hBM);
    GlobalUnlock(temp);
    GlobalFree(temp);
  end else begin
    GlobalUnlock(hBM);
    // DoTwMessage('Could not allocate enough memory to flip image', False);
  end;
end;

constructor TOopsTwain.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHooked := False;
  with AOwner as TWinControl do FHandle := Handle;
  // Init ApplicationIdentity.
  FAppID.Id := 0;                        // Source Manager will assign real value
  with FAppID.Version do begin
    MajorNum := APP_PROTOCOLMAJOR;
    MinorNum := APP_PROTOCOLMINOR;
    Language := TWLG_CHINESE_SIMPLIFIED; // TWLG_ENG;
    Country  := TWCY_CHINA;
    strcopy(Info,  'OopsTwain 4.0 08/02/2004');
  end;
  FAppID.ProtocolMajor   := TWON_PROTOCOLMAJOR;
  FAppID.ProtocolMinor   := TWON_PROTOCOLMINOR;
  FAppID.SupportedGroups := DG_IMAGE_OR_CONTROL;
  strcopy(FAppID.Manufacturer,  '(C)1995-2004,OopsWare.CHINA.');
  strcopy(FAppID.ProductFamily, 'TWAIN Component for Delphi.');
  strcopy(FAppID.ProductName,   'OopsWare Scanner Component');

  FillChar(FDsID, Sizeof(TW_IDENTITY), 0);
  FTransferType := doNativeTransfer;
  hDSMDLL := 0;
  lpDSM_Entry := nil;
  FHooked := False;
  FAutoFeed := False;
  FIsDSMOpen := False;
  FIsDSOpen := False;
  FIsDSEnabled := False;