www.gusucode.com > 新锐领秀网络相册 1.1 > include/aspjpeg.asp

    
<%
'----------------------------------------------------
'	[Gong] (C)2007-2008 .
'	This is NOT a freeware, use is subject to license terms

'	Id: aspjpeg.asp 2008-03-26 00:53:29  Gong
'----------------------------------------------------
'-----------------------------
'组件检测
'-----------------------------
Function gCheckCompment(Compment)
 Dim a
 gCheckCompment=False
 Set a=Server.CreateObject(Compment)
 If isobject(a) Then gCheckCompment=True
 Set a=Nothing
End Function
'-----------------------------
'生成缩略图
'参数说明：
'lPath---源文件
'rPaht---生成缩略图文件
'sWidth---目标宽
'sHeight---目标高
'-----------------------------
Function gCreateSmallImg(lPath,rPath,sWidth,sHeight,iType)
Dim jpegOBJ,tmpW,tmpH,objW,objH
Set jpegOBJ=Server.CreateObject(gJpeg)
With jpegOBJ
  .Open lPath
  tmpW=.OriginalWidth
  tmpH=.OriginalHeight
  objW=tmpW
  objH=tmpH
  '---------------------------------------------------切割，
  If iType = 0 Then 
	if objW>objH Then
		.crop 0,0,objH,objH
	ElseIf objW<objH Then
      .crop 0,0,objW,objW
	End If
	If objW>sWidth Then 
		objW=sWidth
		objH=sWidth
	End if
	If objH>sHeight Then 
		bjH=sHeight
		objW=sHeight
	End iF
   .Width=objW
   .Height=objH
  Else 
  '---------------------------------------------------按比例
	If objW>sWidth Then 
		objW=sWidth
		objH=(sWidth/tmpW)*tmpH
	End If
	If objH>sHeight Then 
		objH=sHeight
		objW=(sHeight/tmpH)*tmpW
	End If
	.Width=objW
	.Height=objH
  End If 
  .Save rPath
End With
Set jpegOBJ=Nothing
End Function

%>