ab.com コミュニティ

　↓のほうでやっていましたが、色々とあったのでここに移行させていただきます。
　リッチエディットでActiveBasicコードの色分けをやっております。
この程、色分けを全て終了することができました。しかし、それでも問題があります。

①それぞれのキーワードを選択しながら色変更をしているので、色変更する前の状態に戻せません。
②あまりにも重たいです。文字ひとつ入力しただけで一秒近くまたされるときもあります。

　①について解決方法と考えているのは、リッチエディットのスクロールバーの位置を色変更前に記録し、変更後に記録した位置に戻すと言うことです。これは可能でしょうか。
　②については、誰かプログラムの「ムダ」を見つけてくれませんでしょうか。
　今回は、現在の状態のソフトを公開したいと思います。
http://www.exfiction.net/~yu0627/temp/AB_T_RichEdit.zip

現在のコードはこちら↓

[ここをクリックすると内容が表示されます]

コード: 全て選択

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

' メモ - 以下の領域を、変数、構造体、定数、関数を宣言するための、
'        グローバル領域として利用することができます。
' ----------------------------------ここから----------------------------------
Declare Function GetDialogBaseUnits Lib "user32.dll" () As Long

Dim hFont As DWord							'フォントのハンドル
Dim lfnt As LOGFONT							'LOGFONT構造体

Dim cfmt As CHARFORMAT						'CHARFOMAT構造体
Dim lpstrFolderPath[MAX_PATH] As Byte		'ソフトの親フォルダ
Dim i As Long, i2=0 As Long					'フラグ
Dim hEdit As DWord							'リッチエディットのハンドル
Dim hLib As DWord							'ライブラリのハンドル
Dim lpKeywordBuffer As BytePtr				'キーワードファイルの内容を保持するバッファ
Dim strKeyword As String					'キーワード

Const RICHEDIT_CLASS = "RichEdit20A"
Const ID_EDIT = &HFF00
Const MaxText = 102400	'最大容量(byte)default=64K

Type FINDTEXTEX
	chrg As CHARRANGE
	lpstrText As BytePtr
	chrgText As CHARRANGE
End Type

Type CHARRANGE
	cpMin As Long
	cpMax As Long
End Type

'フルパスからファイル部を切り取る
GetModuleFileName(GetModuleHandle(0), lpstrFolderPath, MAX_PATH)
i=lstrlen(lpstrFolderPath)-1
Do
	If lpstrFolderPath=Asc("\") Then
		lpstrFolderPath=0
		Exit Do
	End If
	i=i-1
	If i<0 Then Exit Do
Loop

Sub SetKeywordColor()
	'変数宣言
	Dim ftex As FINDTEXTEX			'FINDTEXTEX構造体
	Dim chrg As CHARRANGE			'CHARRANGE構造体
	Dim i As Long, i2 As Long		'フラグ
	Dim dwStartPos As DWord			'範囲の始まり
	Dim strTemp As String			'文字コード格納用
	Dim nLineIndex As Long			'行のインデックス

	'リッチエディットの今までの設定を取得
	SendMessage(hEdit, EM_GETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))

	'元のカーソル位置を取得
	SendMessage(hEdit, EM_EXGETSEL, 0, VarPtr(chrg))

	'ウインドウの描画を停止
	LockWindowUpdate(hEdit)

	'一度全ての文字色を黒に変更
	cfmt.crTextColor=RGB(0, 0, 0)
	SendMessage(hEdit, EM_SETCHARFORMAT, SCF_ALL, VarPtr(cfmt))

	'カーソル位置を先頭にする
	SendMessage(hEdit, EM_SETSEL, 0, 0)

	'キーワードを検索し、その部分の文字色を変更
	i=0 : i2=0
	Do
		'キーワードを取り出す
		If (lpKeywordBuffer=13 and lpKeywordBuffer[i+1]=10) or lpKeywordBuffer=0 Then
			strKeyword[i2]=0
			ftex.chrg.cpMin=0
			ftex.chrg.cpMax=-1
			ftex.lpstrText=StrPtr(strKeyword)
			If SendMessage(hEdit, EM_FINDTEXTEX, FR_WHOLEWORD or FR_DOWN or FR_MATCHCASE, VarPtr(ftex))>-1 Then
				Do
					'キーワードを選択し、その部分の色を変更
					SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
					cfmt.crTextColor=RGB(0, 0, 255)
					SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))
					ftex.chrg.cpMin=ftex.chrgText.cpMax+1
				Loop Until SendMessage(hEdit, EM_FINDTEXTEX, FR_WHOLEWORD or FR_DOWN or FR_MATCHCASE, VarPtr(ftex))=-1
			End If
			If lpKeywordBuffer=0 Then Exit Do
			i=i+2 : i2=0
			Continue
		End If
		strKeyword[i2]=lpKeywordBuffer
		i=i+1 : i2=i2+1
	Loop

	'ダブルクォートの文字色を変更
	SendMessage(hEdit, EM_SETSEL, 0, 0)
	ftex.chrg.cpMin=0
	ftex.chrg.cpMax=-1
	ftex.lpstrText=Ex"\q"
	If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))>-1 Then
		Do
			dwStartPos=ftex.chrgText.cpMin
			ftex.chrg.cpMin=ftex.chrgText.cpMin+1
			If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))>-1 Then
				'ダブルクォートで囲まれた範囲を選択し、その部分の色を変更
				ftex.chrgText.cpMin=dwStartPos
				SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
				cfmt.crTextColor=RGB(160, 20, 20)
				SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))
				ftex.chrg.cpMin=ftex.chrgText.cpMax+1
			End If
		Loop Until SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))=-1
	End If
	'コメントの文字色を変更
	SendMessage(hEdit, EM_SETSEL, 0, 0)
	ftex.chrg.cpMin=0
	ftex.chrg.cpMax=-1
	ftex.lpstrText="'"
	Do
		If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))>-1 Then
			dwStartPos=ftex.chrgText.cpMin
			ftex.chrg.cpMin=ftex.chrgText.cpMax
			ftex.lpstrText=Ex"\r"
			If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))>-1 Then
				ftex.chrgText.cpMin=dwStartPos
				SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
				cfmt.crTextColor=RGB(0, 128, 0)
				SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))
			Else
				Exit Do
			End If
			ftex.chrg.cpMin=ftex.chrgText.cpMax
			ftex.lpstrText="'"
		Else
			Exit Do
		End If
	Loop Until SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))=-1
	'複数行コメントの文字色を変更
	SendMessage(hEdit, EM_SETSEL, 0, 0)
	strTemp=Chr$(47) + Chr$(42)
	ftex.chrg.cpMin=0
	ftex.chrg.cpMax=-1
	ftex.lpstrText=StrPtr(strTemp)
	If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))>-1 Then
		Do
			dwStartPos=ftex.chrgText.cpMin
			ftex.chrg.cpMin=ftex.chrgText.cpMin+1
			strTemp=Chr$(42) + Chr$(47)
			ftex.lpstrText=StrPtr(strTemp)
			If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))=-1 Then
				'複数行コメントで囲まれた範囲を選択し、その部分の色を変更
				ftex.chrgText.cpMin=dwStartPos
				SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
				cfmt.crTextColor=RGB(0, 128, 0)
				SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))
				Exit Do
			Else
				ftex.chrgText.cpMin=dwStartPos
				SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
				cfmt.crTextColor=RGB(0, 128, 0)
				SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))
				ftex.chrg.cpMin=ftex.chrgText.cpMax+1
				strTemp=Chr$(47) + Chr$(42)
				ftex.lpstrText=StrPtr(strTemp)
			End If
		Loop Until SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))=-1
	End If

	'カーソルを元の位置に戻す
	SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(chrg))

	'ウインドウの描画を再開
	LockWindowUpdate(NULL)

	'文字色を黒に変更
	cfmt.crTextColor=RGB(0, 0, 0)
	SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))

	SendMessage(hEdit, EM_REPLACESEL, FALSE, NULL)
End Sub

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

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

' ----------------------------------ここまで----------------------------------

Sub MainWnd_Destroy()
	DeleteObject(hFont)
    If hEdit Then DestroyWindow(hEdit)
    If hLib Then FreeLibrary(hLib)
	If lpKeywordBuffer Then free(lpKeywordBuffer)
	T_RichEdit_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	Dim dwEvent As DWord							'イベントマスク
	Dim lpstrKeywordFilePath[MAX_PATH] As Byte		'キーワードファイルのパス
	Dim hFile As DWord								'キーワードファイルのハンドル
	Dim dwFileSize As DWord							'ファイルサイズ
	Dim dwAccessByte As DWord						'ファイルアクセスサイズ

	'RICHED32.DLL のロード
	hLib = LoadLibrary("riched20.dll")
	If hLib=0 then
		MessageBox(hMainWnd, "リッチエディットライブラリのロードに失敗", "Error - T_RichEdit", MB_OK or MB_ICONSTOP)
		Exit Sub
	End If
	'リッチエディットコントロールの作成
	hEdit = CreateWindowEx(0, _						'拡張ウィンドウスタイル
				RICHEDIT_CLASS, _					'ウィンドウクラス名
				"", _								'ウィンドウタイトル
				WS_CHILD or WS_VISIBLE or _			'ウインドウスタイル
				WS_BORDER or WS_VSCROLL or _		'〃
				WS_HSCROLL or ES_MULTILINE or _		'〃
				ES_AUTOHSCROLL or ES_AUTOVSCROLL,	'〃
				0, 0, 0, 0, 						'リサイズイベントで大きさを変える
				hMainWnd, 							'親ウィンドウ
				ID_EDIT, 							'コントロールID
				GetModuleHandle(0), _				'インスタンスハンドル
				0)
	If hEdit = 0 Then
		MessageBox(hMainWnd, "リッチエディットの作成に失敗", "Error - T_RichEdit", MB_OK or MB_ICONSTOP)
		Exit Sub
	End If
	
	'テキストの上限を設定
	SendMessage(hEdit, EM_EXLIMITTEXT, 0, MaxText)

	'フォント情報の取得
	'(hFont_MainWnd：メインウィンドのフォントハンドル:Callback.wbpで定義済み)
	GetObject(hFont_MainWnd,Len(lfnt), lfnt)

	'新しいフォントの設定
	ZeroMemory(VarPtr(lfnt), Len(lfnt))
	lfnt.lfHeight=12	'文字の高さ
	lstrcpy(lfnt.lfFaceName, "ＭＳ　ゴシック")
	hFont=CreateFontIndirect(lfnt)

	'エディットボックスに新しいフォントを設定(WM_SETFONT)
	SendMessage(hEdit, WM_SETFONT, hFont, 1)

	'書式の設定(CHARFORMAT構造体)
	With cfmt
		.cbSize	= Len(cfmt)						'構造体のサイズ(=60)
    	.dwMask = CFM_COLOR	or CFM_CHARSET or _
					CFM_FACE or CFM_SIZE		'有効メンバ
    	.yHeight = 280							'(twip)文字の高さ 1point=20twip
      	.crTextColor = RGB(0, 0, 0)				'文字の色
    	.bCharSet = SHIFTJIS_CHARSET     		'キャラクタセット(128=SHIFTJIS_CHARSET)
    	lstrcpy(.szFaceName,"FixedSys")			'フォント名
	End With
	SendMessage(hEdit, EM_SETCHARFORMAT, 0, VarPtr(cfmt))

	'「Dual-font support」を無効にする
	SendMessage(hEdit, EM_SETLANGOPTIONS, 0, 0)

	'タブの間隔を設定
	'SendMessage(hEdit, EM_SETTABSTOPS, 1, 4*LOWORD(GetDialogBaseUnits()) \ 2)

	'マウスイベントを追加する
	dwEvent=SendMessage(hEdit, EM_GETEVENTMASK, 0, 0)
	SendMessage(hEdit, EM_SETEVENTMASK, 0, dwEvent or ENM_MOUSEEVENTS or ENM_UPDATE or ENM_CHANGE)

	'キーワードファイルのパスを設定
	lstrcpy(lpstrKeywordFilePath, lpstrFolderPath & Ex"\\" & "derective.ini")

	'キーワードファイルをオープン
	hFile=CreateFile(lpstrKeywordFilePath, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
						ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
	If hFile=INVALID_HANDLE_VALUE Then
		MessageBox(hMainWnd, "キーワードファイルが存在しません", "T_RichEdit", MB_OK or MB_ICONSTOP)
		ExitProcess(0)
	End If

	'ファイルサイズを取得し、バッファを確保
	dwFileSize=GetFileSize(hFile, 0)
	lpKeywordBuffer=malloc(dwFileSize+1)
	strKeyword=ZeroString(dwFileSize+1)

	'ファイルの内容を読み込む
	ReadFile(hFile, lpKeywordBuffer, dwFileSize, VarPtr(dwAccessByte), ByVal 0)
	lpKeywordBuffer[dwAccessByte]=0

	'ファイルハンドルを閉じる
	CloseHandle(hFile)
End Sub

Sub MainWnd_Resize(SizeType As Long, cx As Integer, cy As Integer)
	'メインウィンドのクライアント領域にエディットを合わせる
	MoveWindow(hEdit, 0, 0, cx, cy, TRUE)
End Sub


Sub MainWnd_Notify(ByRef nmHdr As NMHDR)
'プロジェクトオプションに「コモンコントロールを使用する」必要
	Dim lpmf As *MSGFILTER
	Dim pos As POINTAPI

	'右クリックをつかまえる
	If nmHdr.code = EN_MSGFILTER Then
		lpmf = VarPtr(nmHdr)
		If lpmf->msg = WM_RBUTTONDOWN Then
			pos.x = LOWORD(lpmf->lParam)
			pos.y = HIWORD(lpmf->lParam)
			ClientToScreen(hMainWnd, pos)
            TrackPopupMenu(hMenu_MyMenu_1, _
                 TPM_LEFTALIGN or TPM_TOPALIGN, _
                 pos.x,pos.y,0,hEdit,ByVal NULL)
		End If
	End If
End Sub

見間違えでなければ、
Const MaxText = 102400 '最大容量(byte)default=64K
の部分の数値は100キロバイトです・・・。64キロバイトは65536かと。

> 見間違えでなければ、
> Const MaxText = 102400 '最大容量(byte)default=64K
> の部分の数値は100キロバイトです・・・。64キロバイトは65536かと。
あの～。そこはリッチエディットの初期容量が64KBということです。気にしないで下さい。

MainWnd.sbpの40行目付近

コード: 全て選択

GetModuleFileName(GetModuleHandle(0), lpstrFolderPath, MAX_PATH)
i=lstrlen(lpstrFolderPath)-1

iはGetModuleFileNameの戻り値でも取得できるので

コード: 全て選択

i=GetModuleFileName(GetModuleHandle(0), lpstrFolderPath, MAX_PATH)

とできます。

現状のソースを見るとリッチエディットに入力されている全ての文字に対して
色の変更処理を行っているようですが、これでは入力された文字が多くなる、
キーワード数が多くなるにつれ処理がどんどん重たくなっていきます。
処理を高速にするには簡単に思いつく限り、
1) 色の変更処理を画面に表示されている部分に限定する
2) 変更された行にのみ色変更処理を行う
といった感じでしょうか。

2)を導入できればベストだと思いますが、いかにもバグを誘発しそう(貼り付け
やアンドゥ時等)なので、1)を検討するのがよろしいかと思います。
リッチエディットは使用したことがないのですが、EM_LINELENGTHやEM_GETFIRSTVISIBLELINE
なんかを駆使すれば画面内の文字を取得できる(？)ので、
その画面バッファを使用して変更すれば処理は格段に早くなると思います。
ただ画面をスクロールする度に画面内の文字をバッファに確保、変更を行う
ので、スクロールさせる時は逆に時間がかかってしまうかもしれません。

ノッチさん、みどるべあさん、返信ありがとうございます。
これは携帯のフルブラウザから投稿していますので、正式な返信はパソコンから行いたいと思います。

　みどるべあさん、ノッチさん、ありがとうございます。
現在コードを見直しているところです。

2)を導入できればベストだと思いますが、いかにもバグを誘発しそう(貼り付け
やアンドゥ時等)なので、1)を検討するのがよろしいかと思います。
リッチエディットは使用したことがないのですが、EM_LINELENGTHやEM_GETFIRSTVISIBLELINE
なんかを駆使すれば画面内の文字を取得できる(？)ので、
その画面バッファを使用して変更すれば処理は格段に早くなると思います。
ただ画面をスクロールする度に画面内の文字をバッファに確保、変更を行う
ので、スクロールさせる時は逆に時間がかかってしまうかもしれません。

　ありがとうございます。僕もそれを考えたのですが、どうやって何列表示されているか、表示されている最初の文字の位置と最後の文字を取得するかで悩んでいます。
また、どうやってスクロールバーが移動したのを取得するのか、スクロールバーの位置をどうやって記録するか、どうやってスクロールバーの位置を設定するか、それが分かれば解決...、という分けには行かないと思いますが、うまく行くと思います。

> ありがとうございます。僕もそれを考えたのですが、どうやって何列表示されているか、表示されている最初の文字の位置と最後の文字を取得するかで悩んでいます。

「リッチエディット表示行数」で検索したらまさしくその通りのものが見つかりました。

http://forums.belution.com/ja/vc/000/170/57s.shtml

> また、どうやってスクロールバーが移動したのを取得するのか、スクロールバーの位置をどうやって記録するか、どうやってスクロールバーの位置を設定するか、それが分かれば解決...、という分けには行かないと思いますが、うまく行くと思います。

スクロールバーが移動する時はWM_VSCROLL(縦)というメッセージを飛ばします。
恐らくこのメッセージはリッチエディットに対して送られてくるので、
リッチエディットをサブクラス化してWM_VSCROLLを捕まえてGetScrollPosなんかで
グローバル変数にスクロールバーのポジションを保存、処理を行った後、
SetScrollPosでポジション再指定とすればいいのかな？といったところです。

WM_VSCROLLがもしかしたらhMainWndに送られてくるかもしれませんし、
そもそもうまくいかないかもしれませんが、お試しください。

　ノッチさん、ありがとうございます。
言われたようにやってみたところ、かなり速くなりました。
ただ、どうやって画面がスクロールしたかを取得し、色変更をするかで悩んでおります。
普通に取得できるのですが、文字色変更時にスクロールするので、それで無限ループに入ってしまい、終いには落ちてしまいます。
タイマーでやってみたのですが、ちらつきます。
また、スクロールバーの位置を取得し、元に戻しても、位置が動いてしまいます。
どうすればいいんでしょうか...。

[ここをクリックすると内容が表示されます]

コード: 全て選択

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

' メモ - 以下の領域を、変数、構造体、定数、関数を宣言するための、
'        グローバル領域として利用することができます。
' ----------------------------------ここから----------------------------------
Declare Function GetDialogBaseUnits Lib "user32.dll" () As Long

Dim hFont As DWord							'フォントのハンドル
Dim lfnt As LOGFONT							'LOGFONT構造体

Dim cfmt As CHARFORMAT						'CHARFOMAT構造体
Dim lpstrFolderPath[MAX_PATH] As Byte		'ソフトの親フォルダ
Dim i As Long, i2=0 As Long					'フラグ
Dim hEdit As DWord							'リッチエディットのハンドル
Dim hLib As DWord							'ライブラリのハンドル
Dim lpKeywordBuffer As BytePtr				'キーワードファイルの内容を保持するバッファ
Dim strKeyword As String					'キーワード


Const RICHEDIT_CLASS = "RichEdit20A"
Const ID_EDIT = &HFF00
Const MaxText = 102400	'最大容量(byte)default=64K

Type FINDTEXTEX
	chrg As CHARRANGE
	lpstrText As BytePtr
	chrgText As CHARRANGE
End Type

Type CHARRANGE
	cpMin As Long
	cpMax As Long
End Type

'フルパスからファイル部を切り取る
i=GetModuleFileName(GetModuleHandle(0), lpstrFolderPath, MAX_PATH)-1
Do
	If lpstrFolderPath=Asc("\") Then
		lpstrFolderPath=0
		Exit Do
	End If
	i=i-1
	If i<0 Then Exit Do
Loop

Sub SetKeywordColor(dwFirstCharIndex As DWord, dwEndCharIndex As DWord)
	'変数宣言
	Dim ftex As FINDTEXTEX			'FINDTEXTEX構造体
	Dim chrg As CHARRANGE			'CHARRANGE構造体
	Dim i As Long, i2 As Long		'フラグ
	Dim dwStartPos As DWord			'範囲の始まり
	Dim strTemp As String			'文字コード格納用
	Dim nLineIndex As Long			'行のインデックス
	Dim VScrollInfo As SCROLLINFO	'リッチエディットの縦スクロールバーの位置を格納する
	Dim HScrollInfo As SCROLLINFO	'リッチエディットの横スクロールバーの位置を格納する
	Dim dwEvent As DWord

	'リッチエディットの今までの設定を取得
	SendMessage(hEdit, EM_GETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))

	'元のカーソル位置を取得
	SendMessage(hEdit, EM_EXGETSEL, 0, VarPtr(chrg))

	'スクロールバーの位置を取得
	VScrollInfo.cbSize=Len(VScrollInfo)
	VScrollInfo.fMask=SIF_POS
	GetScrollInfo(hEdit, SB_VERT, VScrollInfo)
	HScrollInfo.cbSize=Len(HScrollInfo)
	HScrollInfo.fMask=SIF_POS
	GetScrollInfo(hEdit, SB_HORZ, HScrollInfo)

	'ウインドウの描画を停止
	LockWindowUpdate(hEdit)

	'一度全ての文字色を黒に変更
	cfmt.crTextColor=RGB(0, 0, 0)
	SendMessage(hEdit, EM_SETCHARFORMAT, SCF_ALL, VarPtr(cfmt))

	'キーワードを検索し、その部分の文字色を変更
	i=0 : i2=0
	Do
		'キーワードを取り出す
		If (lpKeywordBuffer=13 and lpKeywordBuffer[i+1]=10) or lpKeywordBuffer=0 Then
			strKeyword[i2]=0
			ftex.chrg.cpMin=dwFirstCharIndex
			ftex.chrg.cpMax=dwEndCharIndex
			ftex.lpstrText=StrPtr(strKeyword)
			If SendMessage(hEdit, EM_FINDTEXTEX, FR_WHOLEWORD or FR_DOWN or FR_MATCHCASE, VarPtr(ftex))>-1 Then
				Do
					'キーワードを選択し、その部分の色を変更
					SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
					cfmt.crTextColor=RGB(0, 0, 255)
					SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))
					ftex.chrg.cpMin=ftex.chrgText.cpMax+1
				Loop Until SendMessage(hEdit, EM_FINDTEXTEX, FR_WHOLEWORD or FR_DOWN or FR_MATCHCASE, VarPtr(ftex))=-1
			End If
			If lpKeywordBuffer=0 Then Exit Do
			i=i+2 : i2=0
			Continue
		End If
		strKeyword[i2]=lpKeywordBuffer
		i=i+1 : i2=i2+1
	Loop

	'ダブルクォートの文字色を変更
	SendMessage(hEdit, EM_SETSEL, 0, 0)
	ftex.chrg.cpMin=dwFirstCharIndex
	ftex.chrg.cpMax=dwEndCharIndex
	ftex.lpstrText=Ex"\q"
	If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))>-1 Then
		Do
			dwStartPos=ftex.chrgText.cpMin
			ftex.chrg.cpMin=ftex.chrgText.cpMin+1
			If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))>-1 Then
				'ダブルクォートで囲まれた範囲を選択し、その部分の色を変更
				ftex.chrgText.cpMin=dwStartPos
				SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
				cfmt.crTextColor=RGB(160, 20, 20)
				SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))
				ftex.chrg.cpMin=ftex.chrgText.cpMax+1
			End If
		Loop Until SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))=-1
	End If
	'コメントの文字色を変更
	SendMessage(hEdit, EM_SETSEL, 0, 0)
	ftex.chrg.cpMin=dwFirstCharIndex
	ftex.chrg.cpMax=dwEndCharIndex
	ftex.lpstrText="'"
	Do
		If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))>-1 Then
			dwStartPos=ftex.chrgText.cpMin
			ftex.chrg.cpMin=ftex.chrgText.cpMax
			ftex.lpstrText=Ex"\r"
			If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))>-1 Then
				ftex.chrgText.cpMin=dwStartPos
				SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
				cfmt.crTextColor=RGB(0, 128, 0)
				SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))
			Else
				Exit Do
			End If
			ftex.chrg.cpMin=ftex.chrgText.cpMax
			ftex.lpstrText="'"
		Else
			Exit Do
		End If
	Loop Until SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))=-1
	'複数行コメントの文字色を変更
	SendMessage(hEdit, EM_SETSEL, 0, 0)
	strTemp=Chr$(47) + Chr$(42)
	ftex.chrg.cpMin=0
	ftex.chrg.cpMax=-1
	ftex.lpstrText=StrPtr(strTemp)
	If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))>-1 Then
		Do
			dwStartPos=ftex.chrgText.cpMin
			ftex.chrg.cpMin=ftex.chrgText.cpMin+1
			strTemp=Chr$(42) + Chr$(47)
			ftex.lpstrText=StrPtr(strTemp)
			If SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))=-1 Then
				'複数行コメントで囲まれた範囲を選択し、その部分の色を変更
				ftex.chrgText.cpMin=dwStartPos
				SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
				cfmt.crTextColor=RGB(0, 128, 0)
				SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))
				Exit Do
			Else
				ftex.chrgText.cpMin=dwStartPos
				SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
				cfmt.crTextColor=RGB(0, 128, 0)
				SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))
				ftex.chrg.cpMin=ftex.chrgText.cpMax+1
				strTemp=Chr$(47) + Chr$(42)
				ftex.lpstrText=StrPtr(strTemp)
			End If
		Loop Until SendMessage(hEdit, EM_FINDTEXTEX, FR_DOWN, VarPtr(ftex))=-1
	End If

	'カーソルを元の位置に戻す
	SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(chrg))

	'スクロールバーの位置を元に戻す
	SetScrollInfo(hEdit, SB_VERT, VScrollInfo, TRUE)
	SetScrollInfo(hEdit, SB_HORZ, HScrollInfo, TRUE)

	'ウインドウの描画を再開
	LockWindowUpdate(NULL)

	'文字色を黒に変更
	cfmt.crTextColor=RGB(0, 0, 0)
	SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))

	SendMessage(hEdit, EM_REPLACESEL, FALSE, NULL)
End Sub

Function MainWndProc(hWnd As DWord, dwMsg As DWord, wParam As DWord, lParam As DWord) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
	Dim EditRect As RECT					'リッチエディットの範囲
	Dim dwFirstCharIndex As DWord			'最初の文字インデックス
	Dim dwEndCharIndex As DWord				'最後の文字インデックス
	Dim Point As POINTAPI					'POINTAPI構造体。座標が格納される

	'リッチエディットの範囲を取得
	GetClientRect(hEdit, EditRect)
	Point.x=EditRect.left
	Point.y=EditRect.top
	dwFirstCharIndex=LOWORD(SendMessage(hEdit, EM_CHARFROMPOS, 0, VarPtr(Point)))
	Point.x=EditRect.right
	Point.y=EditRect.bottom
	dwEndCharIndex=LOWORD(SendMessage(hEdit, EM_CHARFROMPOS, 0, VarPtr(Point)))

	Select Case dwMsg
		Case WM_COMMAND
			Select Case HIWORD(wParam)
				Case EN_CHANGE
					SetKeywordColor(dwFirstCharIndex, dwEndCharIndex)
			End Select
	End Select

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

' ----------------------------------ここまで----------------------------------

Sub MainWnd_Destroy()
	DeleteObject(hFont)
    If hEdit Then DestroyWindow(hEdit)
    If hLib Then FreeLibrary(hLib)
	If lpKeywordBuffer Then free(lpKeywordBuffer)
	T_RichEdit_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	Dim dwEvent As DWord							'イベントマスク
	Dim lpstrKeywordFilePath[MAX_PATH] As Byte		'キーワードファイルのパス
	Dim hFile As DWord								'キーワードファイルのハンドル
	Dim dwFileSize As DWord							'ファイルサイズ
	Dim dwAccessByte As DWord						'ファイルアクセスサイズ

	'RICHED32.DLL のロード
	hLib = LoadLibrary("riched20.dll")
	If hLib=0 then
		MessageBox(hMainWnd, "リッチエディットライブラリのロードに失敗", "Error - T_RichEdit", MB_OK or MB_ICONSTOP)
		Exit Sub
	End If
	'リッチエディットコントロールの作成
	hEdit = CreateWindowEx(0, _						'拡張ウィンドウスタイル
				RICHEDIT_CLASS, _					'ウィンドウクラス名
				"", _								'ウィンドウタイトル
				WS_CHILD or WS_VISIBLE or _			'ウインドウスタイル
				WS_BORDER or WS_VSCROLL or _		'〃
				WS_HSCROLL or ES_MULTILINE or _		'〃
				ES_AUTOHSCROLL or ES_AUTOVSCROLL,	'〃
				0, 0, 0, 0, 						'リサイズイベントで大きさを変える
				hMainWnd, 							'親ウィンドウ
				ID_EDIT, 							'コントロールID
				GetModuleHandle(0), _				'インスタンスハンドル
				0)
	If hEdit = 0 Then
		MessageBox(hMainWnd, "リッチエディットの作成に失敗", "Error - T_RichEdit", MB_OK or MB_ICONSTOP)
		Exit Sub
	End If
	
	'テキストの上限を設定
	SendMessage(hEdit, EM_EXLIMITTEXT, 0, MaxText)

	'フォント情報の取得
	'(hFont_MainWnd：メインウィンドのフォントハンドル:Callback.wbpで定義済み)
	GetObject(hFont_MainWnd,Len(lfnt), lfnt)

	'新しいフォントの設定
	ZeroMemory(VarPtr(lfnt), Len(lfnt))
	lfnt.lfHeight=12	'文字の高さ
	lstrcpy(lfnt.lfFaceName, "ＭＳ　ゴシック")
	hFont=CreateFontIndirect(lfnt)

	'エディットボックスに新しいフォントを設定(WM_SETFONT)
	SendMessage(hEdit, WM_SETFONT, hFont, 1)

	'書式の設定(CHARFORMAT構造体)
	With cfmt
		.cbSize	= Len(cfmt)						'構造体のサイズ(=60)
    	.dwMask = CFM_COLOR	or CFM_CHARSET or _
					CFM_FACE or CFM_SIZE		'有効メンバ
    	.yHeight = 280							'(twip)文字の高さ 1point=20twip
      	.crTextColor = RGB(0, 0, 0)				'文字の色
    	.bCharSet = SHIFTJIS_CHARSET     		'キャラクタセット(128=SHIFTJIS_CHARSET)
    	lstrcpy(.szFaceName,"FixedSys")			'フォント名
	End With
	SendMessage(hEdit, EM_SETCHARFORMAT, 0, VarPtr(cfmt))

	'「Dual-font support」を無効にする
	SendMessage(hEdit, EM_SETLANGOPTIONS, 0, 0)

	'タブの間隔を設定
	'SendMessage(hEdit, EM_SETTABSTOPS, 1, 4*LOWORD(GetDialogBaseUnits()) \ 2)

	'マウスイベントを追加する
	dwEvent=SendMessage(hEdit, EM_GETEVENTMASK, 0, 0)
	SendMessage(hEdit, EM_SETEVENTMASK, 0, dwEvent or ENM_MOUSEEVENTS or ENM_UPDATE or ENM_CHANGE or ENM_SCROLL)

	'キーワードファイルのパスを設定
	lstrcpy(lpstrKeywordFilePath, lpstrFolderPath & Ex"\\" & "derective.ini")

	'キーワードファイルをオープン
	hFile=CreateFile(lpstrKeywordFilePath, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
						ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
	If hFile=INVALID_HANDLE_VALUE Then
		MessageBox(hMainWnd, "キーワードファイルが存在しません", "T_RichEdit", MB_OK or MB_ICONSTOP)
		ExitProcess(0)
	End If

	'ファイルサイズを取得し、バッファを確保
	dwFileSize=GetFileSize(hFile, 0)
	lpKeywordBuffer=malloc(dwFileSize+1)
	strKeyword=ZeroString(dwFileSize+1)

	'ファイルの内容を読み込む
	ReadFile(hFile, lpKeywordBuffer, dwFileSize, VarPtr(dwAccessByte), ByVal 0)
	lpKeywordBuffer[dwAccessByte]=0

	'ファイルハンドルを閉じる
	CloseHandle(hFile)
End Sub

Sub MainWnd_Resize(SizeType As Long, cx As Integer, cy As Integer)
	'メインウィンドのクライアント領域にエディットを合わせる
	MoveWindow(hEdit, 0, 0, cx, cy, TRUE)
End Sub


Sub MainWnd_Notify(ByRef nmHdr As NMHDR)
'プロジェクトオプションに「コモンコントロールを使用する」必要
	Dim lpmf As *MSGFILTER
	Dim pos As POINTAPI

	'右クリックをつかまえる
	If nmHdr.code = EN_MSGFILTER Then
		lpmf = VarPtr(nmHdr)
		If lpmf->msg = WM_RBUTTONDOWN Then
			pos.x = LOWORD(lpmf->lParam)
			pos.y = HIWORD(lpmf->lParam)
			ClientToScreen(hMainWnd, pos)
            TrackPopupMenu(hMenu_MyMenu_1, _
                 TPM_LEFTALIGN or TPM_TOPALIGN, _
                 pos.x,pos.y,0,hEdit,ByVal NULL)
		End If
	End If
End Sub

　あれから色々と試行錯誤をし、色々な問題を解決しました。
　反応の遅さについては、貼り付け処理時に全てのキーワード色を一括して変更し、
通常文字変更時には画面内のみキーワード色を変更することにしました。
そして、大幅な高速化が出来たわけですが、やはりスクロールバーの位置記録と位置セットは
うまくいきません。今回からはその問題のコード部分のみ公開しようと思います。

リッチエディット作成

[ここをクリックすると内容が表示されます]

コード: 全て選択

'リッチエディットコントロールの作成
	hEdit = CreateWindowEx(0, _						'拡張ウィンドウスタイル
				RICHEDIT_CLASS, _					'ウィンドウクラス名
				"", _								'ウィンドウタイトル
				WS_CHILD or WS_VISIBLE or _			'ウインドウスタイル
				WS_BORDER or WS_VSCROLL or _		'〃
				WS_HSCROLL or ES_MULTILINE or _		'〃
				ES_AUTOHSCROLL or ES_AUTOVSCROLL,	'〃
				0, 0, 0, 0, 						'リサイズイベントで大きさを変える
				hMainWnd, 							'親ウィンドウ
				ID_EDIT, 							'コントロールID
				GetModuleHandle(0), _				'インスタンスハンドル
				0)

スクロールバー位置取得＆位置セット

[ここをクリックすると内容が表示されます]

コード: 全て選択

	Dim VScrollInfo As SCROLLINFO	'SCROLLINFO構造体。縦方向のスクロールバー。
	Dim HScrollInfo As SCROLLINFO	'SCROLLINFO構造体。横方向のスクロールバー。

	'縦横スクロールバーの情報を取得
	VScrollInfo.cbSize=Len(VScrollInfo)
	VScrollInfo.fMask=SIF_ALL or SIF_DISABLENOSCROLL
	GetScrollInfo(hEdit, SB_VERT, VScrollInfo)
	HScrollInfo.cbSize=Len(HScrollInfo)
	HScrollInfo.fMask=SIF_ALL or SIF_DISABLENOSCROLL
	GetScrollInfo(hEdit, SB_HORZ, HScrollInfo)

	'カーソルを元の位置に戻す
	SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(chrg))

	'スクロールバーを元の位置に戻す
	SetScrollInfo(hEdit, SB_VERT, VScrollInfo, TRUE)
	SetScrollInfo(hEdit, SB_HORZ, HScrollInfo, TRUE)

こうしても、スクロールバーの位置は正常にセットされるのですが、表示位置がずれてしまいます。
なんか良い方法はないですかね。

現在のプログラムはこちら
http://www.exfiction.net/~yu0627/temp/T_RichEdit.zip

＃追記
青文字にするキーワードは、以下ので全てでしょうか

キーワード [ここをクリックすると内容が表示されます]

コード: 全て選択

If
Then
Else
ElseIf
End
Select
Case
Do
Loop
Until
While
Wend
Goto
Gosub
Return
For
Next
Continue
Declare
Sub
Function
Exit
Dim
Const
Enum
Let
Type
TypeDef
With
Class
Private
Public
Protected
#include
#resource
#prompt
#N88BASIC
#console
#strict
#define
#ifdef
#ifndef
#else
#endif
Delete

現状のソースがわからないので的確なコメントは難しいですが、
スクロールバーの位置取得設定関数が云々ではなく、その処理を行うタイミング
が原因ではないかと思われます。(もしかしたら違うかも)

GetScrollInfoを行った後debugで構造体の内容確認。
いくつか処理を行うごとにdebugやMessageBoxで処理を止めて状況を見る。
を行うとわかりやすいと思います。
VisualStudioをインストールするとついてくるSPY++ってのを使うとわかりやすい
んですけど。なければdebug等で手動でやるしかないです。

また、EM_SETEVENTMASKでリッチエディットから送るメッセージを選択できます。
EM_SETEVENTMASKでぐぐるとでてくる"yokohama.cool.ne.jp"のページはわかりやすいです。
このメッセージを処理することで現象が変わるかもしれません。

　ノッチさん、ありがとうございます。

現状のソースがわからないので的確なコメントは難しいですが、
スクロールバーの位置取得設定関数が云々ではなく、その処理を行うタイミング
が原因ではないかと思われます。(もしかしたら違うかも)

　これについてですが、スクロールバーの位置を記録するのは文字色を変更する前、
スクロールバーの位置を設定するのは文字色を変更した後です。
どうやら、スクロールバーと表示内容はスクロールバーだけを操作してもいけないようです。
ですので、もし一番上の行が違っていた場合には元の位置まで戻すようにしたのですが、うまくいきません。

一部抜粋の現在のコード [ここをクリックすると内容が表示されます]

コード: 全て選択

Sub SetKeywordColor(dwFirstCharIndex As DWord, dwEndCharIndex As DWord)
	'変数宣言
	Dim ftex As FINDTEXTEX			'FINDTEXTEX構造体
	Dim chrg As CHARRANGE			'CHARRANGE構造体
	Dim i As Long, i2 As Long		'フラグ
	Dim dwStartPos As DWord			'範囲の始まり
	Dim strTemp As String			'文字コード格納用
	Dim nLineIndex As Long			'行のインデックス
	Dim dwOldFirstLineIndex As DWord'文字色変更前の最初の行のインデックス
	Dim dwFirstLineIndex As DWord	'可視状態の最初の行のインデックス
	Dim VScrollInfo As SCROLLINFO	'SCROLLINFO構造体。縦方向のスクロールバー。
	Dim HScrollInfo As SCROLLINFO	'SCROLLINFO構造体。横方向のスクロールバー。

	'リッチエディットの今までの設定を取得
	SendMessage(hEdit, EM_GETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))

	'元のカーソル位置を取得
	SendMessage(hEdit, EM_EXGETSEL, 0, VarPtr(chrg))

	'縦横スクロールバーの情報を取得
	VScrollInfo.cbSize=Len(VScrollInfo)
	VScrollInfo.fMask=SIF_ALL or SIF_DISABLENOSCROLL
	GetScrollInfo(hEdit, SB_VERT, VScrollInfo)
	HScrollInfo.cbSize=Len(HScrollInfo)
	HScrollInfo.fMask=SIF_ALL or SIF_DISABLENOSCROLL
	GetScrollInfo(hEdit, SB_HORZ, HScrollInfo)

	'可視状態の一番上の行を取得
	dwOldFirstLineIndex=SendMessage(hEdit, EM_GETFIRSTVISIBLELINE, 0, 0)

	'ウインドウの描画を停止
	LockWindowUpdate(hEdit)

	---文字色変更処理（略）---

	'カーソルを元の位置に戻す
	SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(chrg))

	'スクロールバーを元の位置に戻す
	SetScrollInfo(hEdit, SB_VERT, VScrollInfo, TRUE)
	SetScrollInfo(hEdit, SB_HORZ, HScrollInfo, TRUE)

	'画面の表示を元の位置に戻す
	dwFirstLineIndex=SendMessage(hEdit, EM_GETFIRSTVISIBLELINE, 0, 0)
	While dwFirstLineIndex<>dwOldFirstLineIndex
		If dwFirstLineIndex-dwOldFirstLineIndex>0 Then
			SendMessage(hEdit, EM_SCROLL, SB_LINEUP, 0)
		Else
			SendMessage(hEdit, EM_SCROLL, SB_LINEDOWN, 0)
		End If
		dwFirstLineIndex=SendMessage(hEdit, EM_GETFIRSTVISIBLELINE, 0, 0)
	Wend

	'ウインドウの描画を再開
	LockWindowUpdate(NULL)

	'文字色を黒に変更
	cfmt.crTextColor=RGB(0, 0, 0)
	SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))

	SendMessage(hEdit, EM_REPLACESEL, FALSE, NULL)
End Sub

　選択してもウインドウをスクロールしないように出来ないでしょうか。

NewとDebugも色が変わると思います。>>yu0627さん

実際の改造に対する助言は、知識不足で出来ませんが、改善方法の１つを提案します。

SetKeywordColor()を呼び出すと、全データを再処理し画面のみ再設定していますが、
修正のあった範囲を取得する事は出来ないのでしょうか？

取得できるなら、修正のあった範囲に、*が無いか確認し、もしあった場合に前後の文字を確認します。
/*または*/なら全体の処理を行い、（複数行にまたがる命令）
無い場合は、その１行のみを処理するようには出来ないでしょうか？

リッチテキストをコントロールした事が無いので無責任な発言になりましたが、
変更の無い部分は処理しない、これが一番効きます。

手元の簡単環境では多少画面の乱れはありますが、スクロールせずに入力が
できました。
以下を'スクロールバーを元の位置に戻す処理のあとに入れて下さい。

コード: 全て選択


'スクロールバーを元の位置に戻す
SetScrollInfo(hEdit, SB_VERT, VScrollInfo, TRUE)
SetScrollInfo(hEdit, SB_HORZ, HScrollInfo, TRUE)
SendMessage(hEdit,WM_HSCROLL,HScrollInfo.nPos*&H10000+SB_THUMBTRACK,0)
SendMessage(hEdit,WM_VSCROLL,VScrollInfo.nPos*&H10000+SB_THUMBTRACK,0)

やってることは、「スクロールバーを操作しましたよ」とリッチエディットに
うそ情報を与えて表示位置を更新させているだけです。
先にWM_VSCROLLをしてからWM_HSCROLLを行うと微妙にずれますのでこのままの
順番で。
SetKeywordColor関数の内容が手元にあるものとyu0627さんが持っているもので
恐らく違うので、違う動きをするかもしれませんが試す価値はあると思います。

ab.com コミュニティ

キーワードの色分け(2)

キーワードの色分け(2)

返信＠yu0627

返信＠yu0627

返信＠yu0627

Re: 返信＠yu0627

返信＠yu0627

返信＠yu0627

Re: 返信＠yu0627

返信＠yu0627

今更ですが。

できた！？表示位置を元に戻す