presentacion de imagenes con Auto-viewer

Iniciado por ‭‭‭‭jackl007, 6 Septiembre 2008, 19:25 PM

0 Miembros y 1 Visitante están viendo este tema.

‭‭‭‭jackl007

Bueno, queriendo hacer una presentacion de imagenes, me encontre con un proyecto muy simpatico, y le agrege un programita para pre-configurar parte de las imagenes que se mostraran en el, ya que hacerlas manualmente son molestosas, aun mas cuando las imagenes son de distintas resoluciones.

aqui esta la url del proyecto del Autoviewer:
http://www.airtightinteractive.com/projects/autoviewer/

bajamos el paquete del autoviewer (necesario para poder hacer la presentacion):
http://www.airtightinteractive.com/projects/autoviewer/autoviewer.zip
y ya tenemos los archivos necesarios, para lo nuestro.

ejemplo:
http://usuarios.lycos.es/jkbenites29/Auto-viewer



ahora lo mio, abrimos un proyecto y colocamos estos controles como en la imagen:

damos las propiedades al control text2 necesarias: multiline, y bars

Código (vb) [Seleccionar]

Private Declare Function GetObject _
    Lib "gdi32" _
    Alias "GetObjectA" ( _
        ByVal hObject As Long, _
        ByVal nCount As Long, _
        lpObject As Any) As Long

'Estructutra necesesaria para la informacion del Bitmap
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

'Array de bytes y variable para la estructura
Dim PicBits() As Byte, PicInfo As BITMAP

Dim ArchivoXML As String
Dim MAX As Integer
'Variable para almacenar la imagen
Dim Laimagen As IPictureDisp
Function Nombre(path)
Nombre = Mid(path, InStrRev(path, "\") + 1)
End Function
Function Factor(ByVal num As Double)
Dim N As Integer
N = Round(num)

If N < 680 Then
Factor = 1
Else

    Dim temp As Double
    temp = N / MAX
    If temp > 1 Then
    Factor = N / temp
    Else
    Factor = N
    End If

    Factor = Round(temp, 4)
End If

End Function
Function Div(numW, numH)
Dim N As Integer

N = numW: MAX = 680
If numW < numH Then
N = numH
MAX = 500
End If


Dim temp As Double
temp = Factor(N)

numW = Round(numW / temp)
numH = Round(numH / temp)
'If MAX = 500 Then numH = numH - 100

Dim Adicional As Integer
Adicional = 450 - numH


If Adicional > 0 Then

If numH > 350 Then
numW = Round((numW * (numH + Adicional)) / numH)
numH = numH + Adicional

End If
End If

End Function

Function Subfolders(path)
    On Error Resume Next
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim N_w, N_h As Integer
   
    Set Drives = fso.Drives
    newpath = path
    Set Fold = fso.GetFolder(newpath)
    Set Files = Fold.Files
   
    For Each File In Files

    Set Laimagen = LoadPicture(File.path)
    GetObject Laimagen, Len(PicInfo), PicInfo

        ext = fso.GetExtensionName(File.path)
        ext = LCase(ext)
        If ext = "jpg" Then
       N_w = CLng(PicInfo.bmWidth)
       N_h = CLng(PicInfo.bmHeight)
       test = Div(N_w, N_h)
       
    ArchivoXML = ArchivoXML & vbCrLf & "<image>" & vbCrLf _
                & "     <url>" & Nombre(Text1) & "/" & File.Name & "</url>" & vbCrLf _
                & "     <caption> </caption>" & vbCrLf _
                & "     <width>" & N_w & "</width>" & vbCrLf _
                & "     <height>" & N_h & "</height>" & vbCrLf _
                & "</image>" & vbCrLf
               
                '& "     <width>" & CLng(PicInfo.bmWidth) / 2.4 & "</width>" & vbCrLf
                '& "     <height>" & CLng(PicInfo.bmHeight) / 2.4 & "</height>" & vbCrLf
               
                End If
                DoEvents
    Next

End Function

Private Sub Command1_Click()


ArchivoXML = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>" & vbCrLf _
            & "<gallery frameColor=" & Chr(34) & "0xFFFFFF" & Chr(34) & " frameWidth=" & Chr(34) & "15" & Chr(34) & " imagePadding=" & Chr(34) & "20" & Chr(34) & " displayTime=" & Chr(34) & "6" & Chr(34) & " enableRightClickOpen=" & Chr(34) & "true" & Chr(34) & ">" & vbCrLf & vbCrLf

Subfolders (Text1.Text)

ArchivoXML = ArchivoXML & vbCrLf & "</gallery>"
Text3.Text = ArchivoXML
End Sub


Algunas cositas encontre en la web como la forma de obtener la resolucion de una imagen ...

en el text1 se coloca la ruta de las imagenes, y el programa genera el archivo tratando de acomodar la resolucion de las imagenes a una adecuada, por ejemplo, si se colocan imagenes grandes, el programa encuentra el tamaño apropiado en el archivo.
y ahora tendremos el texto del archivo gallery.xml completo, listo para agregar al proyecto.

esto lo hice, porque me daba pereza ponerme a agregar la configuracion de las imagenes manualmente, asi que mejor un programa que lo haga por mi.

ahora agregamos el archivo gallery.xml afuera de la carpeta que contiene las imagenes (salvo que edites el programa, para que lo coloques a tu gusto).

ahora les dejo un ejemplo:
http://usuarios.lycos.es/jkbenites29/Auto-viewer

(las imagenes las tome yo con mi camara, aqui dejo la url del correspondiente post:
http://foro.elhacker.net/fotografia/fotitos_jaen_peru_with_autoviewer-t224361.0.html