Soyez le premier à donner votre avis sur cette source.
Snippet vu 16 026 fois - Téléchargée 34 fois
<% 'Cette classe permet de générer une vignette de dimension (X,Y) maximale paramétrable, ' à partir d'une image JPEG ou BMP, via l'objet AspImage Class Vignette '***** Les variables privées 'L'objet AspImage Private Image 'Les tailles X et Y max de la vignette Private mvarX Private mvarY '***** Les méthodes privées 'Initialisation de la classe Private Sub Class_Initialize() Set Image = Server.CreateObject("AspImage.Image") End sub 'Destruction de la classe Private Sub Class_Terminate() Set Image=nothing End sub '***** Les propriétés publiques 'La taille X maxi de la vignette Public Property Let maxiX(X) mvarX=X End Property 'La taille Y maxi de la vignette Public Property Let maxiY(Y) mvarY=Y End Property '***** Les méthodes publiques 'Création de la vignette ' - reporigine: chemin virtuel du répertoire où se trouve l'image à transformer ' - nomorigine: nom de l'image à transformer ' - repvignette: chemin virtuel du répertoire où l'on sauvegarde la vignette ' - nomvignette: nom de la vignette obtenue Public Function CreeVignette(reporigine,nomorigine,repvignette,nomvignette) Dim dX 'La valeur réelle calculée de X pour la vignette Dim dY 'La valeur réelle calculée de Y pour la vignette Dim imgX 'La valeur X de l'image à transformer Dim imgY 'La valeur Y de l'image à transformer Image.LoadImage Server.MapPath(reporigine & "/" & nomorigine) imgX=Image.MaxX imgY=Image.MaxY 'Si la largeur ou la hauteur depasse la taille maximale if ((imgX >= mvarX) or (imgY >= mvarY)) then ' Si la largeur et la hauteur depassent la taille maximale if ((imgX >= mvarX) and (imgY >= mvarY)) then 'On cherche la plus grande valeur if (imgX>imgY) then dX = mvarX ' On calcule dY proportionnellement dY = (imgY * dX) / imgX else dY = mvarY ' On Calcule dX proportionnellement dX = (imgX * dY) / imgY end if else if ((imgX > mvarX) and (imgY < mvarY)) then ' Si X depasse la taille maximale dX = mvarX ' On calcule dY proportionnellement dY = (imgY * dX) / imgX else if ((imgX < mvarX) and (imgY > mvarY)) then ' Si Y depasse la taille maximale dY = mvarY ' On calcule X proportionnellement dX = (imgX * dY) / imgY end if end if end if end if 'On redimensionne l'image en fonction des valeurs calculées Image.DPI=72 Image.ImageFormat=1 Image.ResizeR dX, dY 'On sauvegarde la vignette Image.FileName = Server.MapPath(repvignette & "/" & nomvignette) if Image.SaveImage then CreeVignette="" else CreeVignette=Image.Error end if End Function End class %>
ça marche plutôt bien, mais je cherche à créer deux images en même temps.
C'est à dire une basse def et une vignette.
Est-ce que le composant le gère ?
Merci
voila c sur mon serveur et mon code ( c long car en fait 'j'up le fichier puis j'essai de le redim :
<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<title>Document sans titre</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
</head>
<%
'------------------------------------------------------------
Public sub UploaderFichier(mySmartUpload, strAdresse)
'------------------------------------------------------------
'--- upload fichier a une adresse donnée
'------------------------------------------------------------
Dim Fichier
'On error resume next'si erreur on continue quand meme
'mySmartUpload.MaxFileSize = 5000' Taille maximale autorisée : 5 Ko
'mySmartUpload.AllowedFilesList = "gif,jpg"' Upload autorisé sur les gif et jpg uniquement
mySmartUpload.Upload' Selectionne chaque fichier
For each Fichier In mySmartUpload.files
If not Fichier.IsMissing Then
strFichier = Fichier.FileName
Fichier.SaveAs(strAdresse & "" & strFichier)' Upload du fichier
End If
Next
if err.number =0 then 'test si erreur
direc= "
"'si pas erreur alors on affichera l'image dl
else
direc="une erreur c produite : "& strAdresse & "" & strFichier &"
"'si erreur alors on affiche l'erreur
end if
response.Write(direc)
Image_S strAdresse, strFichier
End sub
Public Sub Image_S(strAdresse, strFichier)
Dim Image
Dim nImgX, nImgX_S
Dim nImgY, nImgY_S
on error goto 0
'--- Création de l'objet image
Set Image = Server.CreateObject("AspImage.Image")
response.Write("Objet
")
'--- Chargement de l'image
Image.LoadImage strAdresse & "" & strFichier
nImgX=Image.MaxX
nImgY=Image.MaxY
response.Write("Image : " & strAdresse & "" & strFichier & "
X:" & nImgX & " Y:" & nImgY & "
")
'--- Calcul des dimension
nImgX_S=200
nImgY_S=int((200*nImgY)/nImgX)
response.Write("Dimension X:" & nImgX_S & " Y:" & nImgY_S & "
")
'--- On redimensionne l'image en fonction des valeurs calculées
Image.DPI=72
Image.ImageFormat=1
Image.ResizeR nImgX_S, nImgY_S
response.Write("Redim
")
'--- On sauvegarde
Image.FileName = strAdresse & "" & "small_" & strFichier
response.Write("Adresse : " & strAdresse & "" & "small_" & strFichier & "
")
if Image.SaveImage then 'test si erreur
direc= "
"'si pas erreur alors on affichera l'image dl
else
direc="une erreur c produite : "& Image.Error &"
"'si erreur alors on affiche l'erreur
end if
response.Write("Save : " & strAdresse & "" & "small_" & strFichier & "
")
response.Write(direc)
Set image=nothing
End sub
'------------------------------------------------------------------------------------------------------------------
if request.queryString("Action")="Upload" then
response.expires=0 'ça je sais pas
response.buffer=true'ça je sais pas non plus
On error resume next' Gérer les erreur
' Variables
Dim mySmartUpload 'ce qui permet d'up le fichier
Dim strAdr 'Adresse du fichier
Set mySmartUpload = Server.CreateObject("aspSmartUpload.SmartUpload")' Création de l'Objet
strAdr=Server.MapPath("\Tests\Upload")'à changer pour installer ou vous le voulez
'--- Upload les fichiers à l'adresse strAdr
UploaderFichier mySmartUpload, strAdr
set mySmartUpload=nothing'Si aucune erreur s'est produite on redirige vers uploadok.asp
End if
%>
<form method="POST" action="index.asp?action=Upload" enctype="multipart/form-data">
</form>
</html>
ASPImage.Image error '8000ffff'
This evaluation component has expired. Please register.
alors que g pas réussi à m'en servir ....
ya moyen de cracker la dll tu penses ?
t'a u ce pb toi ?
Quel est le message d'erreur? C'est peut étre un pb de droit en écriture sur le répertoire cible.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.