Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
'/-----------------------------------
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" _
(lpLogFont As LOGFONT) As Long
Const LF_FACESIZE = 32
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
'/--------------------------------------
Private Declare Function SetTextAlign Lib "gdi32" _
(ByVal hdc As Long, ByVal wFlags As Long) As Long
Private Declare Function GetTextAlign Lib "gdi32" (ByVal hdc As Long) As Long
Const TA_LEFT = 0
Const TA_CENTER = 6
Const TA_RIGHT = 2
'/---------------------------------------------
Private Declare Function GetTextCharacterExtra Lib "gdi32" Alias "GetTextCharacterExtraA" _
(ByVal hdc 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 SetTextCharacterExtra Lib "gdi32" Alias "SetTextCharacterExtraA" _
(ByVal hdc As Long, ByVal nCharExtra As Long) As Long
Private Declare Function GetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc As Long, _
ByVal nCount As Long, ByVal lpFacename As String) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Sub cmdCreateFontIndirect_Click()
Dim LF As LOGFONT
Const FW_NORMAL = 400
Const OEM_CHARSET = 255
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_DONTCARE = 0
Picture1.Cls
'/DC 생성
nhDC = GetDC(Picture1.hwnd)
'/구조체 정의
With LF
.lfHeight = 20
.lfWidth = 0
.lfEscapement = 0
.lfOrientation = 0
.lfWeight = FW_NORMAL
.lfItalic = 0
.lfUnderline = 0
.lfStrikeOut = 0
.lfCharSet = OEM_CHARSET
.lfOutPrecision = OUT_DEFAULT_PRECIS
.lfClipPrecision = CLIP_DEFAULT_PRECIS
.lfQuality = DEFAULT_QUALITY
.lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE
End With
lstrcpy LF.lfFaceName, "굴림체"
'/논리 폰트를 생성한다.
hFont = CreateFontIndirect(LF)
'/생성된 폰트 선택
SelectObject nhDC, hFont
TextOut nhDC, 10, 10, "This is the Font!", 17
'/생성된 DC 삭제
ReleaseDC Picture1.hwnd, nhDC
End Sub
Private Sub cmdExit_Click()
End
End Sub
Private Sub cmdGetTextAlign_Click()
Dim nhDC As Long
Dim hAlign As Long
Picture2.Cls
'/DC 생성
nhDC = GetDC(Picture2.hwnd)
'/DC의 텍스트 정렬 설정
hAlign = GetTextAlign(nhDC)
If hAlign = TA_LEFT Then
TextOut nhDC, 40, 40, "Align : LEFT ", 12
ElseIf hAlign = TA_CENTER Then
TextOut nhDC, 40, 40, "Align : CENTER", 14
ElseIf hAlign = TA_RIGHT Then
TextOut nhDC, 40, 40, "Align : RIGHT", 13
End If
ReleaseDC Picture2.hwnd, nhDC
End Sub
Private Sub cmdSetTextAlign_Click()
Dim nhDC As Long
Const TA_TOP = 0
Const TA_BOTTOM = 8
'/ DC를 생성
nhDC = GetDC(Picture2.hwnd)
If cboAlign.ListIndex = -1 Then Exit Sub
If cboAlign.ListIndex = 0 Then
'/ 텍스트 정렬 방식 셋팅
SetTextAlign nhDC, TA_LEFT
ElseIf cboAlign.ListIndex = 1 Then
SetTextAlign nhDC, TA_CENTER
ElseIf cboAlign.ListIndex = 2 Then
SetTextAlign nhDC, TA_RIGHT
End If
'/ 생성된 DC 해제
ReleaseDC Picture2.hwnd, nhDC
End Sub
Private Sub Command3_Click()
End Sub
Private Sub Form_Load()
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
cboAlign.AddItem "Left"
cboAlign.AddItem "Center"
cboAlign.AddItem "Right"
cboAlign.ListIndex = 0
End Sub