home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / resize1a / drawrain.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-09-10  |  4.4 KB  |  124 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   1620
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4590
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   108
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   306
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.PictureBox Picture1 
  14.       AutoRedraw      =   -1  'True
  15.       Height          =   1575
  16.       Left            =   0
  17.       ScaleHeight     =   101
  18.       ScaleMode       =   3  'Pixel
  19.       ScaleWidth      =   301
  20.       TabIndex        =   0
  21.       Top             =   0
  22.       Width           =   4575
  23.       Begin VB.Shape Shape1 
  24.          BorderColor     =   &H007F7F7F&
  25.          BorderWidth     =   4
  26.          Height          =   855
  27.          Left            =   720
  28.          Top             =   240
  29.          Width           =   1095
  30.       End
  31.    End
  32. Attribute VB_Name = "Form1"
  33. Attribute VB_GlobalNameSpace = False
  34. Attribute VB_Creatable = False
  35. Attribute VB_PredeclaredId = True
  36. Attribute VB_Exposed = False
  37. 'DrawRainBow 
  38.  oigres P
  39. 'Email: oigres@postmaster.co.uk
  40. 'indented by indenter5 from www.BMSLtd.co.uk
  41. Dim PreviousWidth As Long, PreviousHeight As Long
  42. Dim pnt As Boolean
  43. 'draw rainbow pure colours = no grey, third colour
  44. Private Sub Form_Load()
  45.     Show
  46.     'resize executed on startup so no need
  47.     'drawrainbow
  48. End Sub
  49. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  50.     Static pre1 As Long
  51.     Static pre2 As Long
  52.     Static prex
  53.     Static prey
  54.     With Shape1
  55.         .Visible = False
  56.         .Top = 0 'Picture1.Top
  57.         .Left = x - 4
  58.         .Width = 8
  59.         .Height = Picture1.Height
  60.         .Visible = True
  61.     End With
  62.     r = &HFF& And Picture1.Point(x, y)
  63.     g = ShiftRight((&HFF00& And Picture1.Point(x, y)), 8)
  64.     b = ShiftRight((&HFF0000 And Picture1.Point(x, y)), 16)
  65.     Form1.Caption = "R=" & Format(Hex(r), "00") & ":G=" & Format(Hex(g), "00") & ":B=" & Format(Hex(b), "00") '& "-:-Formwidth= " & Form1.ScaleWidth
  66.     Picture1.ToolTipText = Form1.Caption
  67.     Form1.Caption = Form1.Caption & " - Resizeable Spectrum By oigres P"
  68. End Sub
  69. Private Function ShiftRight(x As Long, y As Long) As Long
  70. 'funct from Derek Haas
  71. 'kibblesnbits@ snip.net
  72.     ShiftRight = x \ 2 ^ y 'This shifts them
  73. End Function
  74. Private Sub drawrainbow()
  75.     'based on an idea I got from a part of a complicated vb prog called FireStarter
  76.     'firestarter 1999 by Nonlinear Solutions - nls@inode.at
  77.     ''''Visit them at WWW.INODE.AT/NLS
  78.     '
  79.     ' algorithm : split form into 6 bits
  80.     '
  81.     'Dim section  As Integer
  82.     r = 255: g = 0: b = 0
  83.     'radd = 0: gadd = 0: badd = 0
  84.     cadd = 3
  85.     frmscw = Form1.ScaleWidth ' same as picture1.width
  86.     frm2 = Int((frmscw \ 6)) 'integer div; 1 6th of form1.scalewidth  '(frmscw / 1535) * 6
  87.     cadd = 255 / frm2: cadd2 = 0 'cadd; colour addon ; note:255 not 256
  88.    'section = Int(((frmscw - 1) / 6))
  89.     FrmSh = Form1.ScaleHeight - 1
  90.     For x = 0 To frm2 ' section '1 6th of form size
  91.         cadd3 = Int(cadd2) ' cut off fraction for byte
  92.         clr1 = RGB(255, cadd3, 0) 'red to yellow
  93.         Picture1.Line (x, 0)-(x, FrmSh), clr1
  94.         clr2 = RGB(255 - cadd3, 255, 0) 'yellow to green
  95.         Picture1.Line (x + (frm2), 0)-(x + (frm2), FrmSh), clr2
  96.         clr3 = RGB(0, 255, cadd3) 'green to cyan
  97.         Picture1.Line (x + (frm2 * 2), 0)-(x + (frm2 * 2), FrmSh), clr3
  98.         clr4 = RGB(0, 255 - cadd3, 255) 'cyan to blue
  99.         Picture1.Line (x + (frm2 * 3), 0)-(x + (frm2 * 3), FrmSh), clr4
  100.         clr5 = RGB(cadd3, 0, 255) 'blue to magenta
  101.         Picture1.Line (x + (frm2 * 4), 0)-(x + (frm2 * 4), FrmSh), clr5
  102.         clr6 = RGB(255, 0, 255 - cadd3) 'magenta to red
  103.         Picture1.Line (x + (frm2 * 5), 0)-(x + (frm2 * 5), FrmSh), clr6
  104.         cadd2 = cadd2 + cadd 'accumulate
  105.     Next x ' each point in section
  106. End Sub
  107. Private Sub Form_Resize()
  108.     With Picture1
  109.         .Visible = False
  110.         .Top = 0: Picture1.Left = 0
  111.         .Width = ScaleWidth: Picture1.Height = ScaleHeight
  112.         .Visible = True
  113.     End With
  114.     drawrainbow
  115.     With Shape1
  116.         .Visible = False
  117.         .Top = 0 'Picture1.Top
  118.         'Shape1.Left = x - 4
  119.         .Width = 8
  120.         .Height = Picture1.Height
  121.         .Visible = True
  122.     End With
  123. End Sub
  124.