分享
 
 
 

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

王朝asp·作者佚名  2008-06-01
窄屏简体版  字體: |||超大  

很久没有写这个系列了,最近一直在忙其他的东西高级的组件话题我们将讨论一些比较难实现的,复杂的东西前段时间我写了一个龙卷风缩略图水印组件,感觉效果还不错,由于是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

End Sub

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有