plot.~pas

data matrix编码程序 将字符串转换为二维码黑白图形

unit Plot;

interface

type

TPlot = class
private
  FX, FY, FWidth, FHeight: integer;
  FDelayCount : integer;
protected
  procedure MoveL;
  procedure MoveLU;
  procedure MoveU;
  procedure MoveRU;
  procedure MoveR;
  procedure MoveRD;
  procedure MoveD;
  procedure MoveLD;
  function IsXOrigin : boolean;
  function IsYOrigin : boolean;
public
  property X : integer read FX;
  property Y : integer read FY;
  property Width : integer read FWidth;
  property Height : integer read FHeight;
  constructor Create;
  destructor Destroy; override;
  procedure Reset;
  procedure Delay(time : longint = 1000);
  procedure Setup;
  function PlotIsReady : boolean;
  procedure PenUp;
  procedure PenDown;
  procedure MoveTo(ToX, ToY : integer);
end;

implementation

uses Forms, WinIO, SysUtils;

const
  PORT_A = $378;
  PORT_B = $37A;
  PORT_C = $379;
  PORT_D = $27B;

//PORT_A=$278写信号  -- 控制标记头移动
  PLOT_Y_CP   = $01;
  PLOT_Z_DIR  = $02;
  PLOT_Y_DIR  = $04;
  PLOT_Z_CP   = $08;
  PLOT_X_CP   = $10;
  PLOT_READY  = $20;
  PLOT_X_DIR  = $40;

//PORT_B=$27A写信号  -- 控制标记头打印
  PLOT_DCF    = $01; //IsVer2=0, 0=Pendown; IsVer2=1, 1=PenDown
  PLOT_FINISH = $02;

//PORT_C=$279 读信号
  PLOT_PEN_IS_DOWN      = $04;
  PLOT_IS_STOP          = $08;
  PLOT_X_IS_NOT_ORIGIN  = $10;
  PLOT_Y_IS_NOT_ORIGIN  = $20;
  PLOT_PLOT_IS_START    = $40;
  PLOT_SWITCH_IS_UP     = $40;
  PLOT_Z_IS_NOT_ORIGIN  = $80;

//PORT_D = $27B 读信号
  PLOT_IS_VERSION2      = $80;

procedure TPlot.MoveL;  //左
begin
  SetPortVal(PORT_A, PLOT_X_CP, 1);
  Delay;
  SetPortVal(PORT_A, 0 , 1);
  Delay;
  Dec(FX);
end;

procedure TPlot.MoveLU;  //左上
begin
  SetPortVal(PORT_A, PLOT_X_CP or PLOT_Y_DIR or PLOT_Y_CP, 1);
  Delay;
  SetPortVal(PORT_A, PLOT_Y_DIR, 1);
  Delay;
  Dec(FX);
  DEC(FY);
end;

procedure TPlot.MoveU;  //上
begin
  SetPortVal(PORT_A, PLOT_Y_DIR or PLOT_Y_CP, 1);
  Delay;
  SetPortVal(PORT_A, PLOT_Y_DIR, 1);
  Delay;
  Dec(FY);
end;

procedure TPlot.MoveRU;  //右上
begin
  SetPortVal(PORT_A, PLOT_X_DIR or PLOT_X_CP or PLOT_Y_DIR or PLOT_Y_CP, 1);
  Delay;
  SetPortVal(PORT_A, PLOT_X_DIR or PLOT_Y_DIR , 1);
  Delay;
  Inc(FX);
  Dec(FY);
end;

procedure TPlot.MoveR;  //右
begin
  SetPortVal(PORT_A, PLOT_X_DIR or PLOT_X_CP, 1);
  Delay;
  SetPortVal(PORT_A, PLOT_X_DIR, 1);
  Delay;
  Inc(FX);
end;

procedure TPlot.MoveRD;  //右下
begin
  SetPortVal(PORT_A, PLOT_X_DIR or PLOT_X_CP or PLOT_Y_CP, 1);
  Delay;
  SetPortVal(PORT_A, PLOT_X_DIR, 1);
  Delay;
  Inc(FX);
  Inc(FY);
end;

procedure TPlot.MoveD;  //下
begin
  SetPortVal(PORT_A, PLOT_Y_CP, 1);
  Delay;
  SetPortVal(PORT_A, 0, 1);
  Delay;
  Inc(FY);
end;

procedure TPlot.MoveLD;  //左下
begin
  SetPortVal(PORT_A, PLOT_X_CP or PLOT_Y_CP, 1);
  Delay;
  SetPortVal(PORT_A, 0, 1);
  Delay;
  Dec(FX);
  Inc(FY);
end;

procedure TPlot.Delay;
var
  i : integer;
begin
  for i := 1 to time do
  begin
    Application.ProcessMessages;
  end;
end;

function TPlot.IsXOrigin : boolean;
var
  value : longword;
begin
  GetPortVal(PORT_C, value, 1);
  if (value and PLOT_X_IS_NOT_ORIGIN) = 0 then
    Result := True
  else
    Result := False;
end;

function TPlot.IsYOrigin : boolean;
var
  value : longword;
begin
  GetPortVal(PORT_C, value, 1);
  if (value and PLOT_Y_IS_NOT_ORIGIN) = 0 then
    Result := True
  else
    Result := False;
end;

constructor TPlot.Create;
begin
{  InitializeWinIo;
  Reset;}

  if InitializeWinIo then
  begin
    Reset;
  end
  else
  begin
    raise Exception.Create('Init IO Error!');
  end;
end;

destructor TPlot.Destroy;
begin
  ShutdownWinIo;
end;

procedure TPlot.Reset;
const
  MAX_STEP = 30000;
var
  i : integer;
label YOrigin, OK;
begin
  PenUp;
  for i := 1 to MAX_STEP do
  begin
    if IsXOrigin then goto YOrigin;
    MoveL;
  end;
  raise Exception.Create('X Reset Error!');
YOrigin:
  for i := 1 to MAX_STEP do
  begin
    if IsYOrigin then goto OK;
    MoveU;
  end;
  raise Exception.Create('Y Reset Error!');
OK:
  FX := 0;
  FY := 0;
end;

procedure TPlot.Setup;
begin
end;

function TPlot.PlotIsReady : boolean;
begin
  Result := True;
end;

procedure TPlot.PenUp;
begin
  SetPortVal(PORT_B,  PLOT_FINISH, 1);
end;

procedure TPlot.PenDown;
begin
  SetPortVal(PORT_B,  PLOT_DCF or PLOT_FINISH, 1);
end;

procedure TPlot.MoveTo(ToX, ToY : integer);
var
  x0, y0, dx, dy, i, j : integer;
  k : single;
begin
  x0 := X;
  y0 := Y;
  dx := ToX - x0;
  dy := ToY - y0;
  if (dx = 0) and (dy = 0) then exit;
  if Abs(dx) >= Abs(dy) then
  begin
    k := dy / dx;
    if dx > 0 then
    begin
      for i := x0 to ToX do
      begin
        j := Round(k * (i - x0) + y0);
        if j = Y then MoveR
        else if j = Y - 1 then MoveRU
        else if j = Y + 1 then MoveRD;
      end;
    end
    else
    begin
      for i := x0 downto ToX do
      begin
        j := Round(k * (i - x0) + y0);
        if j = Y then MoveL
        else if j = Y - 1 then MoveLU
        else if j = Y + 1 then MoveLD;
      end;
    end;
  end
  else if Abs(dx) < Abs(dy) then
  begin
    k := dx / dy;
    if dy < 0 then
    begin
      for j := y0 downto ToY do
      begin
        i := Round(k * (j - y0) + x0);
        if i = X then MoveU
        else if i = X - 1 then MoveLU
        else if i = X + 1 then MoveRU;
      end;
    end
    else
    begin
      for j := y0 to ToY do
      begin
        i := Round(k * (j - y0) + x0);
        if i = X then MoveD
        else if i = X - 1 then MoveLD
        else if i = X + 1 then MoveRD;
      end;
    end;
  end;     
end;

end.