自分の作成したメインウインドウの描画スピード
の違いについて教えてください。
プロンプトウィンドウとメインウインドウにそれぞれ
同様にラインでテストパターン(渦巻き)を描いていくプログラムを
作ったのですが、実行時にプロンプトウインドウが
メインウインドウより前面にあるときと、その逆に
メインがプロンプトより前面にあるときで
描画速度にかなりの差が見られます。
(プログラムソースは一番下に)
プロンプトが前面にあるときは描画スピードは
速く、メインを前に持ってきたときはその半分以下くらいに
描画スピードがガクっと遅くなります。
色々チェックをしてみたところ、メインウインドウのペイント・イベント
の「BitBlt命令」がその速度の違いの元になっているように思えました。
(ここをRem文にすると速度に変化は無くなりました)
コード: 全て選択
'
'●ペイント・イベント
'
Sub MainWnd_Paint(hDC As HDC)
BitBlt(hDC,0,0,clientRc.right,clientRc.bottom,hMemDC,0,0,SRCCOPY)
End Sub
どうしてなのか理由が分かりません。
もしか自分のプログラムにどこか不正なところが
あるのではないかと思っているのですが。
原因をお知りの方がおられましたら、是非教えてください。
AB version 4.24
(OS)Windows Me
※下のプログラムを実行するとデバッグ実行時に
警告がズラズラと出てきます。
一つのグループはx,y座標などの値をDoubleで計算し
画面表示のためLong型の変数に無理やり代入した時に
検出されるもの。
もう一つのグループはどうも「prompt.sys」の内部で
起こっている現象のようで(ハンドル類をLongで定義している
といった種類のもの)、いずれも自分では
これらの警告を取ることは出来ませんでした。
ただし、そのままでも実行そのものには影響は無いように
思います。
プロジェクト名「UzumakiTest424」で製作。
ここにソースが表示されます [ここをクリックすると内容が表示されます]
コード: 全て選択
'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
#prompt
Declare Function AdjustWindowRectEx Lib "user32" Alias "AdjustWindowRectEx" (ByRef lpRect As RECT, ByVal dsStyle As Long, ByVal bMenu As Long, ByVal dwEsStyle As Long) As Long
Dim windowRc As RECT 'ウインドウの大きさ
Dim clientRc As RECT 'クライアントエリアの大きさ
Dim hMemDC As HDC 'メモリ・ビットマップのDCハンドル
Dim hMemBmp As HBITMAP 'メモリ・ビットマップハンドル
Dim hThread1 As HANDLE 'スレッド1のハンドル
Dim thread1_ID As DWord 'スレッド1のID
Dim bkColor As DWord '背景色
Dim penColor As DWord 'ペン描画色
Dim brushColor As DWord 'ブラシ描画色
Dim rc As RECT 'GDI命令汎用
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy()
DeleteDC(hMemDC)
DeleteObject(hMemBmp)
UzumakiTest424_DestroyObjects()
PostQuitMessage(0)
End Sub
'
' ●クリエイト・イベント
'
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
'メインウインドウのリサイズ
ResizeMainWindow()
' メモリ・ビットマップの作成
CreateMemBitMaps()
'メイン・メモリBmpのクリア
ClearMemBmp()
' 背景色の設定
SetBackColor()
'スレッドの定義
hThread1=CreateThread(ByVal 0,0,AddressOf(MainOperation),0,0,VarPtr(thread1_ID))
End Sub
'
'●スレッド1
'
Sub MainOperation(dwDummy As DWord)
Dim pi As Double '円周率
Dim xo As Long, yo As Long '渦巻き中心座標
Dim x As Long, y As Long '描画地点(中心からの相対座標)
Dim div As Long '円周の分割数
Dim r As Double '渦巻き円の半径初期値
Dim o As Double 'Sin,Cos用の角度セット用
Dim i As Long 'ループカウンタ
penColor=RGB(255,255,0)
pi=3.1415926535898
xo=clientRc.right\2 'スクリーン中心座標を
yo=clientRc.bottom\2 ' 渦巻き中心座標としてセット
div=256
r=240
'最初の描画地点にカレントポジションを移動
x=r+xo
y=yo
Pset(x,y),6
rc.left=x
rc.top=y
'------- ↓これより描画ループ -------
For i=1 To div*32 ' 32周渦巻きを描画
'描画位置の計算
o=2*pi*(i mod div)/div
x=r*Cos(o)+xo
y=r*Sin(o)+yo
'プロンプトウインドウに描画
Line -(x,y),6
'MainWndに描画
rc.right=x
rc.bottom=y
DrawLine(hMemDC)
InvalidateRect(hMainWnd, ByVal 0,0)
Sleep(1)
rc.left=rc.right
rc.top=rc.bottom
'半径を序々に小さくする
r=r-0.02
Next i
'------- 描画ループ終わり -------
End Sub
'
'●ペイント・イベント
'
Sub MainWnd_Paint(hDC As HDC)
BitBlt(hDC,0,0,clientRc.right,clientRc.bottom,hMemDC,0,0,SRCCOPY)
End Sub
'
'●リサイズ・メインウインドウ
'
Sub ResizeMainWindow()
GetClientRect(_PromptSys_hWnd,clientRc)
windowRc.left=clientRc.left
windowRc.top=clientRc.top
windowRc.right=clientRc.right
windowRc.bottom=clientRc.bottom
AdjustWindowRectEx(windowRc, GetWindowLong(hMainWnd, GWL_STYLE), FALSE, GetWindowLong(hMainWnd, GWL_EXSTYLE))
MoveWindow(hMainWnd, windowRc.left+100, windowRc.top+100, windowRc.right-windowRc.left, windowRc.bottom-windowRc.top, TRUE)
End Sub
'
' ●メモリ・ビットマップの作成
'
Sub CreateMemBitMaps()
Dim hDC As HDC
hDC=GetDC(hMainWnd)
' メインのメモリ・ビットマップ作成
hMemDC=CreateCompatibleDC(hDC)
hMemBmp=CreateCompatibleBitmap(hDC, clientRc.right, clientRc.bottom)
SelectObject(hMemDC,hMemBmp)
ReleaseDC(hMainWnd,hDC)
End Sub
'
' ●メイン・メモリBmpのクリア
'
Sub ClearMemBmp()
Dim hBrush As HBRUSH
Dim hOldBrush As HBRUSH
brushColor=bkColor
rc.left=clientRc.left
rc.top=clientRc.top
rc.right=clientRc.right
rc.bottom=clientRc.bottom
DrawBoxFill(hMemDC)
End Sub
'
' ●背景色の設定
'
Sub SetBackColor()
Dim hBrush As HBRUSH
Dim hOldBrush As HBRUSH
' 背景色の設定
bkColor=RGB(0,0,0)
SetBkMode(hMemDC,OPAQUE)
SetBkColor(hMemDC,bkColor)
End Sub
'
' ●ライン描画(MoveToEx & LineTo)
'
Sub DrawLine(ByVal hDC As HDC)
Dim hPen As HPEN
Dim hOldPen As HPEN
hPen= CreatePen(PS_SOLID,0,penColor)
hOldPen=SelectObject(hDC,hPen)
MoveToEx(hDC,rc.left,rc.top,ByVal NULL)
LineTo(hDC,rc.right,rc.bottom)
SelectObject(hDC,hOldPen)
DeleteObject(hPen)
End Sub
'
' ●四角塗りつぶし(FillRect)
'
Sub DrawBoxFill(ByVal hDC As HDC)
Dim hBrush As HBRUSH
Dim hOldBrush As HBRUSH
hBrush=CreateSolidBrush(brushColor)
hOldBrush=SelectObject(hDC,hBrush)
FillRect(hDC,rc,hBrush)
SelectObject(hDC,hOldBrush)
DeleteObject(hBrush)
End Sub