矩形領域の境界線を描画          <TOP>


長方形の境界線を描画します。

GetSystemMetrics システムの現在の構成を取得

SetRect RECT構造体の値を設定

CreateHatchBrush ハッチパターンの論理ブラシを作成

FillRect ブラシで矩形領域を塗りつぶす

FrameRect 矩形の周囲に指定のブラシで境界線を描画

GetDC デバイスコンテキストのハンドルを取得

ReleaseDC デバイスコンテキストを解放

DeleteObject システムリソースを解放

 

例では、作成したブラシで領域内を塗り潰し、さらにフォームの5ドット内側の矩形領域に境界線を描画します。

左:起動時    中:FillRect    右:FrameRect

  

VBでのFrameRectは下図のようにDIAGCROSSで描画されるのですが、FBでは色の変化はありません。

 

'================================================================
'= 矩形領域の境界線を描画
'=    (FrameRect.bas)
'================================================================
#include "Windows.bi"

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

' さまざまなシステムメトリックの値(表示要素の幅と高さ)とシステムの現在の構成を取得。表示要素とは、ウィンドウの一部、またはシステムが表示する画面の一部を意味する。すべてのサイズをピクセル単位で取得
Declare Function Api_GetSystemMetrics& Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&)

' RECT構造体の値を設定
Declare Function Api_SetRect& Lib "user32" Alias "SetRect" (lpRect As RECT, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)

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

' ブラシで矩形領域を塗りつぶす
Declare Function Api_FillRect& Lib "user32" Alias "FillRect" (ByVal hDC&, ByRef r As RECT, ByVal hBrush&)

' 矩形の周囲に指定のブラシで境界線を描画
Declare Function Api_FrameRect& Lib "user32" Alias "FrameRect" (ByVal hDC&, ByRef r As RECT, hBrush&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
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_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

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

#define vbRed &H0000FF                  '赤のカラーコード
#define vbBlue &HFF0000                 '青のカラーコード
#define vbGreen &H00FF00                '緑のカラーコード

#define SM_CXFRAME 32                   'サイズ可変ウィンドウの境界線のX方向の幅
#define SM_CYFRAME 33                   'サイズ可変ウィンドウの境界線のY方向の幅
#define SM_CYSIZE 31                    'タイトルバー内のビットマップの高さ

Var Shared Picture1 As Object

Var SHared Button1 As Object

Var Shared Button2 As Object

 

Picture1.Attach GetDlgItem("Picture1")

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

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


Var Shared rct As RECT
Var Shared hpDC As Long
Var Shared hfDC As Long

'================================================================
'= Picture1およびMainFormのDC取得
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    hfDC = Api_GetDC(GethWnd)
    hpDC = Api_GetDC(Picture1.GethWnd)
End Sub

'================================================================
'= FillRect
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hRedBrush As Long
    Var Ret As Long
    
    rct.Left = 0
    rct.Top = 0
    rct.Right = Picture1.GetWidth
    rct.Bottom = Picture1.GetHeight

    hRedBrush = Api_CreateHatchBrush(HS_DIAGCROSS, vbRed)
    Ret = Api_FillRect(hpDC, rct, hRedBrush)

    Ret = Api_DeleteObject(hRedBrush)
End Sub

'================================================================
'= FrameRect(5ドットフォームの内側)
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var fWidth As Long
    Var fHeight As Long
    Var RndCol As Long
    Var hBrush As Long
    Var Ret As Long

    fWidth = Api_GetSystemMetrics(SM_CXFRAME) * 2
    fHeight = Api_GetSystemMetrics(SM_CYFRAME) * 2 + Api_GetSystemMetrics(SM_CYSIZE)

    Ret = Api_SetRect(rct, 5, 5, GetWidth - fWidth - 5, GetHeight - fHeight - 5)
    hBrush = Api_CreateHatchBrush(HS_DIAGCROSS, vbBlue)  'VBの場合青のDIAGCROSSで描画される
    Ret = Api_FrameRect(hfDC, rct, hBrush)

    Ret = Api_DeleteObject(hWhiteBrush)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Ret = Api_ReleaseDC(GethWnd, hfDC)
    Ret = Api_ReleaseDC(Picture1.GethWnd, hpDC)
End Sub

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