文字列の方向を変更するには？

解決

モエモエ 2007-03-16 23:16:10 No: 98299

いつもこの板の方々にはお世話になっています。
この度パソコンのワイドディスプレイを縦置きにして、
画面を表示する事になったのですが、縦置きにした場合、
テキストやラベル等の文字列の方向を変えなければいけません。
文字列の方向を変更するにはどうすれば良いのでしょうか？
どなたかご教授してもらえないでしょうか。
環境はOSが2003serverでVB6.0です。
宜しくお願いします。

モエモエ 2007-03-17 01:09:59 No: 98300

APIのCreateFontを使用する事により解決しました。
お騒がせしてどうもすいませんでした。

参考までにソースを載せときます。

Option Explicit

' オブジェクトを選択する関数
Private Declare Function SelectObject Lib "gdi32.dll" _
(ByVal hdc As Long, _
ByVal hgdiobj As Long) As Long

' オブジェクトを破棄する関数
Private Declare Function DeleteObject Lib "gdi32.dll" _
(ByVal hObject As Long) As Long

'論理フォントを作成する関数
Private Declare Function CreateFont Lib "gdi32.dll" _
    Alias "CreateFontA" _
   (ByVal nHeight As Long, _
    ByVal nWidth As Long, _
    ByVal nEscapement As Long, _
    ByVal nOrientation As Long, _
    ByVal fnWeight As Long, _
    ByVal fdwItalic As Long, _
    ByVal fdwUnderline As Long, _
    ByVal fdwStrikeOut As Long, _
    ByVal fdwCharSet As Long, _
    ByVal fdwOutputPrecision As Long, _
    ByVal fdwClipPrecision As Long, _
    ByVal fdwQuality As Long, _
    ByVal PitchAndFamily As Long, _
    ByVal lpszFace As String) As Long

Private Sub Command1_Click()

    Dim intAngle         As Integer
    Dim lnghNewFont      As Long
    Dim lnghOriginalFont As Long
    Dim lngHeight        As Long
    Dim lngWidth         As Long

    ' フォントを作成
    With Picture1
        ' ピクセル単位に設定
        .ScaleMode = vbPixels
        ' 継続表示属性を設定
        .AutoRedraw = True
        ' フォントの高さ
        lngHeight = .TextHeight(Text1.Text)
        ' フォントの幅
        lngWidth = 0 '高さにあった幅で描画する場合は0
        intAngle = 90
        With .Font
            lnghNewFont = CreateFont(lngHeight, _
                                    lngWidth, _
                                    intAngle * 10, _
                                    intAngle * 10, _
                                    .Weight, _
                                    .Italic, _
                                    .Underline, _
                                    .Strikethrough, _
                                    .Charset, _
                                    0, _
                                    0, _
                                    0, _
                                    0, _
                                    .Name)
            End With
            ' 作成したフォントを選択
            lnghOriginalFont = SelectObject(.hdc, _
                                            lnghNewFont)
            ' 描画開始位置
            .CurrentX = 0
            .CurrentY = 120
            ' テキストボックスの内容を描画
            Picture1.Print Text1.Text
        ' 元のフォントに戻す
        lnghNewFont = SelectObject(.hdc, _
                                   lnghOriginalFont)
        ' 継続表示属性を解除
        .AutoRedraw = False
    End With
    ' オブジェクトを破棄
    DeleteObject lnghNewFont

End Sub