ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年11月21日(火) 20:44

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 7 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2006年8月04日(金) 21:41 
オフライン

登録日時: 2006年1月31日(火) 10:30
記事: 2
住所: 静岡県富士市
作成してみたので投稿します。

RADツールでEditBox1という名前のエディットボックスを作成し、
以下のコードを貼り付けてください。

MainWnd.sbp:
[hide]
コード:
'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [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
[/hide]


通報する
ページトップ
投稿記事Posted: 2006年8月25日(金) 09:05 
オフライン

登録日時: 2006年5月02日(火) 16:27
記事: 154
これすごいですね!
使わせていただきます!!


通報する
ページトップ
投稿記事Posted: 2006年8月25日(金) 13:45 
オフライン

登録日時: 2005年7月25日(月) 13:27
記事: 893
住所: 埼玉県東松山市
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はいらなくなるので宣言しなくても大丈夫です。

_________________
Website→http://web1.nazca.co.jp/himajinn13sei/top.html
ここ以外の場所では「暇人13世」というHNを主として使用。

に署名を書き換えて欲しいと言われたので暇だしやってみるテスト。


通報する
ページトップ
 記事の件名: ちょっとしたメモ
投稿記事Posted: 2006年8月29日(火) 17:39 
オフライン

登録日時: 2005年10月03日(月) 05:43
記事: 5
住所: 石川県
コード:
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

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

 TestBoxSample_DestroyObjects() の、
 TestBoxSample を、
作成したプロジェクト名に変えるとバグが出なくなります。


メモ書き程度に報告しておきます。

_________________
PC:富士通 FMV-BIBLO MG50K
CPU:Intel Celeron M
メモリ:760MB
OS:Windows Xp Home SP2


通報する
ページトップ
 記事の件名:
投稿記事Posted: 2007年9月17日(月) 15:48 
オフライン

登録日時: 2007年9月16日(日) 19:32
記事: 9
住所: 栃木県某所
これは使えますね!
いただいていきますw


通報する
ページトップ
投稿記事Posted: 2007年10月13日(土) 14:14 
オフライン

登録日時: 2005年7月19日(火) 07:02
記事: 183
住所: 宮城県
グローバル変数を無くしてみました。
Edit窓のフォントサイズで行数描画するようにしてあります。


以下の関数を定義しておき、
[hide=こちらをクリック]
コード:
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
[/hide]
Edit窓が貼り付けられている親窓のメッセージプロシージャで、
WM_CTLCOLOREDITメッセージが送られたら、
コード:
DrawTextLine( lParam, 32 )
で呼び出してください。
  第一引数・・・描画中のEdit窓
  第二引数・・・行数表示領域の横幅

これで、Edit窓の左外側に行数が表示されます。

なお、WM_CTLCOLOREDITメッセージを捉まえて処理をした場合は、
メッセージプロシージャは
引用:
コントロールの背景を描画するときに
使われたブラシのハンドルを返すか 0を返さなければならない
らしいです。参考までに。


【追記】at 2015/09/06
読み取り専用属性の付いたEdit窓に対しては、
WM_CTLCOLORSTATICメッセージを捉まえて処理してください。


最後に編集したユーザー 淡幻星 on 2015年9月06日(日) 12:49 [ 編集 1 回目 ]

通報する
ページトップ
 記事の件名: 淡幻星さんへ
投稿記事Posted: 2008年11月15日(土) 19:59 
ありがとうございます。
便利に使わせていただきます。


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 7 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke