Заполнил форму рисунком - мерцает

[Олег Козлов]

Значит, заполнил я форму рисунком, т.е. в Form_Paint пишем:

Dim X As Integer, Y As Integer
Dim imgWidth As Integer
Dim imgHeight As Integer
Dim frmWidth As Integer
Dim frmHeight As Integer
imgWidth = img_bg.Width
imgHeight = img_bg.Height
frmWidth = Me.Width
frmHeight = Me.Height
For X = 0 To frmWidth Step imgWidth
For Y = 0 To frmHeight Step imgHeight
PaintPicture img_bg, X, Y
Next Y
Next X ',где img_bg - Image с рисунком.


Так вот, вместо кнопок использую Labels, когда мышью наводишь на Label, у Label меняется фон, цвет шрифта... Но при этом форма мерцает. Как исправить это?Я идиот! Убейте меня, кто-нибудь!Я идиот! Убейте меня, кто-нибудь!??

[GM]

Попробуй поэксперементировать с Autoredraw и Clipcontrols.

[MeMBus]

Там действительно, скорее всего, где-нибудь стоит autoredraw. Я бы наверное рисовал не на форме как таковой, а на picture box (предварительно его растянув до нужных размеров и обновляя (refresh) его только тогда, когда это нужно)...

[Rostik Ultra (2)]

Там действительно, скорее всего, где-нибудь стоит autoredraw. Я бы наверное рисовал не на форме как таковой, а на picture box (предварительно его растянув до нужных размеров и обновляя (refresh) его только тогда, когда это нужно)...

Ага а потоп при перемещениии какого нить контрола будешь наблюдать крутые видеоэффекты ( в больших кавычках )

Так что лучше растягивать рисунок на форме

Код: Выделить всё

Option Explicit

Sub SetScalePicture(Frm As Form, PBox As PictureBox)
PBox.AutoSize = True
PBox.ScaleMode = Frm.ScaleMode
Frm.AutoRedraw = True
Call Frm.PaintPicture(PBox.Picture, 0, 0, Frm.ScaleWidth, Frm.ScaleHeight, 0, 0, PBox.ScaleWidth, PBox.ScaleHeight, vbSrcCopy)
End Sub

Private Sub Form_Resize()
  Call SetScalePicture(Me, Picture1)
End Sub

[Олег Козлов]

AutoRedraw у меня False.

А что такое ClipControls (за что отвечает это свойство)?

[ALX_2002]

Стоп. Челы, мож я путаю, но вроде была функция PATBLT или на подобии. Она позволяет рисовать повторяющуюся картинку.



Если путаю, то сорри. Пойду попробую

[Олег Козлов]

Стоп. Челы, мож я путаю, но вроде была функция PATBLT или на подобии. Она позволяет рисовать повторяющуюся картинку.



Если путаю, то сорри. Пойду попробую

С этого момента поподробнее, пжлста...

[schalexey]

Олег Козлов посмотри этот примерчик:
http://schalex.stsland.ru/Player_ala_Winamp.rar
тут все (кнопки, надписи и тд) рисуется ток с помощью BitBlt

[schalexey]

Олег Козлов посмотри этот примерчик:
http://schalex.stsland.ru/Player_ala_Winamp.rar
тут все (кнопки, надписи и тд) рисуется ток с помощью BitBlt

[ALX_2002]

2 Олег Козлов: К сожалению на счёт PatBlt ничего не нашёл.

Но в принципе если рисовать в сгенерённом HDC, то без проблем. Скорость довольно высокая. С этим могу помочь

2 schalexey: WOW ! Красотища ! Сохраню себе.

[ALX_2002]

Код: Выделить всё

'
'
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Dim CDC As Long
Dim CBMP As Long

Dim Ipicture As IPictureDisp
Dim IpictureWidth As Long
Dim IpictureHeight As Long


Private Sub Form_Load()
Me.ScaleMode = vbPixels
CDC = CreateCompatibleDC(Me.hdc)
Set Ipicture = LoadPicture("C:\windows\Голубые кружева 16.bmp")
IpictureWidth = CInt(ScaleY(Ipicture.Width, vbHimetric, vbPixels))
IpictureHeight = CInt(ScaleY(Ipicture.Height, vbHimetric, vbPixels))
Call SelectObject(CDC, Ipicture)
End Sub

Private Sub Form_Paint()

For y = 0 To ScaleHeight Step IpictureHeight
For x = 0 To ScaleWidth Step IpictureWidth
  BitBlt Me.hdc, x, y, IpictureWidth, IpictureHeight, CDC, 0, 0, SRCCOPY
Next
Next

End Sub

Private Sub Form_Unload(Cancel As Integer)
DeleteDC CDC
End Sub


Вот по быстрому набросал. Попробуй. Если это тормозит, то можно ещё ускорить. Хотя у меня вообще ни на грамм не грузит.

Попробуй порасширять форму или сужать.

[schalexey]

OFF:
ALX_2002 ет ешо что была версия почти готовая... ток хард приказал долго жить со всем содежимым (было все, даж менюху (динамическую) с винампа слизал =)) )...

[Шурик]

Конечно много чего уже полезнова написали, но лучше вместо лэйбла использовать пиктуребох!!!

[Олег Козлов]

Дак ведь PictureBox жрет много системных ресурсов - я где-то читал... Да и проще Label воткнуть.

[ALX_2002]

А ещё можно через API всё реализовать.

А можно свой контрол сделать.. Да много чего можно.

Главное только выбрать

[Шурик]

Вобщем мне кажеца, что для этого дела ты не то выбрал...