'================================================================
'= クリッピング領域とパスを結合(�U)
'=    (SelectClipPath2.bas)
'================================================================
#include "Windows.bi"

#define LF_FACESIZE 32

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

Type LOGFONT
    lfHeight         As Long
    lfWidth          As Long
    lfEscapement     As Long
    lfOrientation    As Long
    lfWeight         As Long
    lfItalic         As Byte
    lfUnderline      As Byte
    lfStrikeOut      As Byte
    lfCharSet        As Byte
    lfOutPrecision   As Byte
    lfClipPrecision  As Byte
    lfQuality        As Byte
    lfPitchAndFamily As Byte
    lfFaceName(LF_FACESIZE) As Byte
End Type

' 論理フォントを作成
Declare Function Api_CreateFontIndirect& Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT)

' パスをクリッピング領域に設定
Declare Function Api_SelectClipPath& Lib "gdi32" Alias "SelectClipPath" (ByVal hDC&, ByVal iMode&)

' hDCで指定されたデバイスコンテキストのパスの作成
Declare Function Api_BeginPath& Lib "gdi32" Alias "BeginPath" (ByVal hDC&)

' BeginPathで開始したパスの作成を終了
Declare Function Api_EndPath& Lib "gdi32" Alias "EndPath" (ByVal hDC&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

' テキストを指定の位置に出力
Declare Function Api_TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC&, ByVal nXStart&, ByVal nYStart&, ByVal lpString$, ByVal cbString&)

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' 多角形塗りつぶしモードを設定
Declare Function Api_SetPolyFillMode& Lib "gdi32" Alias "SetPolyFillMode" (ByVal hDC&, ByVal nPolyFillMode&)

' 論理ペンを作成
Declare Function Api_CreatePen& Lib "gdi32" Alias "CreatePen" (ByVal nPenStyle&, ByVal nWidth&, ByVal crColor&)

' 現在位置を受け取るバッファを参照で指定
Declare Function Api_MoveToEx& Lib "gdi32" Alias "MoveToEx" (ByVal hDC&, ByVal x&, ByVal y&, ByVal lpPoint&)

' 現在の位置から終点までを直線で描画
Declare Function Api_LineTo& Lib "gdi32" Alias "LineTo" (ByVal hDC&, ByVal x&, ByVal y&)

' 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' 指定されたデバイスコンテキストの現在ペンを使ってパスが描かれている場合、そのパスを塗りつぶしの対象領域として再定義
Declare Function Api_WidenPath& Lib "gdi32" Alias "WidenPath" (ByVal hDC&)

' バックグラウンドの塗りつぶしモード設定
Declare Function Api_SetBkMode& Lib "gdi32" Alias "SetBkMode" (ByVal hDC&, ByVal iBkMode&)

#define TRANSPARENT 1                   '背景色を設定しない
#define RGN_COPY 5                      'HRGNSRC1のコピーを作成
#define WINDING 2                       '全域塗りつぶしモード
#define PS_SOLID 0                      '実線のペンを作成
#define vbWhite &HFFFFFF                '白のカラーコード
#define vbBlack &H000000                '黒のカラーコード
#define vbRed &H0000FF                  '赤のカラーコード
#define DT_CALCRECT &H400               'テキストを表示するために必要な長方形の大きさをlpRectパラメータに格納

Var Shared Button1 As Object

Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var rc As RECT
    Var lf As LOGFONT
    Var rFont As Long
    Var hDC As Long
    Var hPen As Long
    Var hOldPen As Long
    Var i As Long
	Var txt As String
    Var Ret As Long

    SetFontName "ＭＳ 明朝"
    txt = "札幌市白石区"

    lf.lfHeight = 60
    lf.lfWeight = 400
    lf.lfCharSet = 128

    rFont = Api_CreateFontIndirect(lf)

    hDC = Api_GetDC(GethWnd)
    Ret = Api_SetPolyFillMode(hDC, WINDING)

    'パス用ペンを設定
    hPen = Api_CreatePen(PS_SOLID, 1, vbBlack)
    hOldPen = Api_SelectObject(hDC, rFont)
    Ret = Api_SetBkMode(hDC, TRANSPARENT)

    '通常の文字列描画
    Ret = Api_TextOut(hDC, 10, 5, txt, Len(txt))

    'パスブラケットをオープン
    Ret = Api_BeginPath(hDC)
    Ret = Api_TextOut(hDC, 10, 70, txt, Len(txt))
    Ret = Api_EndPath(hDC)

    Ret = Api_WidenPath(hDC)

    'クリッピング領域とパスを結合
    Ret = Api_SelectClipPath(hDC, RGN_COPY)

    'オブジェクトを選択
    Ret = Api_SelectObject(hDC, hOldPen)

    'パス用ペンを設定
    hPen = Api_CreatePen(PS_SOLID, 1, vbBlack)
    hOldPen = Api_SelectObject(hDC, hPen)

    For i = 71 To 129
        Ret = Api_MoveToEx(hDC, 11, i, 0)
        Ret = Api_LineTo(hDC, 370, i)
    Next

    '論理オブジェクトを削除
    Ret = Api_DeleteObject(hPen)

    'デバイスコンテキストを解放
    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End