[vba] [vba] 엑셀 시트를 픽셀처럼 사용하여 폼의 이미지 박스의 이미지를 시트에 그리기
하나를하더라도최선을
2019-07-08 00:10
6,310
0
본문
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
'Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT) As Long
'Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Const POINTS_PER_INCH As Long = 72
Private Const LOGPIXELSX = 88 ' tell GetDeviceCaps to return horiz
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Private Type POINT
' X As Long
' Y As Long
'End Type
Private Sub CommandButton1_Click()
img.Picture = LoadPicture(ThisWorkbook.Path & "\img.jpg") '// 현재 파일과 같은 경로의 img.jpg 파일을 불러옴
img.PictureSizeMode = fmPictureSizeModeClip
img.AutoSize = True: DoEvents '// 이미지 사이즈에 맞게 컨트롤을 변경하고 이벤트를 시스템에 넘김
Application.ScreenUpdating = False '// 앞으로 화면의 변화를 업데이트 하지 않음
Columns.ColumnWidth = 0.38 '// 모든 셀의 넓이를
Rows.RowHeight = 3.75 '// 모든셀의 높이를
Cells.Interior.Pattern = xlNone '// 채우기 초기화
Dim hDC As Long
hDC = GetDC(FindWindow(vbNullString, Me.Caption)) '// 폼의 핸들값
Dim Y As Integer, X As Integer
For X = 1 To GetGraphicswidth '// 이미지의 넓이만큼
For Y = 1 To GetGraphicsHeight '// 이미지의 높이 만큼
Cells(Y, X).Interior.Color = GetPixel(hDC, X + (PixelsPerPoint * img.Left) - 1, Y + (PixelsPerPoint * img.Top) - 1) '// 셀에 색상을 변경
Next
Next
hDC = ReleaseDC(0, hDC)
Application.ScreenUpdating = True
End Sub
Public Function PixelsPerPoint() As Double
Dim deviceContextHandle As Long
Dim DotsPerInch As Long
deviceContextHandle = GetDC(0)
DotsPerInch = GetDeviceCaps(deviceContextHandle, LOGPIXELSX)
PixelsPerPoint = DotsPerInch / POINTS_PER_INCH
ReleaseDC 0, deviceContextHandle
End Function
Public Function GetGraphicswidth()
GetGraphicswidth = PixelsPerPoint * img.Width
End Function
Public Function GetGraphicsHeight()
GetGraphicsHeight = PixelsPerPoint * img.Height
End FunctionGetPixel 에서 이미지 컨트롤의 위치를 좀더 정확하게 찿을 수 있으면 좋겠다.
귀차나서 이부분은 간단히 마무리 하는걸로...
댓글목록0