Страница: 1 |
|
Вопрос: CutPicture
|
Добавлено: 08.01.07 18:06
|
|
Автор вопроса: 20vek
|
Подскажите как вырезать в Picture
например отверстие. Неприходилось не когда сталкиваться.
Ответить
|
Номер ответа: 4 Автор ответа: 20vek
Вопросов: 10 Ответов: 71
|
Профиль | | #4
|
Добавлено: 08.01.07 23:23
|
На форму кинь Picture и кнопку, да задай какой нибудь рисунок Picture. Poi(номер).x = 1: Poi(номер).y = 0 у меня свои надо изменишь, на свои соответственно.
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PolyBezier Lib "gdi32" (ByVal hdc As Long, lppt As POINTAPI, ByVal cPoints As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Function SetCreatePicture(ByVal propHwnd As Long, ByVal propHDC As Long)
Dim rComb As Long
Dim dl As Long
Dim Poi() As POINTAPI
Dim vDC As Long
vDC = propHDC
ReDim Poi(24)
Poi(0).x = 1: Poi(0).y = 0
Poi(1).x = 43: Poi(1).y = 0
Poi(2).x = 84: Poi(2).y = 1
Poi(3).x = 126: Poi(3).y = 1
Poi(4).x = 113: Poi(4).y = 9
Poi(5).x = 101: Poi(5).y = 18
Poi(6).x = 89: Poi(6).y = 26
Poi(7).x = 102: Poi(7).y = 30
Poi(8).x = 114: Poi(8).y = 35
Poi(9).x = 127: Poi(9).y = 39
Poi(10).x = 112: Poi(10).y = 46
Poi(11).x = 97: Poi(11).y = 54
Poi(12).x = 82: Poi(12).y = 61
Poi(13).x = 97: Poi(13).y = 74
Poi(14).x = 113: Poi(14).y = 88
Poi(15).x = 128: Poi(15).y = 101
Poi(16).x = 117: Poi(16).y = 105
Poi(17).x = 105: Poi(17).y = 108
Poi(18).x = 93: Poi(18).y = 112
Poi(19).x = 104: Poi(19).y = 124
Poi(20).x = 115: Poi(20).y = 137
Poi(21).x = 126: Poi(21).y = 149
Poi(22).x = 85: Poi(22).y = 148
Poi(23).x = 43: Poi(23).y = 147
Poi(24).x = 1: Poi(24).y = 146
dl = BeginPath(vDC)
dl = PolyBezier(vDC, Poi(0), 25)
dl = EndPath(vDC)
rComb = PathToRegion(vDC)
dl = SetWindowRgn(propHwnd, rComb, 1)
End Function
Private Sub Command1_Click()
Call SetCreatePicture(Picture1.hwnd, Picture1.hdc)
End Sub
Ответить
|
Номер ответа: 5 Автор ответа: 20vek
Вопросов: 10 Ответов: 71
|
Профиль | | #5
|
Добавлено: 08.01.07 23:32
|
Или вот прикол попробуй.
Option Explicit
Private Declare Function DeleteObject Lib "gdi32" ( ByVal hObject As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" ( ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W2 As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal c As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal f As String) As Long
Private Declare Function SelectObject Lib "gdi32" ( ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BeginPath Lib "gdi32" ( 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 EndPath Lib "gdi32" ( ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" ( ByVal hdc As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" ( ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Function SetCreateFont( ByVal propHwnd As Long, ByVal propHDC As Long)
Dim rComb As Long
Dim dl As Long
Dim vFont As Long
Dim vFontOld As Long
Dim vDC As Long
vDC = propHDC
vFont = CreateFont(24, 0, 0, 0, 700, 0, 0, 0, 1, 1, 1, 2, 2, "Times New Roman"
vFontOld = SelectObject(vDC, vFont)
dl = BeginPath(vDC)
Call TextOut(vDC, 42, 30, "ФСБ", 3)
dl = EndPath(vDC)
rComb = PathToRegion(vDC)
dl = SelectObject(vDC, vFontOld)
dl = DeleteObject(vFont)
dl = SetWindowRgn(propHwnd, rComb, 1)
End Function
Private Sub Command1_Click()
Call SetCreateFont(Picture1.hwnd, Picture1.hdc)
End Sub
Ответить
|
Страница: 1 |
Поиск по форуму