ab.com コミュニティ

コード: 全て選択

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。

Dim hEdit As Long
Dim LeftMargin As Long

'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	Select Case dwMsg
		Case WM_CTLCOLOREDIT
			DrawTextLine(lParam)
	End Select

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function

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(240, 240, 240))
	hOldPen=SelectObject(hdc, hPen)
	hbr=CreateSolidBrush(RGB(240, 240, 240))
	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, RGB(240, 240, 240))

	For i=topLine To cntLine
		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

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

'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
	TextBoxSample_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Resize(SizeType As Long, cx As Integer, cy As Integer)
	Dim rc As RECT

	GetClientRect(hMainWnd, rc)
	MoveWindow(hEdit, 0, 0, rc.right, rc.bottom, 0)

	GetClientRect(hEdit, rc)
	'SendMessage(hEdit, EM_GETRECT, 0, VarPtr(rc))
	rc.left=rc.left+LeftMargin+5
	SendMessage(hEdit, EM_SETRECT, 0, VarPtr(rc))
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	Dim hdc As HDC
	Dim buf[9] As DWord

	hEdit=GetDlgItem(hMainWnd, EditBox1)
	SetFocus(hEdit)
	hdc=GetDC(hEdit)
	GetCharWidth32(hdc, Asc("0"), Asc("9"), buf)
	LeftMargin=buf[0]*4+3
	ReleaseDC(hEdit, hdc)
End Sub

コード: 全て選択

Sub DrawTextLine( hWnd As HWND, nLeftMargin As Long )
	Dim hDC As HDC
	Dim rc As RECT
	Dim topLine As Long
	Dim cntLine As Long
	Dim i As DWord
	Dim str As String
	Dim lpSize As SIZE

	'デバイスコンテキスト開始
	hDC = GetDC(hWnd)

	'行数の描画領域を、ベース窓の背景色で塗りつぶす。
	SelectObject( hDC, GetStockObject( NULL_PEN ) )
	SelectObject( hDC, GetClassLong( hMainWnd, GCL_HBRBACKGROUND ) )
	GetClientRect( hWnd , rc )
	Rectangle( hDC, rc.left-3, rc.top, -nLeftMargin, rc.bottom )

	'描画すべき行数の数値範囲を取得
	topLine = SendMessage( hWnd, EM_GETFIRSTVISIBLELINE, 0, 0)
	cntLine = SendMessage( hWnd, EM_GETLINECOUNT, 0, 0)

	'行数描画の文字設定
	SelectObject( hDC, SendMessage( hWnd, WM_GETFONT, 0, 0 ) )
	SetTextColor( hDC, RGB(32, 32, 32) )
	SetBkColor( hDC, RGB(240, 240, 240) )
	GetTextExtentPoint32( hDC, "0", 1, lpSize )

	'行数表示位置を、Edit窓の左側（からnLeftMarginだけはみ出した領域）に設定。
	SendMessage(hWnd, EM_GETRECT, 0, VarPtr(rc))
	rc.left = rc.left - nLeftMargin
	rc.right = rc.left + nLeftMargin - 5 '[-5]=境界の幅への対応

	'Edit窓表示範囲の行数を描画。
	rc.top = -lpSize.cy
	For i=topLine To cntLine-1
		str = Str$( i+1 )
		rc.top += lpSize.cy
		If rc.top >= rc.bottom-12 Then Exit For
		DrawText( hDC, StrPtr(str), -1, rc, DT_RIGHT Or DT_TOP Or DT_SINGLELINE Or DT_NOCLIP )
	Next

	'デバイスコンテキスト破棄
	ReleaseDC( hWnd, hDC )
End Sub