ab.com コミュニティ https://www.activebasic.com/forum/ |
|
行番号付きエディットボックス https://www.activebasic.com/forum/viewtopic.php?t=1284 |
ページ 1 / 1 |
作成者: | k2 [ 2006年8月04日(金) 21:41 ] |
記事の件名: | 行番号付きエディットボックス |
作成してみたので投稿します。 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 |
作成者: | MML [ 2006年8月25日(金) 09:05 ] |
記事の件名: | Re: 行番号付きエディットボックス |
これすごいですね! 使わせていただきます!! |
作成者: | konisi [ 2006年8月25日(金) 13:45 ] |
記事の件名: | Re:行番号付きエディットボックス |
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はいらなくなるので宣言しなくても大丈夫です。 |
作成者: | SIZUYA [ 2006年8月29日(火) 17:39 ] |
記事の件名: | ちょっとしたメモ |
コード: '----------------------------------------------------------------------------- ' ここから下は、イベントプロシージャを記述するための領域になります。 Sub MainWnd_Destroy() TextBoxSample_DestroyObjects() PostQuitMessage(0) End Sub TestBoxSample_DestroyObjects() の、 TestBoxSample を、 作成したプロジェクト名に変えるとバグが出なくなります。 メモ書き程度に報告しておきます。 |
作成者: | S/AL [ 2007年9月17日(月) 15:48 ] |
記事の件名: | |
これは使えますね! いただいていきますw |
作成者: | 淡幻星 [ 2007年10月13日(土) 14:14 ] |
記事の件名: | 少々モジュール化してみました。 |
グローバル変数を無くしてみました。 Edit窓のフォントサイズで行数描画するようにしてあります。 以下の関数を定義しておき、 こちらをクリック [ここをクリックすると内容が表示されます]
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 WM_CTLCOLOREDITメッセージが送られたら、 コード: DrawTextLine( lParam, 32 )で呼び出してください。 第一引数・・・描画中のEdit窓 第二引数・・・行数表示領域の横幅 これで、Edit窓の左外側に行数が表示されます。 なお、WM_CTLCOLOREDITメッセージを捉まえて処理をした場合は、 メッセージプロシージャは 引用: コントロールの背景を描画するときに
らしいです。参考までに。使われたブラシのハンドルを返すか 0を返さなければならない 【追記】at 2015/09/06 読み取り専用属性の付いたEdit窓に対しては、 WM_CTLCOLORSTATICメッセージを捉まえて処理してください。 |
作成者: | 三毛CAT [ 2008年11月15日(土) 19:59 ] |
記事の件名: | 淡幻星さんへ |
ありがとうございます。 便利に使わせていただきます。 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |