Asp组件高级入门与精通系列之一

原创 2005年07月13日 23:41:00

很久没有写这个系列了,最近一直在忙其他的东西

高级的组件话题我们将讨论一些比较难实现的,复杂的东西

前段时间我写了一个龙卷风缩略图水印组件,感觉效果还不错,由于是vb写的,有一些难度,大家一起来看看

这里有帖子:http://community.csdn.net/Expert/topic/4115/4115767.xml?temp=.9513056

功能如下:

龙卷风缩略图水印组件1.0版
功能特点:
1.支持从bmp位图,jpeg,gif导入
2.仅支持生成jpeg格式
3.文字水印,支持自定义字体,旋转角度,颜色,字体宽度和高度
4.图片水印,支持透明度
5.暂时不支持直接将文件流写入浏览器
6.消耗系统资源少
7.每个例子都有详细的注释


龙卷风缩略图水印组件0.9版
功能特点:
1.仅仅支持从bmp位图导入
2.仅仅支持生成jpeg格式
3.消耗系统资源少

版本历史
龙卷风缩略图水印组件1.0版
时间:2005-02-13
增加了对jpg,gif图像导入的支持
时间:2005-02-12
功能:增加了图片水印功能
时间:2005-02-11
功能:增加了文字水印功能

龙卷风缩略图水印组件0.9版
时间:2005-02-10
功能:仅支持bmp位图导入功能,支持生成jpeg功能,只有缩略功能


可以免费使用,无任何限制
如有问题,希望提出,以便我改进
我的email:yyg19780718@163.com

代码如下:

模块1:

Option Explicit
'有部分代码不需要,以后可能会用到

Public Const LR_LOADFROMFILE = &H10
Public Const IMAGE_BITMAP = 0
Public Const IMAGE_ICON = 1
Public Const IMAGE_CURSOR = 2
Public Const IMAGE_ENHMETAFILE = 3

Public Const SRCCOPY           As Long = &HCC0020
Public Const BI_RGB = 0&
Public Const DIB_RGB_COLORS = 0 '结构BITMAPINFO中包含了RGB值的数组RGBQUAD
Public Const STRETCH_HALFTONE  As Long = &H4&

Public Type BITMAPINFOHEADER '40 字节位图文件头
        biSize As Long          '结构所需字节数
        biWidth As Long         '图像宽度
        biHeight As Long        '图像高度
        biPlanes As Integer     '必须为1,不用考虑
        biBitCount As Integer   '颜色位数
        biCompression As Long   '指定是否压缩,一般取BI_RGB
        biSizeImage As Long     '实际的位图占据的字节数,=biWidth'(必须是4的整数〕*biHeight
        biXPelsPerMeter As Long '水平分辨率
        biYPelsPerMeter As Long '垂直分辨率
        biClrUsed As Long       '本图像用到的实际实际颜色数
        biClrImportant As Long  '本图像中重要的颜色数,为0,则认为所有的图像都是重要的
End Type

Public Type RGBQUAD
        rgbBlue As Byte         '该颜色的蓝色分量
        rgbGreen As Byte        '该颜色的绿色分量
        rgbRed As Byte          '该颜色的红色分量
        rgbReserved As Byte     '保留值
End Type

Public Type Bitmap
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Public Type BitmapInfo
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
End Type

Public Type BITMAPFILEHEADER
    bfType(1 To 2) As Byte
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type


Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BitmapInfo, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BitmapInfo, ByVal wUsage As Long) As Long
Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BitmapInfo, ByVal wUsage As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long

模块2:

Option Explicit

'以下是输出文字水印的api
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Public Const LF_FACESIZE = 32
Public Const TRANSPARENT = 1
'逻辑字体结构
Public Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * LF_FACESIZE
End Type

'图片水印透明处理
Public Declare Function AlphaBlend Lib "MSIMG32.dll" ( _
  ByVal hdcDest As Long, _
  ByVal nXOriginDest As Long, _
  ByVal nYOriginDest As Long, _
  ByVal nWidthDest As Long, _
  ByVal nHeightDest As Long, _
  ByVal hdcSrc As Long, _
  ByVal nXOriginSrc As Long, _
  ByVal nYOriginSrc As Long, _
  ByVal nWidthSrc As Long, _
  ByVal nHeightSrc As Long, _
  ByVal lBlendFunction As Long _
) As Long

Public Type BLENDFUNCTION
  BlendOp As Byte
  BlendFlags As Byte
  SourceConstantAlpha As Byte
  AlphaFormat As Byte
End Type
' BlendOp:
Public Const AC_SRC_OVER = &H0
' AlphaFormat:
Public Const AC_SRC_ALPHA = &H1

模块3

Option Explicit

'以下是GDI+的声明
Public Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Public Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

Public Type EncoderParameter
   GUID As GUID
   NumberOfValues As Long
   type As Long
   Value As Long
End Type

Public Type EncoderParameters
   Count As Long
   Parameter As EncoderParameter
End Type

Public Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Public Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Public Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long
Public Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Public Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Public Declare Function GdipSaveImageToStream Lib "GDIPlus" (ByVal Image As Long, ByVal stream As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Public Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long

'保存成jpeg格式
Public Sub SaveJPG(ByVal pict As Long, ByVal filename As String, Optional ByVal quality As Byte = 100)
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long

   ' Initialize GDI+
   tSI.GdiplusVersion = 1
   lRes = GdiplusStartup(lGDIP, tSI)
  
   If lRes = 0 Then
  
      ' Create the GDI+ bitmap
      ' from the image handle
      lRes = GdipCreateBitmapFromHBITMAP(pict, 0, lBitmap)
  
      If lRes = 0 Then
         Dim tJpgEncoder As GUID
         Dim tParams As EncoderParameters
        
         ' Initialize the encoder GUID
         CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), _
                         tJpgEncoder
     
         ' Initialize the encoder parameters
         tParams.Count = 1
         With tParams.Parameter ' Quality
            ' Set the Quality GUID
            CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB3505E7EB}"), .GUID
            .NumberOfValues = 1
            .type = 1
            .Value = VarPtr(quality)
         End With
        
         ' Save the image
         lRes = GdipSaveImageToFile(lBitmap, StrPtr(filename), tJpgEncoder, tParams)
                            
         ' Destroy the bitmap
         GdipDisposeImage lBitmap
        
      End If
     
      ' Shutdown GDI+
      GdiplusShutdown lGDIP

   End If
  
   If lRes Then
      Err.Raise vbObjectError + 515, , "保存图像发生了错误,错误号:" & lRes
   End If
  
End Sub

WF从入门到精通系列

WF从入门到精通系列
  • tigerzx
  • tigerzx
  • 2017年03月11日 12:47
  • 158

北风网web开发资深讲师李炎恢出品--ASP系列课程从入门到精通

北风网web开发资深讲师李炎恢出品--ASP系列课程从入门到精通http://www.verycd.com/topics/2755115/中文名: 北风网web开发资深讲师李炎恢出品--ASP系列课程...
  • gxj022
  • gxj022
  • 2010年04月27日 10:32
  • 1504

Redis入门到精通-Redis高级命令

六、Redis高级命令 高级命令 ​ keys * : 返回满足的所有键 ,可以模糊匹配 ​ exists :是否存在指定的key,存在返回1,不存在返回0 ​ exprie:设置某个key的过期时...
  • chensizheng
  • chensizheng
  • 2017年10月23日 12:05
  • 106

Asp组件初级入门与精通系列之一

  • zgqtxwd
  • zgqtxwd
  • 2008年04月24日 08:25
  • 55

Asp组件高级入门与精通系列之二

工程名flysoft   类模块image.clsOption Explicit*****************************************************CSDN VB...
  • online
  • online
  • 2005年07月13日 23:45
  • 2980

Asp组件中级入门与精通系列之一

  • zgqtxwd
  • zgqtxwd
  • 2008年04月24日 13:40
  • 218

Windows 2008从入门到精通系列教程(一)

Windows Server 2008从入门到精通系列教程(一)             自我庆祝一下,荣幸的获得了微软最有价值专家,感谢51CTO这个平台,感谢各位朋友对我的支持和厚爱。以后我...
  • pmpgao
  • pmpgao
  • 2014年11月12日 15:54
  • 720

USB入门系列之一:USB概述

USB是什么呢?一说USB是You SB的意思,即“你傻B”的意思。另一种说法是USB其实是美国的弟弟,因为美国叫USA,USB当然是他的弟弟了。...
  • kevinhg
  • kevinhg
  • 2010年09月30日 23:44
  • 2116

Asp组件高级入门与精通系列之三

asp中测试  生成缩略On Error resume nextset obj=server.CreateObject("flysoft.image")obj.LoadFromFile=server....
  • online
  • online
  • 2005年07月13日 23:58
  • 3761

ZED-Board从入门到精通系列例程——全局定时器

本文系ZED-Board从入门到精通(三):从传统ARM开发到PS开发的转变之后增加的PS例程。由于原文较长,在原帖后面添加例程会使阅读不便,于是单独开一帖。   定时器是硬件系统运行状态的忠实记录者...
  • kkk584520
  • kkk584520
  • 2013年08月17日 22:43
  • 4915
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:Asp组件高级入门与精通系列之一
举报原因:
原因补充:

(最多只允许输入30个字)