frmmain.frm

VB源码三十种算法及图形

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMain 
   Caption         =   "各种算法图形及画笔"
   ClientHeight    =   4500
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4530
   LinkTopic       =   "Form1"
   ScaleHeight     =   300
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   302
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox picBCol 
      Height          =   255
      Left            =   7680
      ScaleHeight     =   195
      ScaleWidth      =   315
      TabIndex        =   6
      Top             =   6600
      Width           =   375
   End
   Begin VB.PictureBox picFCol 
      Height          =   255
      Left            =   7200
      ScaleHeight     =   195
      ScaleWidth      =   315
      TabIndex        =   5
      Top             =   6600
      Width           =   375
   End
   Begin VB.Frame fratemp 
      Height          =   15
      Left            =   0
      TabIndex        =   4
      Top             =   0
      Width           =   8175
   End
   Begin VB.HScrollBar scrHorz 
      Height          =   255
      Left            =   0
      TabIndex        =   3
      Top             =   4200
      Width           =   4215
   End
   Begin VB.VScrollBar scrVert 
      Height          =   4095
      Left            =   4200
      TabIndex        =   2
      Top             =   120
      Width           =   255
   End
   Begin VB.PictureBox picBack 
      Height          =   4095
      Left            =   120
      ScaleHeight     =   269
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   269
      TabIndex        =   0
      Top             =   120
      Width           =   4095
      Begin MSComDlg.CommonDialog comDiag 
         Left            =   4320
         Top             =   120
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
      End
      Begin VB.PictureBox picMain 
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Height          =   3900
         Left            =   0
         ScaleHeight     =   256
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   256
         TabIndex        =   1
         Top             =   0
         Width           =   3900
      End
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件"
      Begin VB.Menu mnuNew 
         Caption         =   "&New"
      End
      Begin VB.Menu mnuOpen 
         Caption         =   "&Open"
      End
      Begin VB.Menu mnuSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuTools 
      Caption         =   "画笔工具(&T)"
      Begin VB.Menu mnuPencil 
         Caption         =   "&Pencil"
      End
      Begin VB.Menu mnuStar 
         Caption         =   "&Star"
      End
      Begin VB.Menu mnuHorzLine 
         Caption         =   "&Horizontal Line"
      End
      Begin VB.Menu mnuVertLine 
         Caption         =   "&Vertical Line"
      End
      Begin VB.Menu mnuCrossND 
         Caption         =   "Cro&ss"
      End
      Begin VB.Menu mnuCross 
         Caption         =   "Diagonal C&ross"
      End
      Begin VB.Menu mnuUDefPolygon 
         Caption         =   "User-defined Polygon"
      End
      Begin VB.Menu mnuDiagLineRL 
         Caption         =   "Diag&onal Line (\)"
      End
      Begin VB.Menu mnuDiagLineLR 
         Caption         =   "Dia&gonal Line (/)"
      End
      Begin VB.Menu mnuText 
         Caption         =   "Te&xt"
      End
      Begin VB.Menu mnuStLine 
         Caption         =   "&Straight Line"
      End
      Begin VB.Menu mnuBrush 
         Caption         =   "&Brush"
      End
      Begin VB.Menu mnuErase 
         Caption         =   "E&rase"
      End
      Begin VB.Menu mnuFRect 
         Caption         =   "Fi&lled Rect"
      End
      Begin VB.Menu mnuFCircle 
         Caption         =   "&Filled Circle"
      End
      Begin VB.Menu mnuCircle 
         Caption         =   "&Circle"
      End
      Begin VB.Menu mnuRect 
         Caption         =   "&Rect"
      End
      Begin VB.Menu mnuPolygon 
         Caption         =   "&Polygon"
      End
      Begin VB.Menu mnuFillReg 
         Caption         =   "&Fill Regions"
      End
   End
   Begin VB.Menu mnuProps 
      Caption         =   "画笔属性(&P)"
      Begin VB.Menu mnuSetDW 
         Caption         =   "&Set the DrawWidth"
      End
      Begin VB.Menu mnuDS 
         Caption         =   "&DrawStyle"
         Begin VB.Menu mnuDFilled 
            Caption         =   "&Filled"
         End
         Begin VB.Menu mnuDLine 
            Caption         =   "&Line"
         End
         Begin VB.Menu mnuDPoint 
            Caption         =   "&Point"
         End
         Begin VB.Menu mnuDLinPoint 
            Caption         =   "Li&ne-Point"
         End
         Begin VB.Menu mnuDLinPointPt 
            Caption         =   "Line&-Point-Point"
         End
      End
      Begin VB.Menu mnuFStyle 
         Caption         =   "&FillStyle"
         Begin VB.Menu mnuFilled 
            Caption         =   "&Filled"
         End
         Begin VB.Menu mnuFHorzLine 
            Caption         =   "&Horizontal Line"
         End
         Begin VB.Menu mnuFVertLine 
            Caption         =   "&Vertical Line"
         End
         Begin VB.Menu mnuFDiagonalRL 
            Caption         =   "Diagonal (&\)"
         End
         Begin VB.Menu mnuFDiagonalLR 
            Caption         =   "Diagonal (&/)"
         End
         Begin VB.Menu mnuFCross 
            Caption         =   "&Cross"
         End
         Begin VB.Menu mnuFDiagCross 
            Caption         =   "Diagonal Cr&oss"
         End
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
    cX = picMain.ScaleWidth
    cY = picMain.ScaleHeight
    scrHorz.Value = 0
    scrHorz.Max = picMain.Width - 5
    scrVert.Value = 0
    scrVert.Max = picMain.Height - 5
    tColors.lBCol = vbBlue
    tColors.lFCol = vbBlack
    picFCol.BackColor = vbBlack
    picBCol.BackColor = vbBlue
End Sub



Private Sub Form_Resize()
    
    On Error GoTo Fa
    
    With picBack
        .Top = 8
        .Left = 8
        .Width = frmMain.ScaleWidth - 28
        .Height = frmMain.ScaleHeight - 60
    End With
    With scrHorz
        .Left = 8
        .Top = 10 + picBack.ScaleHeight
        .Width = picBack.ScaleWidth + 3
    End With
    With scrVert
        .Left = 8 + picBack.ScaleWidth
        .Top = 8
        .Height = picBack.ScaleHeight + 3
    End With
  
    
    With picBCol
        .Left = frmMain.ScaleWidth - 65
        .Top = frmMain.ScaleHeight - 16
    End With
    With picFCol
        .Left = frmMain.ScaleWidth - 33
        .Top = frmMain.ScaleHeight - 16
    End With
    fratemp.Width = frmMain.ScaleWidth
Fa:

End Sub


Private Sub mnuBrush_Click()
    curTools = Tools.sBrush
End Sub

Private Sub mnuCircle_Click()
    curTools = Tools.sCircle
End Sub



Private Sub mnuCross_Click()
    curTools = Tools.sCross
End Sub

Private Sub mnuCrossND_Click()
    curTools = Tools.sCrossND
End Sub

Private Sub mnuDFilled_Click()
    picMain.DrawStyle = 0
End Sub

Private Sub mnuDiagLineLR_Click()
    curTools = Tools.sDiagLineLR
End Sub

Private Sub mnuDiagLineRL_Click()
    curTools = Tools.sDiagLineRL
End Sub

Private Sub mnuDLine_Click()
    picMain.DrawStyle = 1
End Sub

Private Sub mnuDLinPoint_Click()
    picMain.DrawStyle = 3
End Sub

Private Sub mnuDLinPointPt_Click()
    picMain.DrawStyle = 4
End Sub

Private Sub mnuDPoint_Click()
    picMain.DrawStyle = 2
End Sub

Private Sub mnuEmboss_Click()

End Sub

Private Sub mnuErase_Click()
    curTools = Tools.sErase
End Sub

Private Sub mnuFCircle_Click()
    curTools = Tools.sFCircle
End Sub

Private Sub mnuFCross_Click()
    propFillStyle = 6
End Sub

Private Sub mnuFDiagCross_Click()
    propFillStyle = 7
End Sub

Private Sub mnuFDiagonalLR_Click()
    propFillStyle = 5
End Sub

Private Sub mnuFDiagonalRL_Click()
    propFillStyle = 4
End Sub

Private Sub mnuFHorzLine_Click()
    propFillStyle = 2
End Sub

Private Sub mnuFilled_Click()
    propFillStyle = 0
End Sub

Private Sub mnuFillReg_Click()
    curTools = Tools.sFillRegions
End Sub







Private Sub mnuFlip1_Click()

End Sub

Private Sub mnuFlip2_Click()

End Sub

Private Sub mnuFlip3_Click()

End Sub

Private Sub mnuFRect_Click()
    curTools = Tools.sFRect
End Sub

Private Sub mnuFVertLine_Click()
    propFillStyle = 3
End Sub



Private Sub mnuHammer_Click()

End Sub

Private Sub mnuHeat_Click()
    Dim bNo As Boolean
    Dim TColW As Long
    
    Call Save
    For i = 0 To cX
        For j = 0 To cY
            TColW = GetPixel(picMain.hdc, i, j)
            r = TColW Mod 256
            g = (TColW \ 256) Mod 256
            b = TColW \ 256 \ 256
            
            r = Abs(((r ^ 2) / ((b + g) + 10)) * 128)
            b = Abs(((b ^ 2) / ((g + r) + 10)) * 128)
            g = Abs(((g ^ 2) / ((r + b) + 10)) * 128)
nOK:
                If r > 32767 Then
                    r = r - 32767
                ElseIf g > 32767 Then
                    g = g - 32767