[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ビットマップオブジェクトをDeleteObjectしなかったらどうなるのでしょう?』(中途B)
スクリーンキャプチャを題材にAPIの勉強をしています。
すべてUserformモジュールの中で行っている事なのですが、 CreateCompatibleBitmapや、CreateDIBSectionでビットマップオブジェクトを作成する処理を ループの中で繰り返し行っており、 それをDeleteObjectし忘れてた事に、後になって気付きました。
ただ、この状態でもUserform自体は目的の動作をしてくれており、何ら問題ない様に見えます。
「用が済んだら消しておく」という類の処理であろうとは推測しているのですが、 消さなかったらどうなる(どの様な不都合が生ずる)のか? とか、あまり理解出来ていません。 (そもそもAPI自体まだよく解ってません)
そう言えばVBAの中でも、 オブジェクト型変数にNothingを入れてから処理を終わる という書き方をしているコード例も多く見かけますが、あれと似た様な理由なのかな? (これについては当掲示板でも議論されているのを拝見しました [[20041124212113]]とか[[20090303232447]]とか)
でもこれはAPIの話なので、また違ってくる(もっと深刻なのでは? って)気もします。 何か見えない部分で不都合が起こっているのでしょうか?
< 使用 Excel:Excel2010、使用 OS:Windows7 >
試しにタスクマネージャーでメモリを見ながらループを回してみては如何でしょうか。
たぶんExcelを終了させても完全には開放されない部分が残るのではないかと。
あとbmpファイルを操作している場合、ファイルがロックされて開放できなくなるという問題が起きたような気がします。
(_) 2019/03/15(金) 17:00
_さん、ありがとうございます。
>メモリリーク をキーワードに自分でも少し調べてみましたが、 解放し忘れたら、やがてオブジェクト生成の上限に達し、新たなオブジェクトの生成に失敗する みたいな事が書いてありました。 なるほど、それはマズいですね。
>試しにタスクマネージャーでメモリを見ながらループを回してみては やってみました。 Excelプロセスのワーキングセット値の変化を追ってみたのですが、 何だか、微妙です。 増えたり減ったりして、あまり目立った変化には見えないです。 (でも、それはそれでおかしいですよね...)
>bmpファイルを操作している場合、ファイルがロックされて なるほど。今回ファイル操作はしてないのですが、そっち方面の事象もある訳ですね。
ループ中のメモリについては、 ちょっと何パターンか試してみて、また報告します。
(中途B) 2019/03/15(金) 19:54
何となく分かった(気になってるだけかも知れませんが)のでご報告に参りました。 結論的にはやはり、_さんの仰る通り、ループ中のメモリは増加の一途でした。
で、なぜ先程試してみた時にはその様に見えなかったのか、ですが、 まず、今回使用しているUserformモジュール貼りますね。 何せ勉強用モジュールなので落書だらけですが^^; (ついでに突っ込み所があれば指摘して頂きたいですねぇ^^;)
本件に関する着目点はコード内に「★」印でコメントしてある箇所です。 ***************************************************************************************************************
Option Explicit Rem API宣言------------------------------------------------------------------------------------------------- Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long Private Type POINTAPI x As Long Y As Long End Type Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hDC As LongPtr, ByVal x As Long, ByVal Y As Long) As Long Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long) Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As LongPtr) As LongPtr Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As LongPtr Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hDC As LongPtr) As Long Private Declare PtrSafe Function BitBlt Lib "gdi32" ( _ ByVal hdcDest As LongPtr, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, _ ByVal hDCSrc As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, _ ByVal dwRop As Long) As Long Private Declare PtrSafe Function StretchBlt Lib "gdi32" ( _ ByVal hdcDest As LongPtr, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, _ ByVal hDCSrc As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _ ByVal dwRop As Long) As Long Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As Long Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER End Type Private Declare PtrSafe Function CreateDIBSection Lib "gdi32" ( _ ByVal hDC As LongPtr, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As LongPtr, _ ByVal handle As LongPtr, ByVal dw As Long) As LongPtr Private Declare PtrSafe Function GetDIBits Lib "gdi32" ( _ ByVal aHDC As LongPtr, ByVal hBitmap As LongPtr, ByVal nStartScan As Long, ByVal nNumScans As Long, _ lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Const DIB_RGB_COLORS = 0& Private Const vbPicTypeBitmap As Long = 1 Private Const vbSrcCopy As Long = &HCC0020 Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Rem モジュールレベル変数------------------------------------------------------------------------------------ Private LoopFlg As Boolean, PickedFlg As Boolean Private WithEvents ButtonGetPx As MSForms.ToggleButton Private WithEvents ButtonOK As MSForms.CommandButton Private Label1 As MSForms.Label Private Label2 As MSForms.Label Private Image1 As MSForms.Image Private LabelCur As MSForms.Label Rem メソッド------------------------------------------------------------------------------------------------ Public Function GetPixelRGB(ResRGB As Long) As Boolean ButtonOK.Visible = True Me.Show 1 If IsPicked Then ResRGB = Me.BackColor GetPixelRGB = True End If Unload Me End Function Rem プロパティ(主にオートメーションエラー回避)-------------------------------------------------------------- Private Property Get IsRunning() As Boolean IsRunning = LoopFlg End Property Private Property Let IsRunning(newBool As Boolean) If newBool = LoopFlg Then Exit Property LoopFlg = newBool If LoopFlg Then Me.Caption = "実行中([Enter]で取得。[Esc]で中止)" IsPicked = False Else Me.Caption = "待機中(スポイトボタンから実行)" ButtonGetPx.Value = False End If End Property Private Property Get IsPicked() As Boolean IsPicked = PickedFlg End Property Private Property Let IsPicked(newBool As Boolean) If newBool = PickedFlg Then Exit Property PickedFlg = newBool If PickedFlg Then ButtonOK.Enabled = True Else ButtonOK.Enabled = False End If End Property Rem 内部イベント処理---------------------------------------------------------------------------------------- Private Sub ButtonGetPx_Click() If ButtonGetPx.Value Then Call Capture Else IsRunning = False End If End Sub Private Sub ButtonOK_Click() Me.Hide End Sub Private Sub UserForm_Initialize() Set ButtonGetPx = Me.Controls.Add("Forms.ToggleButton.1", "ButtonGetPx") With ButtonGetPx .Top = 3: .Left = 6: .Width = 21: .Height = 21 .PicturePosition = fmPicturePositionCenter .Picture = Application.CommandBars.GetImageMso("PickUpStyle", 16, 16) .TabStop = False End With Set Label1 = Me.Controls.Add("Forms.Label.1", "Label1") With Label1 .Top = 3: .Left = 30: .Width = 96: .Height = 12 .BackStyle = fmBackStyleTransparent .SpecialEffect = fmSpecialEffectSunken .Caption = "座標:" End With Set Label2 = Me.Controls.Add("Forms.Label.1", "Label2") With Label2 .Top = 15: .Left = 30: .Width = 96: .Height = 12 .BackStyle = fmBackStyleTransparent .SpecialEffect = fmSpecialEffectSunken .Caption = "RGB:" End With With Me.Controls.Add("Forms.Label.1", "Label3") .Top = 27: .Left = 6: .Width = 96 + 24: .Height = 24 .BackStyle = fmBackStyleTransparent .Caption = "[Ctrl] 3x3ピクセル平均色" & vbCrLf & "[Shift] 拡大図を更新しない" End With Set Image1 = Me.Controls.Add("Forms.Image.1", "Image1") With Image1 .Top = 3.75: .Left = 127.5: .Width = 31.5: .Height = 31.5 .SpecialEffect = fmSpecialEffectBump ' .PictureSizeMode = fmPictureSizeModeStretch End With Set LabelCur = Me.Controls.Add("Forms.Label.1", "LabelCur") With LabelCur .Top = Image1.Top + 15.75 - 1.5 - 0.75: .Left = Image1.Left + 15.75 - 1.5 - 0.75: .Width = 4.5: .Height = 4.5 .BackStyle = fmBackStyleTransparent .BorderStyle = fmBorderStyleSingle End With Dim r As Long, c As Long For r = 1 To 9 For c = 1 To 9 With Me.Controls.Add("Forms.Label.1", "LabelR" & r & "C" & c) .Top = 3 + (r - 1) * 4.5: .Left = 160.5 + (c - 1) * 4.5: .Width = 5.25: .Height = 5.25 .BorderStyle = fmBorderStyleSingle End With Next Next Set ButtonOK = Me.Controls.Add("Forms.CommandButton.1", "ButtonOK") With ButtonOK .Top = 21: .Left = 204: .Width = 30: .Height = 21 .Caption = "OK" .TakeFocusOnClick = False .TabStop = False .Enabled = False .Visible = False End With Me.Caption = "待機中(スポイトボタンから実行)" Me.Width = 240 Me.Height = 67.5 End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) IsRunning = False If Not Image1.Picture Is Nothing Then Call DeleteObject(Image1.Picture.handle) '★(3):最後のBMPの削除 End Sub Rem 内部処理関数-------------------------------------------------------------------------------------------- Private Sub Capture() Dim hDC As LongPtr, pt As POINTAPI, ptMax As POINTAPI Dim c As Long, lState As Integer Dim r As Long, RGBs() As Variant Dim hPicOld As LongPtr '★(0):前回のhBmp記録用変数 ptMax.x = GetSystemMetrics(SM_CXSCREEN) - 1 ptMax.Y = GetSystemMetrics(SM_CYSCREEN) - 1 IsRunning = True Application.EnableCancelKey = xlDisabled hDC = GetDC(0) Do While IsRunning Call GetCursorPos(pt) If GetAsyncKeyState(vbKeyControl) Then 'Ctrl押下中は3ピクセル四方平均色 RGBs = GetRGBsByhWnd(0&, _ pt.x - IIf(pt.x <= 0, 0, 1), pt.Y - IIf(pt.Y <= 0, 0, 1), _ pt.x + IIf(pt.x >= ptMax.x, 0, 1), pt.Y + IIf(pt.Y >= ptMax.Y, 0, 1)) c = AvgRGB(RGBs) Else c = GetPixel(hDC, pt.x, pt.Y) '←連続で呼び出すと意外に遅い。 ' c = GetRGBsByhWnd(0&, pt.x, pt.Y, 1, 1)(1, 1) '←まだこっちのが速いくらい End If Rem プレビュー的な部分----------------------------------------------------------+ Me.BackColor = c Label1.ForeColor = IIf(GetYfromRGB(c) < 0.5!, &HFFFFFF, &H0&) Label2.ForeColor = Label1.ForeColor Me.Controls("Label3").ForeColor = Label1.ForeColor Label1.Caption = "座標: X= " & pt.x & " Y= " & pt.Y Label2.Caption = "RGB: " & Join(SplitRGB(c), ", ") If GetAsyncKeyState(vbKeyShift) = 0& Then 'Shift押下中は拡大図の描画を更新しない Rem 実験1: 周囲9ピクセル四方をキャプチャしてImageコントロールにPictureとして渡す If Not Image1.Picture Is Nothing Then hPicOld = Image1.Picture.handle '★(1):前回のhBmp覚えといて Set Image1.Picture = CreatePictureByhWnd(0&, pt.x - 4, pt.Y - 4, 9, 9, 4) ' 新しいBMPに置き換えてから If hPicOld Then Debug.Print DeleteObject(hPicOld), "★" '★(2):前回のBMPを削除 ←失敗する LabelCur.BorderColor = Label1.ForeColor Rem 実験2: 同じく周囲9ピクセル四方のRGB値の配列を取得し、対応するラベルを塗る RGBs = GetRGBsByhWnd(0&, pt.x - 4, pt.Y - 4, pt.x + 4, pt.Y + 4) For r = 1 To 9 For c = 1 To 9 Me.Controls("LabelR" & r & "C" & c).BackColor = RGBs(r, c) Next Next End If Rem ----------------------------------------------------------------------------+ DoEvents Sleep 50 lState = GetAsyncKeyState(vbKeyReturn) '上位ビット(&H8000&)が今回:下位ビット(&H1&)が前回以降の状態 If lState Then IsPicked = True IsRunning = False '今回または前回以降押されてれば止める(上位ビットだけで判定しない) ElseIf GetAsyncKeyState(vbKeyEscape) Then IsRunning = False 'Escキーで中止(lStateはゼロのままループを抜ける) End If Loop Call ReleaseDC(0, hDC) Application.EnableCancelKey = xlInterrupt End Sub Private Function SplitRGB(aRGB As Long, Optional Percentage As Boolean) As Variant Rem RGB値をR,G,Bの各要素の配列に変換 Dim i As Long, Ary(0 To 2) As Variant For i = 0 To 2 Ary(i) = (aRGB \ &H100& ^ i) Mod &H100& If Percentage Then Ary(i) = CSng(Ary(i) / &HFF&) Next SplitRGB = Ary End Function Private Function GetYfromRGB(aRGB As Long) As Single Rem RGB値から輝度(0以上1以下の数値)を算出 (HSLカラーモデルとの混同を避ける為「Y」で表現) Const prmR = 0.298912!, prmG = 0.586611!, prmB = 0.114478! Dim vRGB() As Variant vRGB = SplitRGB(aRGB) GetYfromRGB = vRGB(0) * prmR + vRGB(1) * prmG + vRGB(2) * prmB GetYfromRGB = GetYfromRGB / &HFF& If GetYfromRGB > 1! Then GetYfromRGB = 1! If GetYfromRGB < 0! Then GetYfromRGB = 0! End Function
Private Function CreatePictureByhBmp(ByVal hBmp As LongPtr) As IPictureDisp Rem ビットマップハンドルからIPictureを作る Dim IID_IDispatch As GUID, Bmp As PicBmp, IPic As IPicture With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With With Bmp .Size = Len(Bmp) .Type = vbPicTypeBitmap .hBmp = hBmp End With Call OleCreatePictureIndirect(Bmp, IID_IDispatch, 1, IPic) Set CreatePictureByhBmp = IPic End Function Private Function CreatePictureByhWnd(ByVal hWndSrc As LongPtr, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, Optional ByVal Zoom As Single = 1!) As IPictureDisp Rem ウインドウハンドルからIPictureを作る(Zoom:縮尺指定(但しアスペクト比変更には非対応)) If Zoom <= 0 Then Zoom = 1! Dim Rtn As LongPtr Dim hDCSrc As LongPtr, hDCMemory As LongPtr Dim hBmp As LongPtr, hBmpPrev As LongPtr hDCSrc = GetWindowDC(hWndSrc) hDCMemory = CreateCompatibleDC(hDCSrc) hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc * Zoom, HeightSrc * Zoom) hBmpPrev = SelectObject(hDCMemory, hBmp) Rtn = StretchBlt(hDCMemory, 0, 0, WidthSrc * Zoom, HeightSrc * Zoom, hDCSrc, LeftSrc, TopSrc, WidthSrc, HeightSrc, vbSrcCopy) hBmp = SelectObject(hDCMemory, hBmpPrev) Call DeleteDC(hDCMemory) Call ReleaseDC(hWndSrc, hDCSrc) If Rtn Then Set CreatePictureByhWnd = CreatePictureByhBmp(hBmp) ' Call DeleteObject(hBmp) 'ココでビットマップオブジェクトを破棄してしまったら絵が消えてしまう。どうしよ... End Function Private Function GetRGBsByhWnd(ByVal hWndSrc As LongPtr, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal RightSrc As Long, ByVal BottomSrc As Long) As Variant Rem ウインドウハンドルから各ピクセルのRGB値を2次元配列で返す Dim WidthSrc As Long, HeightSrc As Long Dim Rtn As LongPtr Dim hDCSrc As LongPtr, hDCMemory As LongPtr Dim hBmp As LongPtr, hBmpPrev As LongPtr Dim bi As BITMAPINFO Dim RGBBuff() As Byte, r As Long, c As Long, vRGB() As Variant WidthSrc = RightSrc - LeftSrc + 1 HeightSrc = BottomSrc - TopSrc + 1 hDCSrc = GetWindowDC(hWndSrc) hDCMemory = CreateCompatibleDC(hDCSrc) With bi.bmiHeader .biSize = Len(bi.bmiHeader) .biWidth = WidthSrc .biHeight = -HeightSrc 'トップダウン走査 .biPlanes = 1 ' .biBitCount = 24 '1pxあたり[BB][GG][RR]の3バイト。(だけど1行あたり4バイトの倍数にサイズ補正が必要。余剰部分が各行の末尾に残るので、後で配列をちょん切る必要がある) ' .biSizeImage = -Int(-(WidthSrc * 3) / 4) * 4 * HeightSrc 'って事でサイズ補正(なんか自動で補正入るっぽいけど)やっぱ32bitのが楽なのかもな・・・ .biBitCount = 32 '1pxあたり[BB][GG][RR][&HFF]の4バイト。(かと言ってLong配列で受け取ったらバイトオーダー逆転してる。そのままHTMLカラーコードに使っちゃうには良いかも?) .biSizeImage = WidthSrc * 4 * HeightSrc '必ず1行あたり4バイトの倍数になるのでサイズ補正不要 End With hBmp = CreateDIBSection(hDCSrc, bi, DIB_RGB_COLORS, 0&, 0&, 0&) hBmpPrev = SelectObject(hDCMemory, hBmp) Rtn = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy) If Rtn Then ' ReDim RGBBuff(1 To -Int(-(WidthSrc * 3) / 4) * 4, 1 To HeightSrc) ReDim RGBBuff(1 To WidthSrc * 4, 1 To HeightSrc) Rtn = GetDIBits(hDCMemory, hBmp, 0&, HeightSrc, RGBBuff(1, 1), bi, DIB_RGB_COLORS) End If hBmp = SelectObject(hDCMemory, hBmpPrev) Debug.Print DeleteObject(hBmp), "◆" 'コメントアウトするとメモリが食い潰されていく Call DeleteDC(hDCMemory) Call ReleaseDC(hWndSrc, hDCSrc) If Rtn = 0 Then Exit Function ReDim vRGB(1 To HeightSrc, 1 To WidthSrc) For r = 1 To HeightSrc For c = 1 To WidthSrc ' vRGB(r, c) = RGBBuff(c * 3, r) + RGBBuff(c * 3 - 1, r) * &H100& + RGBBuff(c * 3 - 2, r) * &H100& ^ 2 vRGB(r, c) = RGBBuff(c * 4 - 1, r) + RGBBuff(c * 4 - 2, r) * &H100& + RGBBuff(c * 4 - 3, r) * &H100& ^ 2 Next Next GetRGBsByhWnd = vRGB End Function Private Function AvgRGB(AryRGB() As Variant) As Long Rem RGB値の配列から単純平均RGB値を算出 Dim i As Variant, vRGB() As Variant Dim Cnt As Long, Avg(0 To 2) As Variant, j As Long For Each i In AryRGB Cnt = Cnt + 1 vRGB = SplitRGB(CLng(i)) For j = 0 To 2 Avg(j) = Avg(j) + vRGB(j) Next Next For j = 0 To 2 Avg(j) = Avg(j) \ Cnt Next AvgRGB = Avg(0) + Avg(1) * &H100& + Avg(2) * &H100& ^ 2 End Function Rem 標準モジュールでの使用例 =================================== 'Sub ColorPicker_test() ' Dim c As Long ' If UserForm1.GetPixelRGB(c) Then MsgBox "&H" & Hex(c) & "&" 'End Sub Rem ============================================================
***************************************************************************************************************
★印の部分((0)から(3)までの4ヵ所)が、DeleteObjectし忘れてた事に気付いて追記した部分なのですが、 ★(2)のDeleteObjectは戻値ゼロで失敗してしまいます。
If Not Image1.Picture Is Nothing Then hPicOld = Image1.Picture.handle '★(1):前回のhBmp覚えといて Set Image1.Picture = CreatePictureByhWnd(0&, pt.x - 4, pt.Y - 4, 9, 9, 4) ' 新しいBMPに置き換えてから If hPicOld Then Debug.Print DeleteObject(hPicOld), "★" '★(2):前回のBMPを削除 ←失敗する
試しに Set Image1.Picture・・・ の行の手前でDeleteObjectしてみたら、こちらは成功しました。
If hPicOld Then Debug.Print DeleteObject(hPicOld), "★" '★(2):前回のBMPを削除して ←成功する Set Image1.Picture = CreatePictureByhWnd(0&, pt.x - 4, pt.Y - 4, 9, 9, 4) ' 新しいBMPに置き換える
ここにDeleteObjectがなくてもタスクマネージャーでメモリの増加傾向が見えなかった事と併せると、 どうやらImage1に新しいPictureがSetされたことにより、 前回のビットマップオブジェクトは自動的にメモリから削除されたのではないか? と想像してます。
対して、GetRGBsByhWnd内にある◆印付きのDeleteObjectは、 試しにこれをコメントアウトすると、_さんの仰る通り、ループ中のメモリは少しずつ増加していきました。 こちらのビットマップはこの関数内でしか使われないので、関数内で削除しない限り解放されないハズ。 こっちには元々DeleteObject入れてあったので、気付くのが遅くなってしまいました。
上記の想像が正しいとすれば、このモジュールについては★印部分の記述は不要ですね。
という感じで、 勝手に解釈して落ち着いております。
(中途B) 2019/03/15(金) 22:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.