FakeProcedure for Multiline Note

[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
;----------------------------------------------------------------------------------------------------

[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

[Lubos]

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

[Lubos]

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.

[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

[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
;----------------------------------------------------------------------------------------------------

[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

[Lubos]

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

[mk-soft]

You can take this
A waste product of my "ButtonColorGadget"

DrawTextBox.pbi -> http://www.purebasic.fr/german/viewtopi ... 27#p322127

GT

[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.

[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

[rsts]

Macro error? #PB_Editor_BuildCount

[Zach]

Go into Compiler Options -> Constants tab, and tick the box to enable the constant

[rsts]

Thanks Zach