rotfont1.frm

vb源码大全

VERSION 5.00
Begin VB.Form frmRotFont 
   Caption         =   "旋转彩色文字"
   ClientHeight    =   5280
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7080
   LinkTopic       =   "Form1"
   ScaleHeight     =   5280
   ScaleWidth      =   7080
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text1 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "0"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   1
      EndProperty
      Height          =   495
      Left            =   1080
      TabIndex        =   4
      Top             =   3960
      Width           =   1215
   End
   Begin VB.CommandButton cmdDemo 
      Caption         =   "旋转演示"
      Height          =   495
      Left            =   840
      TabIndex        =   3
      Top             =   4680
      Width           =   1215
   End
   Begin VB.Timer Timer1 
      Interval        =   400
      Left            =   3480
      Top             =   4080
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "清空"
      Height          =   495
      Left            =   2640
      TabIndex        =   2
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   495
      Left            =   4560
      TabIndex        =   1
      Top             =   4680
      Width           =   1215
   End
   Begin VB.PictureBox Picture1 
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   18
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3735
      Left            =   105
      ScaleHeight     =   3675
      ScaleWidth      =   6750
      TabIndex        =   0
      Top             =   105
      Width           =   6810
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "旋转角度                  (-360,360)"
      Height          =   180
      Left            =   120
      TabIndex        =   5
      Top             =   3960
      Width           =   3240
   End
End
Attribute VB_Name = "frmRotFont"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'SelectObject用于选择字体对象
Private Declare Function SelectObject Lib "gdi32" _
        (ByVal hDC As Long, ByVal hObject As Long) As Long
Private fnt As CLogFont '自定义的类模块对象
Dim ShowDemo As Boolean

'清空图片框
Private Sub cmdClear_Click()
   Picture1.Cls
End Sub

Private Sub cmdDemo_Click()
    ShowDemo = True
    Timer1.Enabled = True
    Picture1.Cls
    Text1.Text = 0
End Sub

'退出演示程序
Private Sub cmdExit_Click()
    Unload Me
End Sub

'加载窗体
'创建字体对象，默认字体为图片框字体
Private Sub Form_Load()
   Set fnt = New CLogFont
   Set fnt.LogFont = Picture1.Font
   'HScroll1.Value = 0
   Text1.Text = 0
   Set Me.Icon = Nothing
   ShowDemo = False
   Timer1.Enabled = False
End Sub

'响应图片框MouseUp事件
'如是左键则在非自动演示状态下以当前角度，在鼠标当前位置打印文字
'是其他键则清空图片框
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim hFont As Long
    
    fnt.Rotation = Text1.Text
    If Button = 1 Then
       
        With Picture1
            hFont = SelectObject(.hDC, fnt.Handle)
            .CurrentX = X
            .CurrentY = Y
            Picture1.Print "旋转角度： " & fnt.Rotation
            Call SelectObject(.hDC, hFont)
        End With
       
    Else
        Call cmdClear_Click
    End If
End Sub

'响应时钟控件Timer事件
'不断改变旋转角度
Private Sub Timer1_Timer()
Dim hFont As Long
If (Not ShowDemo) Then
    Exit Sub
End If
fnt.Rotation = Text1.Text
Static clrIndex As Integer  '控制颜色
  If Text1.Text >= 360 Then
    Text1.Text = 0
    ShowDemo = False
  Else: Text1.Text = Text1.Text + 10
  End If
  If (Text1.Text Mod 360) = 0 Then Picture1.Cls

   
   With Picture1
        hFont = SelectObject(.hDC, fnt.Handle)
        .CurrentX = .ScaleWidth \ 2
        .CurrentY = .ScaleHeight \ 2
        Picture1.ForeColor = QBColor(clrIndex)
        clrIndex = clrIndex + 1
        If clrIndex = 16 Then
            clrIndex = 0
        End If
       If (fnt.Rotation Mod 30 = 0) Then
            Picture1.Print "   旋转彩色文字" '& fnt.Rotation
       End If
        Call SelectObject(.hDC, hFont)
   End With
End Sub