リストビューの中にプログレスバーを表示するには？ (ID:84668)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 今、ちらつきの事に関するサイト巡りをしております。 ＞以前試した時、カスタムドローでは、ちらつきを抑えきれなかったと思う。 ＞代わりに、WM_PAINTメッセージで、描画処理をした様な．．． そうなんですか？知識が浅いものでよくわからないのですが・・・ ちょっと長くなりますがソースを載せてみます。 '============================================================================== ' サブクラス化を行う際のウィンドウプロシージャ '============================================================================== Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim udtNMHdr As NMHDR Dim udtNMLvw As NMLISTVIEW Dim udtCdLvw As NMLVCUSTOMDRAW Dim colBarItems As BarItems Dim clsBarItem As BarItem Dim lngObj As Long Select Case uMsg Case WM_NOTIFY CopyMemory udtNMHdr, ByVal lParam, LenB(udtNMHdr) If GetProp(udtNMHdr.hwndFrom, PROP_GRAPHLIST) Then CopyMemory udtNMLvw, ByVal lParam, LenB(udtNMLvw) If udtNMLvw.hdr.code = NM_CUSTOMDRAW Then CopyMemory udtCdLvw, ByVal lParam, LenB(udtCdLvw) Select Case udtCdLvw.nmcd.dwDrawStage Case CDDS_POSTERASE, CDDS_PREERASE WindowProc = CDRF_DODEFAULT Case CDDS_PREPAINT WindowProc = CDRF_NOTIFYITEMDRAW Case CDDS_ITEMPREPAINT 'アイテムの描画を行う直前のメッセージ WindowProc = CDRF_NOTIFYPOSTPAINT Case CDDS_ITEMPOSTPAINT 'アイテムの描画を行った直後のメッセージ '-- グラフの描画 Set colBarItems = objArray.Item(CStr(udtNMHdr.hwndFrom)) For Each clsBarItem In colBarItems Call DrawGraph(udtNMLvw.hdr.hwndFrom, udtCdLvw.nmcd.hdc, _ udtCdLvw.nmcd.dwItemSpec, clsBarItem.TargetColumn, _ clsBarItem.ForeColor) Next WindowProc = CDRF_DODEFAULT End Select End If End If Case Else End Select If WindowProc = 0& Then WindowProc = CallWindowProc(lpProcOrg, hwnd, uMsg, wParam, lParam) End If End Function '============================================================================== ' グラフの描画メソッド '============================================================================== Private Sub DrawGraph(ByVal hwnd As Long, ByVal hdc As Long, _ ByVal iItemIndex As Long, ByVal iColumnIndex As Long, _ ByVal clrForeColor As Long) Dim strVal As String Dim curVal As Currency Dim udtRect As RECT Dim hFont As Long Dim hOldBrush As Long Dim hBrush As Long Dim hOldPen As Long Dim hPen As Long Dim lngOldColor As Long ListView_GetSubItemRect hwnd, iItemIndex, iColumnIndex, LVIR_BOUNDS, udtRect '-- 見た目を良くするために各行間を1ピクセルづつあける udtRect.Top = udtRect.Top + 1 udtRect.Bottom = udtRect.Bottom udtRect.Left = udtRect.Left + 1 udtRect.Right = udtRect.Right - 1 hFont = GetStockObject(DEFAULT_GUI_FONT) SelectObject hdc, hFont '-- いったん白で塗りつぶす hPen = GetStockObject(NULL_PEN) hBrush = CreateSolidBrush(vbWhite) hOldPen = SelectObject(hdc, hPen) hOldBrush = SelectObject(hdc, hBrush) Rectangle hdc, _ udtRect.Left, _ udtRect.Top, _ udtRect.Right, _ udtRect.Bottom DeleteObject SelectObject(hdc, hOldBrush) '-- テキストの描画 lngOldColor = GetTextColor(hdc) ListView_GetItemText hwnd, iItemIndex, iColumnIndex, strVal If IsNumeric(strVal) Then curVal = CCur(strVal) Else curVal = 0 End If SetTextColor hdc, clrForeColor DrawText hdc, curVal & "%", -1, udtRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE If curVal > 100 Then curVal = 100 End If '-- 反転モード SetROP2 hdc, R2_NOTXORPEN '-- 値に応じたバーの塗りつぶし hBrush = CreateSolidBrush(clrForeColor) hOldBrush = SelectObject(hdc, hBrush) Rectangle hdc, _ udtRect.Left, _ udtRect.Top, _ udtRect.Left + Fix((udtRect.Right - udtRect.Left) * curVal / 100), _ udtRect.Bottom DeleteObject SelectObject(hdc, hOldBrush) DeleteObject SelectObject(hdc, hOldPen) '-- 枠線の描画 SetROP2 hdc, R2_COPYPEN hBrush = GetStockObject(NULL_BRUSH) hOldBrush = SelectObject(hdc, hBrush) hPen = GetStockObject(BLACK_PEN) hOldPen = SelectObject(hdc, hPen) Rectangle hdc, _ udtRect.Left, _ udtRect.Top, _ udtRect.Right, _ udtRect.Bottom Call SelectObject(hdc, hOldBrush) Call SelectObject(hdc, hOldPen) '-- 最後にテキストカラーを描画前の色に戻す SetTextColor hdc, lngOldColor End Sub DrawGraphの中でhdc(表画面？)に逐一書き込んでいるのがちらつきの原因なんでしょうかね？サイト巡りをしてみたところ、CreateCompatibleDCなんかを使って裏画面みたいなものをつくって、それを一気に表画面に転送すればちらつきを抑えられる見たいな事がよく書かれているのですが・・・実際にどういう風にやればいいかわかりません。 それともますおさんがおっしゃるみたいにカスタムドローではちらつきは抑えられないのでしょうか？