Søg
Avatar billede sjh Nybegynder
19. oktober 2000 - 21:14 Der er 26 kommentarer og
1 løsning

HTMLFormating

Er der en ekspert der kan hjælpe mig med HTMLFormating, mit script virker (Fint) men når jeg har lavet 50-60 linjer og vil indtaste eks: i linje 25 springer den ned i bunden af skrivefæltet hvor ungår jeg det.


Dim color
Private Sub main_Click()
    Dim s As String
    s = LCase(RichTextBox1.Text)
    color = &HFF0000
Call Replace(s, \"<html>\")
Call Replace(s, \"</html>\")
Call Replace(s, \"<br>\")
Call Replace(s, \"</br>\")
Call Replace(s, \"<i>\")
Call Replace(s, \"</i>\")
Call Replace(s, \"<u>\")
Call Replace(s, \"</u>\")
Call Replace(s, \"<b>\")
Call Replace(s, \"</b>\")
Call Replace(s, \"<center>\")
Call Replace(s, \"</center>\")
Call Replace(s, \"/\")
Call Replace(s, \"<head>\")
Call Replace(s, \"</head>\")
Call Replace(s, \"<body>\")
Call Replace(s, \"</body>\")
Call Replace(s, \"<a href=\")
Call Replace(s, \"</a>\")
    color = &HC0&
Call Replace(s, \"<title>\")
Call Replace(s, \"</title>\")
Call Replace(s, \"<a href\")
Call Replace(s, \"</a>\")
Call Replace(s, \"color\")
Call Replace(s, \"font\")
Call Replace(s, \"width\")
Call Replace(s, \"height\")
Call Replace(s, \"img\")
Call Replace(s, \"=\")
End Sub

Sub Replace(sSource As String, ByVal sSearch As String)
    Call ReplaceAux(1, sSource, sSearch)
End Sub

Sub ReplaceAux(lPos As Long, sSource As String, ByVal sSearch As String)
    lPos = InStr(lPos, sSource, sSearch)
    If lPos <> 0 Then
        Call ChangeFormat(lPos, Len(sSearch))
        lPos = lPos + 1
        Call ReplaceAux(lPos, sSource, sSearch)
    End If
End Sub

Sub ChangeFormat(ByVal lPos As Long, ByVal lLength As Long)
    RichTextBox1.SelStart = lPos - 1
    RichTextBox1.SelLength = lLength
    RichTextBox1.SelColor = color
End Sub

Private Sub RichTextBox2_Change()
Dim A

RichTextBox1.TextRTF = RichTextBox2.TextRTF
A = RichTextBox2.SelStart
RichTextBox1.SelStart = 0
RichTextBox1.SelLength = Len(RichTextBox1)
RichTextBox1.SelColor = &H0&

Call main_Click

RichTextBox2.TextRTF = RichTextBox1.TextRTF
RichTextBox2.SelStart = A
RichTextBox2.SelColor = &H0&
End Sub
Avatar billede powell Nybegynder
20. oktober 2000 - 09:14 #1
Jeg forstår dit problem sådan at du har to Richtextboxe, editerer du i midten af en text i den ene, havner den i slutningen af den anden box? Er det korekt.
Avatar billede sjh Nybegynder
20. oktober 2000 - 15:10 #2
Ja det er korekt, kan ud klare den eller har ud et script der funker. ;)
Avatar billede vbghost Nybegynder
20. oktober 2000 - 22:02 #3
ja har en bedre script til \"farvning\" af syntax. hvis du vil atltså bruge den?
Avatar billede vbghost Nybegynder
20. oktober 2000 - 22:07 #4
scripten bruger ikke to RT boxe
Avatar billede sjh Nybegynder
21. oktober 2000 - 02:20 #5
Kan det lave <html></html> osv... om til en anden farve og virker det også med mange linjer så kan vi nok finde ud af det. ;)
Avatar billede sjh Nybegynder
22. oktober 2000 - 23:16 #6
vbghost: Kan du ikke finde det script. ;)
Avatar billede powell Nybegynder
23. oktober 2000 - 08:04 #7
Den smarte: Du mangler en form for \"linjetæller\", så den altid ved hvor den skal sætte ændringerne ind, hvis den ikke ved hvor ændringerne skal være bliver de tilført til sidst.

Den langsomme: At du opdaterer hele boksen igen. Så du starter med at slette den richbox som har oversat koden for dig. og fylder den med den nye kode.
Avatar billede sjh Nybegynder
23. oktober 2000 - 12:37 #8
powell:
(1) Hvordan laver jeg en \"linjetæller\"
(2) \"starter med at slette den richbox som har oversat...\" hvad mener du med det?
Avatar billede powell Nybegynder
23. oktober 2000 - 12:58 #9
sjh -> Gider du at skrive kort, hvordan dit program det virker. Mit hoved er muligvis ikke skruet rigtigt på idag....
Avatar billede sjh Nybegynder
23. oktober 2000 - 18:44 #10
powell:

RichTextBox 2 stk

RichTextBox1: bruges til oversætte er nomal \".Visible = False\" (Finder alt HTML og giver det den teksten farve)

RichTextBox2: bruges til at skrive rediger i, når der skrives kaller den \"Call main_Click\"

sådan funker det, jeg håber du forstår. ;)
Avatar billede vbghost Nybegynder
23. oktober 2000 - 22:51 #11
sjh: WinME har lige \"slettet\" alle mine partioner.
Så jeg har ca. 2 dage fixet det op igen... med Powerquest Lost and Found !!! (cool stuff)...

Jeg har lige en stor rodemappe (et drev), og jeg har svært ved at finde rundt i den (det er ca. 4 partioner der er sat i rodedrevet, så jeg skal lige finde ud af det med farver...) det bliver nok til i morgen, siden jeg har noget andet at lave...

denne script kan: finde <> og </> og farve dem... ;)
Avatar billede sjh Nybegynder
24. oktober 2000 - 02:53 #12
vbghost: Jeg håber du kan rede dine filer, det er jo ikke så sjovt at midste dem, det kenner jeg fra mig selv. :(
Avatar billede vbghost Nybegynder
25. oktober 2000 - 22:17 #13
Drop mig ud af det: WinMe har gået totalt amok... kan ikke finde hardisken igen???

så... du må vente
Avatar billede sjh Nybegynder
25. oktober 2000 - 22:48 #14
vbghost: Det går nok.
Det haster ikke med mig, jeg håber du kan rede dine filer/harddisk
Avatar billede powell Nybegynder
26. oktober 2000 - 08:45 #15
Jeg arbejder på sagen ;)
Avatar billede sjh Nybegynder
26. oktober 2000 - 20:35 #16
powell: det lyder godt. ;)
Avatar billede sjh Nybegynder
26. oktober 2000 - 21:20 #17
Jeg har fået lavet et nyt script som jeg synes virker beder, hvor den ikke springer ned i bunden af skrivefæltet, det var RichTextBox1.Visible = False og True der skulle til, og så bruger det kun en RichTextBox.

Men, som powell skræv \"Den langsomme: At du opdaterer hele boksen igen\"


\'----------- NytScript -----------
Dim TextColor
Dim HtmlColor
Dim GåseColor

Private Sub OpdaterHtmlTag_Click()
    With RichTextBox1
    Getselstart = .SelStart
    .Visible = False
\'------------------------------ TextColor ------------------------------
    .SelStart = 0: .SelLength = Len(.Text): .SelColor = TextColor: .SelBold = 0
\'------------------------------ TextColor ------------------------------

    tag_closeA = 1: tag_closeB = 1
    Do
\'------------------------------ HtmlColor ------------------------------
        tag_openA = InStr(tag_closeA, .Text, \"<\")
        If tag_openA = 0 Then Exit Do
        tag_closeA = InStr(tag_openA, .Text, \">\")
        If tag_openA = 0 Then tag_closeA = 0

        .SelStart = tag_openA - 1
        .SelLength = tag_closeA - tag_openA + 1
        .SelColor = HtmlColor
        .SelBold = 1
    Loop
\'------------------------------ HtmlColor ------------------------------
    Do
\'------------------------------ GåseColor ------------------------------
        tag_openB = InStr(tag_closeB, .Text, \"=\" & Chr(34))
        If tag_openB = 0 Then Exit Do
        tag_closeB = InStr(tag_openB + 2, .Text, Chr(34))
        If tag_openB = 0 Then tag_closeB = 0

        .SelStart = tag_openB
        .SelLength = tag_closeB - tag_openB
        .SelColor = GåseColor:
        .SelBold = 0
    Loop
\'------------------------------ GåseColor ------------------------------
    .Visible = True
    .SelStart = Getselstart
    .SetFocus
End With
End Sub
Private Sub Form_Load()
TextColor = 0
HtmlColor = &H800000
GåseColor = &HC00000
End Sub


Hvis man kunne lave et søge script som søger tilbage fra SelStart til den første \"<html tag>\" og opdater den stump når man trykker en tast ville det nok værer Nummer 1.
Avatar billede powell Nybegynder
27. oktober 2000 - 12:11 #18
Jeg håber jeg for tid til at kaste et blik på det, arbejder hårdt for tiden...

Det er præcis tællerdelen jeg kikker på, det er den sjoveste løsning.
Avatar billede sjh Nybegynder
27. oktober 2000 - 21:27 #19
Her tæller den linjer, men hvordan man for markøren til at stå i en bestemt linje???


\'--- (999999) er max linjetæller *2 (hvis der står (10) vil den kun tælle 5 linje) ---
Private Sub RichTextBox1_Change()
Text1.Text = RichTextBox1.GetLineFromChar(999999)
End Sub
Avatar billede sjh Nybegynder
27. oktober 2000 - 23:38 #20
powell: Jeg fant en tæller i melem mine script, den kan hjælpe dig og mig med at komme vider.

Script:

\'--- Intast i Form ---
\' (1) TextBox
\' (1) RichTextBox
\'---------------------

Private Sub RichTextBox1_Click()
Call LinePos(RichTextBox1, Text1)
End Sub

Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
Call LinePos(RichTextBox1, Text1)
End Sub

Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
Call LinePos(RichTextBox1, Text1)
End Sub
\'--- Intast i Form ---




\'--- Intast i Module ---

Private Declare Function SendMessageLong Lib \"USER32\" Alias _
        \"SendMessageA\" (ByVal hWnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, lParam As Long) As Long

Private Declare Function SendMessageByRef Lib \"USER32\" Alias \"SendMessageA\" (ByVal hWnd As Long, ByVal wMsg As Long, wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageByLong Lib \"USER32\" Alias \"SendMessageA\" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETFIRSTVISIBLELINE = &HCE

Public Sub LinePos(rtf As RichTextBox, txt As TextBox)
Dim lLine As Long, lCol As Long
Dim cCol As Long, lChar As Long, I As Long

  lChar = rtf.SelStart + 1

  \'--- Line number ---
  lLine = 1 + SendMessageLong(rtf.hWnd, EM_LINEFROMCHAR, _
  rtf.SelStart, 0&)

  \'--- Position --
  cCol = SendMessageLong(rtf.hWnd, EM_LINELENGTH, lChar - 1, 0&)
  I = SendMessageLong(rtf.hWnd, EM_LINEINDEX, lLine - 1, 0&)
  lCol = lChar - I
 
  \'--- TextBox ---
  txt = \"Line: \" & lLine & \", Col: \" & lCol
End Sub

\'--- Intast i Module ---



Håber det kan hjælpe. ;)
Avatar billede sjh Nybegynder
28. oktober 2000 - 02:02 #21
Har lavet om på Modulet:

\'--- Intast i Module ---

Private Declare Function SendMessageLong Lib \"USER32\" Alias _
        \"SendMessageA\" (ByVal hWnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, lParam As Long) As Long

Private Declare Function SendMessageByRef Lib \"USER32\" Alias \"SendMessageA\" (ByVal hWnd As Long, ByVal wMsg As Long, wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageByLong Lib \"USER32\" Alias \"SendMessageA\" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETFIRSTVISIBLELINE = &HCE

Public Sub LinePos(rtf As RichTextBox, LineNum, LineSel, LineEnd)
Dim lLine As Long, lSel As Long
Dim sSel As Long, lTotal As Long, I As Long

    lTotal = rtf.SelStart + 1

    \'--- Line number ---
    lLine = 1 + SendMessageLong(rtf.hWnd, EM_LINEFROMCHAR, rtf.SelStart, 0&)

    \'--- Position --
    sSel = SendMessageLong(rtf.hWnd, EM_LINELENGTH, lTotal - 1, 0&)
    I = SendMessageLong(rtf.hWnd, EM_LINEINDEX, lLine - 1, 0&)

    \'--- End Position --
    lEnd = SendMessageLong(rtf.hWnd, EM_LINELENGTH, -1, 0&)
    lSel = lTotal - I - 1

  \'--- Value Back ---
    LineNum = lLine: LineSel = lSel: LineEnd = lEnd
End Sub

\'--- Intast i Module ---





Bruges sådan i Form:

\'--- Intast i Form ---
\' (3) TextBox
\' (1) RichTextBox
\'---------------------
Dim LineNum
Dim LineSel
Dim LineEnd

Private Sub RichTextBox1_Click()
Call LinePos(RichTextBox1, LineNum, LineSel, LineEnd)

Text1 = LineNum
Text2 = LineSel
Text3 = LineEnd
End Sub
\'--- Intast i Form ---
Avatar billede sjh Nybegynder
01. november 2000 - 21:52 #22
powell:
du skræv at du arbejder på sagen.
sker der noget eller har du droppet det.

vbghost:
hvad med dig har du droppet det eller hvad.


ellers vile jeg lukke dette spørgsmål. :(
Avatar billede powell Nybegynder
02. november 2000 - 11:30 #23
JEg har blot ikke haft så meget tid, jeg har skam ikke droppet det...
Avatar billede powell Nybegynder
02. november 2000 - 11:31 #24
En anden løsning kunne være at du smed din email. Og lukkede dette spørgsmål, så hvis vbghost eller jeg havde et svar kunne vi maile det til dig, så kunne du altid derefter åbne et nyt spørgsmål!
Avatar billede powell Nybegynder
02. november 2000 - 14:35 #25
Nu har jeg \"leget\" lidt med forskellige modeler.
Der findes forskellige muligheder for at tælle sig frem til et bestemt punkt.

1. At man kaster alle linierne over i en database. (den nemme og forholdsvis hurtigt)
2. At man har en \"usynlig\" listefelt, som alle linierne kastes ned i. (den er en anelse sværere, men også en løsning)
3. At man sætter et tegn i slutningen af hver skrevet linje og derefter et nummer. (Dette er den dumme, men kald den også, jeg-gider-ikke-sætte-mig-ind-i-andre-løsninger-løsningen)
Avatar billede sjh Nybegynder
02. november 2000 - 23:28 #26
powell:
løsning 1. ikke så smat hvis den skal laves til OCXfil (ActiveX Control)

prøv at kaste et blik filen her:
http://hjem.get2net.dk/sjh/eksperten/eksperten.zip

Avatar billede sjh Nybegynder
22. november 2000 - 22:15 #27
<powell/vbghost/andre>
hvis i finder et svar på mit spørgsmål, åbne jeg det igen.
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Programmeringssprog kurser
Kurser inden for grundlæggende programmering
Se alle Programmeringssprog kurser

Flere spørgsmål fra Visual Basic kategorien

Titel Indlæg Oprettet Seneste aktivitet
Send mail fra "Outlook New" via VBA i excel Af lonmat i Visual Basic 5 29/08/202512:28 04/09/202515:48
Klik Event i MS Project Af per2edb i Visual Basic 0 05/08/202510:10 -
VBA koder lagt i MS project kolonner Af per2edb i Visual Basic 0 16/05/202512:31 -
Foto fra Word eller Excel Af MSchlamovitz i Visual Basic 1 22/04/202514:55 25/04/202511:21
Proxy server.. Af SommerFyr i Visual Basic 12 10/07/202417:34 12/07/202414:34
Se alle spørgsmål i kategorien Opret spørgsmål

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I går 21:00 Libre Office Impress Af Frank i Andre styresystemer
I går 11:47 VB script Af Jenshentze i Word
I går 11:21 Popup ved opstart Af mort1 i Windows
04/0918:50 Slet lokal konto Af ErikHg i Windows
04/0916:05 Ændre tal i en celle Af xvid i Excel
White papers
Flere white papers »