PureBasic Forums - English

Posted: **Wed Jul 21, 2010 5:56 pm**


Procedure Editor_Select(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)
  sel.CHARRANGE
  sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1

  If LineEnd = -1
    LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1
  EndIf
  sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0)

  If CharEnd = -1
    sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0)
  Else
    sel\cpMax + CharEnd - 1
  EndIf
  SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)
EndProcedure

Procedure Editor_S_FontName(Gadget, FontName.s)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE
  PokeS(@format\szFaceName, FontName)
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Editor_G_FontName(Gadget)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE  
  SendMessage_(GadgetID(Gadget), #EM_GETCHARFORMAT, #SCF_SELECTION, @format)
  MessageRequester("Information","Font Name : "+PeekS(@format\szFaceName),#MB_ICONINFORMATION)
EndProcedure

Procedure Editor_S_FontColor(Gadget, Color.l)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_COLOR
  format\crTextColor = Color
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Editor_G_FontColor(Gadget)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_COLOR
  SendMessage_(GadgetID(Gadget), #EM_GETCHARFORMAT, #SCF_SELECTION, @format)
  MessageRequester("Information","Font Color : "+"RGB("+Str(Red(format\crTextColor))+","+Str(Green(format\crTextColor))+","+Str(Blue(format\crTextColor))+")",#MB_ICONINFORMATION)
EndProcedure

Procedure Editor_S_FontSize(Gadget, Fontsize.l)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_SIZE
  format\yHeight = FontSize*20
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Editor_G_FontSize(Gadget)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_SIZE  
  SendMessage_(GadgetID(Gadget), #EM_GETCHARFORMAT, #SCF_SELECTION, @format)  
  MessageRequester("Information","Font Size-->Line Height  : "+Str(format\yHeight/20),#MB_ICONINFORMATION)
EndProcedure

Procedure Editor_S_CharFormat(Gadget, Flags.l)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
  format\dwEffects = Flags
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Editor_G_CharFormat(Gadget)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_BOLD|#CFM_ITALIC|#CFM_UNDERLINE|#CFM_STRIKEOUT 
  SendMessage_(GadgetID(Gadget), #EM_GETCHARFORMAT, #SCF_SELECTION, @format)
  MessageRequester("Information","Character Format  : "+Str(format\dwEffects),#MB_ICONINFORMATION)
EndProcedure


If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(1, 10, 10, 480,300)
  For i = 12 To 400
  FreeGadget(1)
  EditorGadget(1, 10, 10, 480,i)
  HideGadget(1,1) 
  AddGadgetItem(1, 0, "This is a RED, underlined big text")
  AddGadgetItem(1, 1, "Times new Roman")
  AddGadgetItem(1, 2, "This is Italic and Strikeout")
  AddGadgetItem(1, 3, "This is usual Text")
  
  Editor_Select(1, 0, 1, 0, -1)
    Editor_S_FontColor(1,$0102FE)
    Editor_S_FontSize(1, 18)
    Editor_S_CharFormat(1,#CFM_UNDERLINE)
    
  Editor_Select(1, 1, 1, 1, -1)
    Editor_S_FontColor(1, $FC0303)
    Editor_S_FontSize(1, 14)
    Editor_S_CharFormat(1,#CFM_BOLD)

  Editor_Select(1, 2, 1, 2, -1)
    Editor_S_FontColor(1,$000000)
    Editor_S_FontName(1, "Times New Roman")
    Editor_S_FontSize(1, 12)
    Editor_S_CharFormat(1, #CFM_ITALIC|#CFM_STRIKEOUT) 
    
  Editor_Select(1, 4, 0, 4, 1)                         ;No of Lines + 1

  If SendMessage_(GadgetID(1), #EM_GETFIRSTVISIBLELINE,0,0) = 0
     Editor_Select(1, 0, 0, 0, 0)
     HideGadget(1,0)
     Break
  EndIf
  Next
  

  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

Posted: **Wed Jul 21, 2010 7:43 pm**

Hi, RASHAD
Maybe...

Good Day

Code: Select all

Procedure look()
AddGadgetItem(1, 0, "This is a RED, underlined big text") 
	AddGadgetItem(1, 1, "Times new Roman") 
	AddGadgetItem(1, 2, "This is Italic and Strikeout") 
	AddGadgetItem(1, 3, "This is usual Text") 
	 
	Editor_Select(1, 0, 1, 0, -1) 
	Editor_S_FontColor(1,$0102FE) 
	Editor_S_FontSize(1, 18) 
	Editor_S_CharFormat(1,#CFM_UNDERLINE) 
	 
	Editor_Select(1, 1, 1, 1, -1) 
	Editor_S_FontColor(1, $FC0303) 
	Editor_S_FontSize(1, 14) 
	Editor_S_CharFormat(1,#CFM_BOLD) 
	 
	Editor_Select(1, 2, 1, 2, -1) 
	Editor_S_FontColor(1,$000000) 
	Editor_S_FontName(1, "Times New Roman") 
	Editor_S_FontSize(1, 12) 
	Editor_S_CharFormat(1, #CFM_ITALIC|#CFM_STRIKEOUT)  
	 
	Editor_Select(1, 4, 0, 4, 1)                         ;No of Lines + 1 
EndProcedure

If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
	For i = 12 To 400 
	EditorGadget(1, 10, -301, 480,i) 
	look() 
	If SendMessage_(GadgetID(1), #EM_GETFIRSTVISIBLELINE,0,0) = 0 
	Editor_Select(1, 0, 0, 0, 0) 
	Break 
	EndIf 
Next 
EditorGadget(1, 10, 10, 480,i)
look()  


Repeat 
Until WaitWindowEvent() = #PB_Event_CloseWindow 
EndIf

Posted: **Thu Jul 22, 2010 9:58 am**

Thanks for sharing

Posted: **Thu Jul 22, 2010 12:05 pm**

EditorGadget , Font Size Twips ,Font Size Pixels ,DPI and Windows different Vers is a big mess
Next is a new approach I hope you like it

Have Fun

Code: Select all


;Functions originally by Freak modified somehow by srod
;Autoresizing tip By RASHAD


Procedure AutoresizeEG(Gadget)
  OldStyle = GetWindowLongPtr_(GadgetID(Gadget),#GWL_STYLE)
  For i = 12 To 500 Step 4
  MoveWindow_(GadgetID(Gadget),10,10,480,i,1)
  SendMessage_(GadgetID(Gadget),#WM_VSCROLL,#SB_TOP,0)
  SendMessage_(GadgetID(Gadget),#WM_VSCROLL,#SB_BOTTOM,0)  
  NewStyle = GetWindowLongPtr_(GadgetID(Gadget),#GWL_STYLE)
  If NewStyle <> OldStyle
     Break
  EndIf
  Next
EndProcedure


Procedure Editor_Select(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)
  sel.CHARRANGE
  sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1

  If LineEnd = -1
    LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1
  EndIf
  sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0)

  If CharEnd = -1
    sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0)
  Else
    sel\cpMax + CharEnd - 1
  EndIf
  SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)
EndProcedure

Procedure Editor_S_FontName(Gadget, FontName.s)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE
  PokeS(@format\szFaceName, FontName)
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Editor_G_FontName(Gadget)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE  
  SendMessage_(GadgetID(Gadget), #EM_GETCHARFORMAT, #SCF_SELECTION, @format)
  MessageRequester("Information","Font Name : "+PeekS(@format\szFaceName),#MB_ICONINFORMATION)
EndProcedure

Procedure Editor_S_FontColor(Gadget, Color.l)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_COLOR
  format\crTextColor = Color
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Editor_G_FontColor(Gadget)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_COLOR
  SendMessage_(GadgetID(Gadget), #EM_GETCHARFORMAT, #SCF_SELECTION, @format)
  MessageRequester("Information","Font Color : "+"RGB("+Str(Red(format\crTextColor))+","+Str(Green(format\crTextColor))+","+Str(Blue(format\crTextColor))+")",#MB_ICONINFORMATION)
EndProcedure

Procedure Editor_S_FontSize(Gadget, Fontsize.l)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_SIZE
  format\yHeight = FontSize*20
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Editor_G_FontSize(Gadget)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_SIZE  
  SendMessage_(GadgetID(Gadget), #EM_GETCHARFORMAT, #SCF_SELECTION, @format)  
  MessageRequester("Information","Font Size-->Line Height  : "+Str(format\yHeight/20),#MB_ICONINFORMATION)
EndProcedure

Procedure Editor_S_CharFormat(Gadget, Flags.l)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
  format\dwEffects = Flags
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Editor_G_CharFormat(Gadget)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_BOLD|#CFM_ITALIC|#CFM_UNDERLINE|#CFM_STRIKEOUT 
  SendMessage_(GadgetID(Gadget), #EM_GETCHARFORMAT, #SCF_SELECTION, @format)
  MessageRequester("Information","Character Format  : "+Str(format\dwEffects),#MB_ICONINFORMATION)
EndProcedure

If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(1, 10, 10, 480,12,#PB_Editor_ReadOnly|1)                        ;0 Left aligned - 1 Center aligned - 2 Right aligned
  AddGadgetItem(1, 0, "This is a RED")
  AddGadgetItem(1, 1, "Times new Roman")
  AddGadgetItem(1, 2, "This is Italic and Strikeout")
  AddGadgetItem(1, 3, "This is usual Text")
  
  Editor_Select(1, 0, 1, 0, -1)
    Editor_S_FontColor(1,$0102FE)
    Editor_S_FontName(1, "Forte")
    Editor_S_FontSize(1,52)
    Editor_S_CharFormat(1,#CFM_UNDERLINE)    
    
  Editor_Select(1, 1, 1, 1, -1)
    Editor_S_FontColor(1, $73E06D)
    Editor_S_FontName(1, "Broadway")
    Editor_S_FontSize(1, 24)
    Editor_S_CharFormat(1,#CFM_BOLD)

  Editor_Select(1, 2, 1, 2, -1)
    Editor_S_FontColor(1,$FB1404)
    Editor_S_FontName(1, "Times New Roman")
    Editor_S_FontSize(1, 16)
    Editor_S_CharFormat(1, #CFM_ITALIC|#CFM_STRIKEOUT)    
   
  Editor_Select(1, 0, 0, 0, 0) 
  AutoresizeEG(1)
  
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

Posted: **Thu Jul 22, 2010 12:21 pm**

Hi
i like good job, thanks

bye

Posted: **Thu Jul 22, 2010 12:54 pm**

@kernadec
@KCC
Thank you

Updated Ver 2.0 code for any FontSizes

Posted: **Fri Jul 23, 2010 7:50 am**

Rashad, no offence intended, but you really should give mention to the original authors of some of this code, even if it is a straight-forward and simple utility (though the resizing part escapes me right now!) Considering that half of the functions have been lifted directly from a posting of mine, routines which in turn were originally posted by Freak, politeness does kind of suggest that due credit should thus be given to Freak in this case.

"Code based upon some routines originally posted by Freak..."

As I say, no offence intended, 'cause I'm sure that I have been guilty of this myself!

Posted: **Fri Jul 23, 2010 9:49 am**

@srod Hi
The tip is about Autoresizing the EditorGadget not The functions of that gadget
Many times I mentioned Freak and srod when it was about how to change size or change color
and so on

But do not be angry
- The Functions of the EditorGadget are by Freak - srod - Falco and Others as implementation for MS Edit Control
- The Autorezing tip is by RASHAD

I hope I did not steel that tip from somebody else by mistake
In that case I hope he will forgive me

And the previous post just updated to be more good
Sorry srod I still do not feel that I did somthing wrong
And srod no offence if it is simple and straight forward why did not you answer the guy who was asking about how to get the right heigt of the EditorGadget with simple or not simple idea?I wonder !
No srod I am polite and I do not steel
Please srod find somebody else to attack him
I always come with simple or not simple NEW ideas and I think it is not bad to do

Posted: **Fri Jul 23, 2010 10:25 am**

As I said, no offence was offered or intended.

Posted: **Fri Jul 23, 2010 2:23 pm**

Whew, this makes me glad you forgot about all that Sqlite-Autocomplete code you posted last year!

Posted: **Fri Jul 23, 2010 3:46 pm**

Now what?
The tip is based on MS code.

Code: Select all


Procedure AutoresizeEG(Gadget)
  OldStyle = GetWindowLongPtr_(GadgetID(Gadget),#GWL_STYLE)
  For i = 12 To 500 Step 4
  MoveWindow_(GadgetID(Gadget),10,10,480,i,1)
  SendMessage_(GadgetID(Gadget),#WM_VSCROLL,#SB_TOP,0)
  SendMessage_(GadgetID(Gadget),#WM_VSCROLL,#SB_BOTTOM,0)  
  NewStyle = GetWindowLongPtr_(GadgetID(Gadget),#GWL_STYLE)
  If NewStyle <> OldStyle
     Break
  EndIf
  Next
EndProcedure


Procedure LineFormat(Gadget,FName$,FSize,FColor,FFlags)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE|#CFM_COLOR|#CFM_SIZE|#CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE  
  PokeS(@format\szFaceName, FName$)
  format\yHeight = FSize*1440/72
  format\crTextColor = FColor
  format\dwEffects = FFlags
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(1, 10, 10, 480,12,#PB_Editor_ReadOnly|1) ;0 Left aligned - 1 Center aligned - 2 Right aligned

    LineFormat(1,"Forte",52,$0102FE,#CFM_UNDERLINE)     ;LineFormat(#Gadget,Font Name,Font Size,Font Color,Font Flags)
    AddGadgetItem(1, 0, "This is a RED") 

    LineFormat(1,"Broadway",24,$73E06D,#CFM_BOLD)
    AddGadgetItem(1, 1, "Times new Roman")

    LineFormat(1,"Times new Roman",16,$FB1404,#CFM_ITALIC|#CFM_STRIKEOUT)
    AddGadgetItem(1, 2, "This is Italic and Strikeout")    
   
    AddGadgetItem(1, 3, "This is usual Text")
    AutoresizeEG(1)
  
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

Posted: **Fri Jul 23, 2010 5:54 pm**

netmaestro wrote:Whew, this makes me glad you forgot about all that Sqlite-Autocomplete code you posted last year!

You b*stard!

Apologies to Rashad for hijacking the thread.

Posted: **Fri Jul 23, 2010 10:40 pm**

RASHAD wrote:Now what?
The tip is based on MS code.
[ code ]

Seems to be more elegant, but the "This is usual Text" line is not shown in usual char size

BTW is there an easy possibility to change the attributes for just one word?

Posted: **Sat Jul 24, 2010 5:26 am**

Hi Michael
thank you for your kind words
For "This is usual Text"
Compile the code in unicode
Or Add LineFormat() for that line

For the possibility of changing the size or the attribute or may be the font name for one word in the line
the answer is YES
while it is out the scope of the tip but I am working right now with a more advanced one and I will post it
as soon as I finish it
Be tuned

Have a good day sir

Posted: **Sat Jul 24, 2010 2:42 pm**

Ver 3.0
This code as per @MV request
It is not the advanced one
I hope you like it

Code: Select all

#CFM_LINK  = $20

Procedure AutoresizeEG(Gadget)
  OldStyle = GetWindowLongPtr_(GadgetID(Gadget),#GWL_STYLE)
  For i = 12 To 500 Step 4
  MoveWindow_(GadgetID(Gadget),10,10,480,i,1)
  SendMessage_(GadgetID(Gadget),#WM_VSCROLL,#SB_TOP,0)
  SendMessage_(GadgetID(Gadget),#WM_VSCROLL,#SB_BOTTOM,0)  
  NewStyle = GetWindowLongPtr_(GadgetID(Gadget),#GWL_STYLE)
  If NewStyle <> OldStyle
     Break
  EndIf
  Next
EndProcedure


Procedure CharFormat(Gadget,FName$,FSize,FColor,FFlags)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE|#CFM_COLOR|#CFM_SIZE|#CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE|#CFM_LINK
  PokeS(@format\szFaceName, FName$)
  format\yHeight = FSize*1440/72
  format\crTextColor = FColor
  format\dwEffects = FFlags
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)  
EndProcedure

Procedure AddText(Gadget,Text$,Eolf)
If Eolf = 1
   Text$ = Text$ + #CRLF$
EndIf
SendMessage_(GadgetID(Gadget), #EM_REPLACESEL, #True, @Text$)
EndProcedure

If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(1, 10, 10, 480,12,#PB_Editor_ReadOnly|1)                    ;0 Left aligned - 1 Center aligned - 2 Right aligned

    CharFormat(1,"Forte",14,$0102FE,#CFM_UNDERLINE)                        ;CharFormat(#Gadget,Font Name,Font Size,Font Color,Font Flags)
    AddText(1,"This is a Test",0)                                          ;AddText(#Gadget,Text$,End of Line Flag(1 new line - 0 continue at the same line))

    CharFormat(1,"Broadway",24,$78FE87,#CFM_BOLD|#CFM_ITALIC)
    AddText(1," It is OK ",0)
    
    CharFormat(1,"Forte",14,$FD0202,#CFM_UNDERLINE)
    AddText(1,"For MV",1)

    CharFormat(1,"Times new Roman",16,$FB1404,#CFM_ITALIC|#CFM_STRIKEOUT)
    AddText(1,"This is Italic and Strikeout",1)
    
    CharFormat(1,"Times new Roman",10,$000000,#CFM_LINK)
    AddText(1,"This is a Link",1)
   
    AutoresizeEG(1)
  
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

PureBasic Forums - English

*New Ver 4 : AutoResize EditorGadget And More.... [Windows]

*New Ver 4 : AutoResize EditorGadget And More.... [Windows]

Re: AutoResize EditorGadget [Windows]

Re: AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Ver 2 : AutoResize EditorGadget [Windows]

Re: Updated Ver 3 : AutoResize EditorGadget [Windows]