Заполнение формы - VB
Формулировка задачи:
Подскажите пожалуйста есть ли способы произвольного заполнения формы точками и обратно исчезновения их.
Что то вроде рассвет-закат.
Решение задачи: «Заполнение формы»
textual
Листинг программы
- Option Explicit
- Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long
- Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, Graphics As Long) As Long
- Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal Graphics As Long) As Long
- Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
- Private Declare Function GdipCreateImageAttributes Lib "gdiplus" (imageattr As Long) As Long
- Private Declare Function GdipSetImageAttributesColorMatrix Lib "gdiplus" (ByVal imageattr As Long, ByVal ClrAdjType As Long, ByVal enableFlag As Long, colourMatrix As Any, grayMatrix As Any, ByVal flags As Long) As Long
- Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long
- Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
- Private Declare Function GdipDisposeImageAttributes Lib "gdiplus" (ByVal imageattr As Long) As Long
- Private Declare Function GdipSetImageAttributesThreshold Lib "gdiplus" (ByVal imageattr As Long, ByVal ClrAdjType As Long, ByVal enableFlag As Long, ByVal threshold As Single) As Long
- Private Declare Function GdipDrawImageRectRectI Lib "gdiplus" (ByVal Graphics As Long, ByVal image As Long, ByVal dstx As Long, _
- ByVal dsty As Long, ByVal dstwidth As Long, ByVal dstheight As Long, _
- ByVal srcx As Long, ByVal srcy As Long, ByVal srcwidth As Long, ByVal srcheight As Long, _
- ByVal srcUnit As Long, Optional ByVal imageAttributes As Long = 0, _
- Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As Long
- Private Declare Function GdipSetImageAttributesColorKeys Lib "gdiplus" (ByVal imageattr As Long, ByVal ClrAdjType As Long, ByVal enableFlag As Long, ByVal colorLow As Long, ByVal colorHigh As Long) As Long
- Const ColorAdjustTypeBitmap = 1
- Dim gr As Long, bmp As Long, attr As Long, token As Long
- Private Sub Form_Load()
- Dim si(3) As Long
- si(0) = 1: GdiplusStartup token, si(0): AutoRedraw = True: ScaleMode = vbPixels
- GdipCreateImageAttributes attr: GdipCreateFromHDC Me.hdc, gr
- GdipCreateBitmapFromHBITMAP Picture.Handle, Picture.hpal, bmp
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- GdipDeleteGraphics gr: GdipDisposeImage bmp: GdiplusShutdown token: GdipDisposeImageAttributes attr
- End Sub
- Private Sub Timer1_Timer()
- Static value As Long, mtx(4, 4) As Single, s As Single
- s = Abs((value / 100) - 1): mtx(0, 0) = s: mtx(1, 1) = s: mtx(2, 2) = s: mtx(3, 3) = 1: mtx(4, 4) = 1
- GdipSetImageAttributesColorMatrix attr, ColorAdjustTypeBitmap, 1, mtx(0, 0), ByVal 0&, 0
- GdipDrawImageRectRectI gr, bmp, 0, 0, ScaleWidth, ScaleHeight, 0, 0, ScaleWidth, ScaleHeight, 2, attr
- value = ((value Mod 200) + 1): Refresh
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д