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.
1 Comment