コントロールの背景色設定テスト             <TOP>


コントロール(TextBox、EditBox、PictureBox)の背景色を設定するテストです。

FillRect 長方形を塗りつぶす

CreateSolidBrush 純色論理ブラシの作成

SetBKMode 背景色の塗り潰しモード設定

SetBKColor デバイスコンテキストの背景色を設定

TextOut テキストを指定の位置に出力

GetDC デバイスコンテキストの取得

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

 

スクロールバーでRGBの値を設定し、その色を各コントロールの背景色にしています。
そのときのRGB値をテキストボックスに表示しています。


現在ウインドウの再描画の解決ができていません! エディットボックスに文字入力する際背景色が戻ってしまいます。

 

'================================================================
'= 背景色を変更する
'=    (SetBkColor.bas)
'================================================================
#include "Windows.bi"

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

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

' 純色で論理ブラシを作成
Declare Function Api_CreateSolidBrush& Lib "gdi32" Alias "CreateSolidBrush" (ByVal crColor&)

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

' デバイスコンテキストの背景色を設定
Declare Function Api_SetBkColor& Lib "gdi32" Alias "SetBkColor" (ByVal hDC&, ByVal crColor&)

' デバイスコンテキストの背景色を取得(ここでは使っていません)
Declare Function Api_GetBkColor& Lib "gdi32" Alias "GetBkColor" (ByVal hDC&)

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

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

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

#define OPAQUE 2                        '背景色を設定する
#define TRANSPARENT 1                   '背景色を設定しない

Var Shared Text(7) As Object
Var Shared Edit1 As Object
Var Shared Combo1 As Object
Var Shared List1 As Object
Var Shared Check1 As Object
Var Shared Picture1 As Object
Var Shared HScroll1 As Object
Var Shared HScroll2 As Object
Var Shared HScroll3 As Object

For i = 0 To 7
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1)))
    Text(i).SetFontSize 14
Next
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
List1.Attach GetDlgItem("List1") : List1.SetFontSize 14
Combo1.Attach GetDlgItem("Combo1") : Combo1.SetFontSize 14
Check1.Attach GetDlgItem("Check1") : Check1.SetFontSize 14
Picture1.Attach GetDlgItem("Picture1")
HScroll1.Attach GetDlgItem("HScroll1")
HScroll2.Attach GetDlgItem("HScroll2")
HScroll3.Attach GetDlgItem("HScroll3")

Var Shared hDCT As Long            'Text(6)のデバイスコンテキスト
Var Shared hDCE As Long            'Edit1のデバイスコンテキスト
Var Shared hDCP As Long            'Picture1のデバイスコンテキスト
Var Shared hDCC As Long            'Combo1のデバイスコンテキスト
Var Shared hDCL As Long            'List1のデバイスコンテキスト
Var Shared hDCK As Long            'Check1のデバイスコンテキスト
Var Shared rgbColor As Long
Var Shared r As Byte
Var Shared g As Byte
Var Shared b As Byte

'================================================================
'=
'================================================================
Declare Sub BackColorSet edecl ()
Sub BackColorSet()
    Var rct As RECT
    Var x As Integer
    Var y As Integer
    Var txt As String
    Var cbStr As Long
    Var colBrush As Long
    Var Ret As Long

    colBrush = Api_CreateSolidBrush(rgbColor)            '描画色を設定

    rct.Top = 0
    rct.Left = 0
    rct.Right = Text(6).GetWidth - 2
    rct.Bottom = Text(6).GetHeight - 2

    txt = "TEXT7"
    cbStr = Len(txt)
    Ret = Api_FillRect(hDCT, rct, colBrush)              '長方形を設定
    Ret = Api_SetBkMode(hDCT, OPAQUE)                    'Text(6)の背景色のモードを設定する
    Ret = Api_SetBkColor(hDCT, rgbColor)                 '背景色を設定する
    Ret = Api_TextOut(hDCT, 0, 0, txt, cbStr)            '指定位置にtxt表示

    rct.Top = 0
    rct.Left = 0
    rct.Right = Edit1.GetWidth - 6                       '3D枠分減算
    rct.Bottom = Edit1.GetHeight  -6                     '〃

    If Edit1.GetWindowText = "" Then
        txt = "EDIT1"
    Else
        txt = Edit1.GetWindowText
    End If

    cbStr = Len(txt)
    Ret = Api_FillRect(hDCE, rct, colBrush)              '長方形を設定
'   Ret = Api_SetBkMode(hDCE, OPAQUE)                    'Edit1の背景色のモードを設定する
    Ret = Api_SetBkColor(hDCE, rgbColor)                 '背景色を設定する
    Ret = Api_TextOut(hDCE, 0, 0, txt, cbStr)            '指定位置にtxt表示

    x = 20                                               'Picture1内のx位置
    y = 16                                               'Picture1内のy位置
    txt = "PICTURE1"
    cbStr = Len(txt)

    rct.Top = 0
    rct.Left = 0
    rct.Right = Picture1.GetWidth - 2                    '左右ライン分減算
    rct.Bottom = Picture1.GetHeight - 2                  '上下ライン分減算

    Ret = Api_FillRect(hDCP, rct, colBrush)              '長方形を設定
    Ret = Api_SetBkMode(hDCP, OPAQUE)                    'Picture1の背景色のモードを設定する
    Ret = Api_SetBkColor(hDCP, rgbColor)                 '背景色を設定する
    Ret = Api_TextOut(hDCP, x, y, txt, cbStr)            '指定位置にtxt表示

    rct.Top = 2
    rct.Left = 2
    rct.Right = Combo1.GetWidth - 22                     '3D枠+▼分減算
    rct.Bottom = Combo1.GetHeight - 2                    '〃

    txt = "COMBO1"
    cbStr = Len(txt)
    Ret = Api_FillRect(hDCC, rct, colBrush)              '長方形を設定
    Ret = Api_SetBkMode(hDCC, OPAQUE)                    'Combo1の背景色のモードを設定する
    Ret = Api_SetBkColor(hDCC, rgbColor)                 '背景色を設定する
    Ret = Api_TextOut(hDCC, 2, 2, txt, cbStr)            '指定位置にtxt表示

    rct.Top = 0
    rct.Left = 0
    rct.Right = List1.GetWidth - 6                       '3D枠分減算
    rct.Bottom = List1.GetHeight - 6                     '〃
    txt = "LIST1"
    cbStr = Len(txt)
    Ret = Api_FillRect(hDCL, rct, colBrush)              '長方形を設定
    Ret = Api_SetBkMode(hDCL, OPAQUE)                    'List1の背景色のモードを設定する
    Ret = Api_SetBkColor(hDCL, rgbColor)                 '背景色を設定する
    Ret = Api_TextOut(hDCL, 0, 0, txt, cbStr)            '指定位置にtxt表示

    rct.Top = 0
    rct.Left = 16
    rct.Right = Check1.GetWidth
    rct.Bottom = Check1.GetHeight

    txt = "CHECK1"
    cbStr = Len(txt)
    Ret = Api_FillRect(hDCK, rct, colBrush)              '長方形を設定
    Ret = Api_SetBkMode(hDCK, OPAQUE)                    'Check1の背景色のモードを設定する
    Ret = Api_SetBkColor(hDCK, rgbColor)                 '背景色を設定する
    Ret = Api_TextOut(hDCK, 18, 2, txt, cbStr)           '指定位置にtxt表示
End Sub

'================================================================
'=
'================================================================
Declare Sub Scroll_Change edecl ()
Sub Scroll_Change()
    r = HScroll1.GetScrollPos
    g = HScroll2.GetScrollPos
    b = HScroll3.GetScrollPos
    rgbColor = RGB(r, g, b)

    Text(3).SetWindowText Trim$(Str$(r))
    Text(4).SetWindowText Trim$(Str$(g))
    Text(5).SetWindowText Trim$(Str$(b))
    txt1$ = "RGB( " & Trim$(Str$(r)) & ", " & Trim$(Str$(g)) & ", " & Trim$(Str$(b)) & ")"
    txt2$ = "RGB( &&H" & Hex$(r) & ", &&H" & Hex$(g) & ", &&H" & Hex$(b) & ")"
    Text(7).SetWindowText txt1$ & Chr$(13,10) & txt2$
    BackColorSet
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    HScroll1.SetScrollPos 128
    HScroll2.SetScrollPos 128
    HScroll3.SetScrollPos 128

    hDCT = Api_GetDC(Text(6).GethWnd)                    'Text(6)のDC取得
    hDCE = Api_GetDC(Edit1.GethWnd)                      'Edit1のDC取得
    hDCP = Api_GetDC(Picture1.GethWnd)                   'Picture1のDC取得
    hDCC = Api_GetDC(Combo1.GethWnd)                     'Combo1のDC取得
    hDCL = Api_GetDC(List1.GethWnd)                      'List1のDC取得
    hDCK = Api_GetDC(Check1.GethWnd)

    rgbColor = RGB(HScroll1.GetScrollPos, HScroll2.GetScrollPos, HScroll3.GetScrollPos)
    BackColorSet
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl (Cancel%, Mode%)
Sub MainForm_QueryClose(Cancel%, Mode%)
    Var Ret As Long

    If Cancel% = 0 Then
        Ret = Api_ReleaseDC(Text(6).GethWnd, hDCT)
        Ret = Api_ReleaseDC(Edit1.GethWnd, hDCE)
        Ret = Api_ReleaseDC(Picture1.GethWnd, hDCP)
        Ret = Api_ReleaseDC(Combo1.GethWnd, hDCC)
        Ret = Api_ReleaseDC(List1.GethWnd, hDCL)
        End
    End If
End Sub

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