Try
Dim lImage As Image = Image.FromFile(appPath + "\" + "ActiveDisplay" + "\" + "Helmets" + "\" + vData + **"extension loop need"**)
ResizePicture(Me.PictureBox1, lImage)
Catch ex As Exception
End Try
I'm searching for a image name in viewer and need to loop through extensions
any help would be appreciated
You can use a String array and a For Each
Dim extensions As String() = {".png", ".jpg", ".bmp"}
For Each ext As String In extensions
Dim file As String = appPath + "\" + "ActiveDisplay" + "\" + "Helmets" + "\" + vData + ext
'I recomend use: Dim file As String= String.Format("{0}\ActiveDisplay\Helmets\{1}\{2}", appPath, vData, ext)
If IO.File.Exists(file) Then
Dim lImage As Image = Image.FromFile(file)
End If
Next
Related
i am using visual studio 2005 and i want to print Arabic on POS thermal printer. when i try to print it shows ????? in print
here is my code:
Public Sub GiftReceipt()
Try
Dim displayString As String
Dim ESC As String = Chr(&H1B) + "a" + Chr(0)
Dim ESC2 As String = Chr(&H1B) + "#"
Dim ESC1 As String = Chr(&H1B) + "a" + Chr(1)
Dim ESC4 As String = Chr(&H1B) + "a" + Chr(2)
Dim ESC5 As String = Chr(&H1B) + "!" + Chr(17)
Dim ESC6 As String = Chr(&H1B) + "!" + Chr(1)
Dim ESC7 As String = Chr(&H1B) + "t%"
Dim ESC8 As String = Chr(&H1B) + "?0"
Dim ESC9 As String = Chr(&H1B) + "R" + Chr(17)
displayString = vbNewLine
displayString += ESC7 + "معطار" + ESC8 + vbNewLine
displayString += vbNewLine
Dim pd As New PrintDialog()
pd.PrinterSettings = New PrinterSettings()
pd.UseEXDialog = True
Call DefaultPrinterName()
RawPrinterHelper.SendStringToPrinter(DefaultPrinterName, displayString)
Catch ex As Exception
MsgBox(ex.ToString())
End Try
End Sub
i have alredy tried to convert it to windows-1256, and also tried using many esc pos commands
I checked .7z website FAQ and other related website for my issue. But didn't find best solution for this issue.
When .7z filename has no space then my cmd is running perfectecly for Unzip. But when zip foldername contain space then its not working.
Dim args As String = "e " + """" + zipFileFolder + """" + " -o" + ToFolder + "" + " -p""Password123""" + " -aoa"
example: Zip file name:
3344-2633-9058-4583_37DB40L1KLJU_15_07_2017__18_40_39_FSserviceLog.7z
then it is running perfectly but for this file name:
6530-0567-9050-2878
AVsetting_WD-WXS1A176FF0E_15_05_2017__17_57_37-F6serviceLog.7z
where space is there between 2878 and AVsetting, then my cmd is not working. Please guild me for this.
Please check following code:
Function extract7z(zipFileFolder As String, ToFolder As String)
Try
Dim args As String = "e " & """" & zipFileFolder & """" & " -o" & ToFolder & "" & " -p""cyberspa123""" & " -aoa"
Dim p As New Process
Dim pInfo As New ProcessStartInfo
pInfo.FileName = exePath
pInfo.Arguments = args
pInfo.WindowStyle = ProcessWindowStyle.Hidden
p.StartInfo = pInfo
p.Start()
p.WaitForExit()
' System.Diagnostics.Process.Start(exePath, args)
'Threading.Thread.Sleep(1000)
' System.IO.File.Delete(zipFileFolder)
For Each foundFile As String In My.Computer.FileSystem.GetFiles(ToFolder)
Dim check As String = System.IO.Path.GetExtension(foundFile)
If (check = ".7z") Then
Dim zipFolderpath1 As String = System.IO.Path.GetFullPath(ToFolder & "/" & System.IO.Path.GetFileNameWithoutExtension(foundFile))
extract7z(foundFile, zipFolderpath1)
End If
Next
Catch ex As Exception
Console.WriteLine(ex.Message.ToString)
MessageBox.Show(ex.Message.ToString)
End Try
End Function
I repurposed the code on MicrosoftPowerpointConverter - MoinMoin to work without the Microsoft Scripting Runtime.
I was able to generate a new file and export text to it, (I know that's the easy part), where I am getting stuck is in two places:
Formatting bullets:
Original code
' Check for bullets
If aShape.TextFrame.TextRange.ParagraphFormat.Bullet = msoTrue Then
outText = Replace(outText, Chr(10), " * ")
End If
My code
' Check for bullets
If oShape.TextFrame.TextRange.ParagraphFormat.Bullet.Type <> ppBulletNone Then
outText = Replace(outText, Chr(10), " * ")
End If
This doesn't work at all, and it totally ignores bullet formatting, but still outputs the content without the *
Exporting images:
Original Code
' Is it a picture or embedded object
If aShape.Type = msoPicture Or aShape.Type = msoEmbeddedOLEObject Or aShape.Type = msoLinkedPicture Or aShape.Type = msoGroup Then
aShape.Export outPath + "\image" + Trim(Str(i)) + Trim(Str(j)) + ".png", ppShapeFormatPNG
oFileStream.WriteLine (Chr(13) + "attachment:image" + Trim(Str(i)) + Trim(Str(j)) + ".png" + Chr(13))
End If
My code
' Is it a picture or embedded object
If oShape.Type = msoPicture Or oShape.Type = msoEmbeddedOLEObject Or oShape.Type = msoLinkedPicture Or oShape.Type = msoGroup Then
Dim imagepath
imagepath = oPres.Path & "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png"
oShape.Export imagepath, ppShapeFormatPNG
Print #iFile, (Chr(13) + "<img src=" + Chr(34) + "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png" + Chr(34) + ">" + Chr(13))
End If
This code throws up the following error in windows, and is totally ignored in Mac
Adding my complete code below:
Sub ExportToWiki()
' Iterators
Dim i As Integer
Dim j As Integer
' Pres, Slide, Shape
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSlide As Slide 'Slide Object
Dim oShp As Shape 'Shape Object
Dim iFile As Integer 'File handle for output
iFile = FreeFile 'Get a free file number
Dim PathSep As String
Dim FileNum As Integer
Set oPres = ActivePresentation
Set oSlides = oPres.Slides
FileNum = FreeFile
'Open output file
' NOTE: errors here if file hasn't been saved
Open oPres.Path & "/text.xml" For Output As FileNum
' File Handling
Dim outText As String
' Table exports
Dim row As Integer
Dim col As Integer
Dim cellText As String
' Select my ppt
' Write TOC
Print #iFile, ("[[TableOfContents]]")
' Loop through slides
For i = 1 To oPres.Slides.Count
Set oSlide = oPres.Slides(i)
' Loop through shapes
For j = 1 To oSlide.Shapes.Count
Set oShape = oSlide.Shapes(j)
' Is it a text frame?
If oShape.HasTextFrame Then
If oShape.TextFrame.HasText Then
outText = oShape.TextFrame.TextRange.Text
' Check for bullets
If oShape.TextFrame.TextRange.ParagraphFormat.Bullet.Type <> ppBulletNone Then
outText = Replace(outText, Chr(10), " * ")
End If
If j = 1 Then ' Assume first text is always the header
outText = "= " + outText + " ="
End If
Print #iFile, (outText + Chr(13) + "[[BR]]" + Chr(13))
End If
End If
' Is it a table?
If oShape.Type = msoTable Then
cellText = ""
For row = 1 To oShape.Table.Rows.Count
For col = 1 To oShape.Table.Columns.Count
If row = 1 Then
cellText = cellText + "||<class=" + Chr(34) + "tableheader" + Chr(34) + ">" + oShape.Table.Columns.Item(col).Cells(row).Shape.TextFrame.TextRange.Text
Else
cellText = cellText + "||" + oShape.Table.Columns.Item(col).Cells(row).Shape.TextFrame.TextRange.Text
End If
If col = oShape.Table.Columns.Count Then
cellText = cellText + "||" + Chr(13)
End If
Next col
Next row
Print #iFile, (Chr(13) + cellText + Chr(13))
End If
' Is it a picture or embedded object
If oShape.Type = msoPicture Or oShape.Type = msoEmbeddedOLEObject Or oShape.Type = msoLinkedPicture Or oShape.Type = msoGroup Then
Dim imagepath
imagepath = oPres.Path & "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png"
oShape.Export imagepath, ppShapeFormatPNG
Print #iFile, (Chr(13) + "<img src=" + Chr(34) + "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png" + Chr(34) + ">" + Chr(13))
End If
Next j
Next i
Close #iFile
End Sub
For the first part, I think you probably need to recursively check each paragraph within the TextRange as bullets can be set for the whole text range or specific paragraphs within it and if there is a mix, you'll get unexpected results. I also don't see why the replacement is being made for Char 10. I think you should be returning the text for the paragraphs where a bullet is found and prefixing it with your Wiki string. For example:
' Check for bullets
Dim p As Long
Dim para As String
With oShape.TextFrame.TextRange
For p = 1 To .Paragraphs.Count
If .Paragraphs(p).ParagraphFormat.Bullet.Type <> ppBulletNone Then
para = " * " & .Paragraphs(p).Text
Else
para = .Paragraphs(p).Text
End If
outText = outText & para
Next
End With
For the second point, I got the same error because the images sub folder didn't exist. Once I created it manually, the code ran on PC. For Mac, you'll need to use POSIX or AppleScript path syntax if I recall correctly, for example:
#If Mac Then
Public Const PathSeparator = ":"
#Else
Public Const PathSeparator = "\"
#End If
However, if you're using PowerPoint:mac 2016 then things are more complicated due to its sandboxed environment. Check this article for more info:
http://www.rondebruin.nl/mac/mac034.htm
I am trying to remove the blank lines at the end of a text file. The program takes a file, manipulates it and produces another file. However, there's blank lines at the end of the file that I need to get rid of...
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
' Save to desktop if nothing is selected
If txtDestLoc.Text = "" Then
txtDestLoc.Text = "C:\Documents and Settings\" & LCase(Environment.UserName) & "\desktop"
End If
If txtFileLoc.Text <> "" Then
Dim fsr As New FileStream(txtFileLoc.Text, FileMode.Open)
Dim sr As New StreamReader(fsr)
Dim sb As New System.Text.StringBuilder
'Dim strHeader As String
' Get just file name
Dim strFileName = Me.OpenFileDialog1.FileName()
Dim fnPeices() As String = strFileName.Split("\")
Dim fileName As String = ""
fileName = "CCCPositivePay.txt"
Dim strOutFile As String = txtDestLoc.Text & "\" & fileName
Dim fsw As New FileStream(strOutFile, FileMode.Create, FileAccess.Write)
Dim w As New StreamWriter(fsw)
Dim i As Double
Dim srRow As String
Dim strW As String
Dim strDate As String
Dim strAmt As String
Dim strChNo As String
Dim strName As String
Dim strAddInfo As String
Dim strCustAcct As String
Dim totamt As Double = 0
Dim strAcct As String = "2000002297330"
strLoc = txtDestLoc.Text()
srRow = ""
Do While sr.Peek() <> -1
srRow = srRow.ToString & sr.ReadLine()
If srRow.Length = 133 Then
If srRow.Substring(131, 2) = "CR" Then
strCustAcct = srRow.Substring(2, 18).Replace("-", "")
strName = srRow.Substring(23, 35)
strAddInfo = srRow.Substring(23, 30)
strDate = srRow.Substring(103, 4) + srRow.Substring(97, 2) + srRow.Substring(100, 2)
strChNo = srRow.Substring(110, 10)
strAmt = strip(srRow.Substring(121, 10))
strW = strAcct + strChNo.Trim.PadLeft(10, "0") + strAmt.Trim.PadLeft(10, "0") + strDate + " " + strAddInfo + Space(8) + strName + Space(20)
sb.AppendLine(strW)
totamt = totamt + CDbl(strAmt)
i = i + 1
End If
End If
srRow = ("")
Loop
'w.WriteLine(strHeader)
w.WriteLine(sb.ToString)
Dim file As String = txtFileLoc.Text
Dim path As String = txtFileLoc.Text.Substring(0, File.lastindexof("\"))
Dim strFileProcessed As String
strFileProcessed = fnPeices(fnPeices.Length - 1)
Label1.Text = "Refund File Processed: " & strFileProcessed
Label2.Text = "File saved to: " & strOutFile
' Close everything
w.Close()
sr.Close()
fsw.Close()
fsr.Close()
' Move file after processing
System.IO.File.Move(file, path + "\CB008_Processed\" + Now.ToString("MMddyyyyHHmm") + strFileProcessed)
' Put a copy of the results in "Processed" folder
System.IO.File.Copy(strOutFile, path + "\CB008_Processed\" + Now.ToString("MMddyyyyHHmm") + fileName)
Else
MessageBox.Show("Please select a Refund file to process.", "CCC Refund File", MessageBoxButtons.OK)
End If
End Sub
Public Function strip(ByVal des As String)
Dim strorigFileName As String
Dim intCounter As Integer
Dim arrSpecialChar() As String = {".", ",", "<", ">", ":", "?", """", "/", "{", "[", "}", "]", "`", "~", "!", "#", "#", "$", "%", "^", "&", "*", "(", ")", "_", "-", "+", "=", "|", " ", "\"}
strorigFileName = des
intCounter = 0
Dim i As Integer
For i = 0 To arrSpecialChar.Length - 1
Do Until intCounter = 29
des = Replace(strorigFileName, arrSpecialChar(i), "")
intCounter = intCounter + 1
strorigFileName = des
Loop
intCounter = 0
Next
Return strorigFileName
End Function
Only do a Writeline if Not String.IsNullOrEmpty(sb)
When I load images using openfiledialog I need to store a backup copy of the images to the other folder using the same filename and with the same extension.So how do i do that as in the below mentioned code I am able to copy only one image and I have given random string for that image.But I don't need that.I want to copy with the same filename and with the same extension.And if I have the same filename it should overwrite it but not with a different name and extension.
Any help will be greatly appreciated.
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
OpenFileDialog1.Multiselect = True
Dim r As New Random()
Dim i As Integer
Dim strTemp As String = ""
For i = 0 To 8
strTemp = strTemp & Chr(CInt(Int((26 * r.NextDouble()) + 65)))
Next
Dim str As String
For Each str In OpenFileDialog1.FileNames
System.IO.File.Copy(str, Application.StartupPath + "\DownloadedImages\" & "strTemp.jpg", True)
Next
End If
And I achieved it but there is one problem I am able to copy one image can you say me how to do it for multiple images.And here is the code:
Dim fso As New FileSystemObject
Dim str As String
str = OpenFileDialog1.FileName
MyExtension = fso.GetExtensionName(str)
For i = 0 To OpenFileDialog1.FileNames.Length - 1
System.IO.File.Copy(OpenFileDialog1.FileNames(i), Application.StartupPath + "\DownloadedImages\" + strTemp & "." & MyExtension, True)
Next
This line:
System.IO.File.Copy(str, Application.StartupPath + "\DownloadedImages\" & "strTemp.jpg", True)
Should read:
System.IO.File.Copy(str, Application.StartupPath + "\DownloadedImages\" & strTemp & ".jpg", True)
You should use the Path class. It has methods for getting files names with or without extension as well getting the extension only.
Also, strTemp should not be in quotes as this will be the literal string "strTemp" not the value in the variable strTemp
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim str As String
For Each str In OpenFileDialog1.FileNames
Dim fso As New FileSystemObject
Dim MyName As String
Dim MyExtension As String
MyName = fso.GetFileName(CStr(str))
MyExtension = fso.GetExtensionName(MyName)
System.IO.File.Copy(str, Application.StartupPath + "\Backup\" + MyName & "." & MyExtension, True)
CheckedListBox1.Items.Add(str, CheckState.Checked)
Thumbcontrol1.AddThumbnail(str)
Thumbcontrol1.BackgroundImage = Nothing
CheckedListBox1.SelectedIndex = 0
Next