| フォントの（種類・サイズ・スタイル）設定をする （１０１） | |
| 用紙の設定や向きの設定は１度きりだけど、フォント関係の設定は印刷設定中何度も変更しますよね、プログラムが長くなって見難く同じような設定を何度も面倒ですよね、そこでサブプロシージャ化してみました。 印刷も表示も設定は同じなのでどちらにでも使用できるようにしました。 Option Explicit 'SampleNo=101 WindowsXP VB6.0(SP5) 2002.05.19 Private Sub sFontSet(myObj As Object, FntName As Integer, FntSize _ As Integer, FntStyle As Integer) '================================================================ '* myObj = オブジェクト名(Form Or Printer 等) '* FntName = フォントの名前 '* FntSize = フォントサイズ '* FntStyle = フォントスタイル '* FntStyle=1 太字 FntStyle=10 斜体 '* FntStyle=50 消線 FntStyle=100 アンダーライン '* スタイルの組合せはそれぞれの数値の合計で指定 '* sFontSet 1,12,101 のように指定して使って下さい '* フォントはＭＳ Ｐゴシックで１２ポイントで太字でアンダーライン付 '================================================================ Dim intFStyle As Integer On Error Resume Next intFStyle = FntStyle With myObj 'フォント名を設定 Select Case FntName Case 0 .FontName = "ＭＳ ゴシック" Case 1 .FontName = "ＭＳ Ｐゴシック" Case 2 .FontName = "ＭＳ 明朝" Case 3 .FontName = "ＭＳ Ｐ明朝" Case Else .FontName = "ＭＳ ゴシック" End Select If FntSize <= 0 Or FntSize > 72 Then FntSize = 9 'フォントサイズのデフォルト設定 End If 'フォントサイズを設定 .FontSize = FntSize 'フォントスタイルを初期値に設定 .FontBold = False .FontItalic = False .FontStrikethru = False .FontUnderline = False '指定のフォントスタイルを組み合わせに設定 If intFStyle >= 100 Then .FontUnderline = True 'アンダーライン intFStyle = intFStyle - 100 End If If intFStyle >= 50 Then .FontStrikethru = True '取り消し線 intFStyle = intFStyle - 50 End If If intFStyle >= 10 Then .FontItalic = True '斜体 intFStyle = intFStyle - 10 End If If intFStyle = 1 Then .FontBold = True '太字 End If End With End Sub 位置指定用プロシージャ Private Sub Locate(myObj As Object, X As Long, Y As Long, myStr As String) With myObj .ScaleMode = vbCharacters 'キャラクターモード .CurrentX = X '桁位置 .CurrentY = Y '行位置 End With myObj.Print myStr End Sub Private Sub Command1_Click() '関数使用例 Form1のところをPrinter に変えると印刷 sFontSet Form1, 1, 12, 101 Locate Form1, 5, 2, "VBレスキュー(花ちゃん)" sFontSet Form1, 3, 16, 111 Locate Form1, 5, 4, "VBレスキュー(花ちゃん)" End Sub |
|