Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Рисунок из me.Picture в PictureBox или UserControl Добавлено: 20.05.06 20:20  

Автор вопроса:  Telishev S | Web-сайт: tsa-molotoff.jino-net.ru
использую такой код:

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
Автор ответа:
 ENIX



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
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
 Профиль | | #2 Добавлено: 21.05.06 15:55
BitBlt

Ответить

Номер ответа: 3
Автор ответа:
 Telishev S



Вопросов: 11
Ответов: 44
 Web-сайт: tsa-molotoff.jino-net.ru
 Профиль | | #3
Добавлено: 21.05.06 17:51
У контрола нет свойств Left и Top( по крайней мере они прямо не существуют)
Из за этого юзаю GetWindowRect

Ответить

Номер ответа: 4
Автор ответа:
 Telishev S



Вопросов: 11
Ответов: 44
 Web-сайт: tsa-molotoff.jino-net.ru
 Профиль | | #4
Добавлено: 21.05.06 17:53

У контрола нет свойств Left и Top( по крайней мере они прямо не существуют)
Из за этого юзаю GetWindowRect

Сорри, есс-но у UserControl

Ответить

Номер ответа: 5
Автор ответа:
 Telishev S



Вопросов: 11
Ответов: 44
 Web-сайт: tsa-molotoff.jino-net.ru
 Профиль | | #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 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам