- Katılım
- 31 Aralık 2005
- Mesajlar
- 4,344
- Excel Vers. ve Dili
- Office 365 (64 bit) - Türkçe
Bu program ile bir resmi Excel hücrelerine çevirebilirsiniz.
Kaynak Kod:
Kaynak Kod:
Kod:
[SIZE=2]Imports System.Threading
Public Class Form1
Private bmp As Bitmap, th As Thread
Private Sub BtnBrowse_Click(sender As Object, e As EventArgs) Handles BtnBrowse.Click
Dim dlg As New OpenFileDialog With {
.Filter = "Jpg|*.jpg;*.jpeg|Bmp|*.bmp|Gif|*.gif|Icon|*ico",
.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
}
Dim res As DialogResult = dlg.ShowDialog()
If res = DialogResult.Cancel Then Exit Sub
bmp = New Bitmap(dlg.FileName)
Me.PictureBox1.Image = bmp
End Sub
Private Sub BtnAction_Click(sender As Object, e As EventArgs) Handles BtnAction.Click
[COLOR=darkgreen] 'Asenkron ve en yüksek CPU önceliği (hız için) prosedur çağırma...[/COLOR]
th = New Thread(AddressOf PicToXL) With {.Priority = ThreadPriority.Highest}
th.Start()
End Sub
Private Sub BtnStop_Click(sender As Object, e As EventArgs) Handles BtnStop.Click
th.Abort()
ResetPrgBar()
End Sub
Private Sub ResetPrgBar()
PrgBar.Value = 0
End Sub
Private Sub PicToXL()
Dim xl = CreateObject("Excel.Application")
Dim wb As Object = xl.WorkBooks.Add
Dim sh As Object = wb.WorkSheets(1)
xl.Windows(1).Zoom = 30
sh.Cells.ColumnWidth = 0.27[COLOR=darkgreen] '0,1 cm[/COLOR]
sh.Cells.RowHeight = 2.25[COLOR=darkgreen] '0,1 cm[/COLOR]
xl.Visible = True
xl.EnableEvents = False
xl.Calculation = -4135 [COLOR=DarkGreen]'manuel[/COLOR]
Dim pixColor As Color, i As Integer = 0
PrgBar.Maximum = bmp.Width * bmp.Width
For y As Integer = 0 To bmp.Height - 1
For x = 0 To bmp.Width - 1
pixColor = bmp.GetPixel(x, y)
sh.Cells(y + 1, x + 1).Interior.Color = RGB(pixColor.R, pixColor.G, pixColor.B)
i += 1
PrgBar.Value = i
Next
Next
PrgBar.Value = 0
MsgBox("İşlem tamamlandı.", MsgBoxStyle.Information, "Zeki GÜRSOY")
End Sub
End Class
[/SIZE]
Ekli dosyalar
-
17.9 KB Görüntüleme: 50
-
38.6 KB Görüntüleme: 57