'================================================================
'= 文字列を描画(�Y)
'=    (SelectClipPath4.bas)
'================================================================
#include "Windows.bi"

#define LF_FACESIZE 32

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       As String * LF_FACESIZE
End Type

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

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

' 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_TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC&, ByVal nXStart&, ByVal nYStart&, ByVal lpString$, ByVal cbString&)

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
Declare Function Api_BitBlt& Lib "gdi32" Alias "BitBlt" (ByVal hDestDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)

' 指定したデバイスコンテキストのクリッピング領域とパスを結合
Declare Function Api_SelectClipPath& Lib "gdi32" Alias "SelectClipPath" (ByVal hDC&, ByVal iMode&)

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

' 指定されたウィンドウのデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

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

#define SRCCOPY &HCC0020                'そのまま転送
#define RGN_COPY 5                      'HRGNSRC1のコピーを作成
#define TRANSPARENT 1                   '背景色を設定しない

Var Shared Bitmap As Object
Var Shared Picture1 As Object
Var Shared Picture2 As Object
Var Shared Edit1 As Object
Var Shared Button1 As Object

BitmapObject Bitmap
Picture1.Attach GetDlgItem("Picture1")
Picture2.Attach GetDlgItem("Picture2")
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared hDC1 As Long
Var Shared hDC2 As Long

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var Ret As Long

    hDC1 = Api_GetDC(Picture1.GethWnd)
    hDC2 = Api_GetDC(Picture2.GethWnd)

    Bitmap.LoadFile "Pic.bmp"
    Picture2.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var lf As LOGFONT
    Var rFont As Long
    Var txt As String
    Var Ret As Long
  
    txt = "札幌市白石区"
    
    lf.lfHeight = 60
    lf.lfCharSet = 128
    lf.lfFaceName = Edit1.GetWindowText & Chr$(0)
    lf.lfWeight = 700

    Picture1.Cls

    rFont = Api_CreateFontIndirect(lf)
    Ret = Api_SelectObject(hDC1, rFont)
    Ret = Api_SetBkMode(hDC1, TRANSPARENT)
    Ret = Api_BeginPath(hDC1)
    Ret = Api_TextOut(hDC1, 5, 5, txt, Len(txt))
    Ret = Api_EndPath(hDC1)
    Ret = Api_SelectClipPath(hDC1, RGN_COPY)
    Ret = Api_BitBlt(hDC1, 5, 5, Picture2.GetWidth, Picture2.GetHeight, hDC2, 0, 0, SRCCOPY)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

    'デバイスコンテキストを解放
    Ret = Api_ReleaseDC(Picture1.GethWnd, hDC1)
    Ret = Api_ReleaseDC(Picture2.GethWnd, hDC2)
End Sub

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