How put Image location dynamically Crystal report from byte array - image

My problem is simple but I don't find the solution.
I know how modifiy dynamically a picture when I've the path.
But In my project I collect signature of people. I don't want file (not secure enough) then I store it in database (I use signature_pad and server side I use
Dim dataUri = MesDonnees.Img
Dim encodedImage = dataUri.Split(",")(1)
Bdd.field = Convert.FromBase64String(encodedImage)
...
But I don't solve how put it in footer of my document...
I read some works but always it's from details section and I just have string type, number, boolean... not byte or something
Thanks for your help
UPDATE
I've an idea. Try to link this image to ashx file
Dim IdAtt As Long = CLng(HelperParams.GetParamURL("IdAttach"))
Dim Typ As Integer = CInt(HelperParams.GetParamURL("Typ"))
Dim LesDatas As New MyEntities
Dim Att As Attachement = GetMonAttachement(IdAtt, LesDatas)
If Att IsNot Nothing Then
context.Response.ContentType = "image/png"
If Typ = 1 Then
context.Response.BinaryWrite(Att.SignCollaborateur)
Else
If Att.SignClient Is Nothing Then
Dim Vid() As Byte = New Byte(0) {}
context.Response.BinaryWrite(Vid)
Else
context.Response.BinaryWrite(Att.SignClient)
End If
End If
context.Response.Flush()
context.Response.End()
End If
Catch ex As Exception
End Try
If I put in IE: http://localhost:63888/Signature.ashx?IdAttach=4&Typ=2
I've my picture
But I try to create SignClient parameter et assign it location (x-2)
cryRpt.SetParameterValue("SignClient", "~/Signature.ashx?IdAttach=4&Typ=2")
cryRpt.SetParameterValue("SignClient", HttpContext.Current.Server.MapPath("/Signature.ashx") & "?IdAttach=4&Typ=2")
cryRpt.SetParameterValue("SignClient", "http://localhost:63888/Signature.ashx?IdAttach=4&Typ=2")
This 3 methods don't work.
I try to put directly : http://localhost:63888/Signature.ashx?IdAttach=4&Typ=2 in location (x-2) of image tabs : idem
I put a break point to ashx, never reach. Then I open network tab developpement tool and my ashx never call.
I've an picture in header (logo) and I change picture location with a path file (e:/../logo.png) and it's good.
Someone have an idea?

Finally, after try and try, the only solution I find is
1/ to make subreport (my request return only 1 line)
2/ in subreport delete all section except details section
3/ Create a class with property Contenu as byte()
4/ Add datafield in subreport to this new class and drop the field in detail section
For signaturepad, just put backgroundcolor : rgb(255,255,255) but penColor : (1,1,1)
else (CR or acrobat) show black image.

Related

Calling PdfSharp xImg = XImage.FromFile(myImage) immediatly after Bitmap.Save(myImage, ImageFormat.Jpeg)

Good afternoon,
testing a my Window form application I noted an unexpected beaviour when coupling PdfSharp xImg = XImage.FromFile(myImage) with a preceding Bitmap.Save(myImage, ImageFormat.Jpeg).
Briefly:
I create a Bitmap from say 195202_000.jpg and then I save it as xxxx.jpg;
I create the Ximage.FromFile(xxxx.jpg) and add it to a Pdf in creation;
I create another Bitmap this time from 195202_001.jpg and I save it using again the name xxxx.jpg. No problems of overwriting occur.
I create the Ximage.FromFile(xxxx.jpg) and add it to the Pdf in creation;
I save the Pdf.
Well: at the end, xxxx.jpg contains correctly 195202_001.jpg, the Pdf file contains correctly two pages, but the Issue is that both the two pages contain 195202_000.jpg !!!
I do not understand where this issue raises.
If I change the name of the saved bitmap at every step (say xxxx1.jpg, xxxx2.jpg) all is fine.
Thanks for any help.
Paolo.
I attach the rough code used for producing and analizing the issue.
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim pdf As New PdfDocument
Dim fArray(1) As String
'TWO images.jpg PathName in array
fArray(0) = "C:\Users\Administrator\Desktop\myTestInp\195202_000.jpg"
fArray(1) = "C:\Users\Administrator\Desktop\myTestInp\195202_001.jpg" `
'Looping the array: creat bitmap from each image in fArray(), draw and save it as a new jpg,
'immediatly(re - Load) the new jpeg for adding it to a Pdf.
'Issue that I noted occurs when using the same PathName for saving and re-loading the image.
'Please see below.
For i As Integer = 0 To 1
'CREATE BitmapInp from fArray(i)
Dim BitmapInp As Bitmap = New Bitmap(fArray(i))
'DRAW BitmapOut
Dim BitmapOut As New Bitmap(BitmapInp.Width, BitmapInp.Height)
Dim grBitmapOut = Graphics.FromImage(BitmapOut)
grBitmapOut.DrawImage(BitmapInp, 0, 0, BitmapInp.Width, BitmapInp.Height)
grBitmapOut.Dispose()
BitmapInp.Dispose()
'SAVE BitmapOut as "C:\Users\Administrator\Desktop\myTestOut\xxxx.jpg"
'NOTE: each time, the Bitmap is saved using the same file name above.
'overwriting does not raise errors.
BitmapOut.Save("C:\Users\Administrator\Desktop\myTestOut\xxxx.jpg", ImageFormat.Jpeg)
BitmapOut.Dispose()
'LOAD BitmapOut as xImg from "C:\Users\Administrator\Desktop\myTestOut\xxxx.jpg"
'NOTE: FromFile just saved
Using xImg = XImage.FromFile("C:\Users\Administrator\Desktop\myTestOut\xxxx.jpg")
Dim page = pdf.AddPage()
Dim grPdf = PdfSharp.Drawing.XGraphics.FromPdfPage(page)
page.Width = 500 * 72 / xImg.HorizontalResolution
page.Height = 500 * 72 / xImg.HorizontalResolution
xImg.Interpolate = False
grPdf.DrawImage(xImg, 0, 0, page.Width, page.Height)
End Using
Next
'END of loop
'SAVE Pdf
pdf.Save("C:\Users\Administrator\Desktop\myTestOut\Dummy.Pdf")
'Issue: the Pdf contains correctly two pages, but they are equals! And precisely is
' the first image that occurs two times!
End Sub
I didn't check the source code of PDFsharp/MigraDoc, but maybe the filename is used as a "unique key" to prevent incorporating multiple copies of the same image into one PDF file.
If the same image is used on multiple pages, only one copy of the image data is included in the file.
I know that PDFsharp tries to prevent multiple copies - and IIRC the filename is the key.
And yes, using different file names should resolve the issue.

VBA download and embed images using url from adjacent cell

I've attempted the solution in the following.
Inserting an Online Picture to Excel with VBA
Unfortunately I get a run-time error '1004'
"Unable to get the Insert property of the Picture class"
which stops on the following code :
Set myPicture = ActiveSheet.Pictures.Insert(pic)
Could this be due to my Office version 2016 (64bit) ?
If not, are there any suggestions of how I might get embed images to adjacent cells in column AK using the image urls from column AJ ?
Thanks in advance
There's some evidence that Excel has trouble downloading from AWS, and I've recreated your issue using the URL you mentioned. In this case, if I were on a deadline I'd put in this fall-back method when the first one fails: download the file, then insert it into the document, then delete the file.
directDownloadFailed:
Dim FileNum As Long
Dim TempFile As String
Dim FileData() As Byte
Dim WHTTP As Object
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
WHTTP.Open "GET", imgURL, False
WHTTP.Send
FileData = WHTTP.ResponseBody
Set WHTTP = Nothing
FileNum = FreeFile
TempFile = "path\to\save\img.jpg"
Open TempFile For Binary Access Write As #FileNum
Put #FileNum, 1, FileData
Close #FileNum
Set img = ActiveSheet.Pictures.Insert(TempFile)
SetAttr TempFile, vbNormal
Kill TempFile
GoTo resumeProcessingImg
#keydemographic
I appreciate the response and that definitely sounds like an option but I cannot get that code to work or incorporate it into the code I'm using. I get a compile error "Label Not defined" on GoTo resumeProcessingImg
The following will download and embed the images into the cells but the code stops once it gets to the s3 aws image urls.
I'll try a few other ways to incorporate your code but I'm not having much luck with it so far.
This is my test file
Sub URL2IMG()
Dim pic As String 'path of pic
Dim myPicture As Picture 'embedded pic
Dim rng As Range 'range over which we will iterate
Dim cl As Range 'iterator
Set rng = Range("b2:b12") '<~~ as needed, Modify range to where the images are to be embedded.
For Each cl In rng
pic = cl.Offset(0, -1) '<~~ defines image link URL in column to the left of the embedded column
Set myPicture = ActiveSheet.Pictures.Insert(pic)
'you can play with the following to manipulate the size & position of the picture.
With myPicture
.ShapeRange.LockAspectRatio = msoFalse
' currently this shrinks the picture to fit inside the cell.
.Width = cl.Width
.Height = cl.Height
.Top = Rows(cl.Row).Top
.Left = Columns(cl.Column).Left
End With
Next
End Sub

Using VBA Macro To open Link to picture

My goal of this program is to open a picture in a folder by selecting a cells value in the active row which im using the line to do.
picture = Cells(ActiveRow, 6).Value
I am getting a Run time error '1004' Application-defined or object defined error
Here is my full code
Sub Picture_Click()
Sheets("Master").Unprotect Password:="Conti1"
Sheets("Records").Unprotect Password:="Conti1"
Dim picture As String
Dim ActiveRow As Long
Worksheets("Master").Activate
ActiveRow = Rows(ActiveCell.Row).Select
picture = Cells(ActiveRow, 6).Value
ChDir"P:\926_TM\03_LocalExchange\Tracking_and_Labeling\LabEquipment\pictures"
Workbooks.Open picture
End Sub
I am trying to use the value from the selected cell to be the name of the picture file in the selected folder, the picture I would like to open.
also I am getting a value of -1 for ActiveRow
Any help would be great!
You can't open a picture with the Workbooks.Open method, as that method is exclusively for opening workbooks.
One option is to use a Shell command to open the picture. In this example, I will open a picture located on the the Pictures folder named Test.png
Private Sub OpenPic()
Shell "mspaint.exe C:\Users\USERNAME\Pictures\Test.png"
End Sub
This will open the picture in paint.
Adapting this method to your code:
Sub Picture_Click()
Sheets("Master").Unprotect Password:="Conti1"
Sheets("Records").Unprotect Password:="Conti1"
Dim picture As String
Dim ActiveRow As Long
Worksheets("Master").Activate
ActiveRow = ActiveCell.Row
picture = Cells(ActiveRow, 6).Value
Shell "mspaint.exe P:\926_TM\03_LocalExchange\Tracking_and_Labeling\LabEquipment\pictures\" & picture
End Sub
This assumes that the value in Activerow, 6 includes the file extension.
As an aside: I would add that you don't need to define ActiveRow at all and could just use it as-is.
So this:
ActiveRow = ActiveCell.Row
picture = Cells(ActiveRow, 6).Value
Can be rewritten as:
picture = Cells(ActiveCell.Row, 6).Value
And you can omit the ActiveRow variable altogether.
ActiveRow is a Long, so you cannot select a row and say that is a number. You would simply write
ActiveRow = ActiveCell.Row
In the immediate window, if you write ?Rows(ActiveCell.Row).Select, it will return a Boolean Value, not a number.
Also to open a file you should use the FollowHyperlink method:
from msdn:
ActiveWorkbook.FollowHyperlink Address:="http://example.microsoft.com"
Your link would replace the one in the example of course.
picture = "P:\926_TM\03_LocalExchange\Tracking_and_Labeling\LabEquipment\pictures\" & Cells(ActiveRow, 6).Value
ActiveWorkbook.FollowHyperlink Address:=picture
This answer will help you to open in default photo viewer.
I tried,
Sub image_opener()
Dim photo_path As String
photo_path = Worksheets("Sheet1").Range(Selection.Address).Value
PID = Shell(photo_path, vbNormalFocus)
End Sub
but the above code didn't work for me. I think the McAfee in my PC is preventing the excel from running that shell command.
So, I created a openImg.bat file containing
%1
%1 basically takes the input from the user.
Normally we can open image using this openImg.bat by,
openImg.bat path_of_image/image.jpg
So, I edited the VBA accordingly
Sub image_opener()
Dim photo_path As String
photo_path = Worksheets("Sheet1").Range(Selection.Address).Value
PID = Shell("bat_file_path\openImg.bat " & photo_path, vbNormalFocus)
End Sub
photo_path = "image_path/image.jpg" . Finally I setup a shortcut key for the macro from Developer>Macros>Options>Shortcut Key .
The above worked for me.

Unbound imagecontrol ONLY show First image when imagelink is added in a 1:N relation

Background:
Entry is via a subform for adding/showing/linking images.
I do not want to store the image files within my DB, the image folder is separate. The DB will grow rather large in time.
I have created a click-control enabling a popup for user to browse and click on the imagePATH to be added in a Bound Textfield (called Bildadress, no not misspelled in My country, Grin ) in the subform.
See code below.
Then I add a new unbound Image-control and specify its Controlsource = the Textfield mentioned above.
For the firs image this works wonderful, but for the following the Image-control returns NULL (not show att all). The data in the Textfield updates as it should.
Will the 2nd stage only work in a 1:1 relationship OR can I (with your help) use VBA code to make this work?
OPTIMAL would be to get this to work and also a 2nd Bound Textfield just displaying the actual image file name. .
I hope someone out there have encountered this problem who also didnt want to use Attachment to store the files within the databae.
CODE:
Private Sub AddFilePath_Click()
Call Selectfile
End Sub
Public Function Selectfile() As String
Dim Fd As FileDialog
Set Fd = Application.FileDialog(msoFileDialogOpen)
With Fd
.AllowMultiSelect = False
.Title = "Välj önskad fil"
If .Show = True Then
Selectfile = .SelectedItems(1)
Me.Bildadress = Selectfile
Else
Exit Function
End If
End With
Set Fd = Nothing
End Function
If you use a bound textbox that holds the image-path then you can use
Me.Imagecontrol.Picture = Me.BoundTextControl.Value
to load the picture into an unbound image control. In your case that would be something like
If .Show = True Then
Me.Bildadress.value = .SelectedItems(1)
Me.Bild.Picture = Me.Bildadress.value
Else
It would be best to also load the respective picture in the OnCurrent Event.
Private Sub Form_Current()
Me.Bild.Picture = Me.Bildadress.value
End Sub
However, keep in mind that access is a one-file-database and you break that paradigm when using links to external files where the files would belong into the DB.

How to call a visio macro from a stencil

i have written some Macros for Visio. Now I copied these to a Stencil called Macros.vss
How can I call my Macros now?
It all depends on what the macros do and how you'd like to call them. I'm going to assume they're simply macros that will execute something within the active Visio page.
By default in Visio VBA, any public subs with no arguments get added to the Visio Tools->Macros menu, in a folder named by the document holding the macros (in this case Macros) and then separated into folders by module name. If you're the only person using the macros then you probably don't need to do anything else.
However, since you put them in a vss file I'll assume you'd like to distribute them to other people.
There's something funny (and by funny I mean irritating) about Visio and how toolbars and buttons work, when added programmatically. Unfortunately, when you create a toolbar using the UIObject and Toolbar and ToolbarItem classes, Visio is going to assume the code you're calling resides in the active drawing, and cannot be in a stencil. So I can give you a little guidance on using those classes, but basically it consists of distributing a .vst template along with your .vss files, with just a single required sub in the .vst file.
So, instead of using a custom toolbar, you can attach code to shape masters in your .vss file that execute the code when they get dropped on a drawing document (using CALLTHIS and the EventDrop event in the shapesheet). With this method I just have a sub that gets called using callthis that takes a shape object as an argument, executes some code, then deletes the shape (if I don't want it around anymore).
And lastly, you can manipulate the Visio UI programmatically to add a toolbar and buttons for your macros. Below is some sample code, basically the way I do it with a solution I developed. As I mentioned above, the most important part of using this method is to have a document template (.vst) that holds a sub (with the below code it must be named RunStencilMacro) that takes a string as an argument. This string should be the "DocumentName.ModuleName.SubName". This sub must take the DocumentName out of the string, and get a Document object handle to that document. Then it must do ExecuteLine on that document with the ModuleName.SubName portion. You'll have to step through the code and figure some things out, but once you get the hang of what's going on it should make sense.
I'm not sure of any other ways to execute the macros interactively with VBA. I think exe and COM addons may not have this issue with toolbars...
Private Sub ExampleUI()
Dim UI As Visio.UIObject
Dim ToolbarSet As Visio.ToolbarSet
Dim Toolbars As Visio.Toolbars
Dim Toolbar As Visio.Toolbar
Dim ToolbarItems As Visio.ToolbarItems
Dim ToolbarItem As Visio.ToolbarItem
Dim TotalToolBars As Integer
Dim Toolbarpos As Integer
Const ToolbarName = "My Toolbar"
' Get the UIObject object for the toolbars.
If Visio.Application.CustomToolbars Is Nothing Then
If Visio.ActiveDocument.CustomToolbars Is Nothing Then
Set UI = Visio.Application.BuiltInToolbars(0)
Else
Set UI = Visio.ActiveDocument.CustomToolbars
End If
Else
Set UI = Visio.Application.CustomToolbars
End If
Set ToolbarSet = UI.ToolbarSets.ItemAtID(visUIObjSetDrawing)
' Delete toolbar if it exists already
TotalToolBars = ToolbarSet.Toolbars.Count
For i = 1 To TotalToolBars
Set Toolbar = ToolbarSet.Toolbars.Item(i - 1)
If Toolbar.Caption = ToolbarName Then
Toolbar.Visible = False
Toolbar.Delete
Exit For
End If
Next
' create toolbar
Set Toolbar = ToolbarSet.Toolbars.Add
Toolbar.Caption = ToolbarName
Dim IconPos As Long ' counter to determine where to put a button in the toolbar
IconPos = IconPos + 1
Dim IconFunction As String
IconFunction = """Macros.Module1.SubName"""
Set ToolbarItem = Toolbar.ToolbarItems.AddAt(IconPos)
With ToolbarItem
.AddOnName = "RunStencilMacro """ & IconFunction & """"
.Caption = "Button 1"
.CntrlType = Visio.visCtrlTypeBUTTON
.Enabled = True
.state = Visio.visButtonUp
.Style = Visio.visButtonIcon
.Visible = True
.IconFileName ("16x16IconFullFilePath.ico")
End With
' Now establish the position of this toolbar
With Toolbar
.Position = visBarTop 'Top overall docking area
.Left = 0 'Puts it x pixels from the left
.RowIndex = 13
.Protection = visBarNoCustomize
Toolbar.Enabled = True
.Visible = True
End With
Visio.Application.SetCustomToolbars UI
Visio.ActiveDocument.SetCustomToolbars UI
End Sub

Resources