Заполнение формы - 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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

6   голосов , оценка 4.167 из 5
Похожие ответы