Skip to content

Commit 0567c7e

Browse files
author
47_TT
committed
BitBltの不具合を修正
1 parent 113f401 commit 0567c7e

File tree

7 files changed

+67
-64
lines changed

7 files changed

+67
-64
lines changed

frmWindowAbout.Designer.vb

Lines changed: 2 additions & 2 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

frmWindowAbout.vb

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,8 @@ Option Strict Off
22
Option Explicit On
33
Friend Class frmWindowAbout
44
Inherits System.Windows.Forms.Form
5-
6-
Private m_sngRaster() As Single
5+
6+
Private m_sngRaster() As Single
77
Private m_lngCounter As Integer
88

99
Private Sub PrintText(ByVal hDC As IntPtr, ByRef Text_Renamed As String, ByVal X As Integer, ByVal Y As Integer)
@@ -126,16 +126,18 @@ Friend Class frmWindowAbout
126126
Dim sngTemp As Single
127127

128128
With Me
129-
Dim picMain_gp As Graphics = picMain.CreateGraphics()
130-
Dim picMain_hDC As IntPtr = picMain_gp.GetHdc()
131-
132129
Call eventArgs.Graphics.Clear(.BackColor)
133130

134131
Dim hDC As IntPtr = eventArgs.Graphics.GetHdc()
135132

136133
sngTemp = m_lngCounter / 10
137134
If sngTemp > 8 Then sngTemp = 8
138135

136+
Dim picMain_BitMap As Bitmap = New Bitmap(picMain.BackgroundImage)
137+
Dim hBitMap As IntPtr = picMain_BitMap.GetHbitmap
138+
Dim hMDC As IntPtr = CreateCompatibleDC(hDC)
139+
SelectObject(hMDC, hBitMap)
140+
139141
For i = 0 To .ClientRectangle.Height - 1
140142

141143
'm_sngRaster(i) = m_sngRaster(i) + Sin((i + m_lngCounter) * RAD * 8)
@@ -147,10 +149,15 @@ Friend Class frmWindowAbout
147149

148150
'Call StretchBlt(.hdc, lngTemp - .ScaleWidth, i, .ScaleWidth, 1, picMain.hdc, 0, i, .ScaleWidth, 1, SRCCOPY)
149151
'Call StretchBlt(.hdc, lngTemp, i, .ScaleWidth, 1, picMain.hdc, 0, i, .ScaleWidth, 1, SRCCOPY)
150-
Call BitBlt(hDC, lngTemp, i, .ClientRectangle.Width, 1, picMain_hDC, 0, i, SRCCOPY)
152+
153+
Call BitBlt(hDC, lngTemp, i, .ClientRectangle.Width, 1, hMDC, 0, i, SRCCOPY)
151154

152155
Next i
153156

157+
DeleteDC(hMDC)
158+
DeleteObject(hBitMap)
159+
picMain_BitMap.Dispose()
160+
154161
'Call BitBlt(.hWnd, 0, 0, .ScaleWidth, .ScaleHeight, picMain.hWnd, 0, 0, SRCCOPY)
155162

156163
lngTemp = 0
@@ -193,9 +200,6 @@ Friend Class frmWindowAbout
193200

194201
'Call PrintText(strTemp, 251, 174)
195202

196-
picMain_gp.ReleaseHdc()
197-
picMain_gp.Dispose()
198-
199203
eventArgs.Graphics.ReleaseHdc()
200204
End With
201205

frmWindowPreview.vb

Lines changed: 10 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -313,14 +313,16 @@ Err_Renamed:
313313
With picPreview
314314
Dim gp As Graphics = .CreateGraphics()
315315

316-
Dim picBackBuffer_gp As Graphics = picBackBuffer.CreateGraphics()
317-
Dim picBackBuffer_hDC As IntPtr = picBackBuffer_gp.GetHdc()
318-
319316
Call gp.Clear(.BackColor)
320317

321318
Dim hDC As IntPtr = gp.GetHdc()
322319

323-
Call BitBlt(hDC, (.ClientRectangle.Width \ 2 - 128) + Val(_txtBGAPara_5.Text) - Val(_txtBGAPara_1.Text), (.ClientRectangle.Height \ 2 - 128) + Val(_txtBGAPara_6.Text) - Val(_txtBGAPara_2.Text), picBackBuffer.ClientRectangle.Width, picBackBuffer.ClientRectangle.Height, picBackBuffer_hDC, 0, 0, SRCCOPY)
320+
Dim picBackBuffer_BitMap As Bitmap = New Bitmap(picBackBuffer.Image)
321+
Dim hBitMap As IntPtr = picBackBuffer_BitMap.GetHbitmap
322+
Dim hMDC As IntPtr = CreateCompatibleDC(hDC)
323+
324+
SelectObject(hMDC, hBitMap)
325+
Call BitBlt(hDC, (.ClientRectangle.Width \ 2 - 128) + Val(_txtBGAPara_5.Text) - Val(_txtBGAPara_1.Text), (.ClientRectangle.Height \ 2 - 128) + Val(_txtBGAPara_6.Text) - Val(_txtBGAPara_2.Text), picBackBuffer.ClientRectangle.Width, picBackBuffer.ClientRectangle.Height, hMDC, 0, 0, SRCCOPY)
324326

325327
If chkBGLine.CheckState Then
326328

@@ -341,14 +343,14 @@ Err_Renamed:
341343

342344
Call Rectangle(hDC, .ClientRectangle.Width \ 2 - 129, .ClientRectangle.Height \ 2 - 129, .ClientRectangle.Width \ 2 + 130, .ClientRectangle.Height \ 2 + 130)
343345

344-
Call BitBlt(hDC, (.ClientRectangle.Width \ 2 - 128) + Val(_txtBGAPara_5.Text), (.ClientRectangle.Height \ 2 - 128) + Val(_txtBGAPara_6.Text), lngNumField(Val(_txtBGAPara_3.Text) - Val(_txtBGAPara_1.Text), 0, 256), lngNumField(Val(_txtBGAPara_4.Text) - Val(_txtBGAPara_2.Text), 0, 256), picBackBuffer_hDC, Val(_txtBGAPara_1.Text), Val(_txtBGAPara_2.Text), SRCCOPY)
346+
Call BitBlt(hDC, (.ClientRectangle.Width \ 2 - 128) + Val(_txtBGAPara_5.Text), (.ClientRectangle.Height \ 2 - 128) + Val(_txtBGAPara_6.Text), lngNumField(Val(_txtBGAPara_3.Text) - Val(_txtBGAPara_1.Text), 0, 256), lngNumField(Val(_txtBGAPara_4.Text) - Val(_txtBGAPara_2.Text), 0, 256), hMDC, Val(_txtBGAPara_1.Text), Val(_txtBGAPara_2.Text), SRCCOPY)
345347

346-
picBackBuffer_gp.ReleaseHdc()
347-
picBackBuffer_gp.Dispose()
348+
DeleteDC(hMDC)
349+
DeleteObject(hBitMap)
350+
picBackBuffer_BitMap.Dispose()
348351

349352
gp.ReleaseHdc()
350353
gp.Dispose()
351-
352354
End With
353355

354356
End Sub

frmWindowTips.Designer.vb

Lines changed: 1 addition & 2 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

frmWindowTips.vb

Lines changed: 13 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ Imports System.Runtime.InteropServices
66
Friend Class frmWindowTips
77
Inherits System.Windows.Forms.Form
88
Private Declare Function DrawText Lib "user32" Alias "DrawTextW" (ByVal hdc As Integer, <MarshalAs(UnmanagedType.LPWStr)> ByVal lpStr As String, ByVal nCount As Integer, <[In]()> ByRef lpRect As RECT, ByVal wFormat As Integer) As Integer
9+
910
Private Const DT_WORDBREAK As Integer = &H10
1011

1112
Dim m_bFirstTips As Boolean
@@ -259,9 +260,6 @@ Friend Class frmWindowTips
259260
Private Sub frmWindowTips_Paint(sender As Object, e As PaintEventArgs) Handles MyBase.Paint
260261
Dim hDC As IntPtr
261262

262-
Dim picIcon_gp As Graphics = picIcon.CreateGraphics()
263-
Dim picIcon_hDC As IntPtr = picIcon_gp.GetHdc()
264-
265263
Dim stringFont As Font = Font
266264
Dim stringBrush As SolidBrush
267265

@@ -288,12 +286,6 @@ Friend Class frmWindowTips
288286

289287
stringFont = New Font(stringFont.FontFamily, 12, stringFont.Style, stringFont.Unit, stringFont.GdiCharSet, stringFont.GdiVerticalFont)
290288

291-
hDC = e.Graphics.GetHdc()
292-
293-
Call BitBlt(hDC, 16, 16, 32, 32, picIcon_hDC, 0, 32, SRCCOPY)
294-
295-
e.Graphics.ReleaseHdc()
296-
297289
If (Not m_bFirstTips) Then
298290
e.Graphics.FillRectangle(Brushes.White, New Rectangle(420, 24, 12, 10))
299291

@@ -302,12 +294,6 @@ Friend Class frmWindowTips
302294
e.Graphics.DrawString(VB.Right(" " & m_intTipsPos, 2), stringFont, stringBrush, New PointF(420, 23))
303295

304296
stringFont = New Font(stringFont.FontFamily, 12, stringFont.Style, stringFont.Unit, stringFont.GdiCharSet, stringFont.GdiVerticalFont)
305-
306-
hDC = e.Graphics.GetHdc()
307-
308-
Call BitBlt(hDC, 16, 16, 32, 32, picIcon_hDC, 0, 32, SRCCOPY)
309-
310-
e.Graphics.ReleaseHdc()
311297
End If
312298

313299
hDC = e.Graphics.GetHdc()
@@ -324,16 +310,26 @@ Friend Class frmWindowTips
324310

325311
End If
326312

313+
Dim picIcon_BitMap As Bitmap = New Bitmap(picIcon.Image)
314+
Dim hBitMap As IntPtr = picIcon_BitMap.GetHbitmap
315+
Dim hMDC As IntPtr = CreateCompatibleDC(hDC)
316+
327317
If m_lngTipsNum And 1 Then
328318

329-
Call BitBlt(hDC, 16, 16, 32, 32, picIcon_hDC, 0, 32, SRCCOPY)
319+
SelectObject(hMDC, hBitMap)
320+
Call BitBlt(hDC, 16, 16, 32, 32, hMDC, 0, 32, SRCCOPY)
330321

331322
Else
332323

333-
Call BitBlt(hDC, 16, 16, 32, 32, picIcon_hDC, 0, 0, SRCCOPY)
324+
SelectObject(hMDC, hBitMap)
325+
Call BitBlt(hDC, 16, 16, 32, 32, hMDC, 0, 0, SRCCOPY)
334326

335327
End If
336328

329+
DeleteDC(hMDC)
330+
DeleteObject(hBitMap)
331+
picIcon_BitMap.Dispose()
332+
337333
Call DrawText(hDC, strTemp, Len(strTemp), ddRect(63, 48, 462, 256), DT_WORDBREAK)
338334

339335
Else
@@ -344,9 +340,6 @@ Friend Class frmWindowTips
344340

345341
End If
346342

347-
picIcon_gp.ReleaseHdc()
348-
picIcon_gp.Dispose()
349-
350343
e.Graphics.ReleaseHdc()
351344
End Sub
352345
End Class

modDraw.vb

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,9 @@ Module modDraw
1717
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Integer, ByVal hObject As Integer) As Integer
1818
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Integer) As Integer
1919

20+
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As IntPtr) As IntPtr
21+
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As IntPtr) As Integer
22+
2023
Public Declare Function TextOut Lib "gdi32" Alias "TextOutW" (ByVal hdc As Integer, ByVal X As Integer, ByVal Y As Integer, <MarshalAs(UnmanagedType.LPWStr)> ByVal lpString As String, ByVal nCount As Integer) As Integer
2124
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Integer, ByVal crColor As Integer) As Integer
2225

modEasterEgg.vb

Lines changed: 25 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -468,9 +468,6 @@ Module modEasterEgg
468468
Dim gp As Graphics = frmMain.picMain.CreateGraphics()
469469
Dim hDC As IntPtr = gp.GetHdc()
470470

471-
Dim picSiromaru_gp As Graphics = frmMain.picSiromaru.CreateGraphics()
472-
Dim picSiromaru_hDC As IntPtr = picSiromaru_gp.GetHdc()
473-
474471
Width = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width
475472
Height = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height
476473

@@ -522,28 +519,37 @@ Module modEasterEgg
522519

523520
srcY = srcY * 32
524521

522+
Dim picSiromaru_BitMap As Bitmap = New Bitmap(frmMain.picSiromaru.Image)
523+
Dim hBitMap As IntPtr = picSiromaru_BitMap.GetHbitmap
524+
Dim hMDC As IntPtr = CreateCompatibleDC(hDC)
525+
SelectObject(hMDC, hBitMap)
526+
525527
'Call Ellipse(frmMain.picmain.hdc, X - 16, .y - 16, X + 16, .y + 16)
526-
Call BitBlt(hDC, X, Y, 32, 32, picSiromaru_hDC, 32, srcY, SRCAND)
527-
Call BitBlt(hDC, X, Y, 32, 32, picSiromaru_hDC, 0, srcY, SRCPAINT)
528+
Call BitBlt(hDC, X, Y, 32, 32, hMDC, 32, srcY, SRCAND)
529+
Call BitBlt(hDC, X, Y, 32, 32, hMDC, 0, srcY, SRCPAINT)
528530

529531
If Y + 32 > Height Then
530532

531533
intTemp = Y + 32 - Height
532534

533-
Call BitBlt(hDC, X, 0, 32, intTemp, picSiromaru_hDC, 32, srcY + 32 - intTemp, SRCAND)
534-
Call BitBlt(hDC, X, 0, 32, intTemp, picSiromaru_hDC, 0, srcY + 32 - intTemp, SRCPAINT)
535+
Call BitBlt(hDC, X, 0, 32, intTemp, hMDC, 32, srcY + 32 - intTemp, SRCAND)
536+
Call BitBlt(hDC, X, 0, 32, intTemp, hMDC, 0, srcY + 32 - intTemp, SRCPAINT)
535537

536538
End If
537539

538540
If X + 32 > Width Then
539541

540542
intTemp = X + 32 - Width
541543

542-
Call BitBlt(hDC, 0, Y, intTemp, 32, picSiromaru_hDC, 64 - intTemp, srcY, SRCAND)
543-
Call BitBlt(hDC, 0, Y, intTemp, 32, picSiromaru_hDC, 32 - intTemp, srcY, SRCPAINT)
544+
Call BitBlt(hDC, 0, Y, intTemp, 32, hMDC, 64 - intTemp, srcY, SRCAND)
545+
Call BitBlt(hDC, 0, Y, intTemp, 32, hMDC, 32 - intTemp, srcY, SRCPAINT)
544546

545547
End If
546548

549+
DeleteDC(hMDC)
550+
DeleteObject(hBitMap)
551+
picSiromaru_BitMap.Dispose()
552+
547553
End Select
548554

549555
'End If
@@ -554,9 +560,6 @@ Module modEasterEgg
554560

555561
'frmMain.cboDirectInput.Text = timeGetTime() - lngTemp
556562

557-
picSiromaru_gp.ReleaseHdc()
558-
picSiromaru_gp.Dispose()
559-
560563
gp.ReleaseHdc()
561564
gp.Dispose()
562565
Exit Sub
@@ -785,9 +788,6 @@ Module modEasterEgg
785788
Dim gp As Graphics = frmMain.picMain.CreateGraphics()
786789
Dim hDC As IntPtr = gp.GetHdc()
787790

788-
Dim picSiromaru_gp As Graphics = frmMain.picSiromaru.CreateGraphics()
789-
Dim picSiromaru_hDC As IntPtr = gp.GetHdc()
790-
791791
With frmMain.picMain
792792
Call SetTextColor(hDC, RGB(255, 255, 255))
793793
.Font = New Font(.Font.FontFamily, 12, .Font.Style, .Font.Unit, .Font.GdiCharSet, .Font.GdiVerticalFont)
@@ -840,9 +840,6 @@ Module modEasterEgg
840840
frmMain.tmrEffect.Enabled = False
841841
g_disp.intEffect = EASTEREGG.OFF
842842

843-
picSiromaru_gp.ReleaseHdc()
844-
picSiromaru_gp.Dispose()
845-
846843
gp.ReleaseHdc()
847844
gp.Dispose()
848845
Exit Sub
@@ -881,9 +878,17 @@ Module modEasterEgg
881878

882879
srcY = srcY * 32
883880

884-
Call BitBlt(hDC, X, Y, 32, 32, picSiromaru_hDC, 32, srcY, SRCAND)
885-
Call BitBlt(hDC, X, Y, 32, 32, picSiromaru_hDC, 0, srcY, SRCPAINT)
881+
Dim picSiromaru_BitMap As Bitmap = New Bitmap(frmMain.picSiromaru.Image)
882+
Dim hBitMap As IntPtr = picSiromaru_BitMap.GetHbitmap
883+
Dim hMDC As IntPtr = CreateCompatibleDC(hDC)
884+
SelectObject(hMDC, hBitMap)
886885

886+
Call BitBlt(hDC, X, Y, 32, 32, hMDC, 32, srcY, SRCAND)
887+
Call BitBlt(hDC, X, Y, 32, 32, hMDC, 0, srcY, SRCPAINT)
888+
889+
DeleteDC(hMDC)
890+
DeleteObject(hBitMap)
891+
picSiromaru_BitMap.Dispose()
887892
End If
888893

889894
lngTemp = lngTemp + sizeTemp.Height + 2
@@ -936,9 +941,6 @@ Module modEasterEgg
936941

937942
End With
938943

939-
picSiromaru_gp.ReleaseHdc()
940-
picSiromaru_gp.Dispose()
941-
942944
gp.ReleaseHdc()
943945
gp.Dispose()
944946
End Sub

0 commit comments

Comments
 (0)