skygzform.ctl

多功能文档编辑器源代码,用VC++开发,适合编程人员参考使用。

VERSION 5.00
Begin VB.UserControl SkyGzForm 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00FFFFFF&
   ClientHeight    =   3735
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4620
   ControlContainer=   -1  'True
   Picture         =   "SkyGzForm.ctx":0000
   ScaleHeight     =   3735
   ScaleWidth      =   4620
   Begin VB.Image ImgJack 
      Height          =   2385
      Left            =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   3825
   End
   Begin VB.Label LbJack 
      BackStyle       =   0  'Transparent
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3135
   End
   Begin VB.Image ImgClose 
      Height          =   255
      Left            =   3320
      Top             =   120
      Width           =   255
   End
End
Attribute VB_Name = "SkyGzForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer, ByVal x3 As Integer, ByVal y3 As Integer) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hrgn As Long, ByVal bRedraw As Boolean) As Long

Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const HTCAPTION = 2

Private m_Hwnd As Long
Private m_Caption As String

Public Event UnloadClick()
Public Event Click()
Attribute Click.VB_Description = "当用户在一个对象上按下并释放鼠标按钮时发生。"
Public Event DblClick()
Attribute DblClick.VB_Description = "当用户在一个对象上按下并释放鼠标按钮后再次按下并释放鼠标时发生。"
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
Attribute MouseMove.VB_Description = "当用户移动鼠标时发生。"
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
Attribute MouseUp.VB_Description = "当用户在拥有焦点的对象上释放鼠标发生。"
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Attribute MouseDown.VB_Description = "当用户在拥有焦点的对象上按下鼠标按钮时发生。"

Private Sub ImgClose_Click()
RaiseEvent UnloadClick
End Sub

Private Sub UserControl_Click()
RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub

Private Sub UserControl_Initialize()
ImgJack.Picture = LoadResPicture(101, vbResBitmap)
ImgClose.Picture = LoadResPicture(102, vbResBitmap)
ImgClose.MouseIcon = LoadResPicture(101, vbResCursor)
ImgClose.MousePointer = 99
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, x, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
ImgClose.Picture = LoadResPicture(104, vbResBitmap)
RaiseEvent MouseMove(Button, Shift, x, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, x, Y)
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
    m_Caption = .ReadProperty("Caption", "")
    Set UserControl.Picture = .ReadProperty("Icon", UserControl.Picture)
End With
End Sub

Private Sub UserControl_Resize()
DrawFrm m_Caption
End Sub

Public Sub SetRgn(ByVal Obj, ByVal Rgn As Long)
Dim Hround As Long
Hround = CreateRoundRectRgn(0, 0, ScaleX(Obj.Width, vbTwips, vbPixels), ScaleY(Obj.Height, vbTwips, vbPixels), Rgn, Rgn)
SetWindowRgn Obj.hwnd, Hround, True
DeleteObject Hround
End Sub

Private Sub ImgClose_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
ImgClose.Picture = LoadResPicture(104, vbResBitmap)
End Sub

Private Sub ImgClose_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
ImgClose.Picture = LoadResPicture(103, vbResBitmap)
End Sub
Private Sub LbJack_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 1 Then
    UserControl.MousePointer = 15
    ReleaseCapture
    SendMessage m_Hwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0
    UserControl.MousePointer = 0
End If
End Sub

Public Property Get hwnd() As Long
Attribute hwnd.VB_MemberFlags = "400"
    hwnd = m_Hwnd
End Property

Public Property Let hwnd(ByVal New_Hwnd As Long)
    m_Hwnd = New_Hwnd
End Property

Public Property Get Caption() As String
Attribute Caption.VB_Description = "返回/设置对象的标题栏中或图标下面的文本。"
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    DrawFrm m_Caption
End Property

Private Sub UserControl_Show()
DrawFrm m_Caption
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
    Call .WriteProperty("Caption", m_Caption, "")
    Call .WriteProperty("Icon", UserControl.Picture)
End With
End Sub


Private Sub DrawFrm(Optional ByVal C_Caption As String = "SkyGz")
If Height <= 1100 Then Height = 1100
If Width <= 1750 Then Width = 1750
With UserControl
    .PaintPicture ImgJack.Picture, 420, 0, .Width, 600, 420, 0, 120, 600
    .PaintPicture ImgJack.Picture, 420, .Height - 600, .Width, 600, 420, ImgJack.Height - 600, 120, 600

    .PaintPicture ImgJack.Picture, 0, 0, 200, .Height, 0, 880, 200, 40
    .PaintPicture ImgJack.Picture, .Width - 210, 0, 210, .Height, ImgJack.Width - 210, 880, 210, 40

    .PaintPicture ImgJack.Picture, 0, 0, 450, 600, 0, 0, 450, 600
    .PaintPicture ImgJack.Picture, 0, .Height - 600, 450, 600, 0, ImgJack.Height - 600, 450, 600

    .PaintPicture ImgJack.Picture, .Width - 1665, 0, 1640, 435, ImgJack.Width - 1665, 0, 1660, 435
    .PaintPicture ImgJack.Picture, .Width - 1665, .Height - 525, 1665, 525, ImgJack.Width - 1665, ImgJack.Height - 525, 1665, 525
    If .Picture <> 0 Then
    .PaintPicture .Picture, 100, 80, 240, 240, 0, 0, 240, 240   '打印标题图标
    End If
End With
'BackColor = C_BackColor

ImgClose.Left = UserControl.ScaleWidth - ImgClose.Width - 370
ImgClose.Top = 100
LbJack.Width = UserControl.Width - 700

SetRgn UserControl, 5

With UserControl
        .FontBold = True
        .ForeColor = &HFFFFFF
        If .Picture <> 0 Then .CurrentX = 401 Else .CurrentX = 101
        .CurrentY = 101
        UserControl.Print C_Caption '打印标题，有阴影的
        .ForeColor = &HA64202
        If .Picture <> 0 Then .CurrentX = 401 Else .CurrentX = 101
        .CurrentY = 100
        UserControl.Print C_Caption
    End With
    UserControl.Line (50, 415)-(UserControl.Width - 78, UserControl.Height - 90), &HFFF6EB, BF
End Sub

Public Property Get Icon() As StdPicture
Attribute Icon.VB_Description = "返回运行时窗体所显示的图标。"
    Set Icon = UserControl.Picture
End Property

Public Property Set Icon(ByVal New_icon As StdPicture)
    Set UserControl.Picture = New_icon
    DrawFrm m_Caption
End Property

Public Property Let Icon(ByVal New_icon As StdPicture)
    Set UserControl.Picture = New_icon
    DrawFrm m_Caption
End Property