I tried to rebuild the BitBlt function in VB.NET, and it works not sooo bad, but my image is always blitted/drawn on 0,0 on the destination bitmap.
Does anybody see my mistake?
As one can see, I am trying to copy the rect (0, 0, 50, 50) from the source bitmap to the point (25,25) in the destination bitmap, but it does not do that:
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
' Make a Bitmap to hold the result.
Dim bm As New Bitmap(Me.PictureBox1.Width, Me.PictureBox1.Height)
CopyBitmap(Me.PictureBox1.Image, bm, 25, 25, 50, 50, 0, 0)
Me.PictureBox2.Image = bm
End Sub
Public Sub CopyBitmap(ByRef uSource As Bitmap, ByRef uTarget As Bitmap, ByVal uDestX As Integer, ByVal uDestY As Integer, ByVal uSrcWidth As Integer, ByVal uSrcHeight As Integer, ByVal uSrcX As Integer, ByVal uSrcY As Integer)
Dim nSrc As New Rectangle
nSrc = Rectangle.FromLTRB(uSrcX, uSrcY, uSrcX + uSrcWidth, uSrcY + uSrcHeight)
Dim nDst As New Rectangle
nDst = Rectangle.FromLTRB(uDestX, uDestY, uDestX + uSrcWidth, uDestY + uSrcHeight)
Using g As Graphics = Graphics.FromImage(uTarget)
' Draw the specified section of the source bitmap to the new one
g.DrawImage(uSource, nSrc, nDst, GraphicsUnit.Pixel)
End Using
End Sub
Doh, I swapped nSrc and nDst.
The 2nd argument in DrawImage should be nDst, and the 3rd argument should be nSrc.
Related
I'm drawing lines in a picturebox inside a form, when I maximize the form the picturebox change height and width automatically because of anchor bounds.
Problem is that the lines are rendered in wrong way on the maximized window,and lines that should be 1 pixel width seem bigger. I'm missing some zoom proprety in picturebox control?
There is a way to avoid that?
I'm using XNA 4.0, here the basic code where pbGame is my picturebox.
Imports Microsoft.Xna.Framework
Imports Microsoft.Xna.Framework.Graphics
Private quit As Boolean = False
Public grafix As GraphicsDevice
Private Function initialize(ByRef surface As PictureBox) As Boolean
Try
Dim pparam As New PresentationParameters
pparam.DeviceWindowHandle = surface.Handle
pparam.IsFullScreen = False
Dim grafixAdapt As GraphicsAdapter = GraphicsAdapter.DefaultAdapter
grafix = New GraphicsDevice(grafixAdapt, GraphicsProfile.HiDef, pparam)
initialize = True
Catch ex As Exception
initialize = False
End Try
End Function
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'Set up the initialize function found above
If InitializeGraphics(pbGame) AndAlso InitializeEffect(grafix) Then
BackgroundWorker1.RunWorkerAsync()
Else
MessageBox.Show("There was a problem initializing XNA.")
Me.Close()
End If
End Sub
Private effect As BasicEffect
Private Function InitializeEffect(ByVal graphics As GraphicsDevice) As Boolean
effect = New BasicEffect(graphics)
Try
effect.VertexColorEnabled = True
effect.Projection = Matrix.CreateOrthographicOffCenter(0, graphics.Viewport.Width, graphics.Viewport.Height, 0, 0, 1)
InitializeEffect = True
Catch ex As Exception
InitializeEffect = False
End Try
End Function
Private Function Set2dLine(ByVal x1 As Integer, ByVal y1 As Integer, ByVal z1 As Integer, _
ByVal x2 As Integer, ByVal y2 As Integer, ByVal z2 As Integer, _
ByVal color As Color) As VertexPositionColor()
Dim vertices1, vertices2 As New VertexPositionColor
vertices1.Position = New Vector3(x1, y1, z1)
vertices1.Color = color
vertices2.Position = New Vector3(x2, y2, z2)
vertices2.Color = color
Return {vertices1, vertices2}
End Function
Private Sub BackgroundWorker1_DoWork(sender As System.Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Do Until quit = True
grafix.Clear(Color.CornflowerBlue)
effect.CurrentTechnique.Passes(0).Apply()
Dim newline() As VertexPositionColor = Set2dLine(50, 10, 0, 150, 10, 0, Color.Black)
grafix.DrawUserPrimitives(PrimitiveType.LineList, newline, 0, 1)
grafix.Present()
Loop
End Sub
I am using Visual Studio express 2013, VB. Simplifying the problem as much as I can, I have a form with a tab control that has 2 tab pages. I want to print both tab pages on the click of one button. Currently I am trying to use CreateGraphics on the individual tabs but I just get the first tab printing on both pages. Here is my code, can anyone please see what I am doing wrong or if I am on completely the wrong lines. It looks to me like the CreateGraphics is not retrieving the right tabpages graphics.
Private Declare Auto Function BitBlt Lib "gdi32.dll" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As System.Int32) As Boolean
Private Const SRCCOPY As Integer = &HCC0020
Private PagePrinting As Integer
Private Sub ToolStripButton2_Click(sender As Object, e As EventArgs) Handles ToolStripButton2.Click
If PrintDialog1.ShowDialog() = DialogResult.OK Then
PagePrinting = 0
PrintDocument1.Print()
End If
End Sub
Private Sub PrintDocument1_PrintPage(sender As Object, e As PrintPageEventArgs) Handles PrintDocument1.PrintPage
If PagePrinting = 0 Then
e.Graphics.DrawImage(GetImage1(), e.MarginBounds)
Else
e.Graphics.DrawImage(GetImage2(), e.MarginBounds)
End If
PagePrinting = PagePrinting + 1
If PagePrinting = 2 Then e.HasMorePages = False Else e.HasMorePages = True
End Sub
Private Function GetImage1() As Bitmap
Dim me_gr As Graphics = Me.BillTabControl.TabPages("PAGE1").CreateGraphics
Dim bm As New Bitmap(Me.BillTabControl.TabPages("PAGE1").ClientSize.Width, Me.BillTabControl.TabPages("PAGE1").ClientSize.Height, me_gr)
Dim bm_gr As Graphics = Graphics.FromImage(bm)
Dim bm_hdc As IntPtr = bm_gr.GetHdc
Dim me_hdc As IntPtr = me_gr.GetHdc
BitBlt(bm_hdc, 0, 0, Me.BillTabControl.TabPages("PAGE1").ClientSize.Width, Me.BillTabControl.TabPages("PAGE1").ClientSize.Height, me_hdc, 0, 0, SRCCOPY)
me_gr.ReleaseHdc(me_hdc)
bm_gr.ReleaseHdc(bm_hdc)
GetImage1 = bm
End Function
Private Function GetImage2() As Bitmap
Dim me_gr As Graphics = Me.BillTabControl.TabPages("PAGE2").CreateGraphics
Dim bm As New Bitmap(Me.BillTabControl.TabPages("PAGE2").ClientSize.Width, Me.BillTabControl.TabPages("PAGE2").ClientSize.Height, me_gr)
Dim bm_gr As Graphics = Graphics.FromImage(bm)
Dim bm_hdc As IntPtr = bm_gr.GetHdc
Dim me_hdc As IntPtr = me_gr.GetHdc
BitBlt(bm_hdc, 0, 0, Me.BillTabControl.TabPages("PAGE2").ClientSize.Width, Me.BillTabControl.TabPages("PAGE2").ClientSize.Height, me_hdc, 0, 0, SRCCOPY)
me_gr.ReleaseHdc(me_hdc)
bm_gr.ReleaseHdc(bm_hdc)
GetImage2 = bm
End Function
Have you tried selecting the second tab before creating the graphics with SelectTab?
You may also want to add a breakpoint to this line to make sure it is being called:
e.Graphics.DrawImage(GetImage2(), e.MarginBounds)
Here is the code that works.
Private Function GetImage1() As Bitmap
Dim bm As New Bitmap(Me.BillTabControl.TabPages("PAGE1").ClientSize.Width, Me.BillTabControl.TabPages("PAGE1").ClientSize.Height)
Me.BillTabControl.TabPages("PAGE1").DrawToBitmap(bm, Me.BillTabControl.TabPages("PAGE1").ClientRectangle)
GetImage1 = bm
End Function
Private Function GetImage2() As Bitmap
Dim bm As New Bitmap(Me.BillTabControl.TabPages("PAGE2").ClientSize.Width, Me.BillTabControl.TabPages("PAGE2").ClientSize.Height)
Me.BillTabControl.TabPages("PAGE2").DrawToBitmap(bm, Me.BillTabControl.TabPages("PAGE2").ClientRectangle)
GetImage2 = bm
End Function
I am trying to create labels which have all four corners rounded, the label is being created programatically as seen below:
Dim lbl1 As Label = New Label()
lbl1.AutoSize = False 'allow resizing
lbl1.BackColor = Color.Yellow
lbl1.Text = newid
lbl1.Height = 46
lbl1.Width = 42
lbl1.Padding = New Padding(1, 1, 1, 1)
How would I switch from the square corners to a more XP styled rounding.
Imports System.Runtime.InteropServices
<DllImport("Gdi32.dll", EntryPoint:="CreateRoundRectRgn")> _
Private Shared Function CreateRoundRectRgn(ByVal iLeft As Integer, ByVal iTop As Integer, ByVal iRight As Integer, ByVal iBottom As Integer, ByVal iWidth As Integer, ByVal iHeight As Integer) As IntPtr
End Function
ex.)
Imports System.Runtime.InteropServices
Public Class Form1
<DllImport("Gdi32.dll", EntryPoint:="CreateRoundRectRgn")> _
Private Shared Function CreateRoundRectRgn(ByVal iLeft As Integer, ByVal iTop As Integer, ByVal iRight As Integer, ByVal iBottom As Integer, ByVal iWidth As Integer, ByVal iHeight As Integer) As IntPtr
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim newid$ = "mylabel"
Dim lbl1 As Label = New Label()
With lbl1
lbl1.AutoSize = False 'allow resizing
lbl1.BackColor = Color.Yellow
lbl1.Text = newid
lbl1.Height = 46
lbl1.Width = 42
lbl1.Padding = New Padding(1, 1, 1, 1)
lbl1.Region = System.Drawing.Region.FromHrgn(CreateRoundRectRgn(2, 2, lbl1.Width - 2, lbl1.Height - 2, 5, 1))
End With
Me.Controls.Add(lbl1)
End Sub
End Class
Hey all i have this code here:
Dim p As Process = Process.GetProcessesByName("Cal").FirstOrDefault
Dim target_hwnd As Long = FindWindow(vbNullString, "Calculator")
If p IsNot Nothing Then
SetWindowPos(target_hwnd, 0, winSize(0), winSize(1), winSize(2), winSize(3), 0)
AppActivate(p.Id)
Dim img As New Bitmap(145, 145) 'size fo the caption area
Dim gr As Graphics = Graphics.FromImage(img)
'sets the offsets and use image size to set region
gr.CopyFromScreen(New Point(winSize(0) + 44, winSize(1) + 179), Point.Empty, img.Size)
img.Save("test.jpg", Drawing.Imaging.ImageFormat.Jpeg)
Process.Start("test.jpg")
End If
As long as i have the window in view it takes the screen shot just fine without any problems. However when i move the form off screen (where i am unable to see it) it only captures a black image.
I've been trying this code out:
Private Declare Function PrintWindow Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal hdcBlt As IntPtr, ByVal nFlags As UInt32) As Boolean
Dim screenCapture As Bitmap
Dim otherForm As New Form
Private Sub CaptureScreen()
Dim target_hwnd As Long = FindWindow(vbNullString, "Calculator")
SetWindowPos(target_hwnd, 0, winSize(0), winSize(1), winSize(2), winSize(3), 0)
screenCapture = New Bitmap(245, 245)
Dim g As Graphics = Graphics.FromImage(screenCapture)
Dim hdc As IntPtr = g.GetHdc
Form1.PrintWindow(target_hwnd, hdc, Nothing)
g.ReleaseHdc(hdc)
g.Flush()
g.Dispose()
If IO.File.Exists("d:\test.jpg") Then
IO.File.Delete("d:\test.jpg")
End If
screenCapture.Save("d:\test.jpg", Drawing.Imaging.ImageFormat.Jpeg)
End Sub
Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
CaptureScreen()
End Sub
Now the above code DOES capture an image even when the window is off screen. The problem with the code above is that i can't tell it to only capture an area within that window that i was able to do with the CopyFromScreen i first posted.
Is this possible using the PrintWindow?
I was able to do this:
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim fileName = "Calculator.jpg"
Dim fileNameCrop = "Calculator-crop.jpg"
' |--b|---|x|
' | | | a|-Form Left to image area
' | V | | b|-Form Top to image area
' a-->[c] | | | c|-Image area Width to capture
' | | | | | c|-Image area Height to capture
' |_________| V V V V
Dim CropRect As New Rectangle(97, 189, 36, 29)
Dim OrignalImage = Image.FromFile(fileName)
Dim CropImage = New Bitmap(CropRect.Width, CropRect.Height)
Using grp = Graphics.FromImage(CropImage)
grp.InterpolationMode = Drawing2D.InterpolationMode.NearestNeighbor
grp.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
grp.DrawImage(OrignalImage, New Rectangle(0, 0, CropRect.Width, CropRect.Height), CropRect, GraphicsUnit.Pixel)
CropImage.Save(fileNameCrop)
End Using
OrignalImage.Dispose()
CropImage.Dispose()
'delete org image
If FileIO.FileSystem.FileExists(fileName) Then FileIO.FileSystem.DeleteFile(fileName)
End Sub
And just crop out the area after i saved the forms image from the first code posted in the OP.
Imports System.Drawing.Imaging
Public Class Form1
Public Shared Function SetImgOpacity(ByVal imgPic As Image, ByVal imgOpac As Single) As Image
Dim bmpPic As New Bitmap(imgPic.Width, imgPic.Height)
Dim gfxPic As Graphics = Graphics.FromImage(bmpPic)
Dim cmxPic As New ColorMatrix()
Dim iaPic As New ImageAttributes()
cmxPic.Matrix33 = imgOpac
iaPic.SetColorMatrix(cmxPic, ColorMatrixFlag.[Default], ColorAdjustType.Bitmap)
gfxPic.DrawImage(imgPic, New Rectangle(0, 0, bmpPic.Width, bmpPic.Height), 0, 0, imgPic.Width, imgPic.Height, GraphicsUnit.Pixel, iaPic)
gfxPic.Dispose()
iaPic.Dispose()
Return bmpPic
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim a As Image = bmpPic.Image
SetImgOpacity(a, 50)
End Sub
End Class
When I click the button nothing happens. What am I doing wrong here ?
I believe that the color matrix values range from 0 to 1, so you should probably use 0.5 instead of 50.
You might want to set the bmpPic.Image to the value returned from your function.
Something like
Dim a As Image = bmpPic.Image
bmpPic.Image = SetImgOpacity(a, 50)