Page 1 of 1
FakeProcedure for Multiline Note
Posted: Wed Mar 26, 2014 10:39 pm
by Lubos
Maybe not so advanced, but quite handy.
Code: Select all
;=================FakeProcedure for Multiline Note==================
;PB 5.22
; Rewritten version - 23.04.2014/2
; Lubos Svoboda. 2014
; Free for using and improving
;Parameters:
;x, y: coordinates of procedure window
;H = height W=width
;Tx$=text of note
; This procedure is a little fake, because it cannot be used for two (or more) notes in one Window. :(
; However, I hope that that one Note for one Window is enough.
Procedure TinyNote(x,y, W, H,Tx$)
FF1= LoadFont(0, "Times New Roman", 11)
If CreateImage(4, W, H,32,RGB(255,255,255)) And StartDrawing(ImageOutput(4))
NewList Noteline.s()
DrawingFont(FF1)
BackColor(RGB(255,255,255))
;Colors for choice - Barva je globální proměnná
If Barva=1
FrontColor(RGB(0,0,0)) ; black
ElseIf Barva=2
FrontColor(RGB(45,68,210)) ; blue
Else
FrontColor (RGB(250, 19, 5)) ; red
EndIf
R=0
St=1
Repeat
A$=""
Lastspace=St
For i=St To Len(Tx$)
If Asc(Mid(Tx$,i,1))=32
Lastspace=i
EndIf
A$= (Mid(Tx$,St,i-St))
If TextWidth(A$)>=W-15
Break
EndIf
Next i
B$= Mid(Tx$,St, Lastspace-St)
A$=Mid(Tx$,St,1+Len(Tx$)-St)
If TextWidth(A$)<W-15
B$=A$
EndIf
AddElement (NoteLine())
Noteline()=B$
St=St+Len(B$)+1
Until St>Len(Tx$)
EndIf
ForEach Noteline()
If R*15>H-15
Break
EndIf
DrawText(3,R*15,Noteline())
R=R+1
Next
StopDrawing()
ImageGadget(4, x, y, W, H, ImageID(4))
FrameGadget(#PB_Any, x-10, y-15, W+20, H+20, N$)
EndProcedure
;----------------------------------------------------------------------------------------------------
;DEMO:
Demo$="Lorem ipsum dolor sit amet, consectetur adipisici elit, sed eiusmod tempor incidunt ut labore et dolore magna aliqua."
D2$=" Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquid ex ea commodi consequat."
D3$= " Quis aute iure reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur."
D4$=" Excepteur sint obcaecat cupiditat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
Demo$=Demo$+d2$+D3$+D4$
Demo2$="V tom latinském textu aby se prase vyznalo. Bude lépe použít češtinu i za cenu úplného blábolu, který bude hustokrutopřísný a nakonec hodí alespoň ty tři řádky potřebné k vyhodnocení účinnosti."
If OpenWindow(0, 0, 0, 400, 400, "Tiny Note", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
TinyNote(20,25,375,75,Demo$)
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf
;----------------------------------------------------------------------------------------------------
Re: FakeProcedure for Multiline Note
Posted: Thu Mar 27, 2014 12:38 am
by STARGÅTE
Why your don't use the TextGadget?
Code: Select all
If OpenWindow(0, 0, 0, 400, 400, "Tiny Note", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
Gadget = TextGadget(#PB_Any, 20,20,360,100,
"Lorem ipsum dolor sit amet, consectetur adipisici elit, sed eiusmod tempor incidunt ut labore et dolore magna aliqua."+
" Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquid ex ea commodi consequat."+
" Quis aute iure reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur."+
" Excepteur sint obcaecat cupiditat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.")
SetGadgetColor(Gadget, #PB_Gadget_BackColor, $FFFFFF)
SetGadgetColor(Gadget, #PB_Gadget_FrontColor, $0000FF)
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf
Re: FakeProcedure for Multiline Note
Posted: Thu Mar 27, 2014 2:31 am
by Lubos
STARGÅTE wrote:
Why your don't use the TextGadget?
Because I had a problem with cropping of text.
Code: Select all
If OpenWindow(0, 0, 0, 400, 400, "Gadget Tiny Note", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
Gadget = TextGadget(#PB_Any, 20,20,330,65,
"Lorem ipsum dolor sit amet, consectetur adipisici elit, sed eiusmod tempor incidunt ut labore et dolore magna aliqua."+
" Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquid ex ea commodi consequat."+
" Quis aute iure reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur."+
" Excepteur sint obcaecat cupiditat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.")
SetGadgetColor(Gadget, #PB_Gadget_BackColor, $FFFFFF)
SetGadgetColor(Gadget, #PB_Gadget_FrontColor, $0000FF)
If LoadFont(0, "Times New Roman", 8)
SetGadgetFont(Gadget, FontID(0))
EndIf
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf
Re: FakeProcedure for Multiline Note
Posted: Wed Apr 23, 2014 1:41 am
by Lubos
Lubos wrote:STARGÅTE wrote:
Why your don't use the TextGadget?
Because I had a problem with cropping of text.
These problems have been a little bigger, so I had to rewrite the entire procedure.

Re: FakeProcedure for Multiline Note
Posted: Wed Apr 23, 2014 5:57 am
by RASHAD
Hi
Code: Select all
ExamineDesktops()
Global Dim Text$(3)
Text$(0)=" Lorem ipsum dolor sit amet, consectetur adipisici elit, sed eiusmod tempor incidunt ut labore et dolore magna aliqua."
Text$(1)=" Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquid ex ea commodi consequat."
Text$(2)= " Quis aute iure reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur."
Text$(3)=" Excepteur sint obcaecat cupiditat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
LoadFont(0, "Times New Roman", 16)
If OpenWindow(0, 0, 0, 400, 400, "Tiny Note", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
StartDrawing(WindowOutput(0))
DrawingFont(FontID(0))
For i = 0 To 3
TW = TextWidth(Text$(i))
TH = TextHeight(Text$(i))
If TW > width
Width = TW
EndIf
Height = Height + TH + 2
Next
StopDrawing()
ResizeWindow(0,(DesktopWidth(0)-Width)/2,(DesktopHeight(0)-Height)/2,Width+20,Height+20)
TextGadget(0,10,10,Width,Height,Text$(0)+Text$(1)+Text$(2)+Text$(3),#PB_Text_Border)
SetGadgetFont(0,FontID(0))
SetGadgetColor(0, #PB_Gadget_BackColor, $CFFEFC)
SetGadgetColor(0, #PB_Gadget_FrontColor, $0000FF)
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf
Re: FakeProcedure for Multiline Note
Posted: Wed Apr 23, 2014 6:46 am
by Lubos
Hi Rashad,
your solution is nice and simple (as usual). But I think it's not the same. Your window adapts to the text. In my solution, the text is inserted into the window of a certain size and, if necessary, reduced.
Code: Select all
Global Dim w.s(50)
W(35)="Note"
W(36)="Note (incomplete)"
W(37)="The full text incomplete notes can be found in the subdirectory Sources."
W(38)="The note is complete."
;***********************************************************
;***************Tiny Note***********************************
;***********************************************************
Procedure TinyNote(x,y, W, H,Tx$)
FF1= LoadFont(0, "Times New Roman", 11)
If CreateImage(4, W, H,32,RGB(255,255,255)) And StartDrawing(ImageOutput(4))
NewList Noteline.s()
DrawingFont(FF1)
BackColor(RGB(255,255,255))
;Colors for choice - Barva je globální proměnná
If Barva=1
FrontColor(RGB(0,0,0)) ; black
ElseIf Barva=2
FrontColor(RGB(45,68,210)) ; blue
Else
FrontColor (RGB(250, 19, 5)) ; red
EndIf
R=0
St=1
Repeat
A$=""
Lastspace=St
For i=St To Len(Tx$)
If Asc(Mid(Tx$,i,1))=32
Lastspace=i
EndIf
A$= (Mid(Tx$,St,i-St))
If TextWidth(A$)>=W-15
Break
EndIf
Next i
B$= Mid(Tx$,St, Lastspace-St)
A$=Mid(Tx$,St,1+Len(Tx$)-St)
If TextWidth(A$)<W-15
B$=A$
EndIf
AddElement (NoteLine())
Noteline()=b$
St=St+Len(b$)+1
Until St>Len(Tx$)
N$=W(35)
Tip$=W(38)
EndIf
ForEach Noteline()
If R*15>H-15
N$= W(36)
Tip$=W(37)
Break
EndIf
DrawText(3,R*15,Noteline())
R=R+1
Next
StopDrawing()
ImageGadget(4, x, y, W, H, ImageID(4))
GadgetToolTip(4,Tip$ )
FrameGadget(#PB_Any, x-10, y-15, W+20, H+20, N$)
EndProcedure
;***********************************************************
;----------------------------------------------------------------------------------------------------
;DEMO:
Demo$="Lorem ipsum dolor sit amet, consectetur adipisici elit, sed eiusmod tempor incidunt ut labore et dolore magna aliqua."
D2$=" Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquid ex ea commodi consequat."
D3$= " Quis aute iure reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur."
D4$=" Excepteur sint obcaecat cupiditat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
Demo$=Demo$+d2$+D3$+D4$
Demo2$="V tom latinském textu aby se prase vyznalo. Bude lépe použít češtinu i za cenu úplného blábolu, který bude hustokrutopřísný a nakonec hodí alespoň ty tři řádky potřebné k vyhodnocení účinnosti."
If OpenWindow(0, 0, 0, 400, 400, "Tiny Note", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
TinyNote(20,25,360,75,Demo$)
; TinyNote(20,25,360,75,Demo2$)
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf
;----------------------------------------------------------------------------------------------------
Re: FakeProcedure for Multiline Note
Posted: Wed Apr 23, 2014 10:02 am
by RichardL
Hi,
An alternative solution might be to use the EditorGadget().
Or have I missed a special need?
RichardL
Code: Select all
Demo$ = "Lorem ipsum dolor sit amet, consectetur adipisici elit, sed eiusmod tempor incidunt ut labore et dolore magna aliqua."
Demo$ + " Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquid ex ea commodi consequat."
Demo$ + " Quis aute iure reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur."
Demo$ + " Excepteur sint obcaecat cupiditat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
If OpenWindow(0, 0, 0, 400, 400, "Tiny Note", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
EditorGadget(42,12,20,375,75,#PB_Editor_WordWrap | #PB_Editor_ReadOnly)
SetGadgetFont(42,FontID(LoadFont(#PB_Any, "Times New Roman", 11)))
SetGadgetColor(42,#PB_Gadget_FrontColor,#Red)
AddGadgetItem(42,-1,Demo$)
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf
Re: FakeProcedure for Multiline Note
Posted: Wed Apr 23, 2014 1:12 pm
by Lubos
RichardL wrote:Hi,
An alternative solution might be to use the EditorGadget().
Or have I missed a special need?
RichardL
Hi RichardL,
your solution is simpler and can do more. I can hear the whiz Occam 's razor around my head.
My consolation is only one minor imperfection of EditorGadget (). It seems that there may be a spontaneous change the font size.
Code: Select all
Demo$="V tom latinském textu aby se prase vyznalo. Bude lépe použít češtinu i za cenu úplného blábolu, který bude hustokrutopřísný a nakonec hodí alespoň ty tři řádky potřebné k vyhodnocení účinnosti."
If OpenWindow(0, 0, 0, 400, 400, "Tiny Note", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
EditorGadget(42,12,20,375,157,#PB_Editor_WordWrap | #PB_Editor_ReadOnly)
SetGadgetFont(42,FontID(LoadFont(#PB_Any, "Times New Roman", 11)))
SetGadgetColor(42,#PB_Gadget_FrontColor,#Red)
AddGadgetItem(42,-1,Demo$)
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf

Lubos
Re: FakeProcedure for Multiline Note
Posted: Wed Apr 23, 2014 10:39 pm
by mk-soft
You can take this
A waste product of my "ButtonColorGadget"
DrawTextBox.pbi ->
http://www.purebasic.fr/german/viewtopi ... 27#p322127
GT

Re: FakeProcedure for Multiline Note
Posted: Fri Apr 25, 2014 5:57 am
by Zach
No idea why the editor gadget is doing that.
But you can try sending it an RTF string to set the font size instead of doing it through a PB command.
Re: FakeProcedure for Multiline Note
Posted: Sun Apr 27, 2014 3:32 pm
by Axolotl
Hi everybody,
some code I use in my programs (shorten for better understanding).
Code: Select all
;-"Module: Demo.pbi
;· Copyright © 2014 by AHa
;············································································
;· Read this:
;· WARNING! THE CODE IS PROVIDED "AS IS" with NO GUARANTEES OF ANY KIND!
;· USE THIS AT YOUR OWN RISK - YOU ARE THE ONLY PERSON RESPONSIBLE for
;· ANY DAMAGE THIS CODE MAY CAUSE - YOU HAVE BEEN WARNED!
;············································································
EnableExplicit
#Main_ProgramName$ = "Demo of DialogBox"
#Main_ProgramCreator$ = "Andreas"
;- Enums
Enumeration Windows ;' enums can by chained by this!
#WndMain
#WndDialog
EndEnumeration
Enumeration Gadgets ;' enums
#WndMain_Btn1
#WndMain_Btn2
#WndMain_Btn3
#WndDialog_EdtText
EndEnumeration
Macro ProgramVersion()
"1."+Str(#PB_Editor_BuildCount)
EndMacro
Procedure.s GetText()
Protected t$
t$ = "{\rtf1\ansi\ansicpg1252\deff0\deflang1031"
t$ + "{\fonttbl"
t$ + "{\f0\fswiss\fprq2\fcharset0 Segoe UI;}" ;: "Segoe UI", Arial
t$ + "{\f1\fswiss\fcharset0 Segoe UI;}"
t$ + "}"
t$ + "{\colortbl ;\red0\green0\blue128;\red128\green128\blue128;}"
t$ + "\viewkind4\uc1\pard\cf0\qc\b\f0\fs16 "
t$ + "\cf1\b\fs18 License Agreement and Disclaimer of Warranty \pard\cf0\b0\fs6 \par\par \fs16 "
; t$ + "Anyone may use this software unrestrictedly.\par\par "
t$ + "\b "+#Main_ProgramName$+"\b0 is free software and is distributed in the hope that it will be useful, but "
t$ + "\b without any warranty\b0 ; without even the implied warranty of \b merchantability\b0 "
t$ + "or \b fitness\b0 for a \b particular purpose\b0 .\par\par "
t$ + "I most certainly will not accept any responsibility for any \ul mishaps\ulnone either resulting "
t$ + "directly or indirectly from the use of this software. \par\par "
t$ + "\pard\qc\cf1\b You must assume the entire risk of using it!\par\pard\cf0\b0\par "
t$ + "You have to accept this license agreement, otherwise please close the program and "
t$ + "delete all program files. \par\pard "
t$ + "\qc\b \par All rights reserved!\par "
t$ + "\pard\b0 \par "+FormatDate("%dd.%mm.%yyyy", #PB_Compiler_Date)+". Thanks for using "+#Main_ProgramName$+". "+#Main_ProgramCreator$+".\par "
;t$ + "Compiler Version "+StrF(#PB_Compiler_Version/100, 2)+""
t$ + "}"
ProcedureReturn t$
EndProcedure
Procedure DialogBox_SubClassProc(hWnd, uMsg, wParam, lParam)
Protected Result
Result = CallWindowProc_(GetProp_(GetParent_(hWnd), "DialogBox_SubClassProc"), hWnd, uMsg, wParam, lParam)
HideCaret_(hWnd) ;' Windows only!
ProcedureReturn Result
EndProcedure
Procedure DialogBox(Text$="")
Protected Event
If OpenWindow(#WndDialog, 0, 0, 400, 400, "Dialog", #PB_Window_SystemMenu|#PB_Window_WindowCentered, WindowID(#WndMain))
EditorGadget(#WndDialog_EdtText, -1, -1, 402, 402, #PB_Editor_ReadOnly|#PB_Editor_WordWrap)
SetGadgetColor(#WndDialog_EdtText, #PB_Gadget_BackColor, GetSysColor_(#COLOR_BTNFACE))
HideCaret_(GadgetID(#WndDialog_EdtText))
SetProp_(WindowID(#WndDialog), "DialogBox_SubClassProc", SetWindowLong_(GadgetID(#WndDialog_EdtText), #GWL_WNDPROC, @DialogBox_SubClassProc()))
If Text$ = ""
Restore my_Text
Read.s Text$ ;:Debug Text$
Text$ = ReplaceString(Text$, "$ProgramName$", #Main_ProgramName$, #PB_String_NoCase)
Text$ = ReplaceString(Text$, "$ProgramCreator$", #Main_ProgramCreator$, #PB_String_NoCase)
Text$ = ReplaceString(Text$, "$ProgramVersion$", ProgramVersion(), #PB_String_NoCase)
Text$ = ReplaceString(Text$, "$ProgramDate$", FormatDate("%dd.%mm.%yyyy", #PB_Compiler_Date), #PB_String_NoCase)
DataSection
my_Text:
IncludeBinary("<Directory>\Text.rtf") ;' use your own RTF Textfile, this can be created with the help of i.e. WORDPAD.
Data.b 0, 0
EndDataSection
EndIf
SetGadgetText(#WndDialog_EdtText, Text$)
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
CloseWindow(#WndDialog)
EndIf
EndProcedure
If OpenWindow(#WndMain, 0, 0, 400, 400, "Tiny Note", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ButtonGadget(#WndMain_Btn1, 12, 20, 175, 18, "Show Dialog Text1") ;' show Text from rtf file
ButtonGadget(#WndMain_Btn2, 12, 50, 175, 18, "Show Dialog Text2") ;' show only the text line
ButtonGadget(#WndMain_Btn3, 12, 80, 175, 18, "Show Dialog Text3") ;' show the rtf coded text from GetText()
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case #WndMain_Btn1 : DialogBox()
Case #WndMain_Btn2 : DialogBox("This is a special Text.")
Case #WndMain_Btn3 : DialogBox(GetText())
EndSelect
Case #PB_Event_CloseWindow
Break
EndSelect
ForEver
EndIf
;'Bottom of File
Maybe it is helpful.
Have fun.
Cheers Andreas
Re: FakeProcedure for Multiline Note
Posted: Sun Apr 27, 2014 7:47 pm
by rsts
Macro error? #PB_Editor_BuildCount
Re: FakeProcedure for Multiline Note
Posted: Sun Apr 27, 2014 10:19 pm
by Zach
Go into Compiler Options -> Constants tab, and tick the box to enable the constant
Re: FakeProcedure for Multiline Note
Posted: Mon Apr 28, 2014 2:16 am
by rsts

Thanks Zach