很久沒有寫這個系列了，最近一直在忙其他的東西高級的組件話題我們將討論一些比較難實現的，復雜的東西前段時間我寫了一個龍卷風縮略圖水印組件，感覺效果還不錯，由于是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 = 3Public 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 TypePublic Type Bitmap bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End TypePublic Type BitmapInfo bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUAD End TypePublic 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 LongPublic 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 LongPublic 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 模塊3Option Explicit'以下是GDI+的聲明 Public Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End TypePublic Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End TypePublic Type EncoderParameter GUID As GUID NumberOfValues As Long type As Long Value As Long End TypePublic Type EncoderParameters Count As Long Parameter As EncoderParameter End TypePublic 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
