|
[ bradic @ 06.04.2005. 23:18 ] @
[ vujkev @ 06.04.2005. 23:33 ] @
Evo ga jedan mali predlog. Ne radi baš sjajno, ali možda posluži kao ideja
Code: Private Sub Text1_Change() If TextWidth(Text1) > Text1.Width Then Text2 = Text2 & Right$(Text1, 1) Text1 = Left$(Text1, Len(Text1) - 1) Text1.SelStart = Len(Text1) End If End Sub [ Marko_L @ 07.04.2005. 15:44 ] @
A koji je razlog takvog žongliranja sa textbox kontrolama ? Pošto sam primetio po ostalim tvojim temama, praviš nekakav text editor, tako da ako je ovo povezano sa tim, imaćeš problema kada budeš nešto menjao u text1 recimo, jer će ti se sve pobrljaviti.Mnogo je bolje rešenje koristiti jedan textbox, jer u njemu kada dođeš do kraja kontrole, automatski dobijaš horizontalni scroll, tako da nemaš problema sa pregledom i izmenama na tekstu, pa i sa snimanjem.Dva textbox-a je ok koristiti kada recimo hoćeš da napraviš komparaciju tekstualnih fajlova ili tako nešto.Zato i pitam šta pokušavaš napraviti, jer možda postoji bolje rešenje.
[ bradic @ 07.04.2005. 22:07 ] @
Uglavnom radim sa tekstom u QuarkExpressu.
E sad - treba da napravim neke sablone koji ce biti isti onima u QuarkExpressu (ne mogu bas isti, ali bar dosta slicni). Jedan od tih sablona se sastoji iz toga da imam tekst poravnat i levo i desno (Justified) i da mi se tekst prostire ne po visini nego po sirini u vise kolona, posto ce mi tekst u QuarkExpressu kad ga ucitam biti isto tako rasporedjen. Sve ovo sa sablonima radim iz razloga sto - svaki dan u Quarku ubacujem odredjene tekstove koji imaju isti sablon, ali ti ljudi (radi se o vecoj firmi) koji mi unose te tekstove nemaju predstavu o tome koliko mi tacno teksta treba (oni kucaju tekst tu Wordu), a pogotovo ne mogu da mi dobro pripreme tekst za Quark, tako da ja svaki dan gubim ogromno vreme skracujuci tekstove i dr..., sto vec u startu na ovaj nacin moze da se izbegne. Zato su me zainteresovale TextBox i RichEdit kontrola sa kojima pokusavam to da uradim. Znam da resavam problem i sa vec po defaultu datim vrednostima za ove dve kontrole, ali hteo sam da tim ljudima koji mi unose tekstove sto vernije prikazem kako to stvarno i meni u QuarkExpressu izgleda. [ Marko_L @ 08.04.2005. 05:30 ] @
Ok, evo okačio sam ti jednu kontrolu (RTF2.ocx) koja sigurno radi poravnanje i po levoj i po desnoj strani (isprobano).Kada ukucaš tekst stavi ovo, recimo u command button sa kojim ćeš da pozoveš poravnanje (naravno prvo selektuješ deo teksta koji hoćeš da bude poravnat)
Code: Private Sub Command1_Click() RTF21.SelAlignment = 4 End Sub Mislim da ne treba napomenuti da justify radi samo kod redova koji su kucani u kontinuitetu (ali ne i kod onih koji su prekidani enterom) E sad, ima još jedno rešenje, a to je da se text iz textbox-a prebaci u picturebox, pa da se tamo odradi char spacing, ali kako je to malo komplikovanije rešenje, probaj prvo ovo, pa ako ti ne odgovara, pokušaću da ti sastavim kod za picture box.U stvari već imam jedno polu-rešenje, koje treba malo prepraviti, no otom potom. [ bradic @ 09.04.2005. 20:50 ] @
Hvala ti, ova kontrola je OK. Radi poravnanje iz "prve".
Sad mi ostaju jos dve stvari da resim: 1. Kod poravnanja levo i desno (Justified) pojavljuju mi se negde veliki i nesrazmerni razmaci u redu. Kontrola bi trebala bar negde u paragrafu da podeli rec da ti razmaci ne bi ruzno izgledali. Tj. ne postoji nikakva deoba reci. 2. Prelazenje jednog istog teksta (npr: proba.txt) iz okvira u okvir. Ako to sa picture box sto pominjes moze da mi resi ovo pod 1. - posalji mi kod. [svejedno posalji, da nesto naucim :)] Ti si mi poslao vec dve Rich Text kontrole. Za prvu znam odakle potice a za ovu drugu ne znam. Kada bi mi rekao gde da je nadjem mozda bih tamo nasao i help za nju pa da pogledam malo - mozda isceprkam ovo sto mi treba. Hvala ti jos jednom, dosta si mi pomogao, ako naletis na resenja za 1. i 2. gore - javi. Pozdrav [ Marko_L @ 09.04.2005. 21:26 ] @
Što se tiče help-a za RTF2.ocx, možeš ga naći ovde online, mada nije kompletan, tako da ne znam koliko će ti pomoći.U svakom slučaju, ne škodi da pogledaš.
Što se tiče ovih nesrazmernih razmaka, teško da ćeš naći kontrolu koja to radi savršeno, a da nije papreno skupa (ako uopšte i može da se nađe). Ovo rešenje sa pictureboxom ću probati da odradim koliko večeras i da ga postujem ovde, mada odmah da ti kažem, da ni to neće biti potpuno savršeno.Za savršeno rešenje treba razviti dobar algoritam koji bi "umeo" da podeli reč kako treba, a da ona ne izgleda nakaradno, što zahteva dobro poznavanje pravopisa i dosta rada.U svakom slučaju, uradićemo nešto, pa ti vidi da li možeš to da iskoristiš.Možda uz malo eksperimentisanja i napraviš nešto što će ti biti upotrebljivo. [ Marko_L @ 09.04.2005. 22:13 ] @
Ovako.Na formu stavi jednu textbox kontrolu (Text1) i jednu picturebox kontrolu (Picture1), a zatim stavi ovo u modul.
Code: Option Explicit Public Enum qeFitPictureChar eNone eSpace eDash eLine eOops End Enum Private Type qtFitPictureLine sLine As String eEnd As qeFitPictureChar End Type Public Function TextToPicture(Picture As PictureBox, sString As String) As Boolean Dim tLine() As qtFitPictureLine Dim iLine As Integer, iCount As Integer, iFont As Integer Dim iSpace As Integer, iMarker As Integer Dim sSizeX As Single, sSizeY As Single Dim sHeight As Single, sWidth As Single, sArea As Single Dim sLineHeight As Single, sCharWidth As Single Dim sWord As String, sChar As String Dim eCharType As qeFitPictureChar Dim bNewLine As Boolean, bFound As Boolean Dim sOffsetX As Single, sOffsetY As Single Dim lForeColor As Long Dim sborder As Long sborder = 100 ' definise razmak od ivica iSpace = StringCount(sString, vbCrLf) With Picture If sborder * 2 > .ScaleWidth Then GoTo TextToPictureError End If If sborder * 2 > .ScaleHeight Then Stop End If sWidth = .ScaleWidth - sborder * 2 sHeight = .ScaleHeight - sborder * 2 Do iCount = 1 iLine = 1 ReDim tLine(1) sWord = "" Do Do eCharType = eNone sChar = Mid$(sString, iCount, 1) Select Case sChar Case " " eCharType = eSpace Case "-" sSizeX = .TextWidth(tLine(iLine).sLine & sWord & sChar) If sSizeX > sWidth Then eCharType = eOops Else eCharType = eDash End If Case vbLf sChar = "" eCharType = eLine Case vbCr If iCount < Len(sString) Then If Mid$(sString, iCount + 1, 1) = vbLf Then iCount = iCount + 1 End If End If sChar = "" eCharType = eLine Case Else sSizeX = .TextWidth(tLine(iLine).sLine & sWord & sChar) If sSizeX > sWidth Then eCharType = eOops Else sWord = sWord & sChar End If End Select iCount = iCount + 1 Loop While iCount <= Len(sString) And eCharType = eNone bNewLine = False Select Case eCharType Case qeFitPictureChar.eNone tLine(iLine).sLine = tLine(iLine).sLine & sWord tLine(iLine).eEnd = eLine Case qeFitPictureChar.eOops If tLine(iLine).eEnd = eNone Then tLine(iLine).sLine = sWord sWord = sChar Else tLine(iLine).sLine = Trim$(tLine(iLine).sLine) sWord = sWord & sChar End If bNewLine = True Case qeFitPictureChar.eDash, qeFitPictureChar.eSpace tLine(iLine).eEnd = eCharType tLine(iLine).sLine = tLine(iLine).sLine & sWord & sChar sWord = "" Case qeFitPictureChar.eLine tLine(iLine).sLine = tLine(iLine).sLine & sWord tLine(iLine).eEnd = eLine sWord = "" bNewLine = True End Select If bNewLine Then iLine = iLine + 1 ReDim Preserve tLine(iLine) End If Loop While iCount <= Len(sString) bFound = CBool(iLine * .TextHeight("X") > sHeight) If bFound Then iFont = iFont - 1 End If Loop While bFound iCount = 1 .CurrentY = sborder + sOffsetY Do .CurrentX = sborder + sOffsetX tLine(iCount).sLine = Trim(tLine(iCount).sLine) If tLine(iCount).eEnd <> eLine Then sCharWidth = .TextWidth(" ") iSpace = 0 iMarker = 0 Do iMarker = InStr(iMarker + 1, tLine(iCount).sLine, " ") If iMarker > 0 Then iSpace = iSpace + 1 End If Loop While iMarker > 0 sSizeX = sWidth - .TextWidth(tLine(iCount).sLine) bFound = False If iSpace > 0 Then If sSizeX \ iSpace > sCharWidth * 3 Then bFound = True End If Else bFound = True End If If bFound Then sSizeY = Len(tLine(iCount).sLine) - 1 + (iSpace * 2) sSizeY = sSizeX / sSizeY sSizeX = sSizeY * 3 Else sSizeX = sSizeX / iSpace sSizeY = 0 End If iMarker = 1 Do While iMarker <= Len(tLine(iCount).sLine) sChar = Mid$(tLine(iCount).sLine, iMarker, 1) sCharWidth = .CurrentX + .TextWidth(sChar) sLineHeight = .CurrentY Picture.Print sChar If sChar = " " Then sCharWidth = sCharWidth + sSizeX Else sCharWidth = sCharWidth + sSizeY End If .CurrentX = sCharWidth .CurrentY = sLineHeight iMarker = iMarker + 1 Loop Picture.Print "" Else Picture.Print tLine(iCount).sLine End If iCount = iCount + 1 Loop While iCount <= iLine End With TextToPicture = True Exit Function TextToPictureError: TextToPicture = False End Function Public Function StringCount(ByVal Expression As String, _ Item As String) As Integer Dim lPosition As Integer Dim lCount As Integer Do lPosition = InStr(lPosition + 1, Expression, Item) If lPosition > 0 Then lCount = lCount + 1 End If Loop While lPosition > 0 StringCount = lCount End Function Poravnanje pozivaš na sledeći način Code: Dim eGreska As Boolean eGreska = TextToPicture(Picture1, Text1.Text) If eGreska = False Then MsgBox "Doslo je do greske prilikom poravnanja" [ bradic @ 09.04.2005. 22:18 ] @
OK, evo i ja trazim nesto preko NET-a ali kao sto ti kazes - takva gotova resenja su jako skupa koliko vidim.
Nista, jedino mi preostaje da prionem na rad. Vidi ako mozes nesto da uradis, naravno, ako, i kada imas vremena. Inace, da znas - u QuarkExpress mozes da podelis rec koja ti je presla u sledeci red gde hoces sa kombinacijom dirki "CTRL" + "-", tako da mislim da taj algoritam za podelu reci i ne bi mozda morao da izgleda tako komplikovan. (samo razvijam mastu - izgleda jednostavno a mozda je jako komplikovano - vidi ako sam ti ovime dao neku ideju) P.S. Ovo je moj odgovor na tvoju pretposlednju poruku, posto vidim da si mi u medjuvremenu poslao kod. [ Marko_L @ 09.04.2005. 22:36 ] @
Citat: tako da mislim da taj algoritam za podelu reci i ne bi mozda morao da izgleda tako komplikovan. (samo razvijam mastu - izgleda jednostavno a mozda je jako komplikovano - vidi ako sam ti ovime dao neku ideju) Nisam ni rekao da je previše komplikovano, već da treba dosta rada i treba dobro da se osmisli cela ta procedura.E sad, ja lično se nisam mnogo bavio izradom text editora i sličnih stvari, tako da sve ovo što sam ti napisao su samo ideje kako nešto može da se odradi, ali ne i gotova rešenja.Uostalom, svrha ovog foruma i nije da daje gotova rešenja, već da pomogne korisnicima da oni sami nešto urade.Tako da, sad imaš neke smernice, a čini mi se da je ova tvoja ideja sa CTRL + "-" sasvim okej, pa možeš pokušati da uradiš nešto sa tim.Ako negde zapneš, javi se i pomoći ćemo ti koliko je u našoj moći. Copyright (C) 2001-2025 by www.elitesecurity.org. All rights reserved.
|