frmcreate.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form frmCreate 
   AutoRedraw      =   -1  'True
   Caption         =   "奇形怪状的窗体"
   ClientHeight    =   3840
   ClientLeft      =   168
   ClientTop       =   456
   ClientWidth     =   5592
   LinkTopic       =   "Form1"
   NegotiateMenus  =   0   'False
   ScaleHeight     =   3840
   ScaleWidth      =   5592
   StartUpPosition =   1  '所有者中心
   Begin VB.PictureBox picSkin 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   2580
      Left            =   0
      ScaleHeight     =   215
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   308
      TabIndex        =   0
      Top             =   600
      Width           =   3700
   End
   Begin VB.Menu mnuFile 
      Caption         =   "File"
      Begin VB.Menu mnuSelect 
         Caption         =   "Cartman"
         Index           =   101
      End
      Begin VB.Menu mnuSelect 
         Caption         =   "Kenny"
         Index           =   102
      End
      Begin VB.Menu mnuSelect 
         Caption         =   "Kyle"
         Index           =   103
      End
      Begin VB.Menu mnuSelect 
         Caption         =   "Stan"
         Index           =   104
      End
      Begin VB.Menu mnuSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEnd 
         Caption         =   "Exit"
      End
   End
End
Attribute VB_Name = "frmCreate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private bSelectMode As Boolean

Private Sub Form_Load()
    ScaleMode = 3
    MouseIcon = LoadResPicture(101, 2)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MousePointer = 0
End Sub

Private Sub lblMask_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MousePointer = 0
End Sub

Private Sub mnuCreate_Click()

    Dim sFile As String
    Dim fLen As Integer
    
    If picSkin.Picture <> 0 Then
        fLen = Len(txtFileName) + 1
        sFile = App.Path + String(fLen, vbNullChar)
        PathAppend sFile, txtFileName
        
        If Dir(sFile) <> "" Then
            If MsgBox("Overwrite?", vbYesNo, "File exists!") = vbNo Then
                Exit Sub
            End If
        End If
        
        Dim rgn As New clsSkinForm
        
        rgn.CreateRegionFile picSkin, lblMask.BackColor, sFile
        txtFileName = txtFileName + 1
        MsgBox "Region file successfully created."
        Set rgn = Nothing
    Else
        MsgBox "No Picture Loaded!"
    End If
    
End Sub

Private Sub mnuEnd_Click()
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    Dim frm As Form
    
    For Each frm In Forms
        Unload frm
        Set frm = Nothing
    Next
   
End Sub

Private Sub mnuMask_Click()
    If picSkin.Picture <> 0 Then bSelectMode = True
End Sub

Private Sub mnuSelect_Click(Index As Integer)

    Dim skn As New clsSkinForm
    Dim sknfrm As New frmSkin
    
    skn.FormShape sknfrm, Index, Index
    sknfrm.Show
    
    
End Sub

Private Sub mnuSelPic_Click()
    picSkin.Picture = LoadPicture(FileSelect(Me))
    If Me.Width < picSkin.Width Then Me.Width = picSkin.Width
    If Me.Height < picSkin.Height Then Me.Height = picSkin.Height
End Sub

Private Sub picSkin_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bSelectMode Then
        lMaskColour = GetPixel(picSkin.hdc, X, Y)
        
        MousePointer = 0
        bSelectMode = False
    End If
End Sub

Private Sub picSkin_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bSelectMode Then MousePointer = 99
End Sub

Private Sub txtFileName_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MousePointer = 0
End Sub