ASP components advanced introductory and proficient series bis

Senior

Engineering name Flysoft class module Image.cls

Option Explicit

'*****************************************************
' CSDN VB version online (Tornado 3.0 Smile Proud Lake)
' 2005-6-30 Day modified part of code

' Name: Thumbnail watermark Component
' Time: 2005-02-11
' function: Added the function of text watermark
' Time: 2005-02-12
' Function: Increase the image watermark function
' Time: 2005-02-13
' Added to the jpg,gif image import
'*****************************************************

' Define input filename
Private sourceFileName as String
' Define the zoom rate
Private Irate as single
' Define text watermark output string
Private Smasktext as String * 256
' Define text font
Private Smasktextfontname as String
' Define the text gradient
Private Imarkrotate as Single
' A picture of a watermark that needs to be pasted
Private Maskfilename as String

' Load watermark Picture
Public Property Get Loadfrommaskimgfile () as Variant
Loadfrommaskimgfile = Maskfilename
End Property

Public Property Let Loadfrommaskimgfile (ByVal Vnewvalue as Variant)
Maskfilename = Vnewvalue
End Property

' Set the degree of watermark text rotation
' Set write properties
Public Property Let Markrotate (ByVal Vnewvalue as Variant)
If vnewvalue = "" Then
Imarkrotate = 0
Else
Imarkrotate = Vnewvalue * 10
End If
End Property

' Set Watermark font name
' Set write properties
Public Property Let Masktextfontname (ByVal Vnewvalue as Variant)
Smasktextfontname = Vnewvalue
End Property

' Define attributes, get the watermark text entered
' Set write properties
Public Property Let Masktext (ByVal Vnewvalue as Variant)
If vnewvalue = "" Then
Smasktext = "Tornado production"
Else
Smasktext = Vnewvalue
End If
End Property

Public Property Let LoadFromFile (ByVal Vnewvalue as Variant)
sourceFileName = Vnewvalue
End Property

Public Property Let Rate (ByVal Vnewvalue as Variant)
irate = Vnewvalue
End Property

' Output thumbnail
Public Sub outputimgfile (ByVal filename as String)

Dim Picture1 as New stdpicture

' To determine if a file exists, there is no throw error
If Dir (sourceFileName) <> "" Then
Set Picture1 = LoadPicture (sourceFileName)
Else
Err.Raise vbObjectError + 513, Err.Description + "An error occurred while loading the file, please check"
Exit Sub
End If

Dim VH as Long
Dim VW as Long
Dim BM as Bitmap
GetObject Picture1.handle, Len (BM), BM

VW = Bm.bmwidth
VH = Bm.bmheight

' Create a memory device scenario
Dim hDCSrc as Long
Dim Hdcdest as Long

HDCSRC = CreateCompatibleDC (0)
Hdcdest = CreateCompatibleDC (0)

' Select the created bitmap into the device scene
SelectObject hDCSrc, Picture1.handle
' Create a bitmap of the device according to the specified size
Dim HmD as Long
HmD = CreateCompatibleBitmap (HDCSRC, VW * irate, VH * irate)
SelectObject Hdcdest, HmD

' Handle Flex Mode
Dim Lorigmode as Long
Dim Lret as Long
Lorigmode = Setstretchbltmode (hdcdest, Stretch_halftone)
' Scaling by scale
StretchBlt hdcdest, 0, 0, VW * irate, VH * irate, HDCSRC, 0, 0, VW, VH, SRCCOPY

' Restore previous settings
Lret = Setstretchbltmode (hdcdest, Lorigmode)

' Generate JPEG files
Savejpg HmD, filename

' Delete device scene
DeleteDC HDCSRC
DeleteDC hdcdest
' Delete Bitmap objects
DeleteObject HmD

End Sub

' Text watermark
Public Sub outputtxtimgfile (ByVal filename As String, ByVal icolor As String, Optional ByVal iwidth as single =, Option Al ByVal iheight as single = x, Optional ByVal ileft as single = ten, Optional ByVal as single = 100)

Dim Picture1 as New stdpicture

' To determine if a file exists, there is no throw error
If Dir (sourceFileName) <> "" Then
Set Picture1 = LoadPicture (sourceFileName)
Else
Err.Raise vbObjectError + 513, Err.Description + "An error occurred while loading the file, please check"
Exit Sub
End If

Dim VH as Long
Dim VW as Long
Dim BM as Bitmap
GetObject Picture1.handle, Len (BM), BM

VW = Bm.bmwidth
VH = Bm.bmheight

"Create a scene with a memory device
Dim hDCSrc as Long
Dim Hdcdest as Long

HDCSRC = CreateCompatibleDC (0)
Hdcdest = CreateCompatibleDC (0)

' Select the created bitmap into the device scene
SelectObject hDCSrc, Picture1.handle

Dim LF as LogFont
Dim Hfont as Long
Dim nn as Long

Lf.lfheight = iheight ' character height
Lf.lfwidth = iwidth ' character width
Lf.lfescapement = Imarkrotate ' text tilt, counterclockwise direction, a circle with a total angle of 3600
lf.lforientation = 0 ' character tilt angle
lf.lfweight = 0 ' font severity
Lf.lfunderline = 0 ' is underlined
Lf.lfstrikeout = 0 ' Whether strikethrough is added
Lf.lfcharset = 1 &n