Hola amigos :-) de VB-MUNDO, alguien sabe como imprimir 4 formularios con todos sus componentes en una sola pagina, tambien quisiera saber como imprimir un formularios de cabeza osea rotado 180 grados. Gracias por su ayuda.

NO creo que se pueda... te va a convenir conseguirte algun OCX que capture pantalla y te los convierta en imagenes y luego veras como enviarlos todos juntos a la impresora.

Suerte

__________________
Pablo Tilotta
Administrador de...
www.vb-mundo.com
Visual Basic
Videos Programacion
Foro Programacion
Tutoriales Programacion
Visual Basic.NET

y como imprimir una magen rotada 180 grados, alguna idea :?:

Bueno, te doy una idea. No acaba de salir perfecto (falta ajustar margenes, mirar tamaños de los formularios, ajustarlos, etc...) pero esos detalles te los dejo para ti.

imagina un proyecto con 4 formularios de 200 x 200 pixels cada uno llamados Form1, form2, form3, form4 (crealos con Width = 3000 y Height = 3000).
Los creas y pones en ellos cuantos controles, imagenes, etc... quieras.

Creas un modulo y metes este codigo:

Option Explicit

Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = origen
Public Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public 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
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function StretchBlt Lib "gdi32" (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 dwRop As Long) As Long
Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long


Public Sub Imprime()
Dim mDc As Long
Dim mBmp As Long
Dim antBmp As Long
Dim mDc2 As Long
Dim mBmp2 As Long
Dim antBmp2 As Long
Dim Pic As PicBmp
Dim IPic As IPicture
Dim IID_IDispatch As GUID

Dim dl As Long
mDc = CreateCompatibleDC(Form1.hdc)
mBmp = CreateCompatibleBitmap(Form1.hdc, 400, 400)
antBmp = SelectObject(mDc, mBmp)
ShowForm mDc, Form1, 0, 0
ShowForm mDc, Form2, 0, 1
ShowForm mDc, Form3, 1, 0
ShowForm mDc, Form4, 1, 1
'rotamos la imagen
dl = StretchBlt(mDc, 400, 400, -400, -400, mDc, 0, 0, 400, 400, SRCCOPY)
dl = SelectObject(mDc, antBmp)
dl = DeleteDC(mDc)

'creamos un objeto IPictureDisp con la imagen para imprimirlo facilmente
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With Pic
.Size = Len(Pic)
.Type = vbPicTypeBitmap
.hBmp = mBmp
.hPal = 0&
End With
dl = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
'imprimimos
Printer.ScaleMode = 3
Printer.PaintPicture IPic, 0, 0, 400 * (Screen.TwipsPerPixelX / Printer.TwipsPerPixelX), 400 * (Screen.TwipsPerPixelY / Printer.TwipsPerPixelY)
Set IPic = Nothing
Printer.EndDoc

End Sub

Private Sub ShowForm(mDc As Long, MiForm As Form, x As Integer, y As Integer)
Dim pDc As Long
Dim dl As Long
Load MiForm
MiForm.Show
MiForm.ZOrder
DoEvents
'pillamos el hdc de la ventana y copiamos el contenido
pDc = GetWindowDC(MiForm.hwnd)
dl = BitBlt(mDc, x * 200, y * 200, 200, 200, pDc, 0, 0, SRCCOPY)
dl = ReleaseDC(MiForm.hdc, pDc)
MiForm.Hide
Unload MiForm
Set MiForm = Nothing
End Sub

Puedes crear otro form (para la prueba), ponerlo en propiedades de proyecto como objeto inicial y llamar a Imprime desde ese form.
La cosa se basa en crear un Bitmap donde ira la imagen final, pillar los hDc de cada formulario y en modo cuadricula en ese bitmap. Despues rotar el bitmap (en verdad hago dos mirrows vertical y horizontal que da el mismo resultado que rotar 180) y crear un objeto IpictureDisp con ese Bitmap para poder imprimirlo mediante PaintPicture.

Hay que tener en cuenta que la imagen que presenta el Form es la que se ve en pantalla. Es decir, que tienes que tener los formularios totalmente visibles y en primer plano para poder capturar su imagen.
Saludos.

Muchas gracias McNel por tu ayuda, me has ayudado mucho con este codigo ya que no tenia ni idea de como hacer esto mil gracias!

Ahora tengo otro problema y es que solo necesito rotar 2 de los cuatros formularios que se mandan a imprimir en la pagina, como podria hacer esto???, gracias por su respuesta.

Para rotar alguno de los formularios, solo deberias cambiar varias lineas del codigo anterior:
Sub Imprime

Aqui no deberias rotarlo, asi que debes eliminar esta linea:
dl = StretchBlt(mDc, 400, 400, -400, -400, mDc, 0, 0, 400, 400, SRCCOPY)

Cambia la definicion de esta sub:
Private Sub ShowForm(mDc As Long, MiForm As Form, x As Integer, y As Integer)

por:
Private Sub ShowForm(mDc As Long, MiForm As Form, x As Integer, y As Integer,Rotar as Boolean)

esto te supone que dentro del Sub Imprime, debes pasar el nuevo valor al Showform:
ShowForm mDc, Form1, 0, 0, True
ShowForm mDc, Form2, 0, 1, False
ShowForm mDc, Form3, 1, 0, True
ShowForm mDc, Form4, 1, 1, False

Pon True para rotarlo y false para no rotarlo

y por ultimo, modifica estas lineas en el Sub ShowForm:
Quita dl = BitBlt(mDc, x * 200, y * 200, 200, 200, pDc, 0, 0, SRCCOPY)

y pon

If Rotar then
dl = StretchBlt(mDc, (x * 200) + 200, (y * 200) + 200, -200, -200, pDc, 0, 0, 200, 200, SRCCOPY)

Else
dl = BitBlt(mDc, x * 200, y * 200, 200, 200, pDc, 0, 0, SRCCOPY)
End If

Lo he hecho asi de cabeza sin probarlo, espero que funcione.
Saludos.

Me has salvado amigo :-) gracias por tu ayuda, infinitas gracias!!!.

Lo importante es que entiendas como funciona el codigo, asi podras modificarlo a tu conveniencia para adaptarlo a tus necesidades.

Aqui da gusto ayudar, al menos te dan las gracias no como en otros foros en los que he estado. :grin:

Saludos.

Estimado McNel:

Seguramente habrás comprobado que en otros foros ni tan siquiera responden.

En Vb-Mundo tratamos de responder siempre, unas veces acertamos, otras no, pero la intención es lo más importante.

__________________
Un cordial saludo
-Acalanto-

Madrid - España

Visual Basic
Videos Programacion
Foro Programacion
Tutoriales Programacion