The code below saves a populated form as a .JPG image. However, it needs to be able to be opened in IE browser. Any other .JPG image not generated by the code opens and if I change the code to save as a .png it also opens in IE browser. Do I need to do anything special for .JPG/ .JPEG?
Code:
Private Sub btnImage_Click(sender As Object, e As EventArgs) Handles btnImage.Click
Dim dialog As New FolderBrowserDialog()
dialog.RootFolder = Environment.SpecialFolder.Desktop
dialog.SelectedPath = ""
dialog.Description = "Select Save Location"
If dialog.ShowDialog() = DialogResult.OK Then
Savepath = dialog.SelectedPath
SaveName = txtPN.Text
If Not SaveName = "" Then
Using bm As New Bitmap(HUD.pnlMain.Width, HUD.pnlMain.Height, Imaging.PixelFormat.Format16bppRgb555)
HUD.pnlMain.DrawToBitmap(bm, New Rectangle(0, 0, bm.Width, bm.Height))
bm.Save(Savepath & "\" & SaveName & ".JPG") '.PNG
End Using
MsgBox("Image was saved as " & SaveName & " at " & Savepath)
Else
Exit Sub
End If
Exit Sub
End If
End Sub
I get this:
Maybe you should try passing the format.
bm.Save(Savepath & "\" & SaveName & ".JPG", System.Drawing.Imaging.ImageFormat.Jpeg)
Also, you could use the Path class to create the full path of the file.
Related
So. I have an image that can be set as the background image on my vb app and when the user wants to change the image, I have it so that it fetches their chosen image from a showdialog and puts it into a specific filepath for the rest of the program to access. But, when the process is done more than once on its initial run (meaning there is no image in the directory yet) it gives and error saying the process cannot be completed due to ("C:\userdata" & ProteusLogin.txtUsername.Text & "" & "backgroundimage.jpg", "delete.jpg") process being in use.
Here is the code.
Private Sub RDBCustom_doubleclick(sender As Object, e As EventArgs) Handles RDBCustom.Click
RBLight.Checked = False
RBOriginal.Checked = False
RBDark.Checked = False
Dim openfiledialog1 As New OpenFileDialog
Try
My.Computer.FileSystem.CopyFile(openfiledialog1.FileName, "C:\userdata\" & ProteusLogin.txtUsername.Text & "\" & "backgroundimage.jpg")
Catch
If System.IO.File.Exists("C:\userdata\" & ProteusLogin.txtUsername.Text & "\" & "backgroundimage.jpg") = True Then
My.Computer.FileSystem.RenameFile("C:\userdata\" & ProteusLogin.txtUsername.Text & "\" & "backgroundimage.jpg", "delete.jpg")
System.IO.File.Delete("C:\userdata\" & ProteusLogin.txtUsername.Text & "\" & "delete.jpg")
My.Computer.FileSystem.CopyFile(openfiledialog1.FileName, "C:\userdata\" & ProteusLogin.txtUsername.Text & "\" & "backgroundimage.jpg")
End If
End Try
End Sub
I have the follow code that works for sending the output to a richtextbox. I cant figure out how to also have the output sent to a log file if I choose as well. this is the beginnings of my code for choosing to log the output. I cant figure out how to get it to log the output to the file location.
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
If (OpenFileDialog1.ShowDialog() = DialogResult.OK) Then
TextBox31.Text = Chr(34) & OpenFileDialog1.FileName & Chr(34)
End If
End Sub
here is my working code for displaying the output in the richtextbox.
Private Sub ExecuteButton_Click(sender As Object, e As EventArgs) Handles ExecuteButton.Click
System.Windows.Forms.Application.DoEvents()
Dim myprocess As New Process
Dim startinfo As New ProcessStartInfo(TextBox3.Text, TextBox1.Text) With {
.UseShellExecute = False,
.RedirectStandardOutput = True,
.CreateNoWindow = True
}
myprocess.StartInfo = startinfo
myprocess.Start()
Dim str1 As String = ""
Using MyStreamReader As IO.StreamReader = myprocess.StandardOutput
str1 &= MyStreamReader.ReadToEnd
End Using
RichTextBox1.Text = str1
End Sub
Note: This is what I used to be able to log the output
If CheckBox34.Checked = True Then
Dim objWriter As New System.IO.StreamWriter(TextBox31.Text & "\" & Format(Now, "dd-MMM-yyyy") & ".log", True)
objWriter.WriteLine(Format(Now, "dd-MMM-yyyy HH:mm:ss ") & TextBox4.Text & vbCrLf & str1)
objWriter.Close()
End If
Try With this sample:
Dim MyPath = "C:\MyLog.Log"
FileOpen(1, MyPath, OpenMode.Append)
Dim lNumberofRecs = LOF(1)
Print(1, Format(Now, "dd-MMM-yyyy HH:mm:ss") & "#Import Begin" & vbCrLf)
FileClose(1)
or with this:
Dim objWriter As New System.IO.StreamWriter("C:\MyData\mylog.log", True)
objWriter.WriteLine("each log data you have")
objWriter.Close()
I'm trying to write a code in which users can add files to a listview. These files must then be moved to a user specified location. What I can't get to work is the filepath of files that are added to the listview. Here's the code for moving the file:
sPath = My.Settings.DefaultPath & ComboBox1.Text & "\" & ComboBox2.Text & "\"
If txtOnderwerp.Text = "" Then
If ComboBox3.Text = "Make your choice..." Then
MsgBox("Select subject!", MsgBoxStyle.Information)
Else
Try
For Each item As ListViewItem In ListView1.Items
My.Computer.FileSystem.CopyFile(item, sPath & ComboBox3.Text & "\" & item.Text, FileIO.UIOption.AllDialogs)
MsgBox("Copy succesfull.", MsgBoxStyle.Information)
ListView1.Items.Clear()
Me.Close()
Next
Catch ex As Exception
MessageBox.Show("Error copying file: " & ex.Message)
End Try
End If
End If
The code above states an error because 'item' is not a string for the FilsSystem.Copy command. Users can add files to a listview with this code:
Using ofd As New OpenFileDialog
ofd.Multiselect = True
If ofd.ShowDialog = DialogResult.OK Then
For Each fn As String In ofd.FileNames
Dim fi As New IO.FileInfo(fn)
Dim icons As Icon = SystemIcons.WinLogo
Dim li As New ListViewItem(fi.Name, 1)
If Not (ImageList1.Images.ContainsKey(fi.Extension)) Then
icons = System.Drawing.Icon.ExtractAssociatedIcon(fi.FullName)
ImageList1.Images.Add(fi.Extension, icons)
End If
icons = Icon.ExtractAssociatedIcon(fi.FullName)
ImageList1.Images.Add(icons)
ListView1.Items.Add(fi.Name, fi.Extension)
Next
End If
End Using
Answer thanks to advice from Andrew Mortimer.
Code for ListView:
Dim str(2) As String
Dim itm As ListViewItem
Using ofd As New OpenFileDialog
ofd.Multiselect = True
If ofd.ShowDialog = DialogResult.OK Then
For Each fn As String In ofd.FileNames
Dim fi As New IO.FileInfo(fn)
Dim icons As Icon = SystemIcons.WinLogo
'Dim li As New ListViewItem(fi.Name, 1)
If Not (ImageList1.Images.ContainsKey(fi.Extension)) Then
icons = System.Drawing.Icon.ExtractAssociatedIcon(fi.FullName)
ImageList1.Images.Add(fi.Extension, icons)
End If
str(0) = fi.Name
str(1) = fi.FullName
icons = Icon.ExtractAssociatedIcon(fi.FullName)
ImageList1.Images.Add(icons)
itm = New ListViewItem(str)
ListView1.Items.Add(itm)
Next
End If
End Using
Code for copying items in listview:
Dim str As String
Dim copyfilename As String
Dim NewDir As String
Try
NewDir = My.Settings.DefaultPath & ComboBox1.Text & "\" & ComboBox2.Text & "\" & txtOnderwerp.Text
My.Computer.FileSystem.CreateDirectory(NewDir)
For Each item As ListViewItem In ListView1.Items
copyfilename = item.Text
str = item.SubItems.Item(1).Text
My.Computer.FileSystem.CopyFile(str, NewDir & "\" & copyfilename)
MsgBox("Kopiëren is gelukt.", MsgBoxStyle.Information)
ListView1.Items.Clear()
Me.Close()
Next
Catch ex As Exception
MessageBox.Show("Error: " & ex.Message)
End Try
I have used 100% of the code presented as a solution here (and which I am extremely grateful for), but still hitting a wall. The problems is I still cant save the file with the file name I choose (see InputBox), this is because its not the same as rtb further down the code. How do I combine the two?
Code
Dim fileSaved As Boolean
Do Until fileSaved
Dim saveFile As String = InputBox("Enter a file name to save this message")
If saveFile = "" Then Exit Sub
Dim docs As String = My.Computer.FileSystem.SpecialDirectories.MyDocuments
Dim filePath As String = IO.Path.Combine(docs, "Visual Studio 2013\Projects", saveFile & ".txt")
fileSaved = True
If My.Computer.FileSystem.FileExists(filePath) Then
Dim msg As String = "File Already Exists. Do You Wish To Overwrite it?"
Dim style As MsgBoxStyle = MsgBoxStyle.YesNo Or MsgBoxStyle.DefaultButton2 Or MsgBoxStyle.Critical
fileSaved = (MsgBox(msg, style, "Warning") = MsgBoxResult.Yes)
End If
Loop
'THIS CODE save content to Test.txt NOT saveFile as desired
Dim rtb As New RichTextBox
rtb.AppendText("Generation, Num Of Juveniles, Num of Adults, Num of Semiles, Total" & vbNewLine)
For Each saveitem As ListViewItem In ListView1.Items
rtb.AppendText(
saveitem.Text & ", " &
saveitem.SubItems(1).Text & ", " &
saveitem.SubItems(2).Text & ", " &
saveitem.SubItems(3).Text & ", " &
saveitem.SubItems(4).Text & vbNewLine)
Next
rtb.SaveFile("C:\Users\RICHARD\Documents\Visual Studio 2013\Projects\Test.txt", _
RichTextBoxStreamType.PlainText)
The following code loops until a Boolean variable is set to indicate that the data was saved.
Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click
Dim fileSaved As Boolean
Do Until fileSaved
Dim saveFile As String = InputBox("Enter a file name to save this message")
If saveFile = "" Then Exit Sub
Dim docs As String = My.Computer.FileSystem.SpecialDirectories.MyDocuments
Dim filePath As String = IO.Path.Combine(docs, "Visual Studio 2013\Projects", saveFile & ".txt")
fileSaved = True
If My.Computer.FileSystem.FileExists(filePath) Then
Dim msg As String = "File Already Exists. Do You Wish To Overwrite it?"
Dim style As MsgBoxStyle = MsgBoxStyle.YesNo Or MsgBoxStyle.DefaultButton2 Or MsgBoxStyle.Critical
fileSaved = (MsgBox(msg, style, "Warning") = MsgBoxResult.Yes)
End If
Loop
'your code to save the data goes here
'the filePath String contains the path you want to save the file to.
End Sub
[Edit] Correct logic and created a filePath variable to store the path to the file. Also added code to allow the user to exit by entering an empty string.
I was making a mod installer for a Minecraft community, when I ended with this problem:
Here's my code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Button1.Enabled = False
Button2.Enabled = False
ComboBox1.Enabled = False
Button1.Text = "DOWNLOADING... DO NOT QUIT!"
Dim selected As String
Dim issel As Boolean
issel = False
selected = ComboBox1.SelectedItem
If selected = "Minecade Mod 1.7.2" Then
selected = "5"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with OptiFine Standard" Then
selected = "3"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with Optifine Ultra" Then
selected = "4"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with Optifine Standard and Minecade Capes" Then
selected = "1"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with Optifine Ultra and Minecade Capes" Then
selected = "2"
issel = True
End If
If issel = False Then
MsgBox("Invalid Selection! Try again.")
Else
Dim answ As Integer
answ = MsgBox("You have chosen the mod with the ID of: " & selected & "." & vbCrLf & "Do you want to install this mod?", vbYesNo)
If answ = 6 Then
If My.Computer.FileSystem.FileExists("C:\Documents and Settings\All Users\Documents\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip") Then
Dim answOverW As Integer = MsgBox("The file already exists on the download location. Do you wish to download the file again (NO) or do you want to continue with the old one (YES)? (Preferred: Yes)", vbYesNo)
'6y7n
End If
'Installation process begins
Try
Dim dlPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
My.Computer.Network.DownloadFile("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip", dlPath, "", "", False, 500, True)
Dim Unpackandinstall As Boolean = MsgBox("Download succesful. Do you want to unpack and install the archieve?", vbYesNo)
If Unpackandinstall = True Then
'UNPACK -------
'''Error occures inside the TRY tags here!'''
Try
Dim filePath As String
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & ".minecraft\versions\1.7.2modded" & selected
Dim startPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Dim zipPath As String = filePath
Dim extractPath As String = filePath
My.Computer.FileSystem.CreateDirectory(filePath)
ZipFile.CreateFromDirectory(startPath, zipPath)
ZipFile.ExtractToDirectory(zipPath, extractPath)
MsgBox("Decompression, installation and finishing done! Ready to play!")
Catch ex As Exception
MsgBox("Error in decompression and installment proceidure." & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Report to JOWD, as this should NOT happen!")
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
End Try
'''Error area ends!'''
End If
Catch ex As Exception
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
MsgBox("Download failed. Error code below!" & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Check the main topic for a possible solution, if nothing applies leave a reply!")
Exit Sub
End Try
Else
'installation process aborted.
End If
End If
End Sub
I will be happy to answer any question related to my problem, I've tried to look help anywhere but nothing helps me!
Thanks.
Read! Edited.
Regarding the 2 answers from David Sdot and Visual Vincent, - Their answers did not fix my problem.
I tried to use the following line on the code:
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\versions\1.7.2modded" & selected
Same error occurred.
Still looking for more advices from you!
Leave a comment if you want the project file to test it out.
Read! Edited.
Here's the source for the app, do your testing there!
http://files.casualnetwork.net/installers/moddedminec/source/MinecadeModInstaller_Min.zip
Ok so here's my solution to your problem:
Here, I used a WebClient instead of My.Computer.Network.DownloadFile, since I think it's better. (You use whatever you want of course)
Dim Download As New WebClient
Download.DownloadFileAsync(New Uri("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip"), dlPath)
I also noticed some stuff that had to be changed in your code.
For some reason you tried to zip your file into itself:
ZipFile.CreateFromDirectory(startPath, zipPath)
Remove this. :)
And you also tried to extract .minecraft\versions\1.7.2modded to itself by doing this:
Dim startPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Dim zipPath As String = filePath
Dim extractPath As String = filePath
ZipFile.ExtractToDirectory(zipPath, extractPath)
Simply change zipPath from:
Dim zipPath As String = filePath
To:
Dim zipPath As String = startPath
Now the zipping should work fine :)
One more thing I noticed is that you couldn't skip the unzip part even if you pressed "No" in the MsBox. So I changed that code a little:
Dim Unpackandinstall As DialogResult
Unpackandinstall = MessageBox.Show("Download succesful. Do you want to unpack and install the archieve?", "", MessageBoxButtons.YesNo)
If Unpackandinstall = Windows.Forms.DialogResult.Yes Then
...
End If
Here's the whole Try block:
Try
Dim Download As New WebClient
Dim dlPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Download.DownloadFileAsync(New Uri("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip"), dlPath)
Dim Unpackandinstall As DialogResult
Unpackandinstall = MessageBox.Show("Download succesful. Do you want to unpack and install the archieve?", "", MessageBoxButtons.YesNo)
If Unpackandinstall = Windows.Forms.DialogResult.Yes Then
Try
Dim filePath As String
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\versions\1.7.2modded" & selected
Dim startPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Dim zipPath As String = startPath
Dim extractPath As String = filePath
My.Computer.FileSystem.CreateDirectory(filePath)
'ZipFile.CreateFromDirectory(startPath, zipPath)
ZipFile.ExtractToDirectory(zipPath, extractPath)
MsgBox("Decompression, installation and finishing done! Ready to play!")
Catch ex As Exception
MsgBox("Error in decompression and installment proceidure." & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Report to JOWD, as this should NOT happen!")
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
End Try
End If
Catch ex As Exception
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
MsgBox("Download failed. Error code below!" & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Check the main topic for a possible solution, if nothing applies leave a reply!")
Exit Sub
End Try
And just replace
Download.DownloadFileAsync(New Uri("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip"), dlPath)
With your My.Computer.Network code if you'd rather use that instead. :)
Hope this helps!
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & ".minecraft\versions\1.7.2modded" & selected
The path return by Environment.GetFolderPath has no \ at the end and you prepended a dot instead.
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\minecraft\versions\1.7.2modded" & selected