RESIZE IMAGE(دوباره)

amin1us · 26 ژانویه 2006

سلام
بچه ها من چطوري مي تونم بدون كامپوننت اميج ( عكس) رو ريسايز كنم.
كمك!!
در ضمن كسي هاست اي اس پي نمي شناسه كه كامپوننت ASPJEPG روش باشه!؟

:blink:

amin1us · 31 ژانویه 2006

آهاي بروبچ حرفه اي بشتابيد
سلام بچه ها من اين كد ها رو پيدا كردم ولي چون رو سيستم خودم systemFile اجرا نمي شه مي گذارم اينجا تا هم از اين كدا همه استفاده كنن و هم اگه كسي فهميد با اين كدا چطور بايد كار كرد با ما هم بگه!!:happy:

اين فايل اصليش هست

کد:

%>
     <!--#INCLUDE FILE='imgz.asp'-->
     <!--#INCLUDE FILE='propresize.asp'-->
   <%
   ' To test, we'll just try to show all files with a .GIF extension in
   ' the root of C: by fitting them to a common area (75 pixels x 45 pixels)
 
   dim objFSO, objF, objFC  
   dim f1, w, h, c, strType

   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objF = objFSO.GetFolder(Server.MapPath("/images/demos/"))
   Set objFC = objF.Files

   response.write "<table border=""1"" cellpadding=""5"">"

   For Each f1 in objFC
     if instr(ucase(f1.Name), ".JPG") then
        response.write "<tr><td>" & f1.name & "</td><td>" & f1.DateCreated & _
                       "</td><td>" & f1.Size & "</td><td>"
 
        if gfxSpex(f1.Path, w, h, c, strType) = true then
           response.write w & " x " & h & " " & c & " colors</td>"
           response.write "<td><img src=""/images/demos/" & f1.Name & """ " & _
                          ImageResize(f1.Path, 75, 45) & " border=""1""></td>"
        else
           response.write " </td><td align=""center"">bad image</td>"
        end if
 
        response.write "</tr>"
 
     end if
   Next

   response.write "</table>"

   set objFC = nothing
   set objF = nothing
   set objFSO = nothing
%>

اين ايكلودش

کد:

<%
'PropResize  

   function ImageResize(strImageName, intDesiredWidth, intDesiredHeight)

      dim TargetRatio
      dim CurrentRatio
      dim strResize
      dim w, h, c, strType

      if gfxSpex(strImageName, w, h, c, strType) = true then
         TargetRatio = intDesiredWidth / intDesiredHeight
         CurrentRatio = w / h
         if CurrentRatio > TargetRatio then                       ' We'll scale height
            strResize = "width=""" & intDesiredWidth & """"
         else
            strResize = "height=""" & intDesiredHeight & """"     ' We'll scale width
         end if
      else
         strResize = ""
      end if

      ImageResize = strResize

   end Function
%>

اين هم يكي ديگشه!!

کد:

<%
'imgsz_asp.asp
  function GetBytes(flnm, offset, bytes)

     Dim objFSO
     Dim objFTemp
     Dim objTextStream
     Dim lngSize

     on error resume next

     Set objFSO = CreateObject("Scripting.FileSystemObject")
     
     ' First, we get the filesize
     Set objFTemp = objFSO.GetFile(flnm)
     lngSize = objFTemp.Size
     set objFTemp = nothing

     fsoForReading = 1
     Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)

     if offset > 0 then
        strBuff = objTextStream.Read(offset - 1)
     end if

     if bytes = -1 then		' Get All!

        GetBytes = objTextStream.Read(lngSize)  'ReadAll

     else

        GetBytes = objTextStream.Read(bytes)

     end if

     objTextStream.Close
     set objTextStream = nothing
     set objFSO = nothing

  end function


  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  ':::                                                             :::
  ':::  Functions to convert two bytes to a numeric value (long)   :::
  ':::  (both little-endian and big-endian)                        :::
  ':::                                                             :::
  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  function lngConvert(strTemp)
     lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
  end function

  function lngConvert2(strTemp)
     lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
  end function

  
  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  ':::                                                             :::
  ':::  This function does most of the real work. It will attempt  :::
  ':::  to read any file, regardless of the extension, and will    :::
  ':::  identify if it is a graphical image.                       :::
  ':::                                                             :::
  ':::  Passed:                                                    :::
  ':::       flnm        => Filespec of file to read               :::
  ':::       width       => width of image                         :::
  ':::       height      => height of image                        :::
  ':::       depth       => color depth (in number of colors)      :::
  ':::       strImageType=> type of image (e.g. GIF, BMP, etc.)    :::
  ':::                                                             :::
  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  function gfxSpex(flnm, width, height, depth, strImageType)

     dim strPNG 
     dim strGIF
     dim strBMP
     dim strType
     strType = ""
     strImageType = "(unknown)"

     gfxSpex = False

     strPNG = chr(137) & chr(80) & chr(78)
     strGIF = "GIF"
     strBMP = chr(66) & chr(77)

     strType = GetBytes(flnm, 0, 3)

     if strType = strGIF then				' is GIF

        strImageType = "GIF"
        Width = lngConvert(GetBytes(flnm, 7, 2))
        Height = lngConvert(GetBytes(flnm, 9, 2))
        Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
        gfxSpex = True

     elseif left(strType, 2) = strBMP then		' is BMP

        strImageType = "BMP"
        Width = lngConvert(GetBytes(flnm, 19, 2))
        Height = lngConvert(GetBytes(flnm, 23, 2))
        Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
        gfxSpex = True

     elseif strType = strPNG then			' Is PNG

        strImageType = "PNG"
        Width = lngConvert2(GetBytes(flnm, 19, 2))
        Height = lngConvert2(GetBytes(flnm, 23, 2))
        Depth = getBytes(flnm, 25, 2)

        select case asc(right(Depth,1))
           case 0
              Depth = 2 ^ (asc(left(Depth, 1)))
              gfxSpex = True
           case 2
              Depth = 2 ^ (asc(left(Depth, 1)) * 3)
              gfxSpex = True
           case 3
              Depth = 2 ^ (asc(left(Depth, 1)))  '8
              gfxSpex = True
           case 4
              Depth = 2 ^ (asc(left(Depth, 1)) * 2)
              gfxSpex = True
           case 6
              Depth = 2 ^ (asc(left(Depth, 1)) * 4)
              gfxSpex = True
           case else
              Depth = -1
        end select


     else

        strBuff = GetBytes(flnm, 0, -1)		' Get all bytes from file
        lngSize = len(strBuff)
        flgFound = 0

        strTarget = chr(255) & chr(216) & chr(255)
        flgFound = instr(strBuff, strTarget)

        if flgFound = 0 then
           exit function
        end if

        strImageType = "JPG"
        lngPos = flgFound + 2
        ExitLoop = false

        do while ExitLoop = False and lngPos < lngSize

           do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
              lngPos = lngPos + 1
           loop

           if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
              lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
              lngPos = lngPos + lngMarkerSize  + 1
           else
              ExitLoop = True
           end if

       loop
       '
       if ExitLoop = False then

          Width = -1
          Height = -1
          Depth = -1

       else

          Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
          Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
          Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
          gfxSpex = True

       end if
                   
     end if

  end function



  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  ':::     Test Harness                                              :::
  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
  ' To test, we'll just try to show all files with a .GIF extension in the root of C:

  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objF = objFSO.GetFolder("c:\")
  Set objFC = objF.Files

  response.write "<table border=""0"" cellpadding=""5"">"

  For Each f1 in objFC
    if instr(ucase(f1.Name), ".GIF") then
       response.write "<tr><td>" & f1.name & "</td><td>" & f1.DateCreated & "</td><td>" & f1.Size & "</td><td>"

       if gfxSpex(f1.Path, w, h, c, strType) = true then
          response.write w & " x " & h & " " & c & " colors"
       else
          response.write "&nbsp;"
       end if

       response.write "</td></tr>"

    end if

  Next

  response.write "</table>"

  set objFC = nothing
  set objF = nothing
  set objFSO = nothing


%>

فقط اگه فهميديد لطفا كنيد به ما هم بگين!!
و اينكه احتمال اين برنامه واسه فايل JPG كار نمي كنه اگه كسي تونست اينو كاملش كنيد كه JPG هم بتونه ريسايز كنه خيلي خوب ميشه!

از همه بهتر هم اينكه اگه كسي زحمتشو بكشه يه مثال كاربردي هم درست كنه ديگه خيلي خيلي باحال ميشه!!
مرسي فلا باي :wacko:

ikeyvan · 31 ژانویه 2006

این کد ناقص هستش چون تنها کاری که میکنه اطلاعات و image های C: و Server.MapPath("/images/demos/") رو نشون میده

ikeyvan · 31 ژانویه 2006

اینجا رو ببین به درد ات میخوره
http://www.4guysfromrolla.com/webtech/050300-1.shtml

amin1us · 1 فوریه 2006

به نقل از ikeyvan :
اینجا رو ببین به درد ات میخوره
http://www.4guysfromrolla.com/webtech/050300-1.shtml

خوب اينكه همينه كه من گذاشتم

يكي كمممك كنه:wacko:

amin1us · 2 فوریه 2006

سلام بچه ها من اين كد امتحان كردم كار مي كنه فقط مشكلش اينجاس فايل جديدو زخيره نمي كنه

کد:

<%@ page language="vb" contenttype="image/jpeg" Debug="true"%>
<%@ import Namespace="System.IO" %>
<%@ import Namespace="System.Drawing" %>
<%@ import Namespace="System.Drawing.Imaging" %>
<%@ import Namespace="System.Drawing.Drawing2D" %>
<%@ import Namespace="System.Collections" %>
<%@ import Namespace="System.Globalization" %>

<%

	response.clear

    	'Read in the image filename to resize

	Dim strImgSrc as String = Request.QueryString("img")

	Dim intMaxImgWidth as Integer = Request.QueryString("x")

	Dim intMaxImgHeight as Integer = Request.QueryString("y")

	Dim intNewWidth as Integer

	Dim intNewHeight as Integer

	Dim Img as System.Drawing.Image

	Img = System.Drawing.Image.FromFile(Server.MapPath(strImgSrc))



	If Img.Height > intMaxImgHeight

		intNewWidth = (intMaxImgHeight * (Img.Width/Img.Height))

		intNewHeight = intMaxImgHeight

	Else

		intNewWidth = Img.Width

		intNewHeight = Img.Height

	End if



	If intNewWidth > intMaxImgWidth

		intNewHeight = (intMaxImgWidth * (intNewHeight/intNewWidth))

		intNewWidth = intMaxImgWidth

	End if

	

	Img = New system.drawing.bitmap(Img, intNewWidth, intNewHeight)



	Img.Save(Response.OutputStream, imageformat.jpeg)



	Img.Dispose()

	response.end 

%>

اينجا مي تونيد امتحان كنيد كسي چيزي به فكر ش مي رسه؟
http://photo.webadvert.biz/re1.asp
تو قسمت اولش سايزو بدين تو آخرين فيلدشم 2.jpg بزنيد:wacko:

برگزیده های پرشین تولز

RESIZE IMAGE(دوباره)

amin1us

کاربر تازه وارد

amin1us

کاربر تازه وارد

ikeyvan

Registered User

ikeyvan

Registered User

amin1us

کاربر تازه وارد

amin1us

کاربر تازه وارد

تبلیغات متنی