作成者 |
メッセージ |
|
|
ありがとうございます。
便利に使わせていただきます。
ありがとうございます。 便利に使わせていただきます。
|
|
|
投稿記事 |
Posted: 2008年11月15日(土) 19:59 |
|
|
|
|
|
グローバル変数を無くしてみました。
Edit窓のフォントサイズで行数描画するようにしてあります。
以下の関数を定義しておき、
こちらをクリック [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: 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
Edit窓が貼り付けられている親窓のメッセージプロシージャで、
WM_CTLCOLOREDITメッセージが送られたら、
コード: DrawTextLine( lParam, 32 )
で呼び出してください。
第一引数・・・描画中のEdit窓
第二引数・・・行数表示領域の横幅
これで、Edit窓の左外側に行数が表示されます。
なお、 WM_CTLCOLOREDITメッセージを捉まえて処理をした場合は、
メッセージプロシージャは
引用: コントロールの背景を描画するときに
使われたブラシのハンドルを返すか 0を返さなければならない
らしいです。参考までに。
【追記】at 2015/09/06
読み取り専用属性の付いたEdit窓に対しては、
WM_CTLCOLORSTATICメッセージを捉まえて処理してください。
グローバル変数を無くしてみました。 Edit窓のフォントサイズで行数描画するようにしてあります。
以下の関数を定義しておき、 [hide=こちらをクリック][code]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[/code][/hide] Edit窓が貼り付けられている親窓のメッセージプロシージャで、 [b]WM_CTLCOLOREDIT[/b]メッセージが送られたら、 [code]DrawTextLine( lParam, 32 )[/code] で呼び出してください。 第一引数・・・描画中のEdit窓 第二引数・・・行数表示領域の横幅
これで、Edit窓の左外側に行数が表示されます。
なお、[b]WM_CTLCOLOREDIT[/b]メッセージを捉まえて処理をした場合は、 メッセージプロシージャは [quote]コントロールの背景を描画するときに 使われたブラシのハンドルを返すか 0を返さなければならない[/quote] らしいです。参考までに。
【追記】at 2015/09/06 読み取り専用属性の付いたEdit窓に対しては、 [b]WM_CTLCOLORSTATIC[/b]メッセージを捉まえて処理してください。
|
|
|
投稿記事 |
Posted: 2007年10月13日(土) 14:14 |
|
|
|
|
|
これは使えますね!
いただいていきますw
これは使えますね! いただいていきますw
|
|
|
投稿記事 |
Posted: 2007年9月17日(月) 15:48 |
|
|
|
|
|
コード:
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy()
TextBoxSample_DestroyObjects()
PostQuitMessage(0)
End Sub
TestBoxSample_DestroyObjects() の、
TestBoxSample を、
作成したプロジェクト名に変えるとバグが出なくなります。
メモ書き程度に報告しておきます。
[code] '----------------------------------------------------------------------------- ' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy() TextBoxSample_DestroyObjects() PostQuitMessage(0) End Sub [/code]
TestBoxSample_DestroyObjects() の、 TestBoxSample を、 作成したプロジェクト名に変えるとバグが出なくなります。
メモ書き程度に報告しておきます。
|
|
|
投稿記事 |
Posted: 2006年8月29日(火) 17:39 |
|
|
|
|
|
DrawTextLine関数内の コード: 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 の部分を
コード: rc.top=-12
For i=topLine To cntLine-1
str=Str$(i+1)
rc.top+=12
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 と書き換えれば、AB4.2xのエディタのような現象が起こらなくなります。
また、そのように書き換えた場合、変数posはいらなくなるので宣言しなくても大丈夫です。
DrawTextLine関数内の[code] 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[/code]の部分を [code] rc.top=-12 For i=topLine To cntLine-1 str=Str$(i+1) rc.top+=12 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[/code]と書き換えれば、AB4.2xのエディタのような現象が起こらなくなります。 また、そのように書き換えた場合、変数posはいらなくなるので宣言しなくても大丈夫です。
|
|
|
投稿記事 |
Posted: 2006年8月25日(金) 13:45 |
|
|
|
|
|
これすごいですね!
使わせていただきます!!
これすごいですね! 使わせていただきます!!
|
|
|
投稿記事 |
Posted: 2006年8月25日(金) 09:05 |
|
|
|
|
|
作成してみたので投稿します。
RADツールでEditBox1という名前のエディットボックスを作成し、
以下のコードを貼り付けてください。
MainWnd.sbp:
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: '-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [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
作成してみたので投稿します。
RADツールでEditBox1という名前のエディットボックスを作成し、 以下のコードを貼り付けてください。
MainWnd.sbp: [hide][code]'----------------------------------------------------------------------------- ' イベント プロシージャ '----------------------------------------------------------------------------- ' このファイルには、ウィンドウ [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[/code][/hide]
|
|
|
投稿記事 |
Posted: 2006年8月04日(金) 21:41 |
|
|
|
|