Страница: 1 |
Вопрос: Рисунок из me.Picture в PictureBox или UserControl | Добавлено: 20.05.06 20:20 |
Автор вопроса: ![]() |
использую такой код:
Dim tR As Long Dim pLeft, pWidth, PTop, pHeight As Long tR = GetWindowRect(Picture1.hwnd, rc) tR = GetWindowRect(Me.hwnd, fRc) ' почему-то коордитаты картинки больше на 3???! Me.Caption = CStr(rc.Left - fRc.Left - 3) & " " & CStr(rc.Top - fRc.Top - capHeight - 3) pWidth = Picture1.Width pLeft = tPx * (rc.Left - fRc.Left - 3) PTop = tPy * (rc.Top - fRc.Top - capHeight - 3) pHeight = Picture1.Height Picture1.PaintPicture Me.Picture, 0, 0, pWidth, pHeight, pLeft, PTop, pWidth, pHeight Получается совсем не то - что же нужно сделать, чтобы кусок изображения с Parent'a копировался на PictureBox или что-то иное? HELP!!! |
Ответы | Всего ответов: 5 |
Номер ответа: 1 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ICQ: 238819245 Вопросов: 9 Ответов: 76 |
Профиль | Цитата | #1 | Добавлено: 21.05.06 01:14 |
Мда ты меня заставил самому позаниматься этим...чесно никогда не работал с этим.
Во-первых зачем GetWindowRect(). Это лишнее используй свойства Picture1: Left, Top, Height, Width Во-вторых Dim pLeft, pWidth, PTop, pHeight As Long ' все переменные кроме pHeight типа Variant. 'Правильнее будет Dim pLeft as Long, pWidth as Long, PTop as Long, pHeight As Long 'либо Dim pLeft&, pWidth&, PTop&, pHeight& То что на 3 больше - это вроде из-за использования этой апишки. Хотя возможно при переходах из Пикселей в Твипы. Вообщем, если задача содрать кусок изображения с формы и засунуть в Picture1, то вот, что у меня выходит: Dim pX1&, pX2& Dim pY1&, pY2& Dim pHei&, pWid& pHei = Picture1.Height pWid = Picture1.Width pX2 = pX1 + pHei pY2 = pY2 + pWid Picture1.PaintPicture Me.Picture, 0, 0, pWid, pHei, pX2, pY2, pWid, pHei вроде все пашет....вообщем пробуй |
Номер ответа: 2 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Разработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | Цитата | #2 | Добавлено: 21.05.06 15:55 |
BitBlt |
Номер ответа: 3 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 11 Ответов: 44 |
Web-сайт: Профиль | Цитата | #3 | Добавлено: 21.05.06 17:51 |
У контрола нет свойств Left и Top( по крайней мере они прямо не существуют)
Из за этого юзаю GetWindowRect |
Номер ответа: 4 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 11 Ответов: 44 |
Web-сайт: Профиль | Цитата | #4 | Добавлено: 21.05.06 17:53 |
У контрола нет свойств Left и Top( по крайней мере они прямо не существуют) Из за этого юзаю GetWindowRect Сорри, есс-но у UserControl |
Номер ответа: 5 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 11 Ответов: 44 |
Web-сайт: Профиль | Цитата | #5 | Добавлено: 21.05.06 19:30 |
Сам вроде разобрался:
АПИ: Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Const SM_CXBORDER = 5 Private Const SM_CXFRAME = 32 Private Const SM_CYFRAME = 33 Private Const SM_CYBORDER = 6 Private Const SM_CYDLGFRAME = 8 Private Const SM_CXDLGFRAME = 7 Private Const SM_CYFIXEDFRAME = SM_CYDLGFRAME Private Const SM_CXFIXEDFRAME = SM_CXDLGFRAME Dim tPx, tPy As Long Dim rc As RECT Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Const SM_CYCAPTION = 4 Собственно фунцкция: Private Sub UserControl_Paint() Dim tRes As Long Dim tLeft&, tTop&, tHei&, tWid&, tCap&, tXOfs&, tyOfs& 'On Error Resume Next tPx = Screen.TwipsPerPixelX tPy = Screen.TwipsPerPixelY With UserControl tCap = GetSystemMetrics(SM_CYCAPTION) tRes = GetWindowRect(UserControl.hwnd, rc) Select Case Parent.BorderStyle Case Is = vbBSNone tXOfs = 0 tyOfs = 0 tCap = 0 Case Is = vbSizable tXOfs = GetSystemMetrics(SM_CXFRAME) tyOfs = GetSystemMetrics(SM_CYFRAME) Case Is = vbFixedSingle tXOfs = GetSystemMetrics(SM_CXFIXEDFRAME) tyOfs = GetSystemMetrics(SM_CYFIXEDFRAME) End Select tLeft = tPy * rc.Left - Parent.Left - tXOfs * tPy tTop = tPx * rc.Top - Parent.Top - tPx * tCap - tyOfs * tPx tHei = tPx * (-rc.Top + rc.Bottom) tWid = tPy * (rc.Right - rc.Left) .PaintPicture Parent.Picture, 0, 0, tWid, tHei, tLeft, tTop, tWid, tHei End With End Sub Но почему-то при интенсивной работе с графикой(изменение Visible/Invislble массива Image) внутри контрола в разных вариациях Opaque/Trans, AutoRedraw(T/F) иногда мелькает белый цвет(не происходит отрисовка. PS. Не подскажете где найти нормальный контрол(не ОСХ) для Gif анимации? |
Страница: 1 |
|