矩形領域の境界線を描画 <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