Virgonia, Delphi dan Interbase

unit VsrDotMatrixs;
{
 Imam Chalimi
 Agustus, 2006

 Rev:
 03/09/2006 : First complete properties.
 05/09/2006 : SetMargin Added
}

interface

uses
    Windows,
    SysUtils,
    Classes;

const
     VDMA_LEFT     = 0;
     VDMA_RIGHT    = 1;
     VDMA_CENTER   = 2;
     VDMA_JUSTIFY  = 3;

     PRN_INIT        = #27'@';
     PRN_FF          = #12;
     PRN_LF          = #10;
     PRN_PAGE_LENGTH = #27'C';
     PRN_CF_BOTTOM   = #27'N';
     PRN_LEFT        = #27'l';
     PRN_RIGHT       = #27'Q';
     PRN_FONT_ROMAN  = #27'k'#0;
     PRN_FONT_SANS   = #27'k'#1;
     PRN_FONT_COUR   = #27'k'#2;
     PRN_10CPI       = #27'P';
     PRN_12CPI       = #27'M';
     PRN_15CPI       = #27'g';
     PRN_DRAFT       = #27'x'#0;
     PRN_NLQ         = #27'x'#1;
     PRN_ITALIC_ON   = #27'4';
     PRN_ITALIC_OFF  = #27'5';
     PRN_BOLD_ON     = #27'E';
     PRN_BOLD_OFF    = #27'F';
     PRN_ULINE_ON    = #27'-'#1;
     PRN_ULINE_OFF   = #27'-'#0;
     PRN_COND_ON     = #15;
     PRN_COND_OFF    = #18;
     PRN_DBL_WIDTH   = #27'W';
     PRN_DBL_WIDTH_ON    = #27'W'#1;
     PRN_DBL_WIDTH_OFF   = #27'W'#0;
     PRN_DBL_HEIGTH  = #27'w';
     PRN_DBL_HEIGTH_ON   = #27'w'#1;
     PRN_DBL_HEIGTH_OFF  = #27'w'#0;
     PRN_SPC_180     = #27'3';

type
    TVsrDotMatrix = class
      private
        FAbout,
        FTarget: string;
        FFile: TextFile;
        FNLQ,
        FBold,
        FItalic,
        FUnderline,
        FDWidth: Boolean;
        FFontSize,
        FMarginLeft,
        FMarginRight,
        FMarginTop,
        FMarginBottom,
        FLine,
        FPageLength: Integer;
        FSpacing: Real;
        FAlign: Integer;
        procedure SetNLQ(value:Boolean);
        procedure SetBold(value:Boolean);
        procedure SetItalic(value:Boolean);
        procedure SetUnderline(value:Boolean);
        procedure SetDWidth(value:Boolean);
        procedure SetAlign(value:Integer);
        procedure SetFont(value:Integer);
        procedure SetSpacing(value:Real);
        procedure SetLeftMargin(value:Integer);
        procedure SetRightMargin(value:Integer);
        procedure SetTopMargin(value:Integer);
        procedure SetBottomMargin(value:Integer);
      public
        constructor Create;
        function Open:Boolean;
        procedure Close;
        procedure InitPrinter;
        procedure FormFeed;
        procedure NextPage;
        procedure Print(Text:string='';NewLine:Boolean=True);
        function Repl(iLength:Integer;s:string=' '):string;
        function AddSpace(Text:string;iLength:Integer;
                 iAlign:Integer=VDMA_LEFT):String;
        function SplitWord(Text:string;iWidth:Integer;
                 iAlign:Integer=VDMA_LEFT):string;
      published
        property About:string read FAbout;
        property Target:string read FTarget write FTarget;
        property NLQ:Boolean read FNLQ write SetNLQ;
        property Bold:Boolean read FBold write SetBold;
        property Italic:Boolean read FItalic write SetItalic;
        property Underline:Boolean read FUnderline write SetUnderline;
        property DoubleWidth:Boolean read FDWidth write SetDWidth;
        property FontSize:Integer read FFontSize write SetFont;
        property Align:Integer read FAlign write SetAlign;
        property Spacing:Real read FSpacing write SetSpacing;
        property MarginLeft:Integer read FMarginLeft write SetLeftMargin;
        property MarginRight:Integer read FMarginRight write SetRightMargin;
        property MarginTop:Integer read FMarginTop write SetTopMargin;
        property MarginBottom:Integer read FMarginBottom write SetBottomMargin;
        property PageLength:Integer read FPageLength write FPageLength;
    end;

implementation

{ TVsrDotMatrix }

function TVsrDotMatrix.AddSpace(Text: string; iLength,
  iAlign: Integer): String;
begin
     Result:=Text;
     case iAlign of
          VDMA_LEFT: while Length(Result)<iLength do
                     Result:=Result+' ';
          VDMA_RIGHT: while Length(Result)<iLength do
                      Result:=' '+Result;
          VDMA_CENTER: begin
                            while Length(Result)<iLength do
                                  Result:=' '+Result+' ';
                            if Length(Result)>iLength then
                               SetLength(Result,iLength);
                       end;
     end;
end;

procedure TVsrDotMatrix.Close;
begin
     CloseFile(FFile);
end;

constructor TVsrDotMatrix.Create;
begin
     FAbout:='VsrDotMatrix by Imam Chalimi #20060905.0600';
     FTarget:='prn';
end;

procedure TVsrDotMatrix.FormFeed;
begin
     Print(PRN_FF,False);
     FLine:=0;
end;

procedure TVsrDotMatrix.InitPrinter;
begin
     Print(PRN_INIT+PRN_DRAFT+PRN_COND_OFF,False);
     MarginLeft:=0;
     MarginTop:=0;
end;

procedure TVsrDotMatrix.NextPage;
begin
     if FPageLength=0 then
        FormFeed
     else
         while FLine<FPageLength do
               Print;
     FLine:=0;
end;

function TVsrDotMatrix.Open: Boolean;
begin
     if FTarget='' then
        FTarget:='prn';
     AssignFile(FFile,FTarget);
     {$I-}
     Rewrite(FFile);
     {$I+}
     Result:=(IOResult=0);
     FLine:=0;
     FPageLength:=0;
end;

procedure TVsrDotMatrix.Print(Text: string; NewLine: Boolean);
begin
     if (FAlign=VDMA_RIGHT) and (FMarginRight>0) then
        while Length(Text)<FMarginRight do
              Text:=' '+Text;
     if (FAlign=VDMA_CENTER) and (FMarginRight>0) then
        while Length(Text)<FMarginRight do
              Text:=' '+Text+' ';
     if NewLine then
     begin
          Writeln(FFile,Text);
          Inc(FLine);
     end
     else
        Write(FFile,Text);
end;

procedure TVsrDotMatrix.SetAlign(value: Integer);
begin
     FAlign:=value;
end;

procedure TVsrDotMatrix.SetBold(value: Boolean);
begin
     FBold:=value;
     if value then
        Print(PRN_BOLD_ON,False)
     else
        Print(PRN_BOLD_OFF,False);
end;

procedure TVsrDotMatrix.SetDWidth(value: Boolean);
begin
     FDWidth:=value;
     if value then
        Print(PRN_DBL_WIDTH+#1,False)
     else
         Print(PRN_DBL_WIDTH+#0,False);
end;

procedure TVsrDotMatrix.SetFont(value: Integer);
begin
     case value of
          10: if FFontSize=20 then
                 Print(PRN_COND_OFF,False)
              else
                  Print(PRN_10CPI,False);
          12: Print(PRN_12CPI,False);
          15: Print(PRN_15CPI,False);
          20: Print(PRN_COND_ON,False);
     else
         Print(PRN_COND_OFF,False);
     end;
     FFontSize:=value;
end;

procedure TVsrDotMatrix.SetItalic(value: Boolean);
begin
     FItalic:=value;
     if value then
        Print(PRN_ITALIC_ON,False)
     else
         Print(PRN_ITALIC_OFF,False);
end;

procedure TVsrDotMatrix.SetNLQ(value: Boolean);
begin
     FNLQ:=value;
     if value then
        Print(PRN_NLQ,False)
     else
         Print(PRN_DRAFT,False);
end;

procedure TVsrDotMatrix.SetSpacing(value: Real);
begin
     FSpacing:=value;
     Print(PRN_SPC_180+chr(trunc(30*FSpacing)));
end;

procedure TVsrDotMatrix.SetUnderline(value: Boolean);
begin
     FUnderline:=value;
     if value then
        Print(PRN_ULINE_ON,False)
     else
        Print(PRN_ULINE_OFF,False);
end;

function TVsrDotMatrix.Repl(iLength: Integer;s:string): string;
var
   i: Integer;
begin
     Result:='';
     for i:=1 to iLength do
         Result:=Result+s;
end;

function TVsrDotMatrix.SplitWord(Text: string; iWidth,
  iAlign: Integer): string;
var
   aOld,aNew: array of string;
   i,n: Integer;
begin
     while pos(#10,Text)>0 do
           Text[pos(#10,Text)]:=' ';
     while pos(#13,Text)>0 do
           Text[pos(#13,Text)]:=' ';
     while pos('  ',Text)>0 do
           Delete(Text,pos('  ',Text),1);
     Text:=Trim(Text);
     i:=0;
     while pos(' ',Text)>0 do
     begin
          Inc(i);
          SetLength(aOld,i);
          aOld[i-1]:=copy(Text,1,pos(' ',Text)-1);
          Delete(Text,1,pos(' ',Text));
     end;
     Inc(i);
     SetLength(aOld,i);
     aOld[i-1]:=Text;
     n:=0;
     for i:=1 to Length(aOld) do
     begin
          if (n=0) or (Length(aNew[n-1])+Length(aOld[i-1])>iWidth) then
          begin
               Inc(n);
               SetLength(aNew,n);
          end;
          aNew[n-1]:=aNew[n-1]+aOld[i-1]+' ';
     end;
     Result:='';
     for i:=1 to Length(aNew) do
         Result:=Result+aNew[i-1]+#13#10;
end;

procedure TVsrDotMatrix.SetBottomMargin(value: Integer);
begin
     FMarginBottom:=value;
end;

procedure TVsrDotMatrix.SetLeftMargin(value: Integer);
begin
     FMarginLeft:=value;
     Print(PRN_LEFT+chr(value),False);
end;

procedure TVsrDotMatrix.SetRightMargin(value: Integer);
begin
     FMarginRight:=value;
     Print(PRN_RIGHT+chr(value),False);
end;

procedure TVsrDotMatrix.SetTopMargin(value: Integer);
begin
     FMarginTop:=value;
end;

end.