I am building a database and came across an issue that I need help in resolving. This database the customer wants to be able to link pictures to specific records. I have it so the pics are not OLE objects but links to a picture folder that will be on their network drive...So essentially the picture will be a hyperlink to the file path....
My question is does anyone know I way I can have the database reformat the picture automatically to 600 x 800 size, to help save space? We all know if I don't force the DB to do it for them it will not happen and potentially eat up valuable space, as this DB is expected to get quite large. So I would like to keep the picture folder as small as possible, giving the database more room.
You can use the WIA libary as shown in VBA – Resize Image like this:
Function ResizeImageTo600x800(ByVal PathToImage As String, ByVal PathToResizedImage As String) As Boolean
Dim WiaImgFile As Object 'WIA.ImageFile
Set WiaImgFile = CreateObject("WIA.ImageFile")
With CreateObject("WIA.ImageProcess") 'WIA.ImageProcess
.Filters.Add .FilterInfos("Scale").FilterID 'Add Scale Filter to ImageProcess
.Filters(1).Properties("MaximumWidth") = 600 ' Set Width to 600px
.Filters(1).Properties("MaximumHeight") = 800 'Set Height to 800px
'.Filters(1).Properties("PreserveAspectRatio") = False ' uncomment if AspectRatio should not be preseved
WiaImgFile.LoadFile PathToImage ' Load Image
.Apply(WiaImgFile).SaveFile PathToResizedImage ' Apply Filter and save resized Image
ResizeImageTo600x800 = True
Set WiaImgFile = Nothing
End With
End Function
Usage:
If ResizeImageTo600x800("\\path\to\image", "\\path\to\resized\image") then
Msgbox "ResizeImageTo600x800 successful!"
End If
Or:
ResizeImageTo600x800 "\\path\to\image", "\\path\to\resized\image"
Depending on your image types, you may also increase the compression of your image to save space. WIA should support this too (with the Convert Filter and its Quality Property).
Related
I find ABCPDF is very capable. However, so far I had not managed to find a way to draw one PDF into another with rounded corners - until now. But, the approach I discovered depends on getting the correct PDF object id for the inserted PDF stream, and herein lies the reason for this question.
Anyone who knows ABCPDF will ask why that is an issue ? Does not the addImageDoc() function which embeds one PDF inside another return the PDF object ID ? No - it returns something else - most likely the inserted PDF goes into the document catalogue as an isolated object and what you get in the returned ID is an object that refers to it. Unpacking the document streams seems to bear this out.
Long story short, in my experimenting I found that I needed to insert into the stream a 'Do' call, with the target of that derived as:
imgObjId = addImageDoc(some pdf object) // inserted off-page
insert into stream "/Iabc<imgObjId + 1> Do"
For example, if the returned imgObjId value is 5 then I need it to be 6 to make
/Iabc6 Do
Question: Whilst this works OK, I am relying on adding one to the returned value and I wonder how robust that is going to be. Or is there a correct way to achieve this ?
More info: I have kept the question short but readers may be wondering why the above matters? Because to achieve rounded corners you need to construct a stream of PDF commands which has a clipping region defined. Think of a path for a rectangle with Bezier curves for the corners. Having got that, you need to draw an image, or in my case another PDF, into the same context so as to get the clipping effect. After that you can close and reset the graphics state and be a good PDF stack citizen. However, there is no means, other than my approach above, that I can find in ABCPDF to get a handle on the inserted PDF doc stream in the catalogue so as to be able to ask for it to be drawn somewhere else.
Inserting an image seems to be a similar process, except the getinfo() function can discover the pixmap. There appears to be no like approach for an embedded PDF.
I don't know if you can change the target abcpdf rectangle prior to do a "AddImageDoc".
Maybe you can do a trick, getting a Bitmap from the source, editing it by changing borders, and adding to a new doc. Something like this:
Dim oDoc As New WebSupergoo.ABCpdf10.Doc
Dim oImg As System.Drawing.Bitmap
oDoc.Read("D:\source.pdf")
oImg = oDoc.Rendering.GetBitmap()
' image quality can be improved with .Rendering properties as 'AntiAliasImages', etc.
oDoc.Dispose()
oDoc = Nothing
Dim oGraph As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(oImg)
Dim gPath As New System.Drawing.Drawing2D.GraphicsPath
Dim oBrush As New System.Drawing.SolidBrush(System.Drawing.Color.Red) ' only to see the rectangle... white when be ready
gPath.AddRectangle(New System.Drawing.Rectangle(0, 0, oImg.Width, oImg.Height))
' 2 / 100 it's the percent factor for borders
Dim iLeftBorder As Integer = CInt(2 / 100 * (oImg.Width / 2))
Dim iTopBorder As Integer = CInt(2 / 100 * (oImg.Height / 2))
gPath.AddEllipse(New System.Drawing.Rectangle(iLeftBorder, iTopBorder, oImg.Width - (iLeftBorder * 2) - 1, oImg.Height - (iTopBorder * 2) - 1))
oGraph.FillPath(oBrush, gPath)
oBrush.Dispose()
oGraph.Dispose()
oDoc = New WebSupergoo.ABCpdf10.Doc
oDoc.AddImageBitmap(oImg, False)
oDoc.Save("D:\finalpath.pdf")
oDoc.Dispose()
oDoc = Nothing
But it's only a "trick".
I have looked far and wide and reached the end of my wits trying to figure out how to do this. I have looked on XtremeVBTalk.com and the rest of the internet on how to resize a damn StdPicture!
Does anyone know how to do this? Is this even possible?
Thank you so much in advance. I desire not to use any type libraries etc. so if that is offered in a solution I don't think I will be able to use it.
I'm not using A picturebox control at all.
Say I have the following function header, and an StdPicture is passed in:
Private Function EncodeImageToBase64(ByRef Image As StdPicture) As String
I then have the following declarations where I intend on encoding the StdPicture to base64:
Dim xmlDoc As DOMDocument60
Dim xmlNode As MSXML2.IXMLDOMElement
Dim bColor() As Byte
Dim bMask() As Byte
Dim bImage() As Byte
Dim lCrcTable() As Long
Dim lWidth As Long
Dim lHeight As Long
EncodeImageToBase64 = vbNullString
If Image Is Nothing Then
Exit Function
End If
Call CRCTable(lCrcTable)
Call Icon2Arrays(Image, bColor, bMask, lWidth, lHeight)
If Not CreatePngByteArray(bImage, lWidth, lHeight, bColor, bMask, lCrcTable) Then
Debug.Assert False
Exit Function
End If
However, before calling that, I want to cut the image's width and height in half. How can I do so? CreatePngByteArray only supports 16x16 PNGs and I am using 32x32, so I'd like to cut them down in order to pass the asserts they have.
OK, I spent quite some time that I didn't really have on this one, because I didn't know the answer to begin with, but I was still interested in finding out what the potential solution was.
The following answer is my understanding of what you are trying to do, but may not be the answer to the question itself, so it could very well be considered wrong.
So, here's what I came up with. You will need to use an IPictureDisp object instead of an StdPicture object. You will also need to use a PictureBox control, even if you don't really want to.
Create a new project. Add a form, or open an existing one if one is provided. Set the ScaleMode of the form to pixels. Add a PictureBox control on the form. Set the AutoRedraw property of the PictureBox control to 'True', the BorderStyle property of the control to 'None', and the Height and Width properties of the control to 16 pixels each. Add the following code to the form, and modify the location and type of the image that you want to resize, and then the location to save it to:
Private Sub Form_Load()
Dim TestPic As IPictureDisp
Set TestPic = LoadPicture("C:\Users\Your Name\Desktop\image.gif")
With TestPic
.Render Picture1.hDC, 0, 16, 16, -17, 0, 0, .width, .height, 0
End With
SavePicture Picture1.Image, "C:\Users\Your Name\Desktop\image2.bmp"
End Sub
The image can start with any of the types that Visual Basic 6 supports (.bmp, .cur, .gif, .ico, .jpeg or .jpg, and .wmf), but must always be saved in bitmap format. Please note that Visual Basic 6 does not support PNG file formats at all, so you will not be able to use any VB6 functions to open PNG files or create them.
I would be interested in other solutions that other people come up with.
Edit: Fixed dimensions.
Do you mean inside the PICTUREBOX control or inside an IMAGE CONTROL? Because If I remember correctly it has a STRETCH property which autofits the image to the container
#Zaf Khan beat me to it. I have something similar where I have a PictureBox. Under behaviour I have SizeMode set to StretchImage then when I load an image like so
LoadWebImageToPictureBox(ImagePreview, SelectedFile)
it auto fits.
Using Excel VBA, I want to create an image showing the content of a cell.
Manually, I can do this by selecting a cell, clicking on 'copy', selecting another cell, and clicking on 'paste as image'. Then I can select the image and set its formula to =$B$2, for example.
The Macro recorder tells me that this is equivalent to the following code:
Selection.Copy
ActiveSheet.Pictures.Paste.Select
ActiveCell.FormulaR1C1 = "=R[1]C[1]"
I want to achieve the same without using the copy-paste-select commands. In other words, I would like to create a Picture object with predefined FormulaR1C1 property.
I tried ActiveSheet.Pictures.Add(Left, Top, Width, Height) but only got Runtime error '1004': No link to paste. I don't understand what this means.
I tried ActiveSheet.Pictures.Insert and ActiveSheet.Shapes.AddPicture, but they both require a file name to load an external image file, which is not what I want.
Instead of copying the cell, then telling it you want to paste to another cell as a picture, try using:
Range("A1").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Now A1 is in your clipboard as a picture. You can use boring old paste to stick it somewhere else.
Range("B1").Select
ActiveSheet.Paste
Are you trying to get a "live" picture which is linked back to the source range, like using the Camera tool in Excel?
Sub Macro1()
Dim s, rng As Range, rngDest As Range
Set rng = ActiveSheet.Range("B2:C3")
Set rngDest = ActiveSheet.Range("E10")
rng.Copy
With ActiveSheet.Pictures.Paste(link:=True)
.Left = rngDest.Left
.Top = rngDest.Top
End With
End Sub
I don't think you can get around using copy/paste though.
I am trying to create a thumbnail from a PDF file, but I need it to be 300px*300px but no matter what I do I can not get the image to be the correct size. It always seems to be huge.
This is my code:
GhostscriptSettings settings = new GhostscriptSettings();
settings.Page.AllPages = false;
settings.Page.Start = 1;
settings.Page.End = 1;
settings.Size.Native = GhostscriptSharp.Settings.GhostscriptPageSizes.a2;
settings.Device = GhostscriptSharp.Settings.GhostscriptDevices.png16m;
settings.Resolution = new Size(72, 72);
GhostscriptWrapper.GenerateOutput(Path.Combine(FilePath, Filename), FinalPath, settings); // Create the initial thumbnail
Is there any way to output an image with the PPI of 300*300 ?
Cheers,
/r3plica
Looks to me like you are setting a resolution of 300x300. That is 300 dots per inch, which will give you reasonably large files.
You want to change the page size, which looks to me like you are setting to A2. An A2 page at 300 dpi will indeed produce very large output files.....
I have no idea how you would change the media size in C#. The Ghostscript command line switches you need are -dDEVICEWIDTH=300 -dDEVICEHEIGHT=300 -dFIXEDMEDIA
You say you are using a 'PSD' file, which would suggest Photoshop native file format to me, which Ghostscript won't interpret. Possibly you mean a PDF file, in which case you should also add -dPDFFitPage. If on the other hand you mean a PS (PostScript) file, you should set the PageSize Policy to 3 (select nearest media and scale down).
We are using VB6 and Word.Basic object to create documents. Text is inserted at a variety of bookmarks. Our latest requirement wants us to increase the font size for a given insert. We are currently doing this by setting the font size to 12 rather than the 8 that is normally there, however from a maintenance standpoint, I would rather be able to set this to say (currentfontsize + 4)... but so far I have not been able to find any method to get the current font size.
Does anyone have a way to do this?
Setting the font size of a bookmark is straight-forward in VBA:
Dim doc As Document
Const MultiSelection As Long = 9999999
Set doc = Application.ActiveDocument
If doc.Bookmarks.Exists("myBookmark") Then
If doc.Bookmarks("myBookmark").Range.Font.Size = MultiSelection Then
' the range of the bookmark consists of runs with different font sizes
doc.Bookmarks("myBookmark").Range.Font.Size = 12
Else
doc.Bookmarks("myBookmark").Range.Font.Size _
= doc.Bookmarks("myBookmark").Range.Font.Size + 4
End If
End If
Probably a better option if you want to increase the font size proportionally, is to use Font.Grow which will increase the font size to the next available size, e.g. to get from 8 to 12 you would have to call it 4 times.
If doc.Bookmarks.Exists("myBookmark") Then
For i = 1 To 4
doc.Bookmarks("myBookmark").Range.Font.Grow
Next
End If
If you are not familiar with Word's object model, a trick is to use the Macro Recorder. In you case, start the recorder, open the bookmarks dialog, go to the bookmark and then change the font size. The recorded actions will be saved as a module in your Normal.dot file by default. The action of changing the font size of a bookmark would result in the following recorded macro:
Selection.GoTo What:=wdGoToBookmark, Name:="myBookmark"
With ActiveDocument.Bookmarks
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Selection.Font.Size = 12
This code can be the basis for your own function (although it looks a bit different from the above sample, the effect will be the same).
Given a Range object, you can check range.Font.Size.