home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch07 / clrgrads / clrgrads.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-04-13  |  6.5 KB  |  184 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form ClrGradsForm 
  4.    BorderStyle     =   4  'Fixed ToolWindow
  5.    Caption         =   "Gradients"
  6.    ClientHeight    =   5415
  7.    ClientLeft      =   45
  8.    ClientTop       =   285
  9.    ClientWidth     =   6075
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    PaletteMode     =   1  'UseZOrder
  14.    ScaleHeight     =   5415
  15.    ScaleWidth      =   6075
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   3  'Windows Default
  18.    Begin VB.CommandButton Command1 
  19.       Caption         =   "Linear Gradient"
  20.       BeginProperty Font 
  21.          Name            =   "Verdana"
  22.          Size            =   9.75
  23.          Charset         =   0
  24.          Weight          =   400
  25.          Underline       =   0   'False
  26.          Italic          =   0   'False
  27.          Strikethrough   =   0   'False
  28.       EndProperty
  29.       Height          =   360
  30.       Left            =   750
  31.       TabIndex        =   4
  32.       Top             =   210
  33.       Width           =   1665
  34.    End
  35.    Begin VB.PictureBox EndColor 
  36.       AutoRedraw      =   -1  'True
  37.       BackColor       =   &H0000FFFF&
  38.       Height          =   5205
  39.       Left            =   5505
  40.       ScaleHeight     =   5145
  41.       ScaleWidth      =   390
  42.       TabIndex        =   3
  43.       Top             =   120
  44.       Width           =   450
  45.    End
  46.    Begin VB.PictureBox StartColor 
  47.       AutoRedraw      =   -1  'True
  48.       BackColor       =   &H00FFFF00&
  49.       Height          =   5220
  50.       Left            =   105
  51.       ScaleHeight     =   5160
  52.       ScaleWidth      =   390
  53.       TabIndex        =   2
  54.       Top             =   90
  55.       Width           =   450
  56.    End
  57.    Begin VB.PictureBox Picture2 
  58.       AutoRedraw      =   -1  'True
  59.       BackColor       =   &H00404040&
  60.       Height          =   2385
  61.       Left            =   2145
  62.       Picture         =   "ClrGrads.frx":0000
  63.       ScaleHeight     =   155
  64.       ScaleMode       =   3  'Pixel
  65.       ScaleWidth      =   197
  66.       TabIndex        =   1
  67.       Top             =   2775
  68.       Width           =   3015
  69.       Begin VB.CommandButton Command2 
  70.          BackColor       =   &H8000000A&
  71.          Caption         =   "Circular Gradient"
  72.          BeginProperty Font 
  73.             Name            =   "Verdana"
  74.             Size            =   9.75
  75.             Charset         =   0
  76.             Weight          =   400
  77.             Underline       =   0   'False
  78.             Italic          =   0   'False
  79.             Strikethrough   =   0   'False
  80.          EndProperty
  81.          Height          =   375
  82.          Left            =   75
  83.          TabIndex        =   5
  84.          Top             =   1890
  85.          Width           =   1890
  86.       End
  87.    End
  88.    Begin VB.PictureBox Picture1 
  89.       AutoRedraw      =   -1  'True
  90.       Height          =   5175
  91.       Left            =   675
  92.       Picture         =   "ClrGrads.frx":0446
  93.       ScaleHeight     =   341
  94.       ScaleMode       =   3  'Pixel
  95.       ScaleWidth      =   309
  96.       TabIndex        =   0
  97.       Top             =   120
  98.       Width           =   4695
  99.    End
  100.    Begin MSComDlg.CommonDialog CommonDialog1 
  101.       Left            =   4740
  102.       Top             =   4005
  103.       _ExtentX        =   847
  104.       _ExtentY        =   847
  105.       _Version        =   393216
  106.       FontSize        =   2.54052e-29
  107.    End
  108. Attribute VB_Name = "ClrGradsForm"
  109. Attribute VB_GlobalNameSpace = False
  110. Attribute VB_Creatable = False
  111. Attribute VB_PredeclaredId = True
  112. Attribute VB_Exposed = False
  113. Option Explicit
  114. Function GetRed(colorVal As Long) As Integer
  115.      GetRed = colorVal Mod 256
  116. End Function
  117. Function GetGreen(colorVal As Long) As Integer
  118.     GetGreen = ((colorVal And &HFF00FF00) / 256&)
  119. End Function
  120. Function GetBlue(colorVal As Long) As Integer
  121.     GetBlue = (colorVal And &HFF0000) / (256& * 256&)
  122. End Function
  123. Private Sub Command1_Click()
  124. Dim newColor As Long
  125. Dim ipixel As Integer, PWidth As Integer
  126. Dim redInc As Single, greenInc As Single, blueInc As Single
  127. Dim color1 As Long, color2 As Long
  128. Dim startRed As Integer, startGreen As Integer, startBlue As Integer
  129. Dim endRed As Integer, endGreen As Integer, endBlue As Integer
  130.     color1 = StartColor.BackColor
  131.     color2 = EndColor.BackColor
  132.     startRed = GetRed(color1)
  133.     endRed = GetRed(color2)
  134.     startGreen = GetGreen(color1)
  135.     endGreen = GetGreen(color2)
  136.     startBlue = GetBlue(color1)
  137.     endBlue = GetBlue(color2)
  138.     PWidth = Picture1.ScaleWidth
  139.     redInc = (endRed - startRed) / PWidth
  140.     greenInc = (endGreen - startGreen) / PWidth
  141.     blueInc = (endBlue - startBlue) / PWidth
  142.     For ipixel = 0 To PWidth - 1
  143.         newColor = RGB(startRed + redInc * ipixel, startGreen + greenInc * ipixel, startBlue + blueInc * ipixel)
  144.         Picture1.Line (ipixel, 0)-(ipixel, Picture1.Height - 1), newColor
  145.     Next
  146. End Sub
  147. Private Sub Command2_Click()
  148. Dim newColor As Long
  149. Dim radius As Integer, ipixel As Integer, PWidth As Integer
  150. Dim redInc As Single, greenInc As Single, blueInc As Single
  151. Dim color1 As Long, color2 As Long
  152. Dim startRed As Integer, startGreen As Integer, startBlue As Integer
  153. Dim endRed As Integer, endGreen As Integer, endBlue As Integer
  154.     color1 = StartColor.BackColor
  155.     color2 = EndColor.BackColor
  156.     startRed = color1 Mod 256
  157.     endRed = color2 Mod 256
  158.     startGreen = ((color1 And &HFF00) / 256&) Mod 256&
  159.     endGreen = ((color2 And &HFF00) / 256&) Mod 256&
  160.     startBlue = (color1 And &HFF0000) / (256& * 256&)
  161.     endBlue = (color2 And &HFF0000) / (256& * 256&)
  162.     PWidth = Picture1.ScaleWidth / 2
  163.     redInc = (endRed - startRed) / PWidth
  164.     greenInc = (endGreen - startGreen) / PWidth
  165.     blueInc = (endBlue - startBlue) / PWidth
  166.     Picture2.DrawWidth = 2
  167.     ipixel = 0
  168.     For radius = PWidth / 2 To 1 Step -1
  169.         newColor = RGB(startRed + redInc * ipixel, startGreen + greenInc * ipixel, startBlue + blueInc * ipixel)
  170.         Picture2.Circle (Picture2.ScaleWidth / 2, Picture2.ScaleHeight / 2), radius, newColor
  171.         ipixel = ipixel + 2
  172.     Next
  173. End Sub
  174. Private Sub EndColor_Click()
  175.     CommonDialog1.Color = EndColor.BackColor
  176.     CommonDialog1.ShowColor
  177.     EndColor.BackColor = CommonDialog1.Color
  178. End Sub
  179. Private Sub StartColor_Click()
  180.     CommonDialog1.Color = StartColor.BackColor
  181.     CommonDialog1.ShowColor
  182.     StartColor.BackColor = CommonDialog1.Color
  183. End Sub
  184.