结合FSO操作和Aspjpeg组件写的Class

时间：2022-09-18 14:35:27

《结合FSO操作写的一个Class》，尚在完善中,基本功能已具备.也可作为初学者的教程：

程序代码

  1. <%  
  2. '***************************** CDS系统 FSO操作类 Beta1 *****************************  
  3. '调用方法: Set Obj=New FSOControl  
  4. '所有路径必须为绝对路径,请采用Server.MapPath方法转换路径后再定义变量  
  5. '------ FileRun ---------------------------------------  
  6. '  
  7. '必选参数:  
  8. 'FilePath ------ 处理文件路径  
  9. '  
  10. '可选参数:  
  11. 'FileAllowType ------ 处理文件允许的类型,定义方法例: gif|jpg|png|txt  
  12. 'FileNewDir ------ 文件处理后保存到的目录  
  13. 'FileNewName ------ 新文件名前缀,请不要添加后缀, 例: sample.txt 则为 sample  
  14. 'CoverPr ------ 是否覆盖已有的文件 0为否 1为是 默认为1  
  15. 'deletePr ------ 是否删除原文件 0为否 1为是 默认为1  
  16. '---------------------------------------------------------  
  17.  
  18. '------ UpDir(path) 取path的父目录  
  19. 'path可为文件,也可为目录  
  20.  
  21. '------ GetPrefixName(path) 取文件名前缀  
  22. 'path必须为文件,可为完整路径,也可是单独文件名  
  23.  
  24. '------ GetFileName(path) 取文件名  
  25. 'path必须为文件,可为完整路径,也可是单独文件名  
  26.  
  27. '------ GetExtensionName(path) 取文件名后缀,不包含"."  
  28. 'path必须为文件,可为完整路径,也可是单独文件名  
  29.  
  30. '------ FileIs(path) path是否为一文件  
  31. '如为,返回 true 否则返回 false  
  32. '------ FolderCreat(Path)  
  33. '------ Folderdelete(Path,FileIF)  
  34. '------ FileCopy(Path_From,Path_To,CoverIF)  
  35. '------ FileMove(Path_From,Path_To,CoverIF)  
  36. '------ Filedelete(Path)  
  37. '------ Filerename(OldName,NewName,CoverIf)  
  38.  
  39. Class FSOControl  
  40.  
  41. Dim FSO  
  42. Private File_Path,File_AllowType,File_NewFolder_Path,File_NewName,File_CoverIf,File_deleteIf  
  43. Public Property Let FilePath(StrType)  
  44. File_Path=StrType  
  45. End Property  
  46. Public Property Let FileAllowType(StrType)  
  47. File_AllowType=StrType  
  48. End Property  
  49. Public Property Let FileNewDir(StrType)  
  50. File_NewFolder_Path=StrType  
  51. End Property  
  52. Public Property Let FileNewName(StrType)  
  53. File_NewName=StrType  
  54. End Property  
  55. Public Property Let CoverPr(LngSize)  
  56. If isNumeric(LngSize) then  
  57. File_CoverIf=Clng(LngSize)  
  58. End If  
  59. End Property  
  60. Public Property Let deletePr(LngSize)  
  61. If isNumeric(LngSize) then  
  62. File_deleteIf=Clng(LngSize)  
  63. End If  
  64. End Property  
  65.  
  66. Private Sub Class_Initialize()  
  67. Set FSO=createObject("Scripting.FileSystemObject")   
  68. File_Path=""  
  69. File_AllowType="gif|jpg|png|txt"  
  70. File_NewFolder_Path=""  
  71. File_NewName=""  
  72. File_CoverIf=1  
  73. File_deleteIf=0  
  74. End Sub   
  75. Private Sub Class_Terminate()  
  76. Err.Clear  
  77. Set FSO=Nothing  
  78. End Sub  
  79.  
  80.  
  81. Public Function UpDir(ByVal D)  
  82. If Len(D) = 0 then  
  83. UpDir=""  
  84. Else  
  85. UpDir=Left(D,InStrRev(D,"\")-1)  
  86. End If  
  87. End Function  
  88. Public Function GetPrefixName(ByVal D)  
  89. If Len(D) = 0 then  
  90. GetPrefixName=""  
  91. Else  
  92. FileName=GetFileName(D)  
  93. GetPrefixName=Left(FileName,InStrRev(FileName,".")-1)  
  94. End If  
  95. End Function  
  96. Public Function GetFileName(name)  
  97. FileName=Split(name,"\")  
  98. GetFileName=FileName(Ubound(FileName))  
  99. End Function  
  100. Public Function GetExtensionName(name)  
  101. FileName=Split(name,".")  
  102. GetExtensionName=FileName(Ubound(FileName))  
  103. End Function  
  104. Public Function FileIs(Path)  
  105. If fso.FileExists(Path) then  
  106. FileIs=true  
  107. Else  
  108. FileIs=false  
  109. End If  
  110. End Function  
  111.  
  112. Public Function FileOpen(Path,NewFile,ReadAction,LineCount)  
  113. If FileIs(Path)=False then  
  114. If NewFile<>1 then  
  115. FileOpen=False  
  116. ElseIf FolderIs(UpDir(Path))=False then  
  117. FileOpen=False  
  118. Exit Function  
  119. Else  
  120. fso.OpenTextFile Path,1,True  
  121. FileOpen=""  
  122. End If  
  123. Exit Function  
  124. End If  
  125. Set FileOption=fso.GetFile(Path)  
  126. If FileOption.size=0 then  
  127. Set FileOption=Nothing  
  128. FileOpen=""  
  129. Exit Function  
  130. End If  
  131. Set FileOption=Nothing  
  132. Set FileText=fso.OpenTextFile(Path,1)  
  133. If IsNumeric(ReadAction) then  
  134. FileOpen=FileText.Read(ReadAction)  
  135. ElseIf Ucase(ReadAction)="ALL" then  
  136. FileOpen=FileText.ReadAll()  
  137. ElseIf Ucase(ReadAction)="LINE" then  
  138. If Not(IsNumeric(LineCount)) or LineCount=0 then  
  139. FileOpen=False  
  140. Set FileText=Nothing  
  141. Exit Function  
  142. Else  
  143. i=0  
  144. Do While Not FileText.AtEndOfStream  
  145. FileOpen=FileOpen&FileText.ReadLine  
  146. i=i+1  
  147. If i=LineCount then Exit Do  
  148. Loop  
  149. End If  
  150. End If  
  151. Set FileText=Nothing   
  152. End Function  
  153.  
  154. Public Function FileWrite(Path,WriteStr,NewFile)  
  155. If FolderIs(UpDir(Path))=False then  
  156. FileWrite=False  
  157. Exit Function  
  158. ElseIf FileIs(Path)=False and NewFile<>1 then  
  159. FileWrite=False  
  160. Exit Function  
  161. End If  
  162. Set FileText=fso.OpenTextFile(Path,2,True)  
  163. FileText.Write WriteStr  
  164. Set FileText=Nothing  
  165. FileWrite=True  
  166. End Function  
  167.  
  168. Public Function FolderIs(Path)  
  169. If fso.FolderExists(Path) then  
  170. FolderIs=true  
  171. Else  
  172. FolderIs=false  
  173. End If  
  174. End Function  
  175. Public Function FolderCreat(Path)  
  176. If fso.FolderExists(Path) then  
  177. FolderCreat="指定要创建目录已存在"  
  178. Exit Function  
  179. ElseIf Not(fso.FolderExists(UpDir(Path))) then  
  180. FolderCreat="指定要创建的目录路径错误"  
  181. Exit Function  
  182. End If  
  183. fso.createFolder(Path)  
  184. FolderCreat=True  
  185. End Function  
  186. Public Function Folderdelete(Path,FileIF)  
  187. If Not(fso.FolderExists(Path)) then  
  188. Folderdelete="指定要删除的目录不存在"  
  189. Exit Function  
  190. End If  
  191. If FileIF=1 then  
  192. Set FsoFile = Fso.GetFolder(Path)  
  193. If(FsoFile.SubFolders.count>0 or FsoFile.Files.count>0) then  
  194. Set FsoFile=Nothing  
  195. Folderdelete="只要要删除的目录下含有文件或子目录,不允许删除"  
  196. Exit Function  
  197. End If  
  198. Set FsoFile=Nothing  
  199. End If  
  200. Fso.deleteFolder(Path)  
  201. Folderdelete=True  
  202. End Function  
  203. Public Function FileCopy(Path_From,Path_To,CoverIF)  
  204. If Not(fso.FileExists(Path_From)) then  
  205. FileCopy="指定要复制的文件不存在"  
  206. Exit Function  
  207. ElseIf Not(fso.FolderExists(UpDir(Path_To))) then  
  208. FileCopy="指定要复制到的目录不存在"  
  209. Exit Function  
  210. End If  
  211. If CoverIF=0 and fso.FileExists(Path_To) then  
  212. FileCopy="指定要复制到的目录下已存在相同名称文件,不允许覆盖"  
  213. Exit Function  
  214. End If  
  215. fso.CopyFile Path_From,Path_To  
  216. FileCopy=True  
  217. End Function  
  218. Public Function FileMove(Path_From,Path_To,CoverIF)  
  219. If Not(fso.FileExists(Path_From)) then  
  220. FileMove="指定要移动的文件不存在"  
  221. Exit Function  
  222. ElseIf Not(fso.FolderExists(UpDir(Path_To))) then  
  223. FileMove="指定要移动到的目录不存在"  
  224. Exit Function  
  225. End If  
  226. If fso.FileExists(Path_To) then  
  227. If CoverIF=0 then  
  228. FileMove="指定要移动到的目录下已存在相同名称文件,不允许覆盖"  
  229. Exit Function  
  230. Else  
  231. Call Filedelete(Path_To)  
  232. End If  
  233. End If  
  234. fso.MoveFile Path_From,Path_To  
  235. FileMove=True  
  236. End Function  
  237. Public Function Filedelete(Path)  
  238. If Not(fso.FileExists(Path)) then  
  239. Filedelete="指定要删除的文件不存在"  
  240. Exit Function  
  241. End If  
  242. Fso.deleteFile Path  
  243. Filedelete=True  
  244. End Function  
  245. Public Function Filerename(OldName,NewName,CoverIf)  
  246. NewName=NewName&"."&GetExtensionName(OldName)  
  247. If GetFileName(OldName)=NewName then  
  248. Filerename="更改前的文件与更改后的文件名称相同"  
  249. Exit Function  
  250. ElseIf Not(fso.FileExists(OldName)) then  
  251. Filerename="指定更改名称的文件不存在"  
  252. Exit Function  
  253. ElseIf fso.FileExists(UpDir(OldName)&"\"&NewName) then  
  254. If CoverIf=0 then  
  255. Filerename="目录下已存在与更改后的文件名称相同的文件,不允许覆盖"  
  256. Exit Function  
  257. Else  
  258. Call Filedelete(UpDir(OldName)&"\"&NewName)  
  259. End If  
  260. End If  
  261. Set FsoFile=fso.GetFile(OldName)  
  262. FsoFile.Name=NewName  
  263. Set FsoFile=Nothing  
  264. Filerename=True  
  265. End Function  
  266.  
  267. Public Function FileRun()  
  268. If File_NewFolder_Path="" and File_NewName="" then  
  269. FileRun="此操作执行后并未对指定文件产生变动,系统自动中止"  
  270. Exit Function  
  271. ElseIf File_Path="" or Not(fso.FileExists(File_Path)) then  
  272. FileRun="要进行操作的文件不存在"  
  273. Exit Function  
  274. ElseIf Instr(File_AllowType,GetExtensionName(File_Path))=0 then  
  275. FileRun="要进行操作的文件被系统拒绝,允许的格式为: "&Replace(File_AllowType,"|"," ")  
  276. Exit Function  
  277. End If  
  278.  
  279. If File_NewFolder_Path="" then  
  280. File_NewFolder_Path=UpDir(File_Path)  
  281. ElseIf Not(fso.FolderExists(File_NewFolder_Path)) then  
  282. FileRun="指定要移动到的目录不存在"  
  283. Exit Function  
  284. End If  
  285. If Right(File_NewFolder_Path,1)<>"\" then File_NewFolder_Path=File_NewFolder_Path&"\"  
  286. If File_NewName="" then  
  287. File_NewPath=File_NewFolder_Path&GetFileName(File_Path)  
  288. Else  
  289. File_NewPath=File_NewFolder_Path&File_NewName&"."&GetExtensionName(File_Path)  
  290. End If  
  291. If File_Path=File_NewPath then  
  292. FileRun="此操作执行后并未对指定文件产生变动,系统自动中止"  
  293. Exit Function  
  294. ElseIf UpDir(File_Path)<>UpDir(File_NewPath) then  
  295. If File_deleteIf=1 then  
  296. Call FileMove(File_Path,File_NewPath,File_CoverIf)  
  297. Else  
  298. Call FileCopy(File_Path,File_NewPath,File_CoverIf)  
  299. End If  
  300. FileRun=True  
  301. Else  
  302. 'If File_deleteIf=1 then  
  303. Call Filerename(File_Path,GetPrefixName(File_NewPath),File_CoverIf)  
  304. 'Else  
  305. ' Call FileCopy(File_Path,File_NewPath,File_CoverIf)  
  306. 'End If  
  307. FileRun=True  
  308. End If  
  309. End Function  
  310. End Class  
  311. %>   
  312.  
  313.  
  314. 《ASPJPEG综合操作CLASS》  
  315. >>>---------我想分页！--这么长的文章，在这里来个分页多好啊！哈哈----------<<<  
  316. 《ASPJPEG综合操作CLASS》  
  317. 基本上能实现ASPJPEG的所有功能  
  318. 代码有详细注释,还不懂的请提出  
  319.  
  320. 有建议及更多功能提议的请提出  
  321.  
  322. 谢谢  
  323.  
  324.  程序代码  
  325. <%  
  326. 'ASPJPEG综合操作CLASS  
  327. 'Authour: tony 05/09/05  
  328. Class AspJpeg  
  329. Dim AspJpeg_Obj,obj  
  330. Private Img_MathPath_From,Img_MathPath_To,Img_Reduce_Size,CoverIf  
  331. Private Img_Frame_Size,Img_Frame_Color,Img_Frame_Solid,Img_Frame_Width,Img_Frame_Height  
  332. Private Img_Font_Content,Img_Font_Family,Img_Font_Color,Img_Font_Quality,Img_Font_Size,Img_Font_Bold,Img_Font_X,Img_Font_Y  
  333. Private Img_PicIn_Path,Img_PicIn_X,Img_PicIn_Y  
  334. '--------------取原文件路径  
  335. Public Property Let MathPathFrom(StrType)  
  336. Img_MathPath_From=StrType  
  337. End Property  
  338.  
  339. '--------------取文件保存路径  
  340. Public Property Let MathPathTo(strType)  
  341. Img_MathPath_To=strType  
  342. End Property  
  343.  
  344. '--------------保存文件时是否覆盖已有文件  
  345. Public Property Let CovePro(LngSize)  
  346. If LngSize=0 or LngSize=1 or LngSize=true or LngSize=false then  
  347. CoverIf=LngSize  
  348. End If  
  349. End Property  
  350.  
  351. '---------------取缩略图/放大图 缩略值  
  352. Public Property Let ReduceSize(LngSize)  
  353. If isNumeric(LngSize) then  
  354. Img_Reduce_Size=LngSize  
  355. End If  
  356. End Property  
  357.  
  358. '---------------取描边属性  
  359. '边框粗细  
  360. Public Property Let FrameSize(LngSize)  
  361. If isNumeric(LngSize) then  
  362. Img_Frame_Size=Clng(LngSize)  
  363. End If  
  364. End Property  
  365. '边框宽度  
  366. Public Property Let FrameWidth(LngSize)  
  367. If isNumeric(LngSize) then  
  368. Img_Frame_Width=Clng(LngSize)  
  369. End If  
  370. End Property  
  371. '边框高度  
  372. Public Property Let FrameHeight(LngSize)  
  373. If isNumeric(LngSize) then  
  374. Img_Frame_Height=Clng(LngSize)  
  375. End If  
  376. End Property  
  377. '边框颜色  
  378. Public Property Let FrameColor(strType)  
  379. If strType<>"" then  
  380. Img_Frame_Color=strType  
  381. End If  
  382. End Property  
  383. '边框是否加粗  
  384. Public Property Let FrameSolid(LngSize)  
  385. If LngSize=1 or LngSize=0 or LngSize=true or LngSize=false then  
  386. Img_Frame_Solid=LngSize  
  387. End If  
  388. End Property  
  389.  
  390. '---------------取插入文字属性  
  391. '插入的文字  
  392. Public Property Let Content(strType)  
  393. If strType<>"" then  
  394. Img_Font_Content=strType  
  395. End If  
  396. End Property  
  397. '文字字体  
  398. Public Property Let FontFamily(strType)  
  399. If strType<>"" then  
  400. Img_Font_Family=strType  
  401. End If  
  402. End Property  
  403. '文字颜色  
  404. Public Property Let FontColor(strType)  
  405. If strType<>"" then  
  406. Img_Font_Color=strType  
  407. End If  
  408. End Property  
  409. '文字品质  
  410. Public Property Let FontQuality(LngSize)  
  411. If isNumeric(LngSize) then  
  412. Img_Font_Quality=Clng(LngSize)  
  413. End If  
  414. End Property  
  415. '文字大小  
  416. Public Property Let FontSize(LngSize)  
  417. If isNumeric(LngSize) then  
  418. Img_Font_Size=Clng(LngSize)  
  419. End If  
  420. End Property  
  421. '文字是否加粗  
  422. Public Property Let FontBold(LngSize)  
  423. If LngSize=1 or LngSize=0 or LngSize=true or LngSize=false then  
  424. Img_Font_Bold=LngSize  
  425. End If  
  426. End Property  
  427. '输入文字的X坐标  
  428. Public Property Let FontX(LngSize)  
  429. If isNumeric(LngSize) then  
  430. Img_Font_X=Clng(LngSize)  
  431. End If  
  432. End Property  
  433. '输入文字的Y坐标  
  434. Public Property Let FontY(LngSize)  
  435. If isNumeric(LngSize) then  
  436. Img_Font_Y=Clng(LngSize)  
  437. End If  
  438. End Property  
  439.  
  440. '---------------取插入图片属性  
  441. '插入图片的路径  
  442. Public Property Let PicInPath(strType)  
  443. Img_PicIn_Path=strType  
  444. End Property  
  445. '图片插入的X坐标  
  446. Public Property Let PicInX(LngSize)  
  447. If isNumeric(LngSize) then  
  448. Img_PicIn_X=Clng(LngSize)  
  449. End If  
  450. End Property  
  451. '图片插入的Y坐标  
  452. Public Property Let PicInY(LngSize)  
  453. If isNumeric(LngSize) then  
  454. Img_PicIn_Y=Clng(LngSize)  
  455. End If  
  456. End Property  
  457.  
  458.  
  459. Private Sub Class_Initialize()  
  460. Set AspJpeg_Obj=createObject("Persits.Jpeg")   
  461. Img_MathPath_From=""  
  462. Img_MathPath_To=""  
  463. Img_Reduce_Size=150  
  464. Img_Frame_Size=1  
  465. 'Img_Frame_Width=0  
  466. 'Img_Frame_Height=0  
  467. 'Img_Frame_Color="&H000000"  
  468. 'Img_Frame_Bold=false  
  469. Img_Font_Content="GoldenLeaf"  
  470. 'Img_Font_Family="Arial"  
  471. 'Img_Font_Color="&H000000"  
  472. Img_Font_Quality=3  
  473. Img_Font_Size=14  
  474. 'Img_Font_Bold=False  
  475. Img_Font_X=10  
  476. Img_Font_Y=5  
  477. 'Img_PicIn_X=0  
  478. 'Img_PicIn_Y=0  
  479. CoverIf=1  
  480.  
  481. End Sub   
  482. Private Sub Class_Terminate()  
  483. Err.Clear  
  484. Set AspJpeg_Obj=Nothing  
  485. End Sub  
  486. '判断文件是否存在  
  487. Private Function FileIs(path)  
  488. Set fsos=Server.createObject("Scripting.FileSystemObject")  
  489. FileIs=fsos.FileExists(path)  
  490. Set fsos=Nothing  
  491. End Function  
  492.  
  493. '判断目录是否存在  
  494. Private Function FolderIs(path)  
  495. Set fsos=Server.createObject("Scripting.FileSystemObject")  
  496. FolderIs=fsos.FolderExists(path)  
  497. Set fsos=Nothing  
  498. End Function  
  499. '*******************************************  
  500. '函数作用：取得当前文件的上一级路径  
  501. '*******************************************  
  502. Private Function UpDir(ByVal D)  
  503. If Len(D) = 0 then  
  504. UpDir=""  
  505. Else  
  506. UpDir=Left(D,InStrRev(D,"\")-1)  
  507. End If  
  508. End Function  
  509.  
  510. Private Function Errors(Errors_id)  
  511. select Case Errors_id  
  512. Case "0"  
  513. Errors="指定文件不存在"  
  514. Case 1  
  515. Errors="指定目录不存在"  
  516. Case 2  
  517. Errors="已存在相同名称文件"  
  518. Case 3  
  519. Errors="参数溢出"  
  520. End select  
  521. End Function  
  522.  
  523.  
  524. '取图片宽度  
  525. Public Function ImgInfo_Width(Img_MathPath)  
  526. If Not(FileIs(Img_MathPath)) then  
  527. 'Exit Function  
  528. ImgInfo_Width=Errors(0)  
  529. Else  
  530. AspJpeg_Obj.Open Img_MathPath  
  531. ImgInfo_Width=AspJpeg_Obj.width  
  532. End If  
  533. End Function  
  534. '取图片高度  
  535. Public Function ImgInfo_Height(Img_MathPath)  
  536. If Not(FileIs(Img_MathPath)) then  
  537. 'Exit Function  
  538. ImgInfo_Height=Errors(0)  
  539. Else  
  540. AspJpeg_Obj.Open Img_MathPath  
  541. ImgInfo_Height=AspJpeg_Obj.height  
  542. End If  
  543. End Function  
  544. '生成缩略图/放大图  
  545. Public Function Img_Reduce()  
  546. If Not(FileIs(Img_MathPath_From)) then  
  547. Img_Reduce=Errors(0)  
  548. Exit Function  
  549. End If  
  550. If Not(FolderIs(UpDir(Img_MathPath_To))) then  
  551. Img_Reduce=Errors(1)  
  552. Exit Function  
  553. End If  
  554. If CoverIf=0 or CoverIf=False then  
  555. If FileIs(Img_MathPath_To) then  
  556. Img_Reduce=Errors(2)  
  557. Exit Function  
  558. End If  
  559. End If  
  560. AspJpeg_Obj.Open Img_MathPath_From  
  561. AspJpeg_Obj.PreserveAspectRatio = True  
  562. If AspJpeg_Obj.OriginalWidth>AspJpeg_Obj.OriginalHeight Then  
  563. AspJpeg_Obj.Width=Img_Reduce_Size  
  564. Else  
  565. AspJpeg_Obj.Height=Img_Reduce_Size  
  566. End If  
  567. If AspJpeg_Obj.OriginalWidth>Img_Reduce_Size or AspJpeg_Obj.OriginalHeight>Img_Reduce_Size Then  
  568. If AspJpeg_Obj.Width<Img_Reduce_Size or AspJpeg_Obj.Height<Img_Reduce_Size then  
  569. Set AspJpeg_Obj_New=createObject("Persits.Jpeg")  
  570. AspJpeg_Obj_New.new Img_Reduce_Size,Img_Reduce_Size,&HFFFFFF  
  571. AspJpeg_Obj_New.DrawImage (150-AspJpeg_Obj.width)/2,(150-AspJpeg_Obj.height)/2,AspJpeg_Obj  
  572. If Img_Frame_Size>0 then  
  573. Call Img_Pen(AspJpeg_Obj_New)  
  574. End If  
  575. If Img_Font_Content<>"" then  
  576. Img_Font_X=AspJpeg_Obj_New.Width/2  
  577. Img_Font_Y=AspJpeg_Obj_New.Height-15  
  578. Call Img_Font(AspJpeg_Obj_New)  
  579. End If  
  580. AspJpeg_Obj_New.Sharpen 1, 130  
  581. AspJpeg_Obj_New.Save Img_MathPath_To  
  582. Set AspJpeg_Obj_New=Nothing  
  583. Else  
  584. If Img_Frame_Size>0 then  
  585. Call Img_Pen(AspJpeg_Obj)  
  586. End If  
  587. If Img_Font_Content<>"" then  
  588. Img_Font_X=AspJpeg_Obj.Width/2  
  589. Img_Font_Y=AspJpeg_Obj.Height-15  
  590. Call Img_Font(AspJpeg_Obj)  
  591. End If  
  592. AspJpeg_Obj.Sharpen 1, 130  
  593. AspJpeg_Obj.Save Img_MathPath_To  
  594. End If  
  595. Else  
  596. If Img_Frame_Size>0 then  
  597. Call Img_Pen(AspJpeg_Obj)  
  598. End If  
  599. If Img_Font_Content<>"" then  
  600. Img_Font_X=AspJpeg_Obj.Width/2  
  601. Img_Font_Y=AspJpeg_Obj.Height-15  
  602. Call Img_Font(AspJpeg_Obj)  
  603. End If  
  604. AspJpeg_Obj.Sharpen 1, 130  
  605. AspJpeg_Obj.Save Img_MathPath_To  
  606. End If  
  607. End Function  
  608. '生成水印  
  609. Public Function Img_WaterMark()  
  610. If Not(FileIs(Img_MathPath_From)) then  
  611. Img_WaterMark=Errors(0)  
  612. Exit Function  
  613. End If  
  614. If Img_MathPath_To="" then  
  615. Img_MathPath_To=Img_MathPath_From  
  616. ElseIf Not(FolderIs(UpDir(Img_MathPath_To))) then  
  617. Img_WaterMark=Errors(1)  
  618. Exit Function  
  619. End If  
  620. If CoverIf=0 or CoverIf=false then  
  621. If Img_MathPath_To<>Img_MathPath_From and FileIs(Img_MathPath_To) then  
  622. Img_WaterMark=Errors(2)  
  623. Exit Function  
  624. End If  
  625. End If  
  626. AspJpeg_Obj.Open Img_MathPath_From  
  627. If Img_PicIn_Path<>"" then  
  628. If Not(FileIs(Img_PicIn_Path)) then  
  629. Img_WaterMark=Errors(0)  
  630. Exit Function  
  631. End If  
  632. Set AspJpeg_Obj_New=createObject("Persits.Jpeg")  
  633. AspJpeg_Obj_New.Open Img_PicIn_Path  
  634. AspJpeg_Obj.PreserveAspectRatio = True  
  635. AspJpeg_Obj_New.PreserveAspectRatio = True  
  636. If AspJpeg_Obj.OriginalWidth<Img_Reduce_Size or AspJpeg_Obj.OriginalHeight<Img_Reduce_Size then  
  637. Img_WaterMark=Errors(3)  
  638. Exit Function  
  639. End If  
  640. If AspJpeg_Obj_New.OriginalWidth>AspJpeg_Obj_New.OriginalHeight Then  
  641. AspJpeg_Obj_New.Width=Img_Reduce_Size  
  642. Else  
  643. AspJpeg_Obj_New.Height=Img_Reduce_Size  
  644. End If  
  645. If Img_PicIn_X="" then Img_PicIn_X=AspJpeg_Obj.Width-AspJpeg_Obj_New.Width  
  646. If Img_PicIn_Y="" then Img_PicIn_Y=AspJpeg_Obj.Height-AspJpeg_Obj_New.Height  
  647. AspJpeg_Obj.DrawImage Img_PicIn_X,Img_PicIn_Y,AspJpeg_Obj_New  
  648. Set AspJpeg_Obj_New=Nothing  
  649. End If  
  650. If Img_Frame_Size>0 then  
  651. Call Img_Pen(AspJpeg_Obj)  
  652. End If  
  653. If Img_Font_Content<>"" then  
  654. Call Img_Font(AspJpeg_Obj)  
  655. End If  
  656. 'AspJpeg_Obj.Sharpen 1, 130  
  657. AspJpeg_Obj.Save Img_MathPath_To  
  658. End Function  
  659. '生成框架  
  660. Private Function Img_Pen(Obj)  
  661. If Img_Frame_Width=0 then Img_Frame_Width=Obj.Width  
  662. If Img_Frame_Height=0 then Img_Frame_Height=Obj.Height  
  663. Obj.Canvas.Pen.Color = Img_Frame_Color  
  664. Obj.Canvas.Pen.Width = Img_Frame_Size  
  665. Obj.Canvas.Brush.Solid = Img_Frame_Solid  
  666. Obj.Canvas.Bar 1,1,Img_Frame_Width,Img_Frame_Height  
  667. End Function  
  668. '生成水印字  
  669. Private Function Img_Font(Obj)  
  670. Obj.Canvas.Font.Color = Img_Font_Color   
  671. Obj.Canvas.Font.Family = Img_Font_Family   
  672. Obj.Canvas.Font.Quality=Img_Font_Quality  
  673. Obj.Canvas.Font.Size=Img_Font_Size  
  674. Obj.Canvas.Font.Bold = Img_Font_Bold   
  675. Obj.Canvas.Print Img_Font_X,Img_Font_Y,Img_Font_Content  
  676. End Function  
  677. End Class  
  678.  
  679. %>   
标签：

相关文章