VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00000000&
   Caption         =   "Form1"
   ClientHeight    =   9840
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10500
   LinkTopic       =   "Form1"
   ScaleHeight     =   9840
   ScaleWidth      =   10500
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   1200
      Top             =   600
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00000000&
      BorderStyle     =   0  'None
      Height          =   4455
      Left            =   0
      ScaleHeight     =   297
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   353
      TabIndex        =   0
      Top             =   0
      Width           =   5295
      Begin VB.HScrollBar HScroll1 
         Height          =   255
         Left            =   240
         Max             =   20000
         TabIndex        =   2
         Top             =   0
         Value           =   10000
         Width           =   1500
      End
      Begin VB.VScrollBar VScroll1 
         Height          =   1500
         Left            =   0
         Max             =   20000
         TabIndex        =   1
         Top             =   240
         Value           =   10000
         Width           =   255
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type BLENDFUNCTION
    BlendOp As Byte
    BlendFlags As Byte
    SourceConstantAlpha As Byte
    AlphaFormat As Byte
End Type

Private Declare Function AlphaBlend Lib "msimg32" (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 widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor 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

Public Function HSLToRGB( _
    ByVal Hue As Long, _
    ByVal Saturation As Long, _
    ByVal Luminance As Long, _
    Optional Validate As Boolean _
  ) As Long
' by Donald (Sterex 1996), donald@xbeat.net, 20011119
  Dim R As Long, G As Long, B As Long
  Dim lMax As Long, lMid As Long, lMin As Long
  Dim q As Single

  'If Validate Then ValidateHSL Hue, Saturation, Luminance

  lMax = (Luminance * 255) / 100
  lMin = (100 - Saturation) * lMax / 100
  q = (lMax - lMin) / 60
  
  Select Case Hue
  Case 0 To 60
    lMid = (Hue - 0) * q + lMin
    R = lMax: G = lMid: B = lMin
  Case 60 To 120
    lMid = -(Hue - 120) * q + lMin
    R = lMid: G = lMax: B = lMin
  Case 120 To 180
    lMid = (Hue - 120) * q + lMin
    R = lMin: G = lMax: B = lMid
  Case 180 To 240
    lMid = -(Hue - 240) * q + lMin
    R = lMin: G = lMid: B = lMax
  Case 240 To 300
    lMid = (Hue - 240) * q + lMin
    R = lMid: G = lMin: B = lMax
  Case 300 To 360
    lMid = -(Hue - 360) * q + lMin
    R = lMax: G = lMin: B = lMid
  End Select
  
  HSLToRGB = B * &H10000 + G * &H100& + R

End Function

Public Sub Spawn()


Private Sub Form_Resize()
Picture1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Caption = X
End Sub


Private Sub Timer1_Timer()
Static hv As Double, hd As Double
Dim Blend As BLENDFUNCTION, BlendLng As Long
'If Int(10 * Rnd) = 0 Then Spawn

Blend.SourceConstantAlpha = 1
CopyMemory BlendLng, Blend, 4
For i = 0 To 63
hv = hv + (VScroll1.Value - 10000) / 10000
hd = hd + (HScroll1.Value - 10000) / 10000
SetPixelV Picture1.hdc, Picture1.ScaleWidth / 2 + Sin(hv) * (Picture1.ScaleWidth / 2), Cos(hd) * (Picture1.ScaleHeight / 2) + Picture1.ScaleHeight / 2, RGB(0, 0, 255)
SetPixelV Picture1.hdc, Picture1.ScaleWidth / 2 + Cos(hv) * (Picture1.ScaleWidth / 2), Sin(hd) * (Picture1.ScaleHeight / 2) + Picture1.ScaleHeight / 2, RGB(0, 255, 0)
SetPixelV Picture1.hdc, Picture1.ScaleWidth / 2 + Sin(hv) * (Picture1.ScaleWidth / 2), Sin(hd) * (Picture1.ScaleHeight / 2) + Picture1.ScaleHeight / 2, RGB(255, 0, 0)
SetPixelV Picture1.hdc, Picture1.ScaleWidth / 2 + Cos(hv) * (Picture1.ScaleWidth / 2), Cos(hd) * (Picture1.ScaleHeight / 2) + Picture1.ScaleHeight / 2, RGB(255, 255, 255)
Next

'BitBlt Picture1.hdc, 0, 1, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, vbSrcCopy
res = AlphaBlend(Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, BlendLng)
'Caption = res
'Picture1.Refresh
End Sub