Hejsan, jag har följande problem: använd bitblt api anrop, kan inte komma ihåg syntaxen just nu, men jag har löst det på det viset, sök på nätet så hittar du garanterat info om hur du gör. resultatet skall se ut så här: Detta kanske kan var något att arbeta med: Kanske dumt förklarat av mig.. Det finns ingen bild i pictureboxarna utan jag har ritat fram med linjer m.m. och det är det framritade jag vill ha ut, hela pictureboxen är heller inte synlig utan en del av den måste scrollas för att få fram, det är här alla mina försök faller, det som inte är "synligt" det kommer inte med.. Tjena ! KAn du inte lägga med koden så är det lätare att hjälpa dig. Hej! Vad är det du ritar upp? Hur ser koden som ritar upp ut? Det är en affärshemlighet... ;)Kopiera innehållet i två pictureboxar till Clipboard
Låt oss säga att jag har 2 pictureboxar, jag vill att innehållet i picturebox1 skall kopieras till Clipboard tillsammans med innehållet i picturebox2...
Delar av innehållet i picturebox2 är inte synligt på skärmen så det går inte att göra en screenshot-lösning på det hela..
Några förslag??
/FSv: Kopiera innehållet i två pictureboxar till Clipboard
Sv: Kopiera innehållet i två pictureboxar till Clipboard
---------
|Bild 1 |
---------
|Bild 2 |
---------
typ...
/FSv: Kopiera innehållet i två pictureboxar till Clipboard
<code>
Option Explicit
Function Max(ParamArray Values() As Variant) As Variant
Dim Index As Long
Max = Values(0)
For Index = 1 To UBound(Values)
If Max < Values(Index) Then
Max = Values(Index)
End If
Next
End Function
Private Sub Command1_Click()
Picture3.Move 0, 0, Max(Picture1.Width, Picture2.Width), Picture1.Height + Picture2.Height
Picture3.PaintPicture Picture1.Image, 0, 0
Picture3.PaintPicture Picture2.Image, 0, Picture1.Height
Clipboard.Clear
Clipboard.SetData Picture3.Image, vbCFBitmap
End Sub
Private Sub Form_Load()
Picture1.BorderStyle = vbBSNone
Picture2.BorderStyle = vbBSNone
Picture3.AutoRedraw = True
Picture3.BorderStyle = vbBSNone
End Sub
</code>Sv: Kopiera innehållet i två pictureboxar till Clipboard
Sv: Kopiera innehållet i två pictureboxar till Clipboard
Hittade koden för att använda bitblt, men du får experimentera med den så att det passar ditt syfte. objFrom som skickas med i anropet är en referens till en picturebox.
Lycka till !
Public Function CopyEntirePicture(ByRef objFrom As Object) As Boolean
Dim lhDC As Long
Dim lhBMP As Long
Dim lhBMPOld As Long
Dim lWidthPixels As Long
Dim lHeightPixels As Long
' Create a DC compatible with the object we're copying
' from:
lhDC = CreateCompatibleDC(objFrom.hdc)
If (lhDC <> 0) Then
' Create a bitmap compatible with the object we're
' copying from:
lWidthPixels = objFrom.ScaleX(objFrom.ScaleWidth, objFrom.ScaleMode, vbPixels)
lHeightPixels = objFrom.scaleY(objFrom.ScaleHeight, objFrom.ScaleMode, vbPixels)
lhBMP = CreateCompatibleBitmap(objFrom.hdc, lWidthPixels, lHeightPixels)
If (lhBMP <> 0) Then
' Select the bitmap into the DC we have created,
' and store the old bitmap that was there:
lhBMPOld = SelectObject(lhDC, lhBMP)
' Copy the contents of objFrom to the bitmap:
BitBlt lhDC, 0, 0, lWidthPixels, lHeightPixels, objFrom.hdc, 0, 0, SRCCOPY
' Remove the bitmap from the DC:
SelectObject lhDC, lhBMPOld
' Now set the clipboard to the bitmap:
OpenClipboard 0
EmptyClipboard
SetClipboardData CF_BITMAP, lhBMP
CloseClipboard
' We don't delete the Bitmap here - it is now owned
' by the clipboard and Windows will delete it for us
' when the clipboard changes or the program exits.
End If
' Clear up the device context we created:
DeleteObject lhDC
End If
End FunctionSv: Kopiera innehållet i två pictureboxar till Clipboard
Sv: Kopiera innehållet i två pictureboxar till Clipboard
Jag har löst det tack vare alla tips jag fått här..
Problemet med alla varianter var att den delen som inte syntes på skärmen blev vit, lösningen blev att "scrolla" neråt och att kopiera pixel för pixel in i den tredje pictureboxen, koden som jag använde:
<code>
Me.pPrint.Cls
Me.pPrint.Width = Me.contHeader.Width - VScroll1.Width
Me.pPrint.Height = Me.contMonth.Height + Me.contHeader.Height '+ 15000
Me.pPrint.AutoRedraw = True
For Y = 1 To contHeader.Height Step Screen.TwipsPerPixelY
For X = 1 To contHeader.Width Step Screen.TwipsPerPixelX
pPrint.PSet (X, Y), contHeader.Point(X, Y)
Next X
Next Y
For Y = 1 To contMonth.Height Step Screen.TwipsPerPixelY
If Y + contHeader.Height >= contPlaceholder.Height Then
contMonth.Top = contMonth.Top - Screen.TwipsPerPixelY
End If
For X = 1 To contMonth.Width Step Screen.TwipsPerPixelX
DoEvents
pY = Y + contHeader.Height
pPrint.PSet (X, pY), contMonth.Point(X, Y)
Next X
Next Y
Clipboard.Clear
Clipboard.SetData Me.pPrint.Image, vbCFBitmap
contMonth.Top = 0
</code>
Säkert inte det mest optimala sättet att göra det på, men det fungerar..
/FSv: Kopiera innehållet i två pictureboxar till Clipboard
Sv: Kopiera innehållet i två pictureboxar till Clipboard
Nää.. Men jag ritar upp en kalender med linjer och labels som jag sedan fyller med poster från olika källor...
Dag1 Dag2 Dag3 ... Dag31
Per1 X
Per2 XXXXXXXX XXXXXXX
Per3 XXXXXXXXXXXXXXXXXXXXX
.
.
.
Per51 XXX X XXX XXXXX
liknande nåt sånt..