リッチエディットで特定文字の色を変える
Posted: 2006年3月12日(日) 21:22
タイトルのとおりです。過去ログにあるようなnEditを使わず、すべて自前でプログラムを組もうとしています。
現在、あと特定文字を検索し色を変える部分まで来ているのですが、そこからがうまくいきません。
試行錯誤しているので必要のないプログラムまで混ざっていますが。
できないのは、リッチエディット内のテキストを検索するところです。
EM_FINDTEXTEXを使っていますが、いっこうに検索されません。
これができなければ無理なんです。
どこがおかしいか、ご指摘お願い致します。
現在、あと特定文字を検索し色を変える部分まで来ているのですが、そこからがうまくいきません。
[ここをクリックすると内容が表示されます]
コードはＡｃｔｉｖｅＢａｓｉｃＬｉｆｅにあったサンプルを改造してきています。コード: 全て選択
' ----------------------------------------------------------------------------
' イベント プロシージャ
' ----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' メモ - 以下の領域を、変数、構造体、定数、関数を宣言するための、
' グローバル領域として利用することができます。
' ----------------------------------ここから----------------------------------
Dim hFont As DWord 'フォントのハンドル
Dim lfnt As LOGFONT
Dim cfmt As CHARFORMAT
Dim hEdit As DWord
Dim hLib As DWord
Dim nIsRichEditChange As Long
Dim nIsSetKeywordColor As Long
Const RICHEDIT_CLASS = "RichEdit20A"
Const ID_EDIT = &HFF00
Const MaxText = 102400 '最大容量(byte)default=64K
Type FINDTEXTEX
chrg As CHARRANGE
lpstrText As *Char
chrgText As CHARRANGE
End Type
Type CHARRANGE
cpMin As Long
cpMax As Long
End Type
'キーワードを色付けするプロシージャ
Sub SetKeywordColor()
Dim strTextBuffer As String 'テキストバッファ
Dim dwLength As DWord 'テキストの長さ
Dim strTemp As String '新たに書き込むテキストの一時保存用
Dim dw As DWord, dw2 As DWord
Dim ftex As FINDTEXTEX 'FINDTEXT構造体
Dim chrg As CHARRANGE 'CHARRANGE構造体。元のカーソルの位置が格納される
'リッチエディットの今までの設定を取得
SendMessage(hEdit, EM_GETCHARFORMAT, TRUE, VarPtr(cfmt))
'元のカーソル位置を取得
SendMessage(hEdit, EM_EXGETSEL, 0, VarPtr(chrg))
'リッチエディットの反転表示を一時停止
SendMessage(hEdit, EM_HIDESELECTION, 1, 0)
'カーソルの位置を一時的に先頭に変更
SendMessage(hEdit, EM_SETSEL, 0, 0)
dwLength=GetWindowTextLength(hEdit)
'キーワードを検索し、その部分の文字色を変更
ftex.chrg.cpMin=1
ftex.chrg.cpMax=-1
ftex.lpstrText="If"
If SendMessage(hEdit, EM_FINDTEXT, FR_WHOLEWORD or FR_DOWN, VarPtr(ftex))>-1 Then
SendMessage(hEdit, EM_EXSETSEL, 0, VarPtr(ftex.chrgText))
cfmt.crTextColor=RGB(0, 0, 255)
If SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))=0 Then
MessageBox(hMainWnd, "文字色の変更に失敗しました", "Error - T_RichEdit", MB_OK or MB_ICONSTOP)
End If
End If
'リッチエディットの反転表示一時停止を解除
SendMessage(hEdit, EM_HIDESELECTION, 0, 0)
SendMessage(hEdit, EM_SETSEL, chrg.cpMin, chrg.cpMax)/*
cfmt.crTextColor=RGB(0, 0, 0)
If SendMessage(hEdit, EM_SETCHARFORMAT, SCF_SELECTION, VarPtr(cfmt))=0 Then
MessageBox(hMainWnd, "文字色の変更に失敗しました", "Error - T_RichEdit", MB_OK or MB_ICONSTOP)
End If*/
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)
T_RichEdit_DestroyObjects()
PostQuitMessage(0)
End Sub
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
Dim dwEvent As DWord
'RICHED32.DLL のロード
hLib = LoadLibrary("riched20.dll")
If hLib=0 then
MessageBox(hMainWnd,"Failure LoadLib","",MB_OK)
Exit Sub
End If
'リッチエディットコントロールの作成
hEdit = CreateWindowEx(0, _ '拡張ウィンドウスタイル
RICHEDIT_CLASS, _ 'ウィンドウクラス名
"", _ 'ウィンドウタイトル
WS_CHILD or WS_VISIBLE or WS_BORDER or WS_VSCROLL or _
ES_MULTILINE or ES_AUTOVSCROLL, _
0, 0, 0, 0, _ 'あとで、リサイズイベントで大きさを変える
hMainWnd, _ '親ウィンドウ
ID_EDIT, _ 'コントロールID
GetModuleHandle(0), _ 'インスタンスハンドル
0)
If hEdit = 0 Then
MessageBox(hMainWnd,"Failure CreateWindowEx","",MB_OK)
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, "FixedSys")
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 = 128 'キャラクタセット(128=SHIFTJIS_CHARSET)
lstrcpy(.szFaceName,"FixedSys") 'フォント名
End With
SendMessage(hEdit,EM_SETCHARFORMAT,0,VarPtr(cfmt))
'マウスイベントを追加する
dwEvent=SendMessage(hEdit, EM_GETEVENTMASK, 0, 0)
SendMessage(hEdit, EM_SETEVENTMASK, 0, dwEvent or ENM_MOUSEEVENTS or ENM_CHANGE)
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)
Select Case TrackPopupMenu(hMenu_MyMenu_1, TPM_LEFTALIGN or TPM_TOPALIGN or TPM_RETURNCMD, pos.x,pos.y,0,hEdit,ByVal NULL)
Case IDM_UNDO
End Select
End If
End If
End Sub試行錯誤しているので必要のないプログラムまで混ざっていますが。
できないのは、リッチエディット内のテキストを検索するところです。
EM_FINDTEXTEXを使っていますが、いっこうに検索されません。
これができなければ無理なんです。
どこがおかしいか、ご指摘お願い致します。