ImportsSystem
ImportsSystem.Drawing
<ComClass(dImage.ClassId,dImage.InterfaceId,dImage.EventsId)>_
PublicClassdImage
#Region"COMGUIDs"
'这些GUID提供该类的COM标识及其COM接口。
'如果您更改它们，现有的客户端将再也无法
'访问该类。
PublicConstClassIdAsString="29641F37-8FA4-4ED9-9118-9DA8EFA306B9"
PublicConstInterfaceIdAsString="06E4B037-2461-4F83-96BE-2A5D1CAAB0CE"
PublicConstEventsIdAsString="802EBB14-2D4D-416E-BA26-E8ADCD480E26"
#EndRegion
'可创建的COM类必须具有不带参数的
'PublicSubNew()，否则，该类将不会注册到COM注册表中，
'而且不能通过CreateObject
'来创建。
PrivatemyImageAsDrawing.Bitmap
PrivatesyimgAsDrawing.Bitmap
PrivatesyokAsBoolean=False
PrivatemyokAsBoolean=False
PublicSubNew()
MyBase.New()
EndSub
PublicWriteOnlyPropertybigImage()AsString
Set(ByValValueAsString)
Try
myImage=NewBitmap(Value)
myok=True
CatcheAsIO.IOException
myok=False
EndTry
EndSet
EndProperty
PublicWriteOnlyPropertyLogoImage()AsString
Set(ByValValueAsString)
Try
syimg=NewBitmap(Value)
syok=True
CatchexAsException
syok=False
EndTry
EndSet
EndProperty
PublicFunctionSaveAs(ByValToFileAsString,ByValnWidthAsInteger,ByValnHeightAsInteger,ByValnLogoAsBoolean)AsString
Try
Ifmyok=FalseThen
Return"err0"
ExitFunction
EndIf
DimnewbmpAsBitmap=NewBitmap(nWidth,nHeight,Imaging.PixelFormat.Format16bppArgb1555)
DimiXAsInteger
DimiYAsInteger
DimxMaxAsInteger
DimyMaxAsInteger
ForiX=0TonWidth-1
ForiY=0TonHeight-1
newbmp.SetPixel(iX,iY,Color.White)
Next
Next
IfnWidth<myImage.WidthOrnHeight<myImage.HeightThen
IfmyImage.Width/myImage.Height>nWidth/nHeightThen
xMax=nWidth
yMax=myImage.Height*nWidth\myImage.Width
Else
yMax=nHeight
xMax=myImage.Width*nHeight\myImage.Height
EndIf
Else
xMax=myImage.Width
yMax=myImage.Height
EndIf
DimtembmpAsBitmap=NewBitmap(myImage,xMax,yMax)
xMax=(newbmp.Width-tembmp.Width)\2
yMax=(newbmp.Height-tembmp.Height)\2
ForiX=0Totembmp.Width-1
ForiY=0Totembmp.Height-1
newbmp.SetPixel(iX+xMax,iY+yMax,tembmp.GetPixel(iX,iY))
Next
Next
IfsyokAndnLogoThen
DimcobAsColor
DimcocAsColor
xMax=newbmp.Width-syimg.Width-4
yMax=newbmp.Height-syimg.Height-3
ForiX=0Tosyimg.Width-1
ForiY=0Tosyimg.Height-1
cob=syimg.GetPixel(iX,iY)
coc=newbmp.GetPixel(iX+xMax,iY+yMax)
newbmp.SetPixel(iX+xMax,iY+yMax,getnewco(cob,coc))
Next
Next
EndIf
newbmp.Save(ToFile,Imaging.ImageFormat.Jpeg)
newbmp.Dispose()
tembmp.Dispose()
newbmp=Nothing
tembmp=Nothing
Return"OK"
CatchexAsException
Returnex.ToString
EndTry
EndFunction
PublicReadOnlyPropertyWidth()AsInteger
Get
ReturnmyImage.Width
EndGet
EndProperty
PublicReadOnlyPropertyHeight()AsInteger
Get
ReturnmyImage.Height
EndGet
EndProperty
PublicSubClose()
myImage.Dispose()
syimg.Dispose()
myImage=Nothing
syimg=Nothing
EndSub
PrivateFunctiongetnewco(ByValc1AsColor,ByValc2AsColor)AsColor
Dima1AsInteger=c1.A
Dimr1AsInteger=c1.R
Dimg1AsInteger=c1.G
Dimb1AsInteger=c1.B
Dima2AsInteger=c2.A
Dimr2AsInteger=c2.R
Dimg2AsInteger=c2.G
Dimb2AsInteger=c2.B
a2=255-a1
r1=CInt((r1*a1/255)+(r2*a2/255))
g1=CInt((g1*a1/255)+(g2*a2/255))
b1=CInt((b1*a1/255)+(b2*a2/255))
ReturnColor.FromArgb(a1,r1,g1,b1)
EndFunction
EndClass
