VBA/GDIでUserFormに描画/Picture更新時のチラツキを防止するには
解決半年ぶりに質問させていただきます。
昔WEBで調べて切り貼りして作った（写した？）コードですが、エクセルのUserFormに描画するのに、Windowが隠れた時に消えないように、メモリ上のBitmapに描画してから、Bitmap2にコピーし、Picture型に変換してUserFormにセットしているのですが、チラツキが発生します。UserFormのDrawBufferの値を10倍すると良いという記事をみつけて試しましたが、Celeron2.4GHz,256MByteメモリ、オンボードグラフィック、WIN2Kというチープな環境のためか変わり映えしません。何か他に対処方法がありましたら御教示下さい。
コード抜粋を載せます。○一個描くのに、都度Pictureを更新するというコードです。
(前略）
Sub drawCircle(x As Long, y As Long)
Dim hbr As Long
Dim ret As Long
Dim hOldBr As Long
Dim hbmp2 As Long
hdcForm = GetDC(hwndForm)
If hdcForm = 0 Then Exit Sub
hdc = CreateCompatibleDC(hdcForm)
hdc2 = CreateCompatibleDC(hdcForm)
hbmp2 = CreateCompatibleBitmap(hdcForm, rc.Right, rc.Bottom)
hbmpOld = SelectObject(hdc, hbmp)
hbmpOld2 = SelectObject(hdc2, hbmp2)
ReleaseDC hwndForm, hdcForm
hbr = CreateSolidBrush(plotColor)
hOldBr = SelectObject(hdc, hbr)
Ellipse hdc, x - 3, y - 3, x + 3, y + 3
SelectObject hdc, hOldBr
DeleteObject hbr
ret = BitBlt(hdc2, 0, 0, rc.Right, rc.Bottom, hdc, 0, 0, SRCCOPY)
SelectObject hdc, hbmpOld
SelectObject hdc2, hbmpOld2
DeleteDC hdc
DeleteDC hdc2
Set pic = GetPictureObject(hbmp2)
If pic Is Nothing Then DeleteObject hbmp2
Set UserForm1.Picture = pic
End Sub
Private Function GetPictureObject(ByVal hbmp As Long) As Object
Dim iid As GUID
Dim pd As PICTDESC
If hbmp = 0 Then Exit Function
With iid
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With pd
.cbSizeofstruct = Len(pd)
.picType = PICTYPE_BITMAP
.hbitmap = hbmp
End With
OleCreatePictureIndirect pd, iid, 1, GetPictureObject
End Function
よく分かりませんが、参考にされた板で質問されてはどうでしょうか
Application.ScreenUpdating とかで描画を抑制ってのはなし？
頭を使わないやり方だけど
UserForm を使うことはほとんどないので、あまり詳しくは述べませんが、
ウィンドウクラススタイルに CS_SAVEBITS がない上に、背景色で塗り潰す
処理をする普通のウィンドウだと考えられますので、基本的にはチラつきが
生じるはずです。
Windows API 的に解決するのであれば、サブクラス化でもして、
WM_ERASEBKGND や WM_PAINT で、背景色塗りつぶしをせずに、そのまま
DIBなどとして持っているデータを直接描画(Blt系)することになるでしょう。
ただ、そこまでするのは面倒だな、とは思います。
皆様、情報・アドバイスありがとうございます。
数年前に作成した、スキャンしたグラフから数値を読み込むブックを、引っ張り出して使ってみたところチラツキが目に優しくないため、お知恵を拝借と思いました。当時はほとんどROMでしたが、こちらか、モグラの掲示板の記事を参考にさせていただいたのではないかと思います。
ScreenUpdatingについては、試しているのですが、Pictureを書き戻す操作自体が抑制されてしまって、何も描画されなくなってしまいました。
WM_PAINT云々は、「猫でも分かるWindowsプログラミング」を一応読破したけれど、応用するだけの理解に至っていない子猫な自分には荷が重いです。「Excel VBA アクションゲーム作成入門」でも購入してお勉強すればできるのかもしれませんね。
もう少し開いておいてみます。よろしくおねがいします。
Application.ScreenUpdating = Falseに関する記述は誤りでした。
自分の作成したブックの操作を誤っていました。
「チラツキは改善されませんでした」が正しいです。
訂正させていただきます。
上記のVB関数は試せませんでしたが、WinAPIのBlt関係は多少わかるのでその分だけお伝えしておくと、ちらつき発生というのは、色々な場合があって一概には言えませんが、コントロール系のよくあるちらつきは、
1.自分でWM_PAINTとかでドローしていても、背景描画で勝手にバックグラウンドカラーで更新してしまって発生するもの
2.自分でドローを何度も実行していて、更新タイミング外でもその表示が見えてしまう
の２つが多いです。
1は確かWM_CTLCOLORをNULLBURUSHとかにすれば防げたように記憶しています。
2はスレ主さんのコードで言うならばhbmp2を保持しておいて、これを一括してWM_PAINTなどで表示する方法でやるとちらつかなくなります。
最後にちらつき問題は色々と複雑な物を含んでいるので、2のように自分でバックグラウンドを管理するのがもっともスマートだと思います。
少し板違いな話になりましたが参考になりましたら幸いです。
皆様、情報・アドバイスありがとうございます。
下記を参考にWM_PAINTを捕捉して、再描画を試みましたが、空のUserformだと動作するのですが、既存のコードと組み合わせると、マウスカーソルがフォームを外れたとたんにOSが暴走して、上手くいっていません。(それを回避したとき、再サブクラス化もできていない）
http://www11.plala.or.jp/micras/software/whywhat.html
苦肉の策で、
通常の描画は、上記hbmp2をUserFormに直接BitBltで転送する。（ちらつきは軽減された）UserFormを最小化した後、元のサイズに戻す（ExcelのUserFormには無いですが、フォームを表示したままワークシートを操作したい都合上、最小化ボタンを設けてあります）時だけ、ResizeイベントでPictureに変換してから書き戻すという折衷案で、一応動いています。
WM_PAINTでやっている訳ではないので、別のウィンドウで隠された場合には無力で、人様に使っていただくには問題がありますが．．．
もうしばらく、開いておきますので、よろしくおねがいします。
解決といたします。
情報をいただいた皆様、ありがとうございました。
| ツイート |  |