One of ASP Component advanced entry and master series

I haven't written this series for a long time. I 've been busy with other things recently.

For advanced component topics, we will discuss some complicated things that are hard to implement.

I wrote a tornado thumbnail watermark component some time ago. It seems that the effect is good. It is difficult because it was written in VB. Let's take a look.

There is a post: http://community.csdn.net/Expert/topic/4115/4115767.xml? Temp =. 9513056.

Functions:

Tornado thumbnail watermark component Version 1.0
Features:
1. Supports importing from BMP bitmap, JPEG, and GIF
2. Only JPEG format can be generated.
3. Text watermark, supports Custom font, rotation angle, color, font width and height
4. Image Watermark, supports transparency
5. File streams cannot be directly written to the browser.
6. Less system resources are consumed
7. Each example has a detailed comment.

Tornado thumbnail watermark component version 0.9
Features:
1. Only supports importing from BMP bitmap
2. Only JPEG format can be generated.
3. Less system resources are consumed

Version history
Tornado thumbnail watermark component Version 1.0
Time: 2005-02-13
Added support for jpg and GIF image import.
Time: 2005-02-12
Function: adds the image watermark function.
Time: 2005-02-11
Function: added the text watermark function.

Tornado thumbnail watermark component version 0.9
Time: 2005-02-10
Function: only supports BMP bitmap import, JPEG generation, and scaling.

Free to use, no restrictions
If you have any questions, I hope to raise them so that I can improve them.
My email: yyg19780718@163.com

The Code is as follows:

Module 1:

Option explicit
'Some code is not required and may be used in the future

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' structure bitmapinfo contains the array rgbquad of RGB values
Public const stretch_halftone as long = & H4 &

Public type bitmapinfoheader '40-byte Bitmap File Header
Number of bytes required for the bisize as long Structure
Biwidth as long 'image width
Biheight as long 'image height
Biplanes as integer 'must be 1.
Bibitcount as integer 'color digits
Bicompression as long 'specifies whether to compress. Generally, bi_rgb is used.
Bisizeimage as long 'the actual number of bytes occupied by the bitmap, = biwidth' (must be an integer of 4) * biheight
Bixpelspermeter as long horizontal resolution
Biypelspermeter as long vertical resolution
Biclrused as long 'actual number of colors used in this image
Biclrimportant as long 'indicates the number of important colors in the image. If the value is 0, all images are considered important.
End type

Public type rgbquad
Rgbblue as byte 'Blue weight of the color
Rgbgreen as byte 'green weight of the color
Rgbred as byte 'Red weight of the color
Rgbreserved as byte 'reserved value
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 nscwidth as long, byval nscheight as long, byval dwrop as long) as long
Public declare function setstretchbltmode lib "GDI32" (byval HDC as long, byval nstretchmode as long) as long

Module 2:

Option explicit

'The following is an API for outputting text watermarks
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
'Logical font Structure
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

'Image watermark transparency Processing
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

Module 3

Option explicit

'The following is the declaration of 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

'Save As 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-440f81ef32e }"),_
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

'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, "An error occurred while saving the image. Error Code:" & lres
End if

End sub