CreateFont를 사용한 문자열 표시 각도 변환(메모리 사용후 대상 DC에 복사)

이번에는 CreateFont를 사용하는것은 똑같은대
저번 예와 같은효과이다. 그러나 이전 예에서는 직접 대상 DC에 문자열을 표시하였다.
이번에는 대상 DC와 호완 대는 메모리 DC를 생성하고 여기에 비트맵을 생성하여 연결한후
메모리 DC에 문자열을 출력한후
(메모리 DC와 비트맵이 연결되 있으므로 DC에 출력하게되면 비트맵에 출력되게 된다)
메모리 DC에 내용을 대상 DC에 복한 예이다.

다음 결과 이미지로, 이전 예와 같다.

다음은 소스이다.

' 문자열의 각도를 달리하어 똑같은 문자열을 여러개 표시, 직접 표시하지 않고 메모리 DC에 문자를 표시한 이미지를 대상 DC에 복사
Option Explicit

Private Const FW_NORMAL = 400
Private Const DEFAULT_CHARSET = 1
Private Const OUT_DEFAULT_PRECIS = 0
Private Const CLIP_DEFAULT_PRECIS = 0
Private Const PROOF_QUALITY = 2
Private Const DEFAULT_PITCH = 0
Private Const TRANSPARENT = 1
Private Const Message = "테스트"
Private Const LOGPIXELSY = 90
Private Const COLOR_WINDOW = 5

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private mDC As Long, mBitmap As Long ' 화완 DC(메모리 DC)

Private Sub Form_Load()
    Dim Angle As Long ' 각도
    Dim R As RECT ' 사격형
   
    With Picture1
        mDC = CreateCompatibleDC(.hdc)
        mBitmap = CreateCompatibleBitmap(.hdc, .Width / Screen.TwipsPerPixelX, .Height / Screen.TwipsPerPixelY)
        SelectObject mDC, mBitmap ' DC와 비트맵 연결
        SetBkMode mDC, TRANSPARENT ' 배경색을 투명으로
        SetRect R, 0, 0, Picture1.Width / Screen.TwipsPerPixelX, Picture1.Height / Screen.TwipsPerPixelY ' 사각형 좌표
        FillRect mDC, R, GetSysColorBrush(COLOR_WINDOW) ' DC를 시스템 색으로 채운다.
   
        For Angle = 0 To 350 Step 30 ' 메모리 DC에 글자를 출력한다.
            DeleteObject SelectObject(mDC, CreateMyFont(24, Angle)) ' 논리 폰트 생성
            TextOut mDC, (Picture1.Width / Screen.TwipsPerPixelX) / 2, (Picture1.Height / Screen.TwipsPerPixelY) / 2, Message, LenB(Message) ' 글자 출력
        Next Angle
    End With
End Sub

Private Function CreateMyFont(nSize As Integer, nDegrees As Long) As Long ' 논리 폰트 생성
    CreateMyFont = CreateFont(-MulDiv(nSize, GetDeviceCaps(Picture1.hdc, LOGPIXELSY), 72), 0, nDegrees * 10, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Times New Roman")
End Function

Private Sub Form_Paint() ' 폼을 그릴때 픽처 박스에 메모리 DC의 이미지를 복사
    BitBlt Picture1.hdc, 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, mDC, 0, 0, vbSrcCopy
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DeleteObject mBitmap
End Sub