ab.com コミュニティ

Sub DrawTextLine(hWnd As HWND)
    Dim hdc As HDC
    Dim hbr As HBRUSH, hOld As HANDLE
    Dim hPen As HPEN, hOldPen As HANDLE
    Dim hOldFont As HANDLE
    Dim rc As RECT
    Dim topLine As Long, cntLine As Long
    Dim pos As DWord
    Dim i As DWord
    Dim str As String

    GetClientRect(hWnd, rc)

    hdc=GetDC(hWnd)
    hPen=CreatePen(PS_SOLID, 1, RGB(255,255,255))
    hOldPen=SelectObject(hdc, hPen)
    hbr=CreateSolidBrush(RGB(255,255,255))
    hOld=SelectObject(hdc, hbr)
    Rectangle(hdc, rc.left, rc.top, LeftMargin, rc.bottom)
    SelectObject(hdc, hOldPen)
    SelectObject(hdc, hOld)
    DeleteObject(hPen)
    DeleteObject(hbr)

    SendMessage(hWnd, EM_GETRECT, 0, VarPtr(rc))
    rc.left=rc.left-LeftMargin
    rc.right=rc.left+LeftMargin-5
    topLine=SendMessage(hWnd, EM_GETFIRSTVISIBLELINE, 0, 0)
    cntLine=SendMessage(hWnd, EM_GETLINECOUNT, 0, 0)

    hOldFont=SelectObject(hdc, hFont_MainWnd)
    SetTextColor(hdc, RGB(32, 32, 32))
    SetBkColor(hdc, GetSysColor(15))

    For i=topLine To cntLine+1
        str=Str$(i+1)
        pos=SendMessage(hWnd, EM_LINEINDEX, i, 0)
        pos=SendMessage(hWnd, EM_POSFROMCHAR, pos, 0)
        rc.top=HIWORD(pos)

        If rc.top>=rc.bottom Then Exit For

        DrawText(hdc, StrPtr(str), -1, rc, DT_RIGHT Or DT_TOP Or DT_SINGLELINE Or DT_NOCLIP)
    Next i

    SelectObject(hdc, hOldFont)
    ReleaseDC(hWnd, hdc)
End Sub

Select Case dwMsg
		Case WM_CTLCOLOREDIT
			DrawTextLine(lParam)
			If lParam=GetDlgItem(hMainWnd,EditBox1) Then
				' カラー選択ダイアログで取得した色を文字色にする
				SetBkMode(wParam,OPAQUE)
				SetTextColor(wParam As HDC,rgb)
				SetBkColor(wParam As HDC,RGB(255,255,255))
				Exit Function
			End If
End Select