:: Ajustar tamaño de imagen temporalmente ::

[tammander]

3a parte.

Código:

      Private Function RShift(sValue, iBits)
           Dim i__BYTE : i__BYTE = 8
           Dim sResult, sHold, iPartial
           Dim iLen, iCur, sByte, iByte
           
           ' Do nothing if no bit shift requested, or perform LShift.
           If iBits = 0 Then
               RShift = sValue
               Exit Function
           ElseIf iBits < 0 Then
               RShift = LShift(sValue, Abs(iBits))
               Exit Function
           ElseIf LenB(sValue) < Fix(iBits / i__BYTE) Then
               RShift = sValue
               Exit Function        
           End If
   
           ' Elimina todos los bytes
           If Fix(iBits / i__BYTE) > 0 Then 
               sResult = MidB(sValue, 1, LenB(sValue) - Fix(iBits / i__BYTE))
           Else
               sResult = sValue
           End If
           iPartial = iBits Mod i__BYTE
           If iPartial = 0 Then
               RShift = sResult
               Exit Function
           End If
           sHold = sResult
           sResult = ""
   
           ' Byte by Byte, shift remaining bits.
           iLen = LenB(sHold)
           For iCur = iLen To 1 Step -1
               If iCur > 1 Then
                   ' Get this byte (with additional byte prefix)
                   sByte = MidB(sHold, iCur - 1, 2)
                   iByte = (AscB(MidB(sByte, 1, 1)) * 256) + AscB(MidB(sByte, 2, 1))
               Else
                   sByte = MidB(sHold, iCur, 1)
                   iByte = AscB(sByte)
               End If
               ' Perform the shift
               iByte = Fix(CLng(iByte) * 2 ^ (-1 * iPartial))
               ' Convert back to string            
               sByte = ChrB(CLng("&h" & Right(("00" & Hex(iByte)), 2)))
               sResult = sByte & sResult
           Next
           
           ' Finalmente, lee los bytes vacios si es necesario
           iLen = Fix(iBits / i__BYTE)
           If iLen > 0 Then
               For iCur = 1 To iLen
                   sResult = ChrB(0) & sResult
               Next
           End If
           
           RShift = sResult    
       End Function
       
       Private Function ToBinary(sVal)
           Dim iLen, iCur, iByte, iVal, iB, OUT, OUTH
           iLen = LenB(sVal)
           If iLen = 0 Then 
               ToBinary = ""
               Exit Function
           End If
           For iCur = 1 To iLen
               iByte = MidB(sVal, iCur, 1)
               iVal = AscB(iByte)
               OUTH = OUTH & Right("0" & Hex(iVal), 2)
               For iB = 7 To 1 Step -1
                   If iVal >= (2 ^ iB) Then
                       OUT = OUT & "1"
                       iVal = iVal - (2 ^ iB)
                   Else
                       OUT = OUT & "0"
                   End If                
               Next
               If iVal > 0 Then
                   OUT = OUT & "1"
               Else
                   OUT = OUT & "0"
               End If
               OUT = OUT & "."
           Next
           ToBinary = OUTH & "&nbsp;&nbsp;&nbsp;" & OUT
       End Function
       
   End Class