Hello I am having problems with reports of Devexpress, I need to include a label vertically in all pages of report like watermark in the left margin. I see this example of devexpress but is too poor and not is dinamically because the text of the label is not fixed and I charge from database and can change the lenght
https://supportcenter.devexpress.com/ticket/details/t457705/how-to-add-a-brick-with-vertical-text-to-the-margin-of-each-report-page
For example to see correctly I need to do all this calculations
Private Function CreateLabel(ByVal oReport As DevExpress.XtraReports.UI.XtraReport, ByVal page As Page, ByVal _fFuente As Font, ByVal _tamanio As SizeF, ByVal _sTexto As String) As LabelBrick
Dim labelBrick As New LabelBrick() With {.Angle = 90, .Font = _fFuente, .Text = _sTexto, .CanShrinkAndGrow = False}
'Para utilizar el margen derecho
'New PointF(page.Size.Width + (page.MarginsF.Left), ((page.Size.Height - _tamanio.Width) / 2) + page.MarginsF.Top)
'Para utilizar el margen izquierdo
'New PointF((page.MarginsF.Left) / 2, ((page.Size.Height - _tamanio.Width) / 2) + page.MarginsF.Top)
Dim tamanioBrick As New SizeF(_tamanio.Height + _fFuente.Size * 6, _tamanio.Width * 3)
Dim posicionBrick As New PointF((page.MarginsF.Left) / 3, ((page.Size.Height - tamanioBrick.Width) / 2) + page.MarginsF.Top)
labelBrick.Initialize(oReport.PrintingSystem, New RectangleF(posicionBrick, tamanioBrick))
labelBrick.Style.TextAlignment = TextAlignment.MiddleLeft
Return labelBrick
End Function
¿Any ocurrence to solve my problem?
I need a vertical label in the margin of all documents
Related
I have an application that uses a single form that allow users to manipulate settings used to calculate various parameters. All that works until I came to want to;
Want to save an image of that calculation (i.e. an image of the form) or
Print it.
I have found various solutions but most use C# code not VB.NET, those that have used VB.Net seem to create classes that are confusing me.
Basically I can add a button to the form, that I'd like to hide once pressed by using (btnXYZ.Visible=false), then proceed to generate an image file that I can save.
Please can somebody help?
Thank you.
Try this:
Private Function GetSnapShot() As Bitmap
Using image As Image = New Bitmap(Me.Width - 10, Me.Height - 10)
Using graphics As Graphics = graphics.FromImage(image)
graphics.CopyFromScreen(New Point(Me.Left + 5, Me.Top + 5), Point.Empty, New Size(Me.Width - 10, Me.Height - 10))
End Using
Return New Bitmap(SetBorder(image, Color.Black, 1))
End Using
End Function
Private Function SetBorder(ByVal srcImg As Image, ByVal color As Color, ByVal width As Integer) As Image
Dim dstImg As Image = srcImg.Clone()
Dim g As Graphics = Graphics.FromImage(dstImg)
Dim pBorder As Pen = New Pen(color, width)
pBorder.Alignment = Drawing2D.PenAlignment.Center
g.DrawRectangle(pBorder, 0, 0, dstImg.Width - 1, dstImg.Height - 1)
pBorder.Dispose()
g.Save()
g.Dispose()
Return dstImg
End Function
And this is how to use the code:
GetSnapShot().Save("File Path goes here where you want to save the image")
I create pdfs using iTextSharp and add a footnote and watermark to these using a PdfStamper. This has been working fine. Recently the footers and watermarks have not been appearing when the pdfs are viewed in MS Edge. However, if I view the same pdf in Chrome the footers and watermarks appear correctly.
I store the pdfs in blob storage in Azure.
I have recently changed iTextSharp version from V4.1.2.0 to V5.5.13.
The code for adding watermarks and footers is as follows:
Dim byteArray As Byte()
Using stream As MemoryStream = New MemoryStream
reportBlockBlob.DownloadToStream(stream)
reader = New PdfReader(CType(stream.ToArray(), Byte()))
If reader IsNot Nothing Then
Using stamper As PdfStamper = New PdfStamper(reader, stream)
Dim PageCount As Integer = reader.NumberOfPages
If bReportInvalid Then
For i As Integer = 1 To PageCount
StampWaterMark(stamper, i, "INVALID", fontReport60, 35, New text.BaseColor(70, 70, 255), reader.GetPageSizeWithRotation(i))
Next
ElseIf Not UserRoles.Contains(WaspWAVB.con.csUserRoleCertificateSignOff) Then
For i As Integer = 1 To PageCount
StampWaterMark(stamper, i, "DRAFT", fontReport60, 35, New text.BaseColor(70, 70, 255), reader.GetPageSizeWithRotation(i))
Next
End If
If bAddFooter Then
Dim sRepUCN As String = "UCN"
Dim sCopyright As String = "Copyright"
Dim yPos As Integer = 12
Dim xLeftPos As Integer = 36
Dim xMidPos As Single = 297.5
Dim xRightPos As Integer = 559
For i As Integer = 3 To PageCount - iAppendixCount
ColumnText.ShowTextAligned(stamper.GetOverContent(i), text.Element.ALIGN_LEFT, New text.Phrase(sRepUCN, fontMedium), xLeftPos, yPos, 0)
ColumnText.ShowTextAligned(stamper.GetOverContent(i), text.Element.ALIGN_CENTER, New text.Phrase(sCopyright, fontMedium), xMidPos, yPos, 0)
Dim rttnPg As Integer = reader.GetPageRotation(i)
If rttnPg <> 0 Then
xRightPos = 806
End If
ColumnText.ShowTextAligned(stamper.GetOverContent(i), text.Element.ALIGN_RIGHT, New text.Phrase(String.Format(WaspWAVB.con.csPageXofY, i - 2, PageCount - 2 - iAppendixCount), fontMedium), xRightPos, yPos, 0)
Next
End If
End Using
byteArray = stream.ToArray()
End If
End Using
reportBlockBlob.Properties.ContentType = "application/pdf"
reportBlockBlob.UploadFromByteArray(byteArray, 0, byteArray.Length)
Public Shared Sub StampWaterMark(ByRef stamper As PdfStamper,
ByVal i As Integer,
ByVal watermark As String,
ByVal font As text.Font,
ByVal angle As Single,
ByVal color As text.BaseColor,
ByVal realPageSize As text.Rectangle,
Optional ByVal rect As text.Rectangle = Nothing)
Dim gstate = New PdfGState()
gstate.FillOpacity = 0.1F
gstate.StrokeOpacity = 0.3F
stamper.GetOverContent(i).SaveState()
stamper.GetOverContent(i).SetGState(gstate)
stamper.GetOverContent(i).SetColorFill(color)
stamper.GetOverContent(i).BeginText()
Dim ps = If(rect, realPageSize)
Dim x = (ps.Right + ps.Left) / 2
Dim y = (ps.Bottom + ps.Top) / 2
ColumnText.ShowTextAligned(stamper.GetOverContent(i), text.Element.ALIGN_CENTER, New text.Phrase(watermark, font), x, y, angle)
End Sub
I have tried re-arranging the order in which the footer and watermark are applied and commenting out either the addition of watermark or footer. None of this helps.
I use the code to add a footer elsewhere in the code and this works. Where it works, the footer is applied to an individual page. Where it doesn't work I have just collected together pages stored in separate blobs and amalgamated them into one memorystream. The footer and watermark are applied to this.
What is mystifying is that the pdf works fine in Chrome but not in Edge. This works either way round - i.e. if I create it in Chrome and view it in Edge, the footers disappear and if I create it in Edge and view it in Chrome, the footers appear.
Has anyone else seen this problem and knows how to solve it?
When trying to custom draw my coloumn headers and listview items, I was getting jagged text (not anti-aliased) which looked crappy. I came across the following code snippet to render the text and display much more nicely - which works. However, I can't work out how to centre my text in the column. Currently, setting my flags to HorizontalCentre actually centres the text within the entire listview control.
Private Sub lsvOverdueCalls_DrawItem(sender As Object, e As DrawListViewItemEventArgs) Handles lsvOverdueCalls.DrawItem
If e.Item.Selected AndAlso e.Item.ListView.Focused Then
e.Item.BackColor = SystemColors.Highlight
e.Item.ForeColor = e.Item.ListView.BackColor
ElseIf e.Item.Selected AndAlso Not e.Item.ListView.Focused Then
e.Item.BackColor = SystemColors.Control
e.Item.ForeColor = e.Item.ListView.ForeColor
Else
e.Item.BackColor = e.Item.ListView.BackColor
e.Item.ForeColor = e.Item.ListView.ForeColor
End If
e.DrawBackground()
' Draw the header text.
Dim rec As New Rectangle(e.Bounds.X + 2, e.Bounds.Y + 2, e.Bounds.Width - 4, e.Bounds.Height - 4)
Dim flags As TextFormatFlags = TextFormatFlags.HorizontalCenter Or TextFormatFlags.EndEllipsis Or TextFormatFlags.ExpandTabs Or TextFormatFlags.SingleLine
TextRenderer.DrawText(e.Graphics, e.Item.Text, e.Item.ListView.Font, rec, e.Item.ForeColor, flags)
End Sub
My result is this:
I need the Call Number (26155) to sit centre of the Call ID Column.
e.Bounds is the entire width. To get the width of your column, try referencing the Width property of the ListView column.
If you gave your columns keys, reference them by key:
listView1.Columns("callID").Width
or index:
listView1.Columns(0).Width
Then your drawing rectangle would look something like this:
Dim colWidth As Integer = listView1.Columns("callID").Width
Dim rec As New Rectangle(e.Bounds.X, e.Bounds.Y, _
colWidth, e.Bounds.Height)
I have a form called Form1. Its set to startup-Position = Center but when executed it opens up somewhere else (At a random position evrytime).
I am working under Windows XP SP3 , using IDE Visual Studio - 2010. Please provide a workaround to this problem.
I have uploaded a sample project showing the above mentioned problem .
Download link:
http://www.6ybh-upload.com/vt5i4z1wz9pl/Light.zip
You have to set:
Form1.StartPosition = FormStartPosition.Manual
Edit:
Here is a working sample:
Dim X As Integer = (Screen.PrimaryScreen.Bounds.Width - Me.Width) / 2
Dim Y As Integer = (Screen.PrimaryScreen.Bounds.Height - Me.Height) / 2
Me.StartPosition = FormStartPosition.Manual
Me.Location = New System.Drawing.Point(X, Y)
Edit 2:
Here is the improved code based on comments by Hans Passant, (much better):
Dim mainScreen As Screen = Screen.FromPoint(Me.Location)
Dim X As Integer = (mainScreen.WorkingArea.Width - Me.Width) / 2 + mainScreen.WorkingArea.Left
Dim Y As Integer = (mainScreen.WorkingArea.Height - Me.Height) / 2 + mainScreen.WorkingArea.Top
Me.StartPosition = FormStartPosition.Manual
Me.Location = New System.Drawing.Point(X, Y)
Try to use this after resize the screen
Me.Size = New System.Drawing.Size(800, 436)
Me.CenterToScreen()
In your question it isn't quite clear what you have actually tried since there is no such option as "Center" for the StartPosition property of a Form.
However, setting StartPosition to CenterScreen or
Me.StartPosition = FormStartPosition.CenterScreen
if you are doing it programmatically, should get you exactly what you need.
Reference: http://msdn.microsoft.com/en-us/library/system.windows.forms.formstartposition.aspx
Here is the solution:
Dim screen__1 As Screen = Screen.FromControl(frm)
Dim workingArea As Rectangle = screen__1.WorkingArea
frm.Location = New Point() With { _
.X = Math.Max(workingArea.X, workingArea.X + (workingArea.Width - frm.Width) / 2), _
.Y = Math.Max(workingArea.Y, workingArea.Y + (workingArea.Height - frm.Height) / 2) _
}
The Second One:
'frm = is the form object
Dim X As Integer = (Screen.PrimaryScreen.Bounds.Width - frm.Width) / 2
Dim Y As Integer = (Screen.PrimaryScreen.Bounds.Height - frm.Height) / 2
frm.StartPosition = FormStartPosition.Manual
frm.Location = New System.Drawing.Point(X, Y)
For VB.net 2010
put code to form load event
Call CenterToScreen()
this is built in method provided by VS
I am hoping that someone can help me with a problem I've got at the moment using Compact Framework.Net 2 SP 2.
At the moment I have a UI with a series of text boxes and each textbox displays the contents of a database field. These are shown one beneath another with a scroll bar on the right hand side of the form. Each textbox has a set width which might
I would like to adjust the height each text box based on the number of lines it is holding, the font size and the font in order to avoid using scroll bars on each textbox.
At the moment I am been able to do this in a test application.
Screenshot:
see screenshot for output http://morrislgn.brinkster.net/SO/screenshot.jpg
My code:
'Text used in this example:
'TextBox1qwertyuiop lkjhgfdsazxcvbnm1234567890 TextBo
'x1qwer tyuioplkjhgfdsazxcvb nm1234567890
'qwe
'End of exmaple text.
Me.Textbox2.Text = Me.Textbox1.Text
Dim pobjGraphic As Graphics = Me.Textbox2.Parent.CreateGraphics()
Dim pobjSize As SizeF
'Padding values:
Dim piTop As Int32 = 4 'top of text and top of textbox
Dim piBottom As Int32 = 3 'bottom of text and top of textbox
Dim piLines As Int32 = 0
'Based on the font size chosen by the user, create a font to perform the calculation with.
Dim piFontSize As Single = 10
If Me.CheckBox1.Checked.Equals(True) Then
piFontSize = 6
ElseIf Me.CheckBox2.Checked.Equals(True) Then
piFontSize = 8
ElseIf Me.CheckBox3.Checked.Equals(True) Then
piFontSize = 12
Else
piFontSize = 10
End If
Dim pobjFont As New Font("Tahoma", piFontSize, FontStyle.Regular)
'Calculate the height of one line.
pobjSize = pobjGraphic.MeasureString("HELLO WORLD", pobjFont)
'Value of pobjSize returned: {Width = 71.0 Height = 13.0}
'Calculate the number of lines
Dim b As Bitmap
b = New Bitmap(1, 1, Imaging.PixelFormat.Format32bppRgb)
'Calculate the number of lines required to display the text properly based on the lenght of the text the width of the control.
'Length of text to show divide by the width of the textbox
piLines = Graphics.FromImage(b).MeasureString(Me.Textbox2.Text, pobjFont).Width / Me.Textbox2.Width
'Value of piLines returned: 2
If piLines = 0 Then
piLines = 1
End If
'Calculate the size of the text to be displayed using the margins, height of one line and number of lines.
Me.Textbox2.Height = (pobjSize.Height * piLines) + piTop + piBottom
' value produced: 33 = (13 * 2) + 4 + 3
'set font of text box
Me.Textbox2.Font = pobjFont
Finally, I know this can be achieved using a call to the COREDLL.dll using p/invoke but doing this makes the application crash.
Hi Folks,
Below is the pinvoke code as requested:
<Runtime.InteropServices.DllImport("coredll.dll")> _
Private Function SendMessage( _
ByVal hwnd As IntPtr, ByVal msg As Integer, _
ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
<Runtime.InteropServices.DllImport("coredll.dll")> _
Private Function GetCapture() As IntPtr
End Function
<Runtime.InteropServices.DllImport("coredll.dll")> _
Private Function ReleaseCapture() As Boolean
End Function
Public Function GetNumberOfLines(ByVal ptxtCountBox As TextBox) As Integer
Try
Dim hnd As IntPtr = New IntPtr
ptxtCountBox.Capture = True
' Capture the textbox handle.
hnd = GetCapture()
ptxtCountBox.Capture = False
' Get the count of the lines in the box.
Dim plCount As Integer = SendMessage(ptxtCountBox.Handle, EM_GETLINECOUNT, 0, 0)
' Count the number of return lines as we minus this from the total lines to take.
plCount = plCount - (CharCount(ptxtCountBox.Text, vbCrLf, False))
plCount += RemoveNonASCIIReturns(ptxtCountBox)
ReleaseCapture()
hnd = Nothing
' Return the line count.
Return plCount
Catch ex As Exception
GenerateError(msCLASS_NAME, "GetNumberOfLines", ex.Message.ToString)
End Try
End Function
Thanks,
Morris
I asked a similar question and got an answer that completely satisfied my needs on the subject! Please check out stevo3000's answer from my question:
AutoSize for Label / TextBox in .NET Compact Framework
He referred to these two blog posts that just completely fixed my problem with one swipe!
http://www.mobilepractices.com/2007/12/multi-line-graphicsmeasurestring.html
http://www.mobilepractices.com/2008/01/making-multiline-measurestring-work.html
Think I got to the bottom of this:
Public Function GetNumberOfLines(ByVal pstext As String, ByVal pobjfont As Font, ByVal pobjDimensions As Size) As Decimal
Dim pslines As String() = Nothing
'Used to measure the string to be placed into the textbox
Dim pobjBitMap As Bitmap = Nothing
Dim pobjSize As SizeF = Nothing
Try
Dim psline As String = String.Empty
Dim pilinecount As Decimal = 0.0
'Spilt the text based on the number of lines breaks.
pslines = pstext.Split(vbCrLf)
For Each psline In pslines
'Create a graphics image which is used to work out the width of the text.
pobjBitMap = New Bitmap(1, 1, Imaging.PixelFormat.Format32bppRgb)
pobjSize = Graphics.FromImage(pobjBitMap).MeasureString(psline, pobjfont)
'If the width of the text is less than 1.0 then add one to the count. This would incidcate a line break.
If pobjSize.Width < 1.0 Then
pilinecount = pilinecount + 1
Else
'Based on the dimensions of the text, work out the number of lines. 0.5 is added to round the value to next whole number.
pilinecount = pilinecount + (Round((pobjSize.Width / pobjDimensions.Width) + 0.5))
End If
Next
'If the line count it less than 1 return one line.
If pilinecount < 1.0 Then
Return 1.0
Else
Return pilinecount
End If
Catch ex As Exception
Return 1.0
Finally
If pslines IsNot Nothing Then
Array.Clear(pslines, 0, pslines.Length - 1)
pslines = Nothing
End If
If pobjBitMap IsNot Nothing Then
pobjBitMap.Dispose()
End If
End Try
End Function
Granted, its a bit of a hack but it appears to work ok at the moment! Any observations or comments on how to improve this are more than welcome.
Also, about the p/invoke stuff, discovered the root of the problem, or rather the solution. Upgraded the .Net fx on my device and that appears to have resolved the issue.
Thanks
Morris
Well, I would suggest a sound and smart solution to you.
Here's is the Algorithm:
Use a Label control for reference.
Assign:
• The size of Textbox to the Label.
• The font of Textbox to the Label.
• Autosize-property of Label to be True.
• BorderStyle Property of the Label as of Textbox'.
• MinimumSize Property of Label as original size of the Textbox.
• MaximumSize Property of Label as Width-same as original and Height to be a large multiple the original height.
Assign the Textbox' Text to Label's text.
Now: if the PrefferdHeight-property of Label > Height of the Textbox == True
It's time to increase the height of the Textbox and check the above condition until it’s False.
The Label can be disposed off now.
I have also posted a similar solution in MSDN Forum which can also be checked out:
[http://social.msdn.microsoft.com/Forums/en-US/winforms/thread/03fc8e75-fc13-417a-ad8c-d2b26a3a4dda][1]
Regards.
:)