printbarcode.pas

条形码编码算法

     PROCEDURE EnCode(ch : char);
     BEGIN
       Bars := blank;
       case ch of
       '0' : BEGIN Bars[1] := true; Bars[2] := true; END;
       '1' : BEGIN Bars[4] := true; Bars[5] := true; END;
       '2' : BEGIN Bars[3] := true; Bars[5] := true; END;
       '3' : BEGIN Bars[3] := true; Bars[4] := true; END;
       '4' : BEGIN Bars[2] := true; Bars[5] := true; END;
       '5' : BEGIN Bars[2] := true; Bars[4] := true; END;
       '6' : BEGIN Bars[2] := true; Bars[3] := true; END;
       '7' : BEGIN Bars[1] := true; Bars[5]:= true; END;
       '8' : BEGIN Bars[1] := true; Bars[4] := true; END;
       '9' : BEGIN Bars[1] := true; Bars[3] := true; END;
     END;

END;

BEGIN
  EnCode(ch); {returned in Bars}
  for i := 1 to 5  do
  BEGIN
  printbar(Sender,true,Bars[i]);
  printbar(Sender,False,true);

  END;
END;



BEGIN{PPostnet}
  if s = ''  then exit;
    if length(s) <= pnSize then
    BEGIN
      CorrectionTotal := 0;
      for si := 1 to length(s) do
      CorrectionTotal := CorrectionTotal + Ord(s[si]) - 48;
      CorrectionTotal := 10 - (CorrectionTotal Mod 10);
      if CorrectionTotal = 10 then CorrectionTotal := 0;
      s := s + chr(48 + CorrectionTotal);
    END;
    LightWidth := (UsePixelsPerInchX + 11) Div 22; {bar & space = 22 / inch}
    DarkWidth := LightWidth Div 2;{Bars}
    LightWidth := LightWidth - DarkWidth; {spaces}
{    TPaintBox(Sender).BringToFront;}
    HighHeight := (UsePixelsPerInchY + 4) div 8;{.125"}
    LowHeight := (UsePixelsPerInchY + 10) div 20;{.05"}
    StartPoint := 0;
    if Sender = Self.canvas then
    self.Width := ((5 * length(s)) + 2) * (DarkWidth + LightWidth)+ 4;

    {space at start}
{    for LI := 1 to Leadin do PrintBar(Sender,false,False);}
    {Lead In Symbol}
    PrintBar(Sender,true,true);
    PrintBar(Sender,false,true);
    si := 1;
    REPEAT
     BarChar(s[SI]);
     SI := SI + 1;
    UNTIL (SI > length(S));
        {Finish Symbol}
    PrintBar(Sender,true,true);
  END;
(*
BEGIN{DrawBarCode}
    if UsePixelsPerInchX < 5 then
    UsePixelsPerInchX := Screen.PixelsPerInch;
  IF PrintWhere is TForm then
  BEGIN
    StartX := Self.Left;
    StartY := Self.Top;
    if UsePixelsPerInchX = 0 then UsePixelsPerInchX := TForm(PrintWhere).PixelsPerInch;
    WhichCanvas := TForm(PrintWhere).Canvas;
  END
  else
  IF PrintWhere is TCanvas then
  BEGIN

    StartX := Self.Left;
    StartY := Self.Top;
    if PrintWhere = Printer.Canvas then UsePixelsPerInchX := Printer.canvas.font.PixelsPerInch;
    WhichCanvas := TCanvas(PrintWhere);
  END
  else
  IF PrintWhere is TPaintBox then
  BEGIN
     if PrintWhere = Self then
     BEGIN
    StartX := 0;
    StartY := 0;
    END
    ELSE
     BEGIN
    StartX := Self.Left;
    StartY := Self.Top;
    END;
    WhichCanvas := TPaintBox(PrintWhere).Canvas;
  END
  else
  BEGIN
    StartX := 0;
    StartY := 0;
    WhichCanvas := Self.Canvas;
  END;
  SavePenColor := WHichCanvas.pen.color;
  SaveBrushColor := WHichCanvas.Brush.color;

  case Self.FBarcodeType of
  Code39: PCode39(Self.Text,WhichCanvas);
  Interleaved2of5 : PI2of5(self.text,WhichCanvas);
  PostNetZip      : PPostNEt(Self.text,WhichCanvas,5);
  PostNetZipPlus4    : PPostNEt(Self.text,WhichCanvas,9);
  PostNet11       : PPostNEt(Self.text,WhichCanvas,11);
  END;
  WHichCanvas.pen.color := SavePenColor ;
  WHichCanvas.Brush.color := SaveBrushColor;
END;
*)

procedure PFIM(S : string; Sender: TCanvas );

var
SI : integer;
DarkWidth, LightWIdth : integer;
HighHeight : integer;

PROCEDURE  printbar(Sender : TCanvas; drk : boolean); {Uses global vars so all procs can call}
var Barwidth : integer;
BEGIN

  with  Sender do
  BEGIN
  if drk then Pen.Color := FBarColor else  Pen.Color := Self.color;
  if drk then  Brush.Color := FBarColor else Brush.Color := Self.color;
  if drk then Barwidth := DarkWidth else BarWidth := LightWidth;
{  if Highbar then}
  Rectangle(StartPOint + StartX,0+ StartY,StartPOint + BarWidth + StartX,HighHeight + StartY);
  StartPoint := StartPOint + BarWidth;
  END
END;





PROCEDURE barchar(ch : char);
var
    i : integer;


     PROCEDURE EnCode(ch : char);
     BEGIN
       Bars := blank;
       case ch of
       'A' : BEGIN Bars[1] := true; Bars[2] := true;
                   Bars[5] := true; Bars[8] := true;
                   Bars[9] := true;  END;
       'B' : BEGIN Bars[1] := true; Bars[3] := true;
                   Bars[4] := true; Bars[6] := true;
                   Bars[7] := true; Bars[9] := true; END;
       'C' : BEGIN Bars[1] := true; Bars[2] := true;
                   Bars[4] := true; Bars[6] := true;
                   Bars[8] := true; Bars[9] := true; END;
     END;

END;

BEGIN
  EnCode(ch); {returned in Bars}
  for i := 1 to 9  do
  BEGIN
  printbar(Sender,Bars[i]);
  printbar(Sender,FALSE);

  END;
END;



BEGIN{PFIM}
  if s = ''  then exit;
   if not (s[1] in ['A'..'C','a'..'c']) then exit;
    LightWidth := (UsePixelsPerInchX + 16) Div 32; {BAR = 1/32"}
    DarkWidth := LightWidth;{Bars}
{    TPaintBox(Sender).BringToFront;}
    HighHeight := (UsePixelsPerInchY * 5 + 4) div 8;{.625"}
    StartPoint := 0;
    if Sender <> Self.canvas then
    IF FAutoPosition then
    BEGIN
      StartX := canvas.ClipRect.right - usepixelsPerInchX * 2 - darkwidth * 18 - 2;
      StartY := 1;
    END;
    if Sender = Self.canvas then
    BEGIN
    self.Width := (UsePixelsPerInchX ) DIV 2 + DarkWidth + 2;
    Self.Height := HighHeight;
    END;
    BarChar(s[1]);
  END;




procedure PEAN(S : string; Sender: TCanvas);
Type NumberSet = (A,B,C);
var i : integer;
     NumSets : array[1..13] of NumberSet;
     SI : integer;
     Min, ThisHeight : integer;
    CheckDig, Mult, TotalWide : integer;
    Ean13 : boolean; {else ean8}
     StopPt : integer;
PROCEDURE  printbar(Sender : TCanvas; drk, ExtraHigh : boolean); {Uses global vars so all procs can call}
var Barwidth : integer;
BEGIN

  with  Sender do
  BEGIN
  if drk then Pen.Color := FBarColor else  Pen.Color := Self.color;
  if drk then  Brush.Color := FBarColor else Brush.Color := Self.color;
  Barwidth := Wide;
  if ExtraHigh then
  Rectangle(StartPOint + StartX,0+ StartY,StartPOint + BarWidth + StartX,ThisHeight + StartY + (5 * wide))
  else
  Rectangle(StartPOint + StartX,0+ StartY,StartPOint + BarWidth + StartX,ThisHeight + StartY);
  StartPoint := StartPOint + BarWidth;

  END
END;






{NOTE i CALL LEFT DIGIT 1 ..WHAT THEY CALL DIGIT 13 IN THEIR SPECS}
PROCEDURE Encode1(Ch : char);
var i : integer;
BEGIN
  FOR I := 8 to 13 do NumSets[i] := C;
  CASE ch of
  '0' : BEGIN  NumSets[2] := A;
          NumSets[3] := A; NumSets[4] := A;
             NumSets[5] := A; NumSets[6] := A; NumSets[7] := A; END;
  '1' : BEGIN  NumSets[2] := A; NumSets[3] := A; NumSets[4] := B;
             NumSets[5] := A; NumSets[6] := B; NumSets[7] := B; END;
  '2' : BEGIN  NumSets[2] := A; NumSets[3] := A; NumSets[4] := B;
             NumSets[5] := B; NumSets[6] := A; NumSets[7] := B; END;
  '3' : BEGIN  NumSets[2] := A; NumSets[3] := A; NumSets[4] := B;
             NumSets[5] := B; NumSets[6] := B; NumSets[7] := A; END;
  '4' : BEGIN  NumSets[2] := A; NumSets[3] := B; NumSets[4] := A;
             NumSets[5] := A; NumSets[6] := B; NumSets[7] := B; END;
  '5' : BEGIN  NumSets[2] := A; NumSets[3] := B; NumSets[4] := B;
             NumSets[5] := A; NumSets[6] := A; NumSets[7] := B; END;
  '6' : BEGIN  NumSets[2] := A; NumSets[3] := B; NumSets[4] := B;
             NumSets[5] := B; NumSets[6] := A; NumSets[7] := A; END;
  '7' : BEGIN  NumSets[2] := A; NumSets[3] := B; NumSets[4] := A;
             NumSets[5] := B; NumSets[6] := A; NumSets[7] := B; END;
  '8' : BEGIN  NumSets[2] := A; NumSets[3] := B; NumSets[4] := A;
             NumSets[5] := B; NumSets[6] := B; NumSets[7] := A; END;
  '9' : BEGIN  NumSets[2] := A; NumSets[3] := B; NumSets[4] := B;
             NumSets[5] := A; NumSets[6] := B; NumSets[7] := A; END;
  END;
END;





PROCEDURE barchar(ch : char; pos : integer);
Var i : integer;

     PROCEDURE EnCode(ch : char;ns : NumberSet);
     BEGIN
       Bars := blank;
       if ns = A then
       case ch of
       '0' : BEGIN Bars[4] := true; Bars[5] := true;  Bars[7] := true; END;
       '1' : BEGIN Bars[3] := true; Bars[4] := true;  Bars[7] := true; END;
       '2' : BEGIN Bars[3] := true; Bars[6] := true;  Bars[7] := true; END;
       '3' : BEGIN Bars[2] := true; Bars[3] := true; Bars[4] := true;
                                   Bars[5] := true;  Bars[7] := true; END;
       '4' : BEGIN Bars[2] := true; Bars[6] := true;  Bars[7] := true; END;
       '5' : BEGIN Bars[2] := true; Bars[3] := true;  Bars[7] := true; END;
       '6' : BEGIN Bars[2] := true; Bars[4] := true;  Bars[5] := true;
                                   Bars[6] := true;  Bars[7] := true;  END;
       '7' : BEGIN Bars[2] := true; Bars[3] := true;  Bars[4] := true;
                                   Bars[6] := true;  Bars[7] := true;  END;
       '8' : BEGIN Bars[2] := true; Bars[3] := true;  Bars[5] := true;
                                   Bars[6] := true;  Bars[7] := true;  END;
       '9' : BEGIN Bars[4] := true; Bars[6] := true;  Bars[7] := true; END;
     END;
     if ns = B then
       case ch of
       '0' : BEGIN Bars[2] := true; Bars[5] := true; Bars[6] := true; Bars[7] := true; END;
       '1' : BEGIN Bars[2] := true; Bars[3] := true; Bars[6] := true; Bars[7] := true; END;
       '2' : BEGIN Bars[3] := true; Bars[4] := true; Bars[6] := true; Bars[7] := true; END;
       '3' : BEGIN Bars[2] := true; Bars[7] := true; END;
       '4' : BEGIN Bars[3] := true; Bars[4] := true; Bars[5] := true; Bars[7] := true; END;
       '5' : BEGIN Bars[2] := true; Bars[3] := true; Bars[4] := true; Bars[7] := true; END;
       '6' : BEGIN Bars[5] := true; Bars[7] := true; END;
       '7' : BEGIN Bars[3] := true; Bars[7] := true; END;
       '8' : BEGIN Bars[4] := true; Bars[7] := true; END;
       '9' : BEGIN Bars[3] := true; Bars[5] := true; Bars[6] := true; Bars[7] := true; END;
       END;
     if ns = C then
       case ch of
       '0' : BEGIN Bars[1] := true; Bars[2] := true; Bars[3] := true; Bars[6] := true; END;
       '1' : BEGIN Bars[1] := true; Bars[2] := true; Bars[5] := true; Bars[6] := true; END;
       '2' : BEGIN Bars[1] := true; Bars[2] := true; Bars[4] := true; Bars[5] := true; END;
       '3' : BEGIN Bars[1] := true; Bars[6] := true; END;
       '4' : BEGIN Bars[1] := true; Bars[3] := true; Bars[4] := true; Bars[5] := true; END;
       '5' : BEGIN Bars[1] := true; Bars[4] := true; Bars[5] := true; Bars[6] := true; END;
       '6' : BEGIN Bars[1] := true; Bars[3] := true; END;
       '7' : BEGIN Bars[1] := true; Bars[5] := true; END;
       '8' : BEGIN Bars[1] := true; Bars[4] := true; END;
       '9' : BEGIN Bars[1] := true; Bars[2] := true; Bars[3] := true; Bars[5] := true; END;
       END;

END;

BEGIN
{  if (ch in ['0'..'9']) then}
  Sender.Brush.color := Self.Color;
   Sender.textout(StartPOint + StartX,ThisHeight + StartY {+} - WIde,ch);{- allows for char leadin}
  EnCode(ch,NumSetS[Pos]); {returned in Bars}
  for i := 1 to 7  do
  BEGIN
  printbar(Sender,Bars[i],false);{true = always wide.. no wide/narrow}
  END;
END;




BEGIN{EAN}
  if (length(s) in [12,13])   then ean13 := true
  else
  if (length(s) in [7,8])   then ean13 := false
  else
    BEGIN
    if Sender = Self.canvas then
    with  self, canvas do
  BEGIN
  Pen.Color := FBarColor;
  Rectangle(0,0,width,height);
  END;
   exit;
  END;
    if (not FAutoSizing) then
  BEGIN
    if ean13 then
    BEGIN
    Wide := UseWidth div 113;   {95 + leadin 7 + 11}
    TotalWIde := 113 * Wide;
    END
    else
    BEGIN
    Wide := UseWidth div 81; {67 + leadin 7 + 7}
    TotalWIde := 81 * Wide;
    END;
    if wide = 0 then
      BEGIN
    if Sender = Self.canvas then
    with  self, canvas do
  BEGIN
  Pen.Color := FBarColor;
{  if drk then  Brush.Color := FBarColor else Brush.Color := Self.color;}
{  if WideBar then Barwidth := Wide else BarWidth := Narrow;}
  Rectangle(0,0,width,height);
  END;
   exit;
  END;
    ThisHeight := UseHeight - 12 * Wide;
{  Leadin := (UseWidth - (95 * wide)) div 2}
    Sender.Font.Name := 'Ariel';
   Sender.Font.Height := Wide * 14;{must be after wide assigned}
   Sender.Font.Style := [fsBold];
    Sender.Pen.color := Self.color;