unit U_ZBarPoller;

interface

uses
  Classes,
//  SVATimer,
  L_MMTimer,
  U_LogEmitter;

type
  { ------------------------------------------------------------------------ }
  TZBarPoller = class(TLogEmitter)
  private
    const
      ZBAR_TAG: integer = Ord('t');
      ZBAR_UNTAG: integer = Ord('u');
      ZBAR_ACK: integer = Ord('k');
    var
      FZbar: OleVariant;
      FTimer: TMMTimer;
      FOnPamphlet: TNotifyEvent;

      FLongInterval: Cardinal;
      FShortInterval: Cardinal;

      FPrevZBarResult: integer;
      FPrevSequence: integer;
      FPrevZtwHandle: integer;

    function  TryOpeningZBar: boolean;

    procedure SetEnabled(Value: boolean);
    function  GetEnabled: boolean;

    procedure TimerTimer(Sender: TObject);
  public
    constructor Create();
    destructor  Destroy; override;

    function  InterpretScriptResult(ScriptResult: OleVariant; Acknowledge: boolean;
                                    InvertResult: boolean = False): integer;

    property Enabled: boolean               read GetEnabled   write SetEnabled;
    property ZBar: OleVariant               read FZBar;

    property OnPamphlet: TNotifyEvent read FOnPamphlet  write FOnPamphlet;
    property OnLog: TLogEvent         read FOnLog       write FOnLog;
  end;

implementation

uses
  SysUtils, ComObj, Variants;

{ ============================================================================ }

{ TZBarPoller }

{ ---------------------------------------------------------------------------- }
constructor TZBarPoller.Create;
begin
  FLongInterval := 250;
  FShortInterval := 3;
  FPrevZBarResult := 16777216;
  FZBar := CreateOLEObject('ZbarCom.Zaap');
  FTimer := TMMTimer.Create(nil);
  FTimer.Enabled := False;
  FTimer.Interval := FLongInterval;
  FTimer.OnTimer := Self.TimerTimer;
end;
{ ---------------------------------------------------------------------------- }
destructor TZBarPoller.Destroy;
begin
  FTimer.Free;
  FZBar.CloseZbar;
  VarClear(FZBar);

  inherited;
end;

{ ---------------------------------------------------------------------------- }
function TZBarPoller.TryOpeningZBar: boolean;
var
  RetVal: integer;
  Msg: string;
begin
  RetVal := FZBar.LogZBar;
  case RetVal of
    0: begin // ok
      Msg := 'OK';
    end;
    -1: begin // ZBAR_NOTFOUND
      Msg := 'ZBar.dat not found!';
    end;
    -2: begin // ZTREE_NOTFOUND
      Msg := 'ZTreeWin not found!';
    end;
    -3: begin // ZTREE_NOTRUNNING
      Msg := 'ZTreeWin not running!';
    end;
    -8: begin // PSAPI_ERROR
      Msg := 'Unable to load PSAPI libraries.';
    end;
    else begin
      Msg := 'Unexpected error';
    end;
  end;

  if RetVal <> FPrevZBarResult then begin
    WriteToLog('Reading Zbar.dat...');
    WriteToLog(Msg, llInfo, 1);
    FPrevZBarResult := RetVal;
  end;

  Result := (RetVal = 0)
end;

{ ---------------------------------------------------------------------------- }
procedure TZBarPoller.SetEnabled(Value: boolean);
begin
  if Value <> GetEnabled then begin
    if Value = True then begin
      if (FZBar.ZBarOpen = 0) or (FPrevZBarResult <> 0) then begin
        if TryOpeningZBar then begin
          // Read the initial values (possibly old values)
          FZBar.ReadZBar;
          FPrevSequence := FZBar.SequenceNumber;
          FPrevZtwHandle := FZBar.ZTreeHWND;
//          if Assigned(FOnPamphlet) then begin
//            FOnPamphlet(Self);
//          end;
        end;
      end;
      FTimer.Enabled := True;
    end else begin
      FTimer.Enabled := False;
    end;
  end;
end;
{ ---------------------------------------------------------------------------- }
function TZBarPoller.GetEnabled: boolean;
begin
  Result := FTimer.Enabled and (FZBar.ZbarOpen <> 0);
end;

{ ---------------------------------------------------------------------------- }
procedure TZBarPoller.TimerTimer(Sender: TObject);
var
  ZTreeCommand: integer;
begin
  try
    if (FZBar.ZBarOpen = 0) or (FPrevZBarResult <> 0) then begin
      TryOpeningZBar;
    end;

    if FZBar.ZBarOpen <> 0 then begin
      FZBar.ReadZBar;
      if (FZBar.SequenceNumber <> FPrevSequence) or (FZBar.ZTreeHWND <> FPrevZtwHandle) then begin

        // Go faster for a Ctrl-Y command
        ZTreeCommand := FZBar.ZTreeCommand;
        if (ZTreeCommand in [Ord('Y'), Ord('y')]) and (FZBar.ZtreeCommandChar = Ord('t')) then begin
          FTimer.Interval := FShortInterval;
        end else if (FTimer.Interval = FShortInterval) and not (ZTreeCommand in [Ord('Y'), Ord('y')]) then begin
          FTimer.Interval := FLongInterval;
        end;

        // Notify the UI that there's a new pamphlet
        if Assigned(FOnPamphlet) then begin
          FOnPamphlet(Self);
        end;

        FPrevSequence := FZBar.SequenceNumber;
        FPrevZtwHandle := FZBar.ZTreeHWND;
      end;
    end;
  except
    on E: Exception do begin
      WriteToLog(Format('%s while polling ZBar: %s', [E.ClassName, E.Message]));
    end;
  end;
end;

{ ---------------------------------------------------------------------------- }
function TZBarPoller.InterpretScriptResult(ScriptResult: OleVariant; Acknowledge: boolean;
                                            InvertResult: boolean = False): integer;
var
  Tag, Untag: integer;
begin
  if InvertResult then begin
    Tag := ZBAR_UNTAG;
    Untag := ZBAR_TAG;
  end else begin
    Tag := ZBAR_TAG;
    Untag := ZBAR_UNTAG;
  end;
  case VarType(ScriptResult) of
    varSmallint, varInteger, varSingle, varDouble, varCurrency, varShortInt, varByte, varWord, varLongWord, varInt64, varUInt64: begin
      if ScriptResult = 0 then begin
        Result := Tag;
      end else begin
        Result := Untag;
      end;
    end;
    else begin // varEmpty, varNull
      Result := ZBAR_ACK;
    end;
  end;
  if (Result <> ZBAR_ACK) or Acknowledge then begin
    FZBar.WriteZBar(Result);
  end;
end;

end.
