List 7-175 FormPrintPreviewフォームのDrawPreview2プロシージャ
1： Private Function DrawPreview2(ByRef objPic As Object, _
ByRef StartPage As Long, _
ByRef EndPage As Long) As Long
2： ' プレビュー画面を描画する
3： ' MSHFlexGridコントロール版
4： ' 【引数】
5： ' objPic = 描画対象となるオブジェクト（ピクチャボックスかPrinterオブジェクトのいずれか）
6： ' StartPage = 先頭ページ番号
7： ' EndPage = 最終ページ番号
8： ' 【戻り値】
9： ' -1 = エラー
10： ' 正の数 = 出力した最終ページ番号
11： Dim row As Long, col As Long, i As Long
12： Dim newPageFlag As Boolean
13： Dim columnNum As Long
14： Dim colWidth() As Long
15： Dim X As Long, Y As Long
16： Dim MLeft As Long, MRight As Long, MUp As Long, MDown As Long
17： Dim ColWidthTotal As Long
18： Dim ColHeight As Long, ColMaxHeight As Long
19： Dim NowPage As Long
20： Dim drawFlag As Boolean
21： Dim AlignConv As Variant
22：
23： ' 文字揃えの変換配列
24： AlignConv = Array(dbgLeft, dbgLeft, dbgLeft, dbgCenter, dbgCenter, _
dbgCenter, dbgRight, dbgRight, dbgRight, dbgGeneral)
25：
26： ' 余白情報の取得
27： If Not IsNumeric(TXT_UP.Text) Then
28： MsgBox "上余白が不正です", vbOKOnly, "印刷エラー"
29： DrawPreview2 = -1
30： Exit Function
31： Else
32： MUp = CLng(TXT_UP.Text)
33： End If
34：
35： If Not IsNumeric(TXT_DOWN.Text) Then
36： MsgBox "下余白が不正です", vbOKOnly, "印刷エラー"
37： DrawPreview2 = -1
38： Exit Function
39： Else
40： MDown = CLng(TXT_DOWN.Text)
41： End If
42：
43： If Not IsNumeric(TXT_LEFT.Text) Then
44： MsgBox "左余白が不正です", vbOKOnly, "印刷エラー"
45： DrawPreview2 = -1
46： Exit Function
47： Else
48： MLeft = CLng(TXT_LEFT.Text)
49： End If
50：
51： If Not IsNumeric(TXT_RIGHT.Text) Then
52： MsgBox "右余白が不正です", vbOKOnly, "印刷エラー"
53： DrawPreview2 = -1
54： Exit Function
55： Else
56： MRight = CLng(TXT_RIGHT.Text)
57： End If
58：
59： On Error GoTo ErrHandle
60：
61： ' 余白をmm単位からTwip単位に変換する
62： MUp = objPic.ScaleY(MUp, vbMillimeters, vbTwips)
63： MDown = objPic.ScaleY(MDown, vbMillimeters, vbTwips)
64： MLeft = objPic.ScaleX(MLeft, vbMillimeters, vbTwips)
65： MRight = objPic.ScaleX(MRight, vbMillimeters, vbTwips)
66：
67： newPageFlag = True
68： NowPage = 1
69：
70： If (NowPage >= StartPage) And (NowPage <= EndPage) Then
71： ' 表示する
72： drawFlag = True
73： Else
74： ' 表示しない
75： drawFlag = False
76： End If
77：
78： ' MSHFlexGridコントロールの列数を取得
79： columnNum = g_FLXGrid.Cols
80：
81： ' 列の幅を算出する
82： ' 用紙の横幅に合わせた形に表を引き延ばし，
83： ' もとのMSHFlexGridの列幅と比例する形で
84： ' 各列を分配する形で幅を求める
85：
86： ReDim colWidth(columnNum)
87：
88： ColWidthTotal = 0
89：
90： ' 各列の幅と，各列の幅の総和を求める
91： For i = 0 To columnNum - 1
92： colWidth(i) = g_FLXGrid.colWidth(i)
93： ColWidthTotal = ColWidthTotal + colWidth(i)
94： Next
95：
96： ' 各列の幅が合うように揃える
97： For i = 0 To g_FLXGrid.Cols - 1
98： colWidth(i) = colWidth(i) * (objPic.Width - MLeft - MRight) / ColWidthTotal
99： Next
100：
101： ' ページの印刷を開始
102：
103： ' カレント座標を左上の余白内位置に移動する
104： objPic.CurrentX = MLeft
105： objPic.CurrentY = MUp
106：
107： ' タイトルの印刷
108： If NowPage = 1 Then
109： ' 先頭ぺージであれば，タイトルを表示する
110： DrawFrame objPic, g_TitleFrame, MUp, MLeft, MDown, MRight, drawFlag
111： End If
112：
113： ' 行を次々と表示する
114： Y = objPic.CurrentY
115：
116： ' レコード数だけループして各列を描画する
117： g_FLXGrid.FillStyle = flexFillSingle
118：
119： For row = g_FLXGrid.FixedRows To g_FLXGrid.Rows - 1
120： ' 各行の印刷
121： g_FLXGrid.row = row
122：
123： X = MLeft
124： objPic.CurrentX = X
125：
126： ' ページの頭である場合には見出し行を印刷する
127： If newPageFlag Then
128： ' ページの頭である場合
129： newPageFlag = False
130：
131： ' 横罫の印刷
132： X = objPic.CurrentX
133： Y = objPic.CurrentY
134： myLine objPic, X, Y, X + objPic.Width - MLeft - MRight, Y, drawFlag
135： objPic.CurrentX = X
136： objPic.CurrentY = Y
137：
138： If g_FLXGrid.FixedRows <> 0 Then
139： ' 見出し行を印刷する
140：
141： ColMaxHeight = 0
142： X = objPic.CurrentX
143： ' 見出しを印刷
144：
145： ' 見出しのフォントを設定
146： objPic.Font.Name = g_FLXGrid.FontFixed.Name
147： objPic.Font.Bold = g_FLXGrid.FontFixed.Bold
148： objPic.Font.Charset = g_FLXGrid.FontFixed.Charset
149： objPic.Font.Italic = g_FLXGrid.FontFixed.Italic
150： objPic.Font.Size = g_FLXGrid.FontFixed.Size
151： objPic.Font.Strikethrough = g_FLXGrid.FontFixed.Strikethrough
152： objPic.Font.Underline = g_FLXGrid.FontFixed.Underline
153：
154： For i = 0 To g_FLXGrid.FixedRows - 1
155： For col = 0 To g_FLXGrid.Cols - 1
156： ' 見出しを印刷する
157： objPic.CurrentX = X
158： objPic.CurrentY = Y
159： ColHeight = DrawBox(objPic, g_FLXGrid.TextMatrix(i, col), _
colWidth(col), AlignConv(g_FLXGrid.ColAlignmentHeader(0, col)), drawFlag)
160： If ColHeight > ColMaxHeight Then
161： ColMaxHeight = ColHeight
162： End If
163： X = X + colWidth(col)
164： Next
165：
166： ' 縦線を印刷
167： X = MLeft
168： For col = 0 To g_FLXGrid.Cols - 1
169： myLine objPic, X, Y, X, Y + ColMaxHeight, drawFlag
170： X = X + colWidth(col)
171： Next
172：
173： myLine objPic, X, Y, X, Y + ColMaxHeight, drawFlag
174：
175： ' 次の行に移動する
176： objPic.CurrentX = MLeft
177： objPic.CurrentY = Y + ColMaxHeight
178： Next
179： End If
180： End If
181：
182： ' 横罫の印刷
183： X = objPic.CurrentX
184： Y = objPic.CurrentY
185： myLine objPic, X, Y, X + objPic.Width - MLeft - MRight, Y, drawFlag
186： objPic.CurrentX = X
187： objPic.CurrentY = Y
188：
189： ' 1行分のセルの中身を印刷する
190： X = objPic.CurrentX
191： ColMaxHeight = 0
192：
193： For col = 0 To g_FLXGrid.Cols - 1
194： ' 中身を印刷する
195： g_FLXGrid.col = col
196：
197： ' フォントを設定
198： objPic.Font.Name = g_FLXGrid.CellFontName
199： objPic.Font.Bold = g_FLXGrid.CellFontBold
200： objPic.Font.Italic = g_FLXGrid.CellFontItalic
201： objPic.Font.Size = g_FLXGrid.CellFontSize
202： objPic.Font.Strikethrough = g_FLXGrid.CellFontStrikeThrough
203： objPic.Font.Underline = g_FLXGrid.CellFontUnderline
204：
205： objPic.CurrentX = X
206： objPic.CurrentY = Y
207： ColHeight = DrawBox(objPic, g_FLXGrid.Text, colWidth(col), _
AlignConv(g_FLXGrid.ColAlignment(col)), drawFlag)
208：
209： If ColHeight > ColMaxHeight Then
210： ColMaxHeight = ColHeight
211： End If
212： X = X + colWidth(col)
213： Next
214：
215： ' 縦線を印刷
216： X = MLeft
217： For col = 0 To g_FLXGrid.Cols - 1
218： myLine objPic, X, Y, X, Y + ColMaxHeight, drawFlag
219： X = X + colWidth(col)
220： Next
221： myLine objPic, X, Y, X, Y + ColMaxHeight, drawFlag
222：
223： ' 1ページをはみ出ていないかどうかを確認する
224： If objPic.CurrentY > objPic.Height - MDown - MUp Then
225： ' ページをはみ出しているので次のページに移動する
226：
227： ' このページで印刷が終わりかどうか
228： If NowPage >= EndPage Then
229： ' このページで印刷が終わりなのでループを抜ける
230： Exit For
231： End If
232：
233： ' 次のページに移動する
234：
235： ' 最後の横線の印刷
236： X = MLeft
237： objPic.CurrentX = X
238：
239： myLine objPic, X, objPic.CurrentY, X + objPic.Width, objPic.CurrentY, drawFlag
240： objPic.CurrentX = X
241： objPic.CurrentY = Y
242：
243： ' 次のページに移動する
244： If objPic Is Printer And drawFlag Then
245： ' プリンタの場合には改ページする
246： objPic.NewPage
247： End If
248：
249： NowPage = NowPage + 1
250： newPageFlag = True
251：
252： If (NowPage >= StartPage) And (NowPage <= EndPage) Then
253： ' 表示する
254： drawFlag = True
255： Else
256： ' 表示しない
257： drawFlag = False
258： End If
259：
260： objPic.CurrentX = MLeft
261： objPic.CurrentY = MUp
262： End If
263：
264： ' 中断処理になっていないかどうかをチェック
265： If objPic Is Printer Then
266： DoEvents
267： If FormPrinting.bCancelFlag Then
268： ' キャンセル処理
269： objPic.KillDoc
270： MsgBox "印刷が中断されました", vbOKOnly, "印刷"
271： Exit For
272： End If
273： End If
274： Next
275：
276： ' ページの終わり
277： ' 横線の印刷
278： X = MLeft
279： objPic.CurrentX = X
280：
281： myLine objPic, X, objPic.CurrentY, X + objPic.Width - MLeft - MRight, objPic.CurrentY, drawFlag
282： objPic.CurrentX = X
283： objPic.CurrentY = Y
284：
285： If objPic Is Printer Then
286： ' プリンタの場合にはプリンタの終了処理をする
287： objPic.EndDoc
288： End If
289：
290： DrawPreview2 = NowPage
291：
292： Exit Function
293：
294： ErrHandle:
295： ' エラーハンドラ
296： If objPic Is Printer Then
297： ' プリンタの場合には中断処理をする
298： objPic.KillDoc
299： objPic.EndDoc
300： End If
301：
302： DrawPreview2 = -1
303： MsgBox Err.Description, vbOKOnly, "印刷エラー"
304： End Function