|
Troška ma mrzí, že som z mladickej nerozvážnosti zverejnil kód v stave ako je uvedený vyššie, preto uverňujem tento kód upravený a viac menej funkčný. Moderátorov prosím o zmazanie predchádzajúceho príspevku, kedže ja túto možnosť nemám. Príjemný večer
Imports System.Runtime.InteropServices
Public Class Form1
Dim RtfText, pismeno, medzerySirkyObrazka, medzeryDoMedzery As String
Dim F As Integer = FreeFile()
Dim pbx As New PictureBox
Dim charIndex, charIndex2, i, j As Integer
Dim obr() As Object
Dim pt As Point = (pbx.Location)
Dim prvaPolohaPbx As Integer
Dim sirkaObrazka, vyskaPismena, pocetRiadkov As Integer
Dim VScrollPosition As Integer
'udaje potrebne pre funkcnost RichTextBox1_VScroll
Private Const SBS_VERT = 1
<DllImport("User32.dll")> Public Shared Function GetScrollPos(ByVal hWnd As IntPtr, ByVal nBar As Integer) As Integer
End Function
'ulozi skopirovaný text z RTB do suboru - nemusi sa ukladat ani nacitavat staci skopirovat do RTB
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Me.RtfText = Me.RichTextBox1.Rtf
FileOpen(F, "c:\RtfText.txt", OpenMode.Binary)
FilePutObject(F, RtfText)
FileClose(F)
End Sub
'nacita text zo súboru
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
FileOpen(F, "c:\RtfText.txt", OpenMode.Binary)
FileGetObject(F, RtfText)
Me.RichTextBox1.Rtf = RtfText
FileClose(F)
End Sub
'Vlozi obrazok na poziciu kurzoru v texte
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
pbx.Image = Image.FromFile("c:\ruza.jpg")
pbx.Height = 140
pbx.Width = 50
pbx.Location = Me.RichTextBox1.GetPositionFromCharIndex(Me.RichTextBox1.SelectionStart)
pbx.SizeMode = PictureBoxSizeMode.CenterImage
Me.RichTextBox1.Controls.Add(pbx)
'toto mi dalo zabrat
Me.prvaPolohaPbx = Me.pbx.Top + VScrollPosition
End Sub
'pohybuje obrazkom v RTB
Private Sub RichTextBox1_VScroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RichTextBox1.VScroll
VScrollPosition = GetScrollPos(RichTextBox1.Handle, SBS_VERT)
pbx.Top = -VScrollPosition + Me.prvaPolohaPbx
End Sub
'toto bude riaditel nerobi nic pouzival somh na zobrazenie zobrazenie pozicii
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
'pt = Me.pbx.Location
'pt.X = pt.X
'pt.Y = pt.Y + pbx.Height + Me.RichTextBox1.Font.Height - 13
'charIndex = RichTextBox1.GetCharIndexFromPosition(pt)
'Me.Label1.Text = Me.Top
End Sub
' samotne obtekanie
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
' pozicia laveho horneho rohu obrazka
pt = Me.pbx.Location
' poradie pismena v texte na uvedenej pozicii
charIndex = RichTextBox1.GetCharIndexFromPosition(pt)
pt.X = pt.X + pbx.Width
charindex2 = RichTextBox1.GetCharIndexFromPosition(pt)
'zisti sirku obrazka v pismenach
Me.sirkaObrazka = charIndex2 - charIndex
For i = 0 To Me.sirkaObrazka
Me.medzerySirkyObrazka = Me.medzerySirkyObrazka & " "
Next
Me.RichTextBox1.Select(charIndex, 0)
'zisti pocet riadkov
vyskaPismena = Me.RichTextBox1.SelectionFont.Height
pocetRiadkov = Int(pbx.Height / vyskaPismena) + 1
' pozicia laveho horneho rohu obrazka odkial zacneme vkladat medzery
pt = Me.pbx.Location
For j = 0 To pocetRiadkov - 1
pt.Y = pt.Y + Math.Sign(j) * vyskaPismena
charIndex = RichTextBox1.GetCharIndexFromPosition(pt)
Me.RichTextBox1.Select(charIndex, 0)
'spocita pocet pismen do medzery vlavo od obrazka
Do While pismeno <> " " '
Me.RichTextBox1.Select(Me.RichTextBox1.SelectionStart - 1, 1)
pismeno = Me.RichTextBox1.SelectedText
Me.medzeryDoMedzery = Me.medzeryDoMedzery & " "
i += 1
Loop
Me.RichTextBox1.SelectedText = Me.medzerySirkyObrazka & Me.medzeryDoMedzery
Me.medzeryDoMedzery = " "
pismeno = "a" ' aby nepreskocil vyhladavanie medzery v dalsom riadku
Next
End Sub
End Class
Za prípadné pripomienky a návrhy budem vďačný. Napríklad ako vlo žiť ďalší obrázok. Radšej by som bol, keby to bol funkčný kód ako návrhy ako by som to mal urobiť
|