<%
'//检查组件是否安装
Function IsObjInstall(obj) 
  Dim IsObj 
  On Error Resume Next 
  Set IsObj = Server.CreateObject(obj) 
  if Err = 0 then 
     IsObjInstall = "True" 
  else 
     IsObjInstall = "Flase" 
  end If 
  Set IsObj = Nothing 
  If Err <> 0 Then Err.Clear 
 End Function

Sub Cw_jpeg(t0)
	IF Not IsObjInstall("Persits.Jpeg") Then Exit Sub
	IF Check_ispic(t0)=0 Then Exit Sub
	Set AspJpeg=Server.CreateObject("Persits.Jpeg")
	IF AspJpeg.Expires<Now Then Exit Sub
	AspJpeg.Open Trim(Server.MapPath(t0))
	IF AspJpeg.OriginalWidth>Cw_jpeg_t12(0)*2 Then
		IF Cw_jpeg_t1=0 Then
			IF Len(Cw_jpeg_t3)>0 And Len(Cw_jpeg_t6)>0 Then
				Dim LogoWidth,LogoHeight,iLeft,iTop
				LogoWidth=(Cw_jpeg_t5+1)*GetStrLen(Cw_jpeg_t3)/2
				LogoHeight=Cw_jpeg_t5+1

				iLeft=GetPosition_X(AspJpeg.OriginalWidth, LogoWidth, Cw_jpeg_t12(0))
				iTop=GetPosition_Y(AspJpeg.OriginalHeight, LogoHeight, Cw_jpeg_t12(1))
				
				AspJpeg.Canvas.Font.COLOR=Cw_jpeg_t6         ' 文字的颜色
				AspJpeg.Canvas.Font.Family=Cw_jpeg_t4         ' 文字的字体
				AspJpeg.Canvas.Font.Size=Cw_jpeg_t5          ' 文字的大小
				AspJpeg.Canvas.Font.Bold=Cw_jpeg_t7              ' 文字是否粗体
				AspJpeg.Canvas.Font.Quality=4                              ' Antialiased
				AspJpeg.Canvas.PrintText iLeft,iTop,Cw_jpeg_t3         ' 加入文字及坐标位置
				AspJpeg.Canvas.Pen.COLOR=&H0               ' 边框的颜色
				AspJpeg.Canvas.Pen.Width=1                 ' 边框的粗细
				AspJpeg.Canvas.Brush.Solid=False           ' 图片边框内是否填充颜色
				AspJpeg.Quality=Cw_jpeg_t2
				AspJpeg.Save Server.MapPath(t0)     ' 生成文件
			End IF
		Else
			Dim Fso
			Set Fso=CreateObject("Scrip"&"ting."&"File"&"System"&"Object")
			IF Not Fso.FileExists(Server.MapPath(Cw_jpeg_t8)) Then
				Exit Sub
			End IF
			Set Fso=Nothing
			Dim AspJpeg2
			Set AspJpeg2=Server.CreateObject("Persits.Jpeg")
			AspJpeg2.Open Server.MapPath(Cw_jpeg_t8)  '打开水印图片
			iLeft=GetPosition_X(AspJpeg.OriginalWidth,AspJpeg2.Width,Cw_jpeg_t12(0))
			iTop=GetPosition_Y(AspJpeg.OriginalHeight,AspJpeg2.Height,Cw_jpeg_t12(1))
			
			IF Cw_jpeg_t10="" Then
				AspJpeg.DrawImage iLeft,iTop,AspJpeg2,Cw_jpeg_t9,100
			Else
				AspJpeg.DrawImage iLeft,iTop,AspJpeg2,Cw_jpeg_t9,Cw_jpeg_t10,100
			End IF
			AspJpeg.Quality=Cw_jpeg_t2
			AspJpeg.Save Server.MapPath(t0)
			Set AspJpeg2=Nothing	
		End IF
	End IF
	Set AspJpeg= Nothing
End Sub

Sub Jpeg_Thumb(t0)
	IF Not IsObjInstall("Persits.Jpeg") Then Exit Sub
	IF Check_ispic(t0)=0 Then Exit Sub
	Dim AspJpeg,AspJpeg2,bl_h,bl_w
	Set AspJpeg=Server.CreateObject("Persits.Jpeg")
	Set AspJpeg2=Server.CreateObject("Persits.Jpeg")
	IF AspJpeg.Expires<Now Then Exit Sub
	AspJpeg.Open Trim(Server.MapPath(t0))
	AspJpeg2.Open Trim(Server.MapPath(t0))	
	bl_w=Cw_jpeg_t13/AspJpeg.OriginalWidth
	bl_h=Cw_jpeg_t14/AspJpeg.OriginalHeight
	IF Cw_jpeg_t13>0 Then
		IF Cw_jpeg_t14>0 Then
			Select Case Cw_jpeg_t15
			Case "0"   '常规算法：宽度和高度都大于0时，直接缩小成指定大小，其中一个为0时，按比例缩小
				IF bl_w<1 Or bl_h<1 Then
					AspJpeg.Width=Cw_jpeg_t13
					AspJpeg.Height=Cw_jpeg_t14
					AspJpeg.Quality=Cw_jpeg_t2
					AspJpeg.save Server.MapPath(t0)
				End IF
			Case "1"    '裁剪法：宽度和高度都大于0时，先按最佳比例缩小再裁剪成指定大小，其中一个为0时，按比例缩小
				IF bl_w<1 Or bl_h<1 Then
					If bl_w<bl_h Then
						AspJpeg.Height=Cw_jpeg_t14
						AspJpeg.Width=Round(AspJpeg.OriginalWidth * bl_h)   '按缩小成大比例者
					Else
						AspJpeg.Width=Cw_jpeg_t13
						AspJpeg.Height=Round(AspJpeg.OriginalHeight * bl_w)
					End IF
					AspJpeg.Crop 0, 0, Cw_jpeg_t13, Cw_jpeg_t14
					AspJpeg.Quality=Cw_jpeg_t2
					AspJpeg.Save Server.MapPath(t0)
				End IF
			Case "2"  '补充法：在指定大小的背景图上附加上按最佳比例缩小的图片
				'创建一个指定大小的背景图
				AspJpeg2.Width=Cw_jpeg_t13
				AspJpeg2.Height=Cw_jpeg_t14
				AspJpeg2.Canvas.Brush.Solid=True            ' 图片边框内是否填充颜色
				AspJpeg2.Canvas.Brush.COLOR="&HFFFFFF"  '设定背景颜色
				AspJpeg2.Canvas.Bar -1, -1, AspJpeg2.Width+1, AspJpeg2.Height+1 '填充

				'按最佳比例缩小图片
				IF bl_w>bl_h Then
					IF bl_h<1 Then
						AspJpeg.Height=Cw_jpeg_t14
						AspJpeg.Width=Round(AspJpeg.OriginalWidth*bl_h)   '按缩小成小比例者
					End IF
				Else
					IF bl_w<1 Then
						AspJpeg.Width=Cw_jpeg_t13
						AspJpeg.Height=Round(AspJpeg.OriginalHeight*bl_w)
					End IF
				End IF

				'得到缩略图的坐标
				iLeft=(AspJpeg2.Width-AspJpeg.Width)/2
				iTop=(AspJpeg2.Height-AspJpeg.Height)/2
				AspJpeg2.DrawImage iLeft,iTop,AspJpeg   '将缩略图附加到背景上
				AspJpeg2.Quality=Cw_jpeg_t2
				AspJpeg2.Save Server.MapPath(t0)
			End Select

		Else
			IF bl_w<1 Then
				AspJpeg.Width=Cw_jpeg_t13
				AspJpeg.Height=Round(AspJpeg.OriginalHeight*bl_w)
				AspJpeg.Quality=Cw_jpeg_t2
				AspJpeg.Save Server.MapPath(t0)
			End IF
		End If

	Else
		IF Cw_jpeg_t14>0 And bl_h<1 Then
			AspJpeg.Height=Cw_jpeg_t14
			AspJpeg.Width=Round(AspJpeg.OriginalWidth*bl_h)
			AspJpeg.Quality=Cw_jpeg_t2
			AspJpeg.Save Server.MapPath(t0)
		End IF
	End If
	Set AspJpeg=Nothing
	Set AspJpeg2=Nothing
End Sub

Function GetPosition_X(t0,t1,t2)
    Select Case Cw_jpeg_t11
		Case 0:GetPosition_X=t2'左上
		Case 1:GetPosition_X=t2'左下
		Case 2:GetPosition_X=(t0-t1)/2'居中
		Case 3:GetPosition_X=t0-t1-t2'右上
		Case 4:GetPosition_X=t0-t1-t2'右下
		Case Else:GetPosition_X=0'不显示
	End Select
End Function

Function GetPosition_Y(t0,t1,t2)
    Select Case Cw_jpeg_t11
		Case 0:GetPosition_Y=t2'左上
		Case 1:GetPosition_Y=t0-t1-t2'左下
		Case 2:GetPosition_Y=(t0-t1)/2'居中
		Case 3:GetPosition_Y=t2'右上
		Case 4:GetPosition_Y=t0-t1-t2'右下
		Case Else:GetPosition_Y=0'不显示
    End Select
End Function

Function GetStrLen(t0)
    On Error Resume Next
	Dim L,C,WINNT_CHINESE,T,I
    WINNT_CHINESE=(Len("中国")=2)
    IF WINNT_CHINESE Then
        L=Len(t0)
        T=l
        For I=1 To L
            C=Asc(Mid(t0,I,1))
            IF C<0 Then C=C+65536
            IF C>255 Then
                T=T+1
            End IF
        Next
        GetStrLen=T
    Else
        GetStrLen=Len(t0)
    End IF
    IF Err.Number<>0 Then Err.Clear
End Function

Function Check_IsPic(t0)
	Select Case Right(Lcase(t0),3)
		Case "jpg","gif","peg","bmp","png":Check_ispic=1
		Case Else:Check_ispic=0
   End Select
End Function
%>
