'================================================================
'= ハッチパターン作成とブラシの原点
'=    (SetBrushOrgEx.bas)
'================================================================
#include "Windows.bi"

Type POINTAPI
    x As Long
    y As Long
End Type

' ハッチパターンの論理ブラシを作成
Declare Function Api_CreateHatchBrush& Lib "gdi32" Alias "CreateHatchBrush" (ByVal nIndex&, ByVal crColor&)

' 現在のブラシの原点を取得
Declare Function Api_GetBrushOrgEx& Lib "gdi32" Alias "GetBrushOrgEx" (ByVal hDC&, lpPoint As POINTAPI)
  
' ブラシの原点を設定
Declare Function Api_SetBrushOrgEx& Lib "gdi32" Alias "SetBrushOrgEx" (ByVal hDC&, ByVal nXOrg&, ByVal nYOrg&, lppt As POINTAPI)
  
' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' 長方形の描画
Declare Function Api_Rectangle& Lib "gdi32" Alias "Rectangle" (ByVal hDC&, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)

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

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

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

#define HS_BDIAGONAL 3                  '45度(右上から左下)
#define HS_CROSS 4                      '水平と垂直クロスハッチ
#define HS_DIAGCROSS 5                  '45度のクロスハッチ
#define HS_FDIAGONAL 2                  '45度(左上から右下)
#define HS_HORIZONTAL 0                 '水平ハッチ
#define HS_VERTICAL 1                   '垂直ハッチ

Var Shared hBrushNew As Long
Var Shared hBrushOld As Long
Var Shared OldPt As POINTAPI
Var Shared NewPt As POINTAPI
Var Shared hDC As Long

Var Shared Text1 As Object
Var Shared Edit1 As Object
Var Shared Edit2 As Object
Var Shared Radio(5) As Object

For i = 0 To 5
    Radio(i).Attach GetDlgItem("Radio" & Trim$(Str$(i + 1)))
    Radio(i).SetFontSize 12
Next i
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Edit2.Attach GetDlgItem("Edit2") : Edit2.SetFontSize 14

'================================================================
'=
'================================================================
Declare Function Index bdecl () As Integer
Function Index()
    Index = Val(Mid$(GetDlgRadioSelect("Radio1"), 6)) - 1
End Function

'================================================================
'=
'================================================================
Declare Sub SetHatch ()
Sub SetHatch()
    Var Hatch(5) As Long
    Var Ret As Long

    Hatch(0) = HS_HORIZONTAL
    Hatch(1) = HS_VERTICAL
    Hatch(2) = HS_FDIAGONAL
    Hatch(3) = HS_BDIAGONAL
    Hatch(4) = HS_CROSS
    Hatch(5) = HS_DIAGCROSS

    'ブラシの原点を取得保持
    Ret = Api_GetBrushOrgEx(hDC, OldPt)

    'ブラシの原点を設定
    NewPt.x = Val(Edit1.GetWindowText)
    NewPt.y = Val(Edit2.GetWindowText)
    Ret = Api_SetBrushOrgEx(hDC, NewPt.x, NewPt.y, NewPt)
  
    'ハッチパターンの論理ブラシを作成
    hBrushNew = Api_CreateHatchBrush(Hatch(Index), RGB(255, 0, 0))
    hBrushOld = Api_SelectObject(hDC, hBrushNew)

    Ret = Api_Rectangle(hDC, 10, 15, 170, 150)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    hDC = Api_GetDC(GethWnd)
    SetHatch
End Sub

'================================================================
'=
'================================================================
Declare Sub Edit1_Change edecl ()
Sub Edit1_Change()
    Edit2.SetSelText 0, 0
    Edit1.SetSelText 0, -1
    SetHatch
End Sub

'================================================================
'=
'================================================================
Declare Sub Edit2_Change edecl ()
Sub Edit2_Change()
    Edit1.SetSelText 0, 0
    Edit2.SetSelText 0, -1
    SetHatch
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl (Cancel As Integer, Mode As Integer)
Sub MainForm_QueryClose(Cancel As Integer, Mode As Integer)
    If Cancel = 0 Then
        Ret = Api_DeleteObject(Api_SelectObject(hDC, hBrushOld))
        Ret = Api_SetBrushOrgEx(hDC, OldPt.x, OldPt.y, OldPt)
        Ret = Api_ReleaseDC(GethWnd, hDC)
    End If
End Sub

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