main.frm

内似于WINDOWS的画比工具的VB程序

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.MDIForm MDIForm1 
   BackColor       =   &H8000000B&
   Caption         =   "画图1.00版"
   ClientHeight    =   6405
   ClientLeft      =   2280
   ClientTop       =   255
   ClientWidth     =   9330
   Icon            =   "main.frx":0000
   LinkTopic       =   "MDIForm1"
   StartUpPosition =   2  'CenterScreen
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   0
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Menu m1 
      Caption         =   "文件(&F)"
      Begin VB.Menu clear 
         Caption         =   "新建(&N)"
         Shortcut        =   ^N
      End
      Begin VB.Menu open 
         Caption         =   "打开(&O)..."
         Shortcut        =   ^O
      End
      Begin VB.Menu save 
         Caption         =   "保存(&S)"
         Shortcut        =   ^S
      End
      Begin VB.Menu m1b5 
         Caption         =   "-"
      End
      Begin VB.Menu m1b8 
         Caption         =   "打印(&P)..."
         Index           =   1
         Shortcut        =   ^P
      End
      Begin VB.Menu m1b8 
         Caption         =   "-"
         Index           =   2
      End
      Begin VB.Menu m1b9 
         Caption         =   "设置为墙纸(居中)(&L)"
      End
      Begin VB.Menu m1b11 
         Caption         =   "-"
      End
      Begin VB.Menu exit 
         Caption         =   "退出(&X)      Alt+F4"
      End
   End
   Begin VB.Menu m2 
      Caption         =   "编辑(&E)"
      Begin VB.Menu cut 
         Caption         =   "剪切(&T)"
         Shortcut        =   ^X
      End
      Begin VB.Menu copy 
         Caption         =   "复制(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu plst 
         Caption         =   "粘贴(&P)"
         Shortcut        =   ^V
      End
      Begin VB.Menu m2b7 
         Caption         =   "全选(&A)"
         Shortcut        =   ^A
      End
   End
   Begin VB.Menu m3 
      Caption         =   "查看(&V)"
      Begin VB.Menu m3b1 
         Caption         =   "工具箱(&T)"
         Checked         =   -1  'True
         Shortcut        =   ^T
      End
      Begin VB.Menu m3b2 
         Caption         =   "颜料盒(&C)"
         Checked         =   -1  'True
         Shortcut        =   ^L
      End
   End
   Begin VB.Menu m4 
      Caption         =   "图像(&I)"
      Begin VB.Menu m4b1 
         Caption         =   "翻转/旋转(&F)"
         Shortcut        =   ^R
      End
      Begin VB.Menu fanse 
         Caption         =   "反色(&I)"
         Shortcut        =   ^I
      End
      Begin VB.Menu shuxing 
         Caption         =   "属性(&A)"
         Shortcut        =   ^E
      End
      Begin VB.Menu m4b5 
         Caption         =   "消除图像(&C)"
      End
   End
   Begin VB.Menu m51 
      Caption         =   "颜色(&C)"
      Begin VB.Menu m5 
         Caption         =   "编辑颜色(&E)..."
      End
   End
   Begin VB.Menu help 
      Caption         =   "帮助(&H)"
      Begin VB.Menu about 
         Caption         =   "关于本软件"
      End
   End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SelectObject& Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long)
Private Declare Function DeleteObject& Lib "GDI32" (ByVal hObject As Long)
Private Declare Function CreateBitmap& Lib "GDI32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any)
Private Declare Function CreatePatternBrush& Lib "GDI32" (ByVal hbitmap As Long)
Dim a As Integer
Dim f As String
'版权信息
Private Sub about_Click()
Form2.Label1.Caption = "软件信息"
MsgBox "软件作者:UvX e-mail:[e-mail]  *2001.8.20", , "画图1.00版帮助"
End Sub


'清除当前画板
Private Sub clear_Click()
a = MsgBox("是否保存文件?", vbYesNo, "请确认")
If a = 6 Then
CommonDialog1.Filter = "bmp文件|*.bmp|所有文件|*.*"
CommonDialog1.Action = 2
f$ = CommonDialog1.FileName
If f$ <> "" Then
SavePicture Form1.Picture1.Image, f$
End If
End If
'重置
Form2.Label1.Caption = "新建文件"
Form1.Picture1.Line (0, 0)-(Form1.Picture1.Width, Form1.Picture1.Height), RGB(255, 255, 255), BF
End Sub
'图形复制
Private Sub copy_Click()
Form2.Label1.Caption = "复制"
'确定有选择
If Selected = 1 Then
xxx = small(Selectx1, Selectx2)
xwidth = Abs(Selectx2 - Selectx1)
yyy = small(Selecty1, Selecty2)
yheight = Abs(Selecty2 - Selecty1)
'将剪切图形保存在缓冲图形框中
Form5.Picture2.Width = xwidth * 15
Form5.Picture2.Height = yheight * 15
Form5.Picture2.PaintPicture Form1.Picture1.Image, 1, 1, , , xxx, yyy, xwidth, yheight, &HCC0020

Stored = 1
End If

End Sub


'图形剪切
Private Sub cut_Click()
Form2.Label1.Caption = "剪切"
'确定有选择
If Selected = 1 Then
xxx = small(Selectx1, Selectx2)
xwidth = Abs(Selectx2 - Selectx1)
yyy = small(Selecty1, Selecty2)
yheight = Abs(Selecty2 - Selecty1)
'将剪切图形保存在缓冲图形框中，并用底色填充选择区域
Form5.Picture2.Width = xwidth * 15
Form5.Picture2.Height = yheight * 15
Form5.Picture2.PaintPicture Form1.Picture1.Image, 1, 1, , , xxx, yyy, xwidth, yheight, &HCC0020
Form1.Picture1.Line (xxx, yyy)-(xwidth + xxx, yheight + yyy), Curbkcolor, BF

Stored = 1
End If
End Sub
'退出程序
Private Sub exit_Click()
Form2.Label1.Caption = "退出"
a = MsgBox("是否保存文件?", vbYesNo, "请确认")
If a = 6 Then
CommonDialog1.Filter = "bmp文件|*.bmp|所有文件|*.*"
CommonDialog1.Action = 2
f$ = CommonDialog1.FileName
If f$ <> "" Then
SavePicture Form1.Picture1.Image, f$
End If
End If
dl = DeleteObject(newbrush)
dl = DeleteObject(oldbrush)
End
End Sub
'反色操作
Private Sub fanse_Click()
Form2.Label1.Caption = "反色操作"
chu_li ("fanse")
End Sub
'打印操作
Private Sub m1b8_Click(Index As Integer)
Form2.Label1.Caption = "打印"
Printer.Print Form1.Picture1
End Sub
'设置为壁纸(居中-拉伸)
Private Sub m1b9_Click()
Form2.Label1.Caption = "设置为壁纸"

f$ = "back.bmp"
If f$ <> "" Then
SavePicture Form1.Picture1.Image, f$
End If
'调用api函数
Dim ChangeWP
ChangeWP = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "back.bmp", 0)
MsgBox "壁纸设定完毕(居中-拉伸) " & vbCrLf & "" & vbCrLf & UCase$("back.bmp") & vbCrLf & "", 64, "设定为壁纸"
End Sub
'全选
Private Sub m2b7_Click()
Form2.Label1.Caption = "全选"
Selected = 0
Selectx1 = 1
Selecty1 = 1
Selectx2 = 1
Selecty2 = 1
Form1.Line2.x1 = 0
Form1.Line2.y1 = 0
Form1.Line2.x2 = 0
Form1.Line2.y2 = 0
Form1.Line3.x1 = 0
Form1.Line3.y1 = 0
Form1.Line3.x2 = 0
Form1.Line3.y2 = 0
Form1.Line4.x1 = 0
Form1.Line4.y1 = 0
Form1.Line4.x2 = 0
Form1.Line4.y2 = 0
Form1.Line5.x1 = 0
Form1.Line5.y1 = 0
Form1.Line5.x2 = 0
Form1.Line5.y2 = 0
Huabi = 6
Form1.Shape1.Visible = False
lshow
End Sub
'颜料盒,工具箱的隐藏和显示
Private Sub m3b1_Click()
m3b1.Checked = Not m3b1.Checked
Form3.Visible = Not Form3.Visible
If Form3.Visible = True Then
Form2.Label1.Caption = "显示工具箱"
Else: Form2.Label1.Caption = "隐藏工具箱"
End If
End Sub

Private Sub m3b2_Click()
m3b2.Checked = Not m3b2.Checked
Form2.Visible = Not Form2.Visible
If Form3.Visible = True Then
Form2.Label1.Caption = "显示颜料盒"
Else: Form2.Label1.Caption = "隐藏颜料盒"
End If
End Sub
'翻转/旋转 图像
Private Sub m4b1_Click()
SavePicture Form1.Picture1.Image, "backup.bmp"
Form2.Label1.Caption = "翻转/旋转 图像"
Load Form7
Form7.Show
MDIForm1.Enabled = False
End Sub
'拉伸图像
Private Sub m4b2_Click()
Form2.Label1.Caption = "拉伸图像"
Load Form8
Form8.Show
MDIForm1.Enabled = False
End Sub
'消除图像
Private Sub m4b5_Click()
Form2.Label1.Caption = "消除图像"
Call clear_Click
End Sub
'自定义颜色
Private Sub m5_Click()
Form2.Label1.Caption = "自定义颜色"
CommonDialog1.ShowColor
Form2.Picture11.BackColor = CommonDialog1.Color
End Sub
'子窗体的初值
Private Sub MDIForm_Load()
Form1.Width = (Form1.Picture1.Width) * 15
Form1.Height = (Form1.Picture1.Height) * 15
MDIForm1.Width = Form1.Width + Form3.Width * 2.5
Form2.Width = Form3.Width * 1.7 + Form1.Width
Form2.Top = MDIForm1.Height - Form2.Height

'各窗体的属性
Form5.Hide
Form1.Visible = True
Form2.Visible = True
Form3.Visible = True
Form6.Top = Screen.Height / 2 - Form6.Height / 2
Form6.Left = Screen.Width / 2 - Form6.Width / 2
'前景，背景颜色初值
Curcolor = Form2.Picture11.BackColor
Curbkcolor = Form2.Picture10.BackColor
Huabi = 1
MDIForm1.WindowState = 0
Form1.Left = 0
Form1.Top = 0
Form1.Left = Form3.Width
Form1.Top = 0
Form1.Picture1.Width = 500
Form1.Picture1.Height = 330
hbitmap& = CreateBitmap(8, 8, 1, 1, ARRY(1))
newbrush& = CreatePatternBrush(hbitmap)
Form5.Picture1.Width = Form1.Picture1.Width
Form5.Picture1.Height = Form1.Picture1.Height
Curcolor = RGB(0, 0, 0)
Curbkcolor = RGB(255, 255, 255)
End Sub
'窗体的关闭
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
a = MsgBox("是否保存文件?", vbYesNo, "请确认")
If a = 6 Then
CommonDialog1.Filter = "bmp文件|*.bmp|所有文件|*.*"
CommonDialog1.Action = 2
f$ = CommonDialog1.FileName
If f$ <> "" Then
SavePicture Form1.Picture1.Image, f$
End If
End If
dl = DeleteObject(newbrush)
dl = DeleteObject(oldbrush)

End Sub
'窗体变形后的布局
Private Sub MDIForm_Resize()
Form2.Width = Form3.Width + Form1.Width
Form2.Left = 0
Form3.Left = 0
Form3.Top = 0
Form1.Left = Form3.Width
Form1.Top = 0
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
End
End Sub
'打开新文件
Private Sub open_Click()
a = MsgBox("是否保存文件?", vbYesNo, "请确认")
If a = 6 Then
CommonDialog1.Filter = "bmp文件|*.bmp|所有文件|*.*"
CommonDialog1.Action = 2
f$ = CommonDialog1.FileName
If f$ <> "" Then
SavePicture Form1.Picture1.Image, f$
End If
End If
Form2.Label1.Caption = "打开文件"
On Error Resume Next
CommonDialog1.Filter = "bmp文件|*.bmp|jpg文件|*.jpg|所有文件|*.*"
CommonDialog1.Action = 1
f$ = CommonDialog1.FileName
If f$ <> "" Then
Form1.Picture1.Picture = LoadPicture(f$)
Form5.Picture1.Width = Form1.Picture1.Width
Form5.Picture1.Height = Form1.Picture1.Height
End If
End Sub

'粘贴操作
Private Sub plst_Click()
Form2.Label1.Caption = "粘贴"
If Stored = 1 Then
If Selected = 1 Then
'确定粘贴的数值
xxx = small(Selectx1, Selectx2)
xwidth = Abs(Selectx2 - Selectx1)
yyy = small(Selecty1, Selecty2)
yheight = Abs(Selecty2 - Selecty1)
'在picture控件上粘贴
If xwidth < 3 Or yheight < 3 Then
Form1.Picture1.PaintPicture Form5.Picture2.Image, xxx, yyy, , , 1, 1, Form5.Picture2.Width / 15, Form5.Picture2.Height / 15, &HCC0020
Else
Form1.Picture1.PaintPicture Form5.Picture2.Image, xxx, yyy, xwidth, yheight, 1, 1, Form5.Picture2.Width / 15, Form5.Picture2.Height / 15, &HCC0020
End If
Else
Form1.Picture1.PaintPicture Form5.Picture2.Image, 0, 0, Form1.Picture1.Width, Form1.Picture1.Height, 1, 1, Form5.Picture2.Width / 15, Form5.Picture2.Height / 15, &HCC0020
End If
End If
End Sub

'保存文件
Private Sub save_Click()
Form2.Label1.Caption = "保存文件"
CommonDialog1.Filter = "bmp文件|*.bmp|所有文件|*.*"
CommonDialog1.Action = 2
f$ = CommonDialog1.FileName
If f$ <> "" Then
SavePicture Form1.Picture1.Image, f$
End If
End Sub

Private Sub shuxing_Click()
Form2.Label1.Caption = "属性"
Form4.Show
End Sub