VB小程序源代码：为图片添加水印文字或水印图案
' '以下是窗体代码，在 VB6 和 WinXP 调试通过
'需在窗体放置以下控件，所有控件不必设置任何属性（包括位置和大小），全部采用默认设置：
'   1 个 文本框：Text1
'   5 个 按钮：Command1、Command2、Command3、Command4、Command5
'   6 个 下拉列表框：Combo1、Combo2、Combo3、Combo4、Combo5、Combo6
'   3 个 选择按钮：Check1、Check2、Check3
'   2 个 图片框：Picture1、Picture2
'   1 个 形状控件：Shape1
'本人原创，转载请注明文章来源：hi.baidu/100bd/blog/item/c4199fed77e54f3563d09fb5.html
Private Type BitMap
   bmType As Long         '图像类型：0 表示是位图
   bmWidth As Long        '图像宽度（像素）
   bmHeight As Long       '图像高度（像素）
   bmWidthBytes As Long   '每一行图像的字节数
   bmPlanes As Integer    '图像的图层数
   bmBitsPixel As Integer '图像的位数
   bmBits As Long         '位图的内存指针
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Type tyRGB
   R As Long: G As Long: B As Long
End Type
Dim ctIsText As Boolean, ctRun As Boolean, ctF As String
Private Sub Form_Load()
   Me.Caption = "水印"
   Me.ScaleMode = 3
   Command1.Caption = "文字水印": Command1.ToolTipText = "切换到叠加文字水印状态"
  Command2.Caption = "图片水印": Command2.ToolTipText = "切换到叠加图片水印状态"
  Command3.Caption = "装载水印图片"
  Command4.Caption = "打开": Command4.ToolTipText = "加载背景图片"
  Command5.Caption = "保存": Command5.ToolTipText = "保存图片"
  Check1.Caption = "下凹文字": Check2.Caption = "斜体": Check3.Caption = "粗体" 
   
   Picture1.AutoRedraw = True: Picture1.ScaleMode = 3
   Picture2.AutoRedraw = True: Picture2.ScaleMode = 3
   Picture1.AutoSize = True: Picture2.AutoSize = True
   Picture1.BackColor = &H888888
   Picture2.Picture = Me.Icon
   
   Set Shape1.Container = Picture1
   Shape1.DrawMode = 14
   Shape1.FillStyle = 0
   
   Dim I As Long
   For I = 1 To 9
      Combo1.AddItem "0." & I & " 水印清晰度"
   Next
   Combo1.AddItem "1  水印清晰度"
   Combo1.ListIndex = 4
   
   Combo2.AddItem "阴影宽度 1"
   Combo2.AddItem "阴影宽度 2"
   Combo2.AddItem "阴影宽度 3"
   Combo2.ListIndex = 0
   
   For I = 0 To Screen.FontCount - 1
      Combo3.AddItem Screen.Fonts(I)
   Next
   Combo3.Text = "宋体"
   
   For I = 3 To 72 Step 3
      Combo4.AddItem I & "号"
   Next
   Combo4.Text = "15 号"
   
   Combo5.AddItem "彩水印"
   Combo5.AddItem "黑白水印"
   Combo5.AddItem "版画式水印"
   Combo5.ListIndex = 2
   
   For I = 0 To 30
      Combo6.AddItem "背景杂消除 " & I
   Next
   Combo6.ListIndex = 20
   
   Text1.Text = "hi.baidu/100bd" '"一○○度制作" '中国
   Text1.ToolTipText = "在此处输入叠加在图片上的水印文字"
   Call SetKj
   ctRun = True
   Shape1.Visible = False: Shape1.Move 0, 0
   Call AddWater(True)
End Sub
Private Sub SetKj()
   Dim H As Long
   H = Me.TextWidth("A")
   Command1.Move H, H, H * 10, H * 3:       Text1.Move H * 12, H, H * 43, H * 3
   Check1.Move H, H * 5, H * 12, H * 2:     Combo4.Move H * 15, H * 4.5, H * 9
   Combo3.Move H * 24, H * 4.5, H * 23:     Check2.Move H * 48, H * 5, H * 8, H * 2
   Command4.Move H, H * 7.5, H * 6, H * 3:  Command5.Move H * 8, H * 7.5, H * 6, H * 3
   Combo1.Move H * 15, H * 8, H * 18
   Combo2.Move H * 33, H * 8, H * 14:       Check3.Move H * 48, H * 8.5, H * 8, H * 2
   Picture1.Move H, H * 11.5, H * 50, H * 40
   
改变button按钮的形状   Command2.Move H * 57, H, H * 10, H * 3:     Combo6.Move H * 68, H * 1.5, H * 20
   Command3.Move H * 57, H * 5, H * 14, H * 3: Combo5.Move H * 72, H * 5.5, H * 16
   Picture2.Move H * 57, H * 8.5, H * 5, H * 5
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Picture1.ZOrder
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim W As Long, H As Long
   If Button <> 1 Then Exit Sub

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。