Delphi-Projects

1
program UWPrint;
2
{version of:
3
2010-10-05 +no stop on errors - just loging
4
2010-09-28 +specified Printers, not default only
5
}
6

7
{$APPTYPE CONSOLE}
8

9
uses
10
  Printers,
11
  Classes,
12
  SysUtils,
13
  StrUtils,
14
  Russian,
15
  BankUtils;
16

17
{$R *.RES}
18

19
const
20
  Ej = '- - - - - - - - ';
21

22
var
23
  FileName: AnsiString;
24
  F: TextFile;
25
  S: AnsiString;
26

27
  i: Integer;
28

29
  TopMargin: Integer = 0;
30
  LeftMargin: Integer = 0; //8
31
  FontSize: Integer = 8; //10
32

33
function PrintersInfo: AnsiString;
34
var
35
  i: Integer;
36
begin
37
  Result := 'Программа видит следующие принтеры (* - по умолчанию):'#13#10#13#10;
38
  for i := 0 to Printer.Printers.Count - 1 do
39
  begin
40
    if (i = Printer.PrinterIndex) then
41
      Result := Result + Format('%3u* "%s"', [i, Printer.Printers[i]]) + #13#10
42
    else
43
      Result := Result + Format('%3u  "%s"', [i, Printer.Printers[i]]) + #13#10;
44
  end;
45
  RWinToDos(Result);
46
end;
47

48
procedure ExitInfo(s: AnsiString = '');
49
begin
50
  Writeln(RDos('Unix-Windows Print - программа графической печати текстов из Банкира'));
51
  Writeln(RDos('В качестве параметра требует имя файла для печати'));
52
  Writeln(RDos('Вторым параметром может быть указан принтер (номер или имя в 866!)'));
53
  Writeln;
54
  if Length(s) > 0 then
55
  begin
56
    Writeln(RDos('ОШИБКА:'));
57
    Writeln(RDos(s));
58
    Writeln;
59
  end;
60
  Writeln(PrintersInfo);
61
  Writeln;
62
  //Writeln(RDos('Нажмите Enter для выхода'));
63
  //Readln;
64
  Halt(0);
65
end;
66

67
procedure LinePrint(s: AnsiString = '');
68
var
69
  x, y, y1, i: Integer;
70
begin
71
  with Printer do
72
  begin
73
    x := LeftMargin * Canvas.TextWidth('W');
74
    y := Canvas.PenPos.Y;
75
    y1 := Canvas.TextHeight('W');
76
    i := Pos(#12, s);
77

78
    if (y + y1) > PageHeight then
79
    begin
80
      NewPage;
81
      y := TopMargin * y1;
82
    end;
83

84
    if i = 0 then
85
      Canvas.TextOut(x, y, TrimRight(s))
86
    else
87
    begin
88
      if i > 1 then
89
        Canvas.TextOut(x, y, TrimRight(AnsiLeftStr(s, i-1)));
90
      NewPage;
91
      y := TopMargin * y1;
92
      if i < Length(s) then
93
        Canvas.TextOut(x, y, TrimRight(AnsiMidStr(s, i+1, Length(s))));
94
    end;
95

96
    Canvas.PenPos := Point(0, y + y1);
97
  end;
98
end;
99

100
begin
101
  if (ParamCount < 1) or
102
     FindCmdLineSwitch('?') or
103
     FindCmdLineSwitch('h') then
104
    ExitInfo();
105

106
  if Printer.Printers.Count = 0 then
107
  begin
108
    AppendLogMessage('Нет установленных принтеров!');
109
    Halt(1);
110
  end;
111

112
  FileName := ParamStr(1);
113
  if not FileExists(FileName) then
114
  begin
115
    AppendLogMessage('Нет такого файла %s', [FileName]);
116
    Halt(2);
117
  end;
118

119
  if (ParamCount = 2) then
120
  begin
121
    //Printer.SetPrinter(ParamStr(2));
122
    S := ParamStr(2);
123
    if TryStrToInt(S, i) then
124
    begin
125
      if (i > -1) and (i < Printer.Printers.Count) then
126
        Printer.PrinterIndex := i
127
      else
128
      begin
129
        AppendLogMessage('Нет принтера с номером %s', [S]);
130
        Halt(3);
131
      end;
132
    end
133
    else
134
    begin
135
      i := Printer.Printers.IndexOf(S);
136
      if i = -1 then
137
      begin
138
        AppendLogMessage('Нет принтера с именем (в 866) "%s"', [S]);
139
        Halt(4);
140
      end;
141
      Printer.PrinterIndex := i;
142
    end;
143
  end;
144

145
  AssignFile(F, FileName);
146
  //SetLineBreakStyle(F, tlbsLF);
147
  Reset(F);
148
  //Readln(F, S);
149
  {if AnsiEndsStr(#13, S) then
150
  begin
151
    CloseFile(F);
152
    SetLineBreakStyle(F, tlbsCRLF);
153
    Reset(F);
154
  end;}
155

156
  with Printer do
157
  begin
158
    //Orientation := poLandscape;
159
    Orientation := poPortrait;
160
    Title := 'UWPrint - ' + FileName;
161
    BeginDoc;
162

163
    Canvas.Font.Name := 'Courier New';
164
    Canvas.Font.Charset := 204; //RUSSIAN_CHARSET;
165
    Canvas.Font.Size := FontSize;
166

167
    while not EOF(F) do
168
    begin
169
      Readln(F, S);
170
      S := AnsiReplaceStr(S, '$$', #12);
171
      if AnsiStartsStr(Ej, s) then
172
        S := #12
173
      else if AnsiStartsStr(#27'M', S) then
174
        S := AnsiMidStr(S, 2, Length(S));
175
      LinePrint(RWin(S));
176
    end;
177
    EndDoc;
178
  end;
179
  CloseFile(F);
180
end.
181

182