手机站
网通分站
电信主站
密 码:
用户名:
当前位置 : 主页>网络编程>Asp编程>列表

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

来源:互联网 作者:west263.com 时间:2008-02-23
西部数码-全国虚拟主机10强!40余项虚拟主机管理功能,全国领先!双线多线虚拟主机南北访问畅通无阻!免费赠送企业邮局,.CN域名,自助建站480元起,免费试用7天,满意再付款! P4主机租用799元/月.月付免压金!

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

文章整理:西部数码--专业提供域名注册虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!