imscan.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

///////////////////////////////////////////////////////////////////////////////////////

function IETW_DS(var grec: tgrec; dg: TW_UINT32; dat: TW_UINT16; msg: TW_UINT16; pd: TW_MEMREF): boolean;
begin
  with grec do
  begin
    rc := TWRC_FAILURE;
    if (@DSM_Entry <> nil) then
    begin
      try
        rc := DSM_Entry(@AppId, @SourceId, dg, dat, msg, pd);
        if (rc <> TWRC_SUCCESS) and assigned(TWParams) then
        begin
          TWParams.LastError := rc;
          TWParams.LastErrorStr := ResultToStr(rc);
          LogWrite('IETW_DS : ' + TWParams.LastErrorStr);
        end;
      except
      end;
    end;
    result := (rc = TWRC_SUCCESS);
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_OpenSourceManager(var grec: tgrec; hwnd: HWND): boolean;
begin
  with grec do
  begin
    LogWrite('IETW_OpenSourceManager');
    hwnd32SM := TW_INT32(hwnd);
    if (IETW_Mgr(grec, DG_CONTROL, DAT_PARENT, MSG_OPENDSM, @hwnd32SM)) then
    begin
      nState := TWAIN_SM_OPEN;
    end;
    result := (nState >= TWAIN_SM_OPEN);
    if result then
      LogWrite('  IETW_OpenSourceManager : Ok')
    else
      LogWrite('  IETW_OpenSourceManager : FAILED!');
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_CloseSourceManager(var grec: tgrec; hwnd: HWND): boolean;
var
  hwnd32: TW_INT32;
begin
  with grec do
  begin
    LogWrite('IETW_CloseSourceManager');
    IETW_EmptyMessageQueue(grec);
    hwnd32 := TW_INT32(hwnd);
    rc := TWRC_SUCCESS;
    if (IETW_Mgr(grec, DG_CONTROL, DAT_PARENT, MSG_CLOSEDSM, @hwnd32)) then
    begin
      nState := 2;
    end;
    result := (nState <= 2);
    if result then
      LogWrite('  IETW_CloseSourceManager : Ok')
    else
      LogWrite('  IETW_CloseSourceManager : FAILED!');
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_DisableSource(var grec: tgrec): boolean;
begin
  with grec do
  begin
    LogWrite('IETW_DisableSource');
    BreakModalLoop := true;
    if (nState = 5) and (IETW_DS(grec, DG_CONTROL, DAT_USERINTERFACE, MSG_DISABLEDS, @twUI)) then
      nState := 4;
{$IFDEF IETWAINTASKWINDOWS}
    if fWindowList <> nil then
      EnableTaskWindows(fWindowList);
    fWindowList := nil;
{$ENDIF}
    IETW_EmptyMessageQueue(grec);
    result := (nState <= 4);
    if result then
      LogWrite('  IETW_DisableSource : Ok')
    else
      LogWrite('  IETW_DisableSource : FAILED!');
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_CloseSource(var grec: tgrec): boolean;
begin
  with grec do
  begin
    LogWrite('IETW_CloseSource');
    BreakModalLoop := true;
    rc := TWRC_SUCCESS;
    if (nState = 5) then
      IETW_DisableSource(grec);
    if (nState = 4) and (IETW_Mgr(grec, DG_CONTROL, DAT_IDENTITY, MSG_CLOSEDS, @SourceId)) then
      nState := 3;
    result := (nState <= 3);
    if result then
      LogWrite('  IETW_CloseSource : Ok')
    else
      LogWrite('  IETW_CloseSource : FAILED!');
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////
// rest. ProductName del source selezionato

function IETW_SelectImageSource(var SelectedSourceName: string; TWainShared: PIETWainShared; callwnd: HWND): boolean;
var
  NewSourceId: TW_IDENTITY;
  grec: tgrec;
  wnd: HWND;
begin
  try
    result := false;
    Init_grec(grec);
    grec.callwnd := callwnd;
    grec.PTWainShared := TWainShared;
    wnd := CreateProxyWindow(grec);
    if IETW_LoadSourceManager(grec) then
    begin
      if IETW_OpenSourceManager(grec, wnd) then
      begin
        fillmemory(@NewSourceId, sizeof(NewSourceId), 0);
        // Post the Select Source dialog
        result := IETW_Mgr(grec, DG_CONTROL, DAT_IDENTITY, MSG_USERSELECT, @NewSourceId);
        SelectedSourceName := NewSourceId.ProductName;
        IETW_CloseSourceManager(grec, wnd);
      end
      else
      begin
        DestroyProxyWindow(wnd, grec, false);
        exit;
      end;
      IETW_UnloadSourceManager(grec, false);
    end;
    DestroyProxyWindow(wnd, grec, false);
  finally
    windows.setactivewindow(grec.actwnd);
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

procedure ClearError(var grec: tgrec);
begin
  grec.nErrDetail := ED_NONE;
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_GetResultCode(var grec: tgrec): word;
begin
  result := grec.rc;
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_GetConditionCode(var grec: tgrec): word;
var
  twStatus: TW_STATUS;
begin
  with grec do
  begin
    if nState >= 4 then
    begin
      // get source status if open
      IETW_DS(grec, DG_CONTROL, DAT_STATUS, MSG_GET, TW_MEMREF(@twStatus));
    end
    else if nState = 3 then
    begin
      // otherwise get source manager status
      IETW_Mgr(grec, DG_CONTROL, DAT_STATUS, MSG_GET, TW_MEMREF(@twStatus));
    end
    else
    begin
      // nothing open, not a good time to get condition code!
      result := TWCC_SEQERROR;
      exit;
    end;
    if rc = TWRC_SUCCESS then
    begin
      result := twStatus.ConditionCode;
      exit;
    end
    else
      result := TWCC_BUMMER;
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function RecordError(var grec: tgrec; ed: ErrorDetail): boolean;
begin
  with grec do
  begin
    if nErrDetail = ED_NONE then
    begin
      nErrDetail := ed;
      if (ed > ED_START_TRIPLET_ERRS) and (ed < ED_END_TRIPLET_ERRS) then
      begin
        nErrRC := IETW_GetResultCode(grec);
        nErrCC := IETW_GetConditionCode(grec);
      end
      else
      begin
        nErrRC := 0;
        nErrCC := 0;
      end;
    end;
    result := FALSE;
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_OpenSource(var grec: tgrec): boolean;
var
  src: pTW_IDENTITY;
  sn: string;
begin
  with grec do
  begin
    LogWrite('IETW_OpenSource');
    if (nState <> 3) then
    begin
      result := FALSE;
      LogWrite('  IETW_OpenSource : already loaded');
      exit;
    end;

    sn := TWParams.SourceName[TWParams.SelectedSource];

    if sn <> '' then
    begin
      // Find selected source by ProductName
      src := AllocMem(sizeof(TW_IDENTITY));
      IETW_Mgr(grec, DG_CONTROL, DAT_IDENTITY, MSG_GETFIRST, src);
      while rc <> TWRC_ENDOFLIST do
      begin
        if src^.ProductName = sn then
          break;
        zeromemory(src, sizeof(TW_IDENTITY));
        IETW_Mgr(grec, DG_CONTROL, DAT_IDENTITY, MSG_GETNEXT, src);
      end;
      move(src^, SourceId, sizeof(TW_IDENTITY));
      FreeMem(src);
    end
    else
    begin
      // system default source
      SourceId.ProductName[0] := #0;
      SourceId.Id := 0;
    end;
    if (IETW_Mgr(grec, DG_CONTROL, DAT_IDENTITY, MSG_OPENDS, @SourceId)) then
    begin
      nState := 4;
    end
    else
      RecordError(grec, ED_DSM_FAILURE);
    result := (nState = 4);
    if result then
      LogWrite('  IETW_OpenSource : Ok')
    else
      LogWrite('  IETW_OpenSource : FAILED!');
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_EnableSource(var grec: tgrec; hwnd: HWND): boolean;
begin
  with grec do
  begin
    LogWrite('IETW_EnableSource');
    if (nState <> 4) then
    begin
      result := FALSE;
      LogWrite('  IETW_EnableSource : already enabled');
      exit;
    end;
    twUI.ShowUI := not bHideUI;
    twUI.hParent := TW_HANDLE(hwnd);
    twUI.ModalUI := modal;
{$IFDEF IETWAINTASKWINDOWS}
    fWindowList := DisableTaskWindows(0);
{$ENDIF}
    LogWrite('  IETW_EnableSource : ShowUI=' + inttostr(integer(twUI.ShowUI)) + ' hParent=' + inttostr(twUI.hParent) + ' ModalUI=' + inttostr(integer(twUI.ModalUI)));
    IETW_DS(grec, DG_CONTROL, DAT_USERINTERFACE, MSG_ENABLEDS, @twUI);
    if (rc = TWRC_FAILURE) or (rc=TWCC_NODS) then
    begin
      RecordError(grec, ED_DS_FAILURE);
    end
    else
      nState := 5;
    result := (nState = 5);
    if result then
      LogWrite('  IETW_EnableSource : Ok')
    else
      LogWrite('  IETW_EnableSource : FAILED!');
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function GetCapability(var grec: tgrec; var twCapability: TW_CAPABILITY; cap: TW_UINT16): boolean;
begin
  twCapability.Cap := cap;
  twCapability.ConType := TWON_DONTCARE16;
  twCapability.hContainer := 0;
  LogWrite('GetCapability : $' + inttohex(cap, 4));
  IETW_DS(grec, DG_CONTROL, DAT_CAPABILITY, MSG_GET, @twCapability);
  result := grec.rc = TWRC_SUCCESS;
  if result then
    LogWrite('  GetCapability : Ok')
  else
    LogWrite('  GetCapability : FAILED!');
end;

function GetOneStringCapability(var grec: tgrec; outstr: string; cap: TW_UINT16): boolean;
var
  twCapability: TW_CAPABILITY;
  pvalOneValue: pTW_ONEVALUE;
  ptr: pchar;
begin
  result := true;
  if not GetCapability(grec, twCapability, cap) then
  begin
    result := false;
    exit;
  end;
  pvalOneValue := GlobalLock(twCapability.hContainer);
  ptr := @(pvalOneValue^.Item);
  outstr := string(ptr);
  GlobalUnlock(twCapability.hContainer);
  GlobalFree(twCapability.hContainer);
end;

// Supported TW_ONEVALUE (current value)

function SetOneStringCapability(var grec: tgrec; value: string; cap: TW_UINT16): boolean;
var
  twCapability: TW_CAPABILITY;
  pvalOneValue: pTW_ONEVALUE;
  ptr: pchar;
begin
  if not GetCapability(grec, twCapability, cap) then
  begin
    result := false;
    exit;
  end;
  LogWrite('SetOnStringCapability $' + inttohex(cap, 4));
  GlobalFree(twCapability.hContainer);
  twCapability.Cap := cap;
  // write TW_ONEVALUE (current value only)
  value := copy(value, 1, 255);
  twCapability.ConType := TWON_ONEVALUE;
  twCapability.hContainer := GlobalAlloc(GHND, sizeof(TW_ONEVALUE) + 256 - 4);
  pvalOneValue := GlobalLock(twCapability.hContainer);
  pvalOneValue^.ItemType := TWTY_STR255;
  ptr := @(pvalOneValue^.Item);
  strcopy(ptr, pchar(value));
  GlobalUnLock(twCapability.hContainer);
  IETW_DS(grec, DG_CONTROL, DAT_CAPABILITY, MSG_SET, @twCapability);
  result := grec.rc = TWRC_SUCCESS;
  GlobalFree(twCapability.hContainer);
  if result then
    LogWrite('  SetOnStringCapability : Ok')
  else
    LogWrite('  SetOnStringCapability : FAILED!')
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_AbortAllPendingXfers(var grec: tgrec): boolean;
begin
  with grec do
  begin
    LogWrite('IETW_AbortAllPendingXfers');
    breakmodalloop := true;
    if (nState = 7) and IETW_DS(grec, DG_CONTROL, DAT_PENDINGXFERS, MSG_ENDXFER, @pendingXfers) then
    begin
      if pendingXfers.Count <> 0 then
        nState := 6
      else
        nState := 5;
    end;
    if (nState = 6) and (IETW_DS(grec, DG_CONTROL, DAT_PENDINGXFERS, MSG_RESET, @pendingXfers)) then
    begin