'Split' o 'Partir' Bmp ¿?

Iniciado por 3k1n0x, 5 Julio 2008, 23:50 PM

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

3k1n0x

Hola 1 salu2, sucede q estoy en la situacion de q necesito ver con mas detalle unas partes de unos archivos bmp, son como 400 archivos de imagenes bmp los cuales corresponden, cada uno, a 2 hojas de un libro, osea escanearon todo un libro metiendolo abierto en el scanner y pasando las hojas, ahora lo que no se como hacer es para 'partir' cada archivo bmp a los fines de poder ver cada hoja con mas detalle sin estar moviendo nada solo bajando, no se si existe por ahi algun software ya listo que lo haga, alguna idea o alguna api que me facilite la tarea programando algo en vb  :huh: :huh: :huh: salu2s
T3fL0n -> 3k1n0x

3k1n0x

Bueno ya lo he conseguido usando fireworks ara solo me qda inventar algo en vb para q sea automatizado gracias de todas formas salu2s
T3fL0n -> 3k1n0x

Hans el Topo

esto lo hacen los programas de diseño que aceptan macros más bien iría en diseño gráfico del foro

pero si quiers hacer una herramienta sería cargardo cada imagen y troceándola a partir de x punto

si no recuerdo mal en el programita de apis API-Guide tiene un grupo llamado bitmap con las apis correspondientes, echale un ojo

 

3k1n0x

vale ya lo e hecho, como tenia prisa pues tuve q meterle por fuerza bruta con las apis mouse_event y SetCursorPos  :xD , ara lo q no se es como ordenar las hojas, tengo que colocarlas en orden, por ahora estan asi 1,3,5,7... y en otra carpeta estan las pares 2,4,6,... y pues obviamente tengo que colocarlas bien 1,2,3.. para eso supongo que tengo que cambiar los nombres de las hojas impares a numeros impares y las pares a nros pares ya que ambas carpetas tienen el mismo nro de archivos y con los mismos nombres, alguna idea o api que me pueda facilitar la tarea? digo para cambiar los nombres y eso  :huh: :huh: :huh: :huh: salu2s
T3fL0n -> 3k1n0x

Hans el Topo

recorre todos los archivos del directorio que quieras cambiar y haz un bucle que vaya cambiando los nombres con step+2 mismamente, asi te daría 1,3,5,7 que es lo que necesitas

http://www.google.es/search?hl=es&q=recorrer+un+directorio+con+vb6&btnG=Buscar+con+Google&meta=
 

3k1n0x

lo e hecho de esta forma xq no se hacerlo de otra, alguien me podria dcir com hacerlo bn para no tardarme tanto  :huh:

Código (vb) [Seleccionar]
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Sub Form_Load()
Text2.Text = 1
End Sub

Private Sub Timer1_Timer()
Dim lnghWnd As Long, Texto As String
Dim O As Variant
Dim Var As Variant
lnghWnd = GetForegroundWindow
Texto = String(255, Chr(O))
GetWindowText GetForegroundWindow, Texto, 255
Me.Caption = Texto
Var = Left$(Form1.Caption, 49)
Label1.Caption = Var
End Sub

Private Sub renombrar()
Dim ArchivoOrigen As String
Dim ArchivoDestino As String
Set fs = CreateObject("Scripting.FileSystemObject")
ArchivoOrigen = "C:\Documents and Settings\SPC\Escritorio\PARTES DERECHA DE JPGS\" & Text1.Text & ".jpg"
ArchivoDestino = "C:\Documents and Settings\SPC\Escritorio\PARTES DERECHA DE JPGS\" & Text2.Text & ".jpg"
fs.CopyFile ArchivoOrigen, ArchivoDestino
fs.deletefile ArchivoOrigen
Text2.Text = Text2.Text + 2
End Sub


Private Sub Timer2_Timer()
SendKeys "{ENTER}"
Timer2.Enabled = False
Timer3.Enabled = True
End Sub

Private Sub Timer3_Timer()
Text1.Text = Label1.Caption
SendKeys "%{F4}"
SendKeys "{DOWN}"
renombrar
Timer3.Enabled = False
Timer2.Enabled = True
End Sub

Private Sub Timer4_Timer()
Timer2.Enabled = True
End Sub


de esta forma consigo lo q quiero pero aparte de q tarda un monton xq son un viaje de hojas  :huh: :huh:
T3fL0n -> 3k1n0x

Hans el Topo

te voy a explicar una manera sencilla xD

para renombrarlos puedes utilizar un comando ms-2 llamado rename (rename "nombre_archivo_origen" "nombre_nuevo")
lo ejecutas desde vb6 en un bucle y asunto arreglao sin mucha demora
la api/función a utilizar es shell y no hace falta declararla

sabiendote el nombre de los archivos a renombrar, como es el caso, no tienes que utlizar más apis ya que cumple una sucesión,
es decir si son impares el for sería como te he dicho con un step 2, compones el comando a lanzar con el nombre origen sacando el valor del contador y asunto arreglao en un periquete


 

3k1n0x

ya lo habia conseguido pero en ves d qdarme de la forma 1,2,3,4,5,... me qdo de la forma 2,1,4,3,6,5... stoy probando con este codigo y ahora no se como recorrer el listbox 2  :huh: q contiene la lista de archivos para ir pasandoselos al comando rename de la shell , seguire probando

Código (vb) [Seleccionar]
'---------------------------------------------------
    'Agregar lña referencia a Microsoft Scripting Runtime
'---------------------------------------------------


Private Sub Command1_Click()
On Error GoTo errsub

    Dim Fso As FileSystemObject
    Dim El_Directorio As Folder

    Screen.MousePointer = vbHourglass
   
    DoEvents
    List1.Clear

   
    Set Fso = New FileSystemObject
    Set El_Directorio = Fso.GetFolder(Trim$(Text1))

    List1.AddItem Trim$(Text1)
   
   ' Comienza a listar las carpetas
    Call Listar_Directorios(El_Directorio)

    Screen.MousePointer = vbDefault
   
'Error
Exit Sub

errsub:
    MsgBox Err.Description, vbCritical
    Screen.MousePointer = vbDefault

End Sub


Private Sub Listar_Directorios(ByVal El_Directorio As Folder)

    On Error GoTo errsub

    ' Variable de tipo Folder
    Dim Subdirectorio As Folder

    ' Recorre los subdirectorios
    For Each Subdirectorio In El_Directorio.SubFolders
        'Agrega el path
        List1.AddItem El_Directorio.Path & "\" & Subdirectorio.Name
           
        'sigue listando los directorios
        Listar_Directorios Subdirectorio
   
    Next

Exit Sub

'Error
errsub:
'Error de permiso denegado
If Err.Number = 70 Then
   Resume Next
   
ElseIf Err.Number = 91 Then
   Screen.MousePointer = vbDefault
   Exit Sub
Else
   MsgBox Err.Description, vbCritical
   Exit Sub
End If
End Sub

Private Sub Form_Load()
    Command1.Caption = " Listar "
    Text1 = "c:\a"
End Sub

Private Sub List1_Click()

    'Variable de tipo FILE y FOLDER para listar los archivos de un path
    Dim El_Archivo As File
    Dim El_Directorio As Folder

    'Si no hay items en el List sale
    If List1.ListIndex = -1 Then Exit Sub
   
    List2.Clear
   
    'Nuevo objeto FileSystemObject
    Set Fso = New FileSystemObject
   
    ' Obtiene el directorio
    Set El_Directorio = Fso.GetFolder(List1.List(List1.ListIndex))
   
   
    ' Lista los ficheros de esta carpeta
    For Each El_Archivo In El_Directorio.Files
       'Añade la ruta
       List2.AddItem El_Archivo.Name
       
    Next El_Archivo

End Sub

T3fL0n -> 3k1n0x

3k1n0x

bueno ya lo termine con un simple codigo , muchas gracias hans el topo salu2s  ;)
T3fL0n -> 3k1n0x