ledscreen.pas

来自「群星医药系统源码」· PAS 代码 · 共 310 行

unit LEDScreen;

interface

uses Classes, Windows, SysUtils, Forms, Spcomm;

const
  cCommand_Cls = #$0C;
  cCommand_Can = #$18;
  cCommand_Init= #$1B#$40;
  cCommand_SendNumber = #$1B#$51#$41'%.2f'#$0D;
  cCommand_CaretsStyle= #$1B#$5F'%d';
  cCommand_CaretsMove = #$1B#$6C'%d';
  cCommand_ShowNote = #$1F#$5F'%d%d';
  cCommand_ShowWord = #$1B#$73'%d';
  cCommand_ShowPosSystem = #$1f#$50'%d';
  cCommand_ShowCodeStyle = #$1F#$73'%d';

type
  TCustomLEDScreen = Class(TComponent)
  private
    FComm: TComm;
    FLEDScreenPort: String;
    FParityCheck: Boolean;
    FBaudRate: Integer;
    FLineDelay: Longword;
    FActive: Boolean;
    procedure SetActive(const Value: Boolean);
  protected
    procedure DoDelay; virtual;
    function GetLineDispChars: Byte; virtual; abstract;
    function GetDispLines: Byte; virtual; abstract;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Open: Boolean;
    function Close: Boolean;
    function Send(mBuffer: PChar; mSize: Word): Boolean;
    function SendStr(mStr: string): Boolean;

    property LineDispChars: Byte read GetLineDispChars;
    property DispLines: Byte read GetDispLines;
  published
    property Active: Boolean read FActive write SetActive;
    property LEDScreenPort: String read FLEDScreenPort write FLEDScreenPort;//端口号
    property BaudRate: Integer read FBaudRate write FBaudRate; //通讯波特率
    property LineDelay: Longword read FLineDelay write FLineDelay;//行延时
    property ParityCheck: Boolean read FParityCheck write FParityCheck; //奇偶校验
  end;

  TLEDScreen = Class(TCustomLEDScreen)
  private
  protected
    function GetDispLines: Byte; override;
  public
    procedure OpenCashbox; virtual;
    procedure InitState; virtual;
    procedure Display(sLines: Array of String; Flag: integer); virtual;
  end;

  //英文单行
  TLEDScreenEngS = Class(TLEDScreen)
  protected
    function GetDispLines: Byte; override;
  public
    procedure Display(sLines: Array of String; Flag: integer); override;
  end;


  //英文双行
  TLEDScreenEngD = Class(TLEDScreen)
  protected
    function GetDispLines: Byte; override;
  public
    procedure Display(sLines: Array of String; Flag: integer); override;
  end;

  //中文单行
  TLEDScreenChsS = Class(TLEDScreen)
  protected
    function GetDispLines: Byte; override;
  public
    procedure Display(sLines: Array of String; Flag: integer); override;
  end;

  //中文双行
  TLEDScreenChsD = Class(TLEDScreen)
  protected
    function GetDispLines: Byte; override;
  public
    procedure Display(sLines: Array of String; Flag: integer); override;
  end;

  //DIY-POS PD-LED8型，（数字单行+四状态指示灯）
  TLEDScreenPDLED8 = Class(TLEDScreen)
  protected
    function GetDispLines: Byte; override;
  public
    procedure Display(sLines: Array of String; Flag: integer); override;
    procedure SetLightLamp(LampIndex: ShortInt);
  end;

implementation

{ TCustomLEDScreen }

function TCustomLEDScreen.Close: Boolean;
begin
  try
    FComm.StopComm;
    Result := True;
  except
    Result := False;
  end;
  if Result then FActive := False;
end;

constructor TCustomLEDScreen.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FComm := TComm.Create(Self);
  FActive := false;
  FLEDScreenPort := 'COM1';
  FBaudRate := 2400;
  FParityCheck := True;
end;

destructor TCustomLEDScreen.Destroy;
begin
  if Assigned(FComm) then
  begin
    if FActive then
      Close;
    FComm.Free;
  end;
  inherited;
end;

procedure TCustomLEDScreen.DoDelay;
var i: LongWord;
begin
  i := GetTickCount;
  while GetTickCount-i<FLineDelay do
    Application.ProcessMessages;
end;

function TCustomLEDScreen.Open: Boolean;
begin
  Result := True;
  if FActive then Exit;
  with FComm do try
    CommName := FLEDScreenPort;
    BaudRate := FBaudRate;
    Parity := Space;
    ParityCheck := FParityCheck;
    Outx_XonXoffFlow := False;
    Inx_XonXoffFlow := False;
    StartComm;
  except
    Application.MessageBox('打开端口失败！', '警告', MB_ICONERROR);
    Result := False;
  end;
  FActive := Result;
end;

function TCustomLEDScreen.Send(mBuffer: PChar; mSize: Word): Boolean;
begin
  Result := False;
  if LEDScreenPort=''Then Exit;
  Open;
  Result := FComm.WriteCommData(mBuffer, mSize);
end;

function TCustomLEDScreen.SendStr(mStr: string): Boolean;
begin
  Result := Send(PChar(mStr), Length(mStr));
end;

procedure TCustomLEDScreen.SetActive(const Value: Boolean);
begin
  if Value then
    Open
  else
    Close;
end;

{ TLEDScreen }

procedure TLEDScreen.Display(sLines: Array of String; Flag: integer);
begin

end;

function TLEDScreen.GetDispLines: Byte;
begin
  Result := 1;
end;

procedure TLEDScreen.InitState;
begin
  SendStr(cCommand_Init);
end;

procedure TLEDScreen.OpenCashbox;
var prn : textFile;
begin
  if FLEDScreenPort='' then Exit;
  assignfile(prn, FLEDScreenPort);
  rewrite(prn);
  write(prn, CHR(2)+CHR(77));
  closeFile(prn) ;
end;

{ TLEDScreenPDLED8 }

{在电子屏上输出指定的字符串信息
sLines参数中的每一行字符串在电子屏上输出一行，该字符串的第一个字符如果是CHR(127)，
则表示随后的一个字符为状态描述符，不支持的状态描述符将被忽略，目前支持的状态如下：
1：单价，2：小计，3：付款，4：找零
}
procedure TLEDScreenPDLED8.Display(sLines: Array of String; Flag: integer);
var i, k, m: integer;
    str: String;
begin
  if LEDScreenPort='' then Exit;
  inherited;
  m := -1;
  k := Length(sLines);
  for i:=0 to k-1 do begin
    if i>0 then DoDelay;
    SendStr(cCommand_Init);
    str := sLines[i];
    if str[1]=CHR(127) then begin
      m := Byte(str[2])-Byte('0');
      delete(str, 1, 2);
    end;
    if m>0 then
      SetLightLamp(m);
    str := Format(cCommand_SendNumber, [StrToFloat(str)]);
    SendStr(str);
  end;
end;

function TLEDScreenPDLED8.GetDispLines: Byte;
begin
  Result := 1;
end;

//
procedure TLEDScreenPDLED8.SetLightLamp(LampIndex: ShortInt);
var str: String;
begin
  str := Format(cCommand_ShowWord, [LampIndex]);
  SendStr(str);
end;

{ TLEDScreenEngS }

procedure TLEDScreenEngS.Display(sLines: Array of String; Flag: integer);
begin
  inherited;

end;

function TLEDScreenEngS.GetDispLines: Byte;
begin
  Result := 1;
end;

{ TLEDScreenEngD }

procedure TLEDScreenEngD.Display(sLines: Array of String; Flag: integer);
begin
  inherited;

end;

function TLEDScreenEngD.GetDispLines: Byte;
begin
  Result := 2;
end;

{ TLEDScreenChsS }

procedure TLEDScreenChsS.Display(sLines: Array of String; Flag: integer);
begin
  inherited;

end;

function TLEDScreenChsS.GetDispLines: Byte;
begin
  Result := 1;
end;

{ TLEDScreenChsD }

procedure TLEDScreenChsD.Display(sLines: Array of String; Flag: integer);
begin
  inherited;

end;

function TLEDScreenChsD.GetDispLines: Byte;
begin
  Result := 2;
end;

end.