|
3221
|
Programación / Programación Visual Basic / HDC a Picture
|
en: 22 Septiembre 2008, 06:55 am
|
con respecto a los PNG seria cargarlo a el modulo y despues transformarlo a pictura o bitmap ve esta funcion sacada de la Api-Guide la funcion en si transforma de un Hdc a Picture ok' [como ejemplo poongo este codigo completo de la Api-Guide] Const RC_PALETTE As Long = &H100 Const SIZEPALETTE As Long = 104 Const RASTERCAPS As Long = 38 Private Type PALETTEENTRY peRed As Byte peGreen As Byte peBlue As Byte peFlags As Byte End Type Private Type LOGPALETTE palVersion As Integer palNumEntries As Integer palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors End Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID 'Fill GUID info With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With 'Fill picture info With Pic .Size = Len(Pic) ' Length of structure .Type = vbPicTypeBitmap ' Type of Picture (bitmap) .hBmp = hBmp ' Handle to bitmap .hPal = hPal ' Handle to palette (may be null) End With 'Create the picture R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) 'Return the new picture Set CreateBitmapPicture = IPic End Function Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE 'Create a compatible device context hDCMemory = CreateCompatibleDC(hDCSrc) 'Create a compatible bitmap hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc) 'Select the compatible bitmap into our compatible device context hBmpPrev = SelectObject(hDCMemory, hBmp) 'Raster capabilities? RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster 'Does our picture use a palette? HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette 'What's the size of that palette? PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of If HasPaletteScrn And (PaletteSizeScrn = 256) Then 'Set the palette version LogPal.palVersion = &H300 'Number of palette entries LogPal.palNumEntries = 256 'Retrieve the system palette entries R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0)) 'Create the palette hPal = CreatePalette(LogPal) 'Select the palette hPalPrev = SelectPalette(hDCMemory, hPal, 0) 'Realize the palette R = RealizePalette(hDCMemory) End If 'Copy the source image to our compatible device context R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy) 'Restore the old bitmap hBmp = SelectObject(hDCMemory, hBmpPrev) If HasPaletteScrn And (PaletteSizeScrn = 256) Then 'Select the palette hPal = SelectPalette(hDCMemory, hPalPrev, 0) End If 'Delete our memory DC R = DeleteDC(hDCMemory) Set hDCToPicture = CreateBitmapPicture(hBmp, hPal) End Function Private Sub Form_Load() 'KPD-Team 1999 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@Allapi.net 'Create a picture object from the screen Set Me.Picture = hDCToPicture(GetDC(0), 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY) End Sub
solo edita la linea siguiente y edita los datos requeridos Set Picture2.Picture = hDCToPicture(Picture1.hdc, 0, 0, 100, 100) []/code[
|
|
|
3222
|
Programación / Programación Visual Basic / Re: Una ayudita pliss
|
en: 22 Septiembre 2008, 06:47 am
|
DrawText. Const DC_ACTIVE = &H1 Const DC_NOTACTIVE = &H2 Const DC_ICON = &H4 Const DC_TEXT = &H8 Const BDR_SUNKENOUTER = &H2 Const BDR_RAISEDINNER = &H4 Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER) Const BF_BOTTOM = &H8 Const BF_LEFT = &H1 Const BF_RIGHT = &H4 Const BF_TOP = &H2 Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM) Const DFC_BUTTON = 4 Const DFC_POPUPMENU = 5 'Solo Win98/2000 !! Const DFCS_BUTTON3STATE = &H10 Const DT_CENTER = &H1 Const DC_GRADIENT = &H20 'Solo Win98/2000 !! Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long Private Sub Form_Load() AutoRedraw = True Dim r As RECT r.Top = 0 r.Left = 0 r.Bottom = 20 r.Right = 500 DrawText Me.hdc, "Holaaaaaaaaaa", Len("Holaaaaaaaaaa"), r, BF_RECT Or BF_TOP End Sub
BitBlt usa dos piture en el picture1 carga alguna imagen en el segundo no pogas nada Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Sub Form_Load() Picture1.ScaleMode = 3 Picture2.ScaleMode = 3 Picture1.AutoRedraw = True Picture2.AutoRedraw = True r = BitBlt(Picture2.hdc, 0, 0, 100, 100, Picture1.hdc, 10, 10, vbSrcCopy) End Sub
Transparect Blt (Sacado de la Api-Guide) 'This project needs 2 pictureboxes 'Picturebox1 must contain a picture with a lot of white pixels (we're going to use white as transparent color) Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean Private Sub Form_Load() 'KPD-Team 1999 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@Allapi.net Picture1.AutoSize = True 'API uses pixels Picture1.ScaleMode = vbPixels Picture2.ScaleMode = vbPixels End Sub Private Sub Picture2_Paint() 'If we don't call DoEvents first, our transparent image will be completely wrong DoEvents TransparentBlt Picture2.hdc, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbWhite End Sub
|
|
|
3224
|
Programación / Programación Visual Basic / Re: Una ayudita pliss
|
en: 21 Septiembre 2008, 09:30 am
|
Como NO pides ejemplos de coigos mejor te voy al punto sin tanto rollo
Parala imagen: con PaintPicture o con la api bitblt combinarlo con TransparentBlt para transparencias un X color Para texto: Api DrawText
|
|
|
3225
|
Programación / Programación Visual Basic / Re: Redimensionar imagen????
|
en: 20 Septiembre 2008, 05:40 am
|
Hola,yo creo que con un PaintPicture te alcanza...
saludos.
lo mismo digo, aun que la funcion que puse detecta escala la imagen a el picture y lo ajusta a este sin importar el tamaño de la imagen a cargar y no distorciona la imagen en cuestion de anchura y altura je (probarlo para verlo mejor) r=cargarredimencionarimg("c:\img.jpg",picture1)
|
|
|
3226
|
Programación / Programación Visual Basic / Re: como crear funcion que?
|
en: 20 Septiembre 2008, 02:38 am
|
Private Function RndString(ByVal LongString As Integer) As String Dim I As Integer Randomize Timer For I = 0 To LongString Select Case (Int((3 * Rnd) + 1)) Case 1: RndString = RndString & Chr$(Int((10 * Rnd) + 48)) Case 2: RndString = RndString & Chr$(Int((26 * Rnd) + 65)) Case 3: RndString = RndString & Chr$(Int((26 * Rnd) + 97)) End Select Next End Function
Corrigiendo xP Private Function RndString(ByVal LongString As Integer) As String Dim I As Integer Randomize Timer For I = 1 To LongString Select Case (Int((3 * Rnd) + 1)) Case 1: RndString = RndString & Chr$(Int((10 * Rnd) + 48)) Case 2: RndString = RndString & Chr$(Int((26 * Rnd) + 65)) Case 3: RndString = RndString & Chr$(Int((26 * Rnd) + 97)) End Select Next End Function
el anterior me daba 11 caracteres cuando yo pedia 10 je xP este me gusta mas
|
|
|
3227
|
Programación / Programación Visual Basic / Re: Redimensionar imagen????
|
en: 20 Septiembre 2008, 02:12 am
|
Aca esta el codigo espero y te agrade Dim ImagenFoto As IPictureDisp Public Function CargarRedimencionarIMG(sRuta As String, _ PictureFix As PictureBox, _ Optional ByVal Pic_Ancho As Double, _ Optional ByVal Pic_Alto As Double, _ Optional ByVal X As Integer = 0, _ Optional ByVal Y As Integer = 0, _ Optional ByVal X2 = 0, _ Optional ByVal Y2 = 0, _ Optional ByVal Ancho2, _ Optional ByVal Alto2, _ Optional Opcional) As Long On Error GoTo Nel: Dim Ancho As Single, Alto As Single, Porcentaje As Single Pic_Ancho = IIf(Pic_Ancho <= 0, PictureFix.Width, Pic_Ancho) Pic_Alto = IIf(Pic_Alto <= 0, PictureFix.Height, Pic_Alto) PictureFix.Width = Val(Pic_Ancho): PictureFix.Height = Val(Pic_Alto) PictureFix.Cls Set ImagenFoto = LoadPicture(sRuta) Ancho = ImagenFoto.Width Alto = ImagenFoto.Height If Ancho < PictureFix.Width And Alto < PictureFix.Height Then Porcentaje = 100 CargarRedimencionarIMG = CentrarPicture(PictureFix, Ancho, Alto, X, Y, Porcentaje, X2, Y2, Ancho2, Alto2, Opcional) Exit Function End If If Ancho > PictureFix.Width Or Alto > PictureFix.Height Then If Ancho > Alto Then Porcentaje = (PictureFix.Width * 100) / Ancho Else Porcentaje = (PictureFix.Height * 100) / Alto End If CargarRedimencionarIMG = CentrarPicture(PictureFix, Ancho, Alto, X, Y, Porcentaje, X2, Y2, Ancho2, Alto2, Opcional) Exit Function ElseIf Ancho <= PictureFix.Width Or Alto <= PictureFix.Height Then If Ancho > Alto Then Porcentaje = (PictureFix.Width * 100) / Ancho Else Porcentaje = (PictureFix.Width * 100) / Alto End If CargarRedimencionarIMG = CentrarPicture(PictureFix, Ancho, Alto, X, Y, Porcentaje, X2, Y2, Ancho2, Alto2, Opcional) End If Exit Function Nel: Cargar = 0 Err.Clear End Function Private Function CentrarPicture(PictureFix As PictureBox, _ Optional ByVal Ancho As Double, _ Optional ByVal Alto As Double, _ Optional ByVal X As Integer = 0, _ Optional ByVal Y As Integer = 0, _ Optional Porcentaje As Single = 100, _ Optional ByVal X2 As Integer = 0, _ Optional ByVal Y2 As Integer = 0, _ Optional ByVal Ancho2, _ Optional ByVal Alto2, _ Optional Opcional) As Long On Error GoTo Nel Ancho = (Ancho * Porcentaje) / 100 Alto = (Alto * Porcentaje) / 100 PictureFix.Width = Ancho PictureFix.Height = Alto PictureFix.PaintPicture ImagenFoto, X, Y, Ancho, Alto, X2, Y2, Ancho2, Alto2, Opcional CentrarPicture = 1 Exit Function Nel: CentrarPicture = 0 Err.Clear End Function
|
|
|
3228
|
Programación / Programación Visual Basic / Re: Split replacement
|
en: 18 Septiembre 2008, 01:15 am
|
yo cuando aprendia apenas VB hice algo similar solo que mi codigo era muuuy largo xS obviamente apenas empesaba y no por maestros si no por mi propia cuenta y ejemplos descargados era mas o menos el doble o triple de tu codigo je xP haber i lo ayo y lo pongo je.
Aun asi esta bueno xP
|
|
|
3230
|
Programación / Programación Visual Basic / Re: MODEM DSL 305EU
|
en: 16 Septiembre 2008, 05:01 am
|
ante todo buenas noches, acudo esta noche a el chat por tener un problema con un modem starbritge, el modelo es fcc dsl 305eu. El modem es nuevo el problema que presenta es que sincroniza cuando le da la gana, saben tengo otro modem claro de diferente marca el cual en mi linea siempre funcion bien, ahora bien hay alguna configuracion que kle pueda yo realizar o es que espa desprogramado, por tener kla opcion de router? les agradezco de verdad su ayuda
Invitame de lo que te fumaste broo para estar en tu ondaaa Esto ira aquí cuando vea elefantes Rosas ("Como en unos 15 minutos" vive la vida carnal) ja no ya enserio por que piensas que esto va en esta parte?
|
|
|
|
|
|
|