Develop and Download Open Source Software

Browse Subversion Repository

Contents of /printdlg.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Mon Nov 7 12:03:00 2011 UTC (12 years, 4 months ago) by shiraishikazuo
File MIME type: text/x-pascal
File size: 2912 byte(s)


1 unit printdlg;
2
3 {$IFDEF FPC}
4 {$MODE DELPHI}{$H+}
5 {$ENDIF}
6
7 interface
8
9 uses
10 Types,Classes, SysUtils, Graphics, Controls, Forms, Dialogs,
11 ExtCtrls, StdCtrls, Buttons, LResources,
12 {$IFNDEF LclGtk} PrintersDlgs, {$ENDIF}
13 SynEdit;
14
15 type
16
17 { TPrintDialog1 }
18
19 TPrintDialog1 = class(TForm)
20 ListBox1: TListBox;
21 OkButton: TBitBtn;
22 cancelButton: TBitBtn;
23 FontDialog1: TFontDialog;
24 PrinterButton: TButton;
25 FontButton: TButton;
26 {$IFNDEF LclGtk}
27 PrinterSetupDialog1: TPrinterSetupDialog;
28 {$ENDIF}
29 procedure ListBox1SelectionChange(Sender: TObject; User: boolean);
30 procedure PrinterButtonClick(Sender: TObject);
31 procedure FontButtonClick(Sender: TObject);
32 procedure OnFormShow(Sender: TObject);
33 private
34 { Private 宣言 }
35 public
36 procedure execute(memo1:TSynEdit);
37 end;
38
39 //var
40 // PrintDialog1: TPrintDialog1;
41 procedure PrintMemo(memo1:TSynEdit);
42
43 implementation
44 uses Printers,
45 base,sconsts, myutils;
46 {$R *.lfm}
47
48
49 var
50 PrinterFont:TFont;
51
52 procedure PrintMemo(memo1:TSynEdit);
53 var
54 x,y,dy:integer;
55 i: Integer;
56 margin:integer;
57 begin
58 {todo 1 printer}
59
60 with Printer do
61 begin
62 BeginDoc;
63 Canvas.Font.Assign(PrinterFont);
64 Canvas.Font.PixelsPerInch:=XDPI;
65 margin:=XDPI div 2;
66 with Canvas do
67 begin
68 //Brush.Color := clBlack;
69 dy:=TextHeight(Memo1.Lines.Strings[0]);
70 x:=margin; //左margin
71 y:=margin; //上margin
72 i:=0;
73 while i<Memo1.Lines.Count do
74 begin
75 TextOut(x,y, Memo1.Lines.Strings[i]);
76 inc(i);
77 y:=y+dy;
78 if y > pageHeight - margin then
79 begin
80 NewPage;
81 y:=margin;
82 end;
83 end;
84 end;
85 EndDoc;
86 end;
87
88 end;
89
90
91 procedure TPrintDialog1.execute(memo1:TSynEdit);
92 begin
93 if showModal=mrOk then
94 PrintMemo(Memo1);
95 end;
96
97 procedure TPrintDialog1.PrinterButtonClick(Sender: TObject);
98 begin
99 {$IFDEF LclGtk}
100 NotAvailableMessage;
101 {$ELSE}
102 PrinterSetupDialog1.Execute
103 {$ENDIF}
104 end;
105
106 procedure TPrintDialog1.ListBox1SelectionChange(Sender: TObject; User: boolean);
107 begin
108 Printer.PrinterIndex:=ListBox1.ItemIndex;
109 end;
110
111 procedure TPrintDialog1.FontButtonClick(Sender: TObject);
112 begin
113 //FontDialog1.Device:=fdPrinter;
114 FontDialog1.Font:=PrinterFont;
115 if FontDialog1.Execute then
116 PrinterFont.Assign(FontDialog1.Font);
117
118 end;
119
120 procedure TPrintDialog1.OnFormShow(Sender: TObject);
121 begin
122 ListBox1.Items:=printer.printers;
123 ListBox1.ItemIndex:=Printer.PrinterIndex;
124 end;
125
126 initialization
127
128 PrinterFont:=TFont.create;
129 with PrinterFont do
130 begin
131 pitch:=fpFixed;
132 size:=10
133 end;
134
135 finalization
136 PrinterFont.free;
137 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26