home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Any_angle_19597612252005.psc / fTest.frm < prev    next >
Text File  |  2005-05-18  |  7KB  |  238 lines
  1. VERSION 5.00
  2. Begin VB.Form fTest 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "mGradient (any angle) test"
  5.    ClientHeight    =   6375
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   8655
  9.    ClipControls    =   0   'False
  10.    BeginProperty Font 
  11.       Name            =   "Tahoma"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   400
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    LinkTopic       =   "Form1"
  20.    LockControls    =   -1  'True
  21.    MaxButton       =   0   'False
  22.    MinButton       =   0   'False
  23.    ScaleHeight     =   425
  24.    ScaleMode       =   3  'Pixel
  25.    ScaleWidth      =   577
  26.    StartUpPosition =   2  'CenterScreen
  27.    Begin VB.PictureBox picScroll 
  28.       Appearance      =   0  'Flat
  29.       BackColor       =   &H80000005&
  30.       ForeColor       =   &H80000008&
  31.       Height          =   285
  32.       Left            =   6660
  33.       ScaleHeight     =   17
  34.       ScaleMode       =   3  'Pixel
  35.       ScaleWidth      =   110
  36.       TabIndex        =   6
  37.       TabStop         =   0   'False
  38.       Top             =   4770
  39.       Width           =   1680
  40.       Begin VB.Line lnScroll 
  41.          BorderColor     =   &H000000FF&
  42.          X1              =   2
  43.          X2              =   2
  44.          Y1              =   16
  45.          Y2              =   -1
  46.       End
  47.    End
  48.    Begin VB.TextBox txtAngle 
  49.       Height          =   315
  50.       Left            =   7605
  51.       MaxLength       =   3
  52.       TabIndex        =   3
  53.       Text            =   "0"
  54.       Top             =   570
  55.       Width           =   735
  56.    End
  57.    Begin VB.CommandButton cmdPaint 
  58.       Caption         =   "&Paint"
  59.       Default         =   -1  'True
  60.       Height          =   495
  61.       Left            =   6660
  62.       TabIndex        =   4
  63.       Top             =   1065
  64.       Width           =   1680
  65.    End
  66.    Begin VB.TextBox txtIterations 
  67.       Height          =   315
  68.       Left            =   7605
  69.       MaxLength       =   3
  70.       TabIndex        =   1
  71.       Text            =   "1"
  72.       Top             =   150
  73.       Width           =   735
  74.    End
  75.    Begin VB.Line lnAngle 
  76.       BorderColor     =   &H000000FF&
  77.       X1              =   507
  78.       X2              =   507
  79.       Y1              =   276
  80.       Y2              =   198
  81.    End
  82.    Begin VB.Label lblAngle 
  83.       Caption         =   "Angle"
  84.       BeginProperty Font 
  85.          Name            =   "Tahoma"
  86.          Size            =   8.25
  87.          Charset         =   0
  88.          Weight          =   700
  89.          Underline       =   0   'False
  90.          Italic          =   0   'False
  91.          Strikethrough   =   0   'False
  92.       EndProperty
  93.       Height          =   255
  94.       Left            =   6645
  95.       TabIndex        =   2
  96.       Top             =   615
  97.       Width           =   1020
  98.    End
  99.    Begin VB.Label lblIterations 
  100.       Caption         =   "Iterations"
  101.       BeginProperty Font 
  102.          Name            =   "Tahoma"
  103.          Size            =   8.25
  104.          Charset         =   0
  105.          Weight          =   700
  106.          Underline       =   0   'False
  107.          Italic          =   0   'False
  108.          Strikethrough   =   0   'False
  109.       EndProperty
  110.       Height          =   255
  111.       Left            =   6645
  112.       TabIndex        =   0
  113.       Top             =   195
  114.       Width           =   1020
  115.    End
  116.    Begin VB.Label lblTiming 
  117.       Height          =   675
  118.       Left            =   6675
  119.       TabIndex        =   5
  120.       Top             =   1740
  121.       Width           =   1590
  122.    End
  123. End
  124. Attribute VB_Name = "fTest"
  125. Attribute VB_GlobalNameSpace = False
  126. Attribute VB_Creatable = False
  127. Attribute VB_PredeclaredId = True
  128. Attribute VB_Exposed = False
  129. Option Explicit
  130.  
  131. Private Const PI     As Single = 3.14159265358979
  132. Private Const TO_RAD As Single = PI / 180
  133. Private m_oTiming    As New cTiming
  134.  
  135.  
  136.  
  137. Private Sub Form_Load()
  138.  
  139.     If (App.LogMode <> 1) Then
  140.         Call MsgBox("Absolutely recommended: compile first...")
  141.     End If
  142.  
  143.     Set Me.Icon = Nothing
  144.     Call Me.Show
  145.     Call VBA.DoEvents
  146.     
  147.     Call picScroll_MouseMove(1, 0, 0, 0)
  148. End Sub
  149.  
  150. Private Sub Form_Paint()
  151.     
  152.  Const PI As Single = 3.14159265358979
  153.    
  154.    Me.ScaleLeft = -500
  155.    Me.ScaleTop = -250
  156.    Me.Circle (0, 0), 50, vbBlack
  157.    Me.Line (-60, 0)-(60, 0), vbWhite
  158.    Me.CurrentX = Me.CurrentX - 6
  159.    Me.CurrentY = Me.CurrentY - 14
  160.    Me.Print "0║"
  161.    Me.Line (0, -60)-(0, 60), vbWhite
  162. End Sub
  163.  
  164.  
  165.  
  166. Private Sub cmdPaint_Click()
  167.   
  168.   Dim i  As Long
  169.   Dim it As Long
  170.     
  171.     With txtIterations
  172.         If (Not IsNumeric(.Text)) Then
  173.             Call MsgBox("Please, enter a valid 'Iterations' number")
  174.             Call .SetFocus
  175.             .SelStart = 0
  176.             .SelLength = Len(.Text)
  177.             Exit Sub
  178.         End If
  179.         it = Val(.Text)
  180.     End With
  181.     
  182.     Call m_oTiming.Reset
  183.     For i = 1 To it
  184.         Call mGradient.PaintGradient(Me.hDC, 10, 10, 100, 100, RGB(255, 0, 0), RGB(0, 0, 255), Val(txtAngle))
  185.         Call mGradient.PaintGradient(Me.hDC, 115, 10, 300, 100, RGB(255, 0, 0), RGB(0, 0, 255), Val(txtAngle))
  186.         Call mGradient.PaintGradient(Me.hDC, 10, 115, 100, 300, RGB(255, 0, 0), RGB(0, 0, 255), Val(txtAngle))
  187.         Call mGradient.PaintGradient(Me.hDC, 115, 115, 300, 300, RGB(255, 0, 0), RGB(0, 0, 255), Val(txtAngle))
  188.     Next i
  189.     lblTiming = it * 4 & " gradients at " & Val(txtAngle) & "║ rendered in " & Format$(m_oTiming.Elapsed / 1000, "0.0000 s") & vbCrLf & vbCrLf
  190. End Sub
  191.  
  192.  
  193.  
  194. Private Sub picScroll_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  195.     Call picScroll_MouseMove(Button, Shift, x, y)
  196. End Sub
  197.  
  198. Private Sub picScroll_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  199.   
  200.   Dim lAngle As Long
  201.     
  202.     If (Button) Then
  203.         If (x < 0) Then x = 0
  204.         If (x > picScroll.ScaleWidth - 1) Then x = picScroll.ScaleWidth - 1
  205.         With lnScroll
  206.             .X1 = x
  207.             .X2 = x
  208.         End With
  209.         
  210.         lAngle = (x * 364) \ picScroll.ScaleWidth '364?: only for rounding
  211.         With lnAngle
  212.             .X1 = 0
  213.             .Y1 = 0
  214.             .X2 = .X1 + 60 * Cos((360 - lAngle) * TO_RAD)
  215.             .Y2 = .Y1 + 60 * Sin((360 - lAngle) * TO_RAD)
  216.             Call .Refresh
  217.         End With
  218.     
  219.         If (picScroll.Tag = vbNullString) Then txtAngle.Text = lAngle
  220.         Call cmdPaint_Click
  221.     End If
  222. End Sub
  223.  
  224. Private Sub txtAngle_Change()
  225.     
  226.   Dim lAngle As Long
  227.     
  228.     If (IsNumeric(txtAngle.Text)) Then
  229.         lAngle = Val(txtAngle.Text)
  230.         lAngle = lAngle Mod 360
  231.         If (lAngle < 0) Then lAngle = 360 + lAngle
  232.         
  233.         picScroll.Tag = "!"
  234.         Call picScroll_MouseMove(1, 0, (lAngle / 364) * picScroll.ScaleWidth, 0) '364?: only for rounding
  235.         picScroll.Tag = vbNullString
  236.     End If
  237. End Sub
  238.