Using DrawText() API with 32-bit images [WINDOWS]

[Dreamland Fantasy]

Hi there,

I am attempting to use Windows' DrawText_() API with 32-bit images, but the alpha channel of the text is not rendered correctly. I've borrowed some code from http://www.purebasic.fr/english/viewtop ... =4&t=54045 to help illustrate the issue:

Code: Select all

Procedure DrawTextAPI(hndDeviceContext, x, y, Text$, FontID, FrontColor, BackColor, Mode = #OPAQUE)
  Protected PrevFID = SelectObject_(hndDeviceContext, FontID)
  Protected DrawRect.RECT
  DrawRect\left = x
  DrawRect\top = y
  DrawRect\right  = OutputWidth()
  DrawRect\bottom = OutputHeight()
  SetBkColor_(hndDeviceContext, BackColor)
  SetTextColor_(hndDeviceContext, FrontColor)
  SetBkMode_(hndDeviceContext, Mode)
  DrawText_(hndDeviceContext, Text$, -1, @DrawRect, #DT_SINGLELINE | #DT_NOPREFIX)
  SelectObject_(hndDeviceContext, PrevFID)
EndProcedure

Procedure Rebuild()
  x = 10
  y = 10
  w = WindowWidth(0) - x << 1
  h = 20
  
  TestString.s = "Hello World!"
  
  Front.i = GetSysColor_(#COLOR_MENUTEXT)
  Back.i  = GetSysColor_(#COLOR_MENU)
  
  ButtonGadget(20, x, y, 100, 25, "Font...")
  y + 30
  
  TextGadget(0, x, y, w, h, "")
  If (IsFont(0))
    SetGadgetFont(0, FontID(0))
  EndIf
  FID.i = GetGadgetFont(0)
  
  If (StartDrawing(WindowOutput(0)))
    DrawingFont(FID)
    h = TextHeight(TestString)
    ResizeGadget(0, x, y, w, h)
    y + h
    StopDrawing()
  EndIf
  
  ; Display DrawText_() ouput on 24-bit image and then 32-bit image, then repeat with a magenta background
  
  For i = 1 To 4
    If i % 2 : Depth = 24 : Else : Depth = 32 : EndIf
    If i > 2 : bgColor = #Magenta : Else : bgColor = Back : EndIf
    If CreateImage(i, w, h, Depth, bgColor)
      hDC = StartDrawing(ImageOutput(i))
      If hDC
        DrawTextAPI(hDC, 0, 0, TestString + " ... DrawText_() API on " + Str(Depth) + "-bit image", FID, Front, Back, #TRANSPARENT)
        StopDrawing()
      EndIf
      ImageGadget(i, x, y, w, h, ImageID(i))
      y + h
    EndIf
  Next
    
EndProcedure

OpenWindow(0, 0, 0, 480, 360, "DrawText", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
Rebuild()
Repeat
  Event = WaitWindowEvent()
  If (Event = #PB_Event_CloseWindow)
    Done = #True
  ElseIf (Event = #PB_Event_Gadget) And (EventGadget() = 20)
    If FontRequester("Arial", 12, 0)
      LoadFont(0, SelectedFontName(), SelectedFontSize())
      Rebuild()
    EndIf
  EndIf
Until Done

I've used the same routine to render text in 24-bit and 32-bit images and then repeated the process, but with a magenta background as below:

http://www.dfstudios.co.uk/tmp/drawtext.png

I also noted that Danilo posted a solution to the issue at http://www.purebasic.fr/english/viewtop ... api+winapi, but this only works if the background that the text is being drawn on is not transparent. I'm looking to be able to draw the text on transparent backgrounds.

Kind regards,

Francis

[Dreamland Fantasy]

As a rough experiment I've come up with the following code which does allow me to use DrawText_() with 32-bit images, but it is pretty poor in my opinion as it affects the quality of the font (fonts appear thinner than before) and any background images or colours are affected (the magenta colour is no longer displayed):

Code: Select all

Procedure DrawTextAPI(hndDeviceContext, x, y, Text$, FontID, FrontColor, BackColor, Mode = #OPAQUE)
  Protected PrevFID = SelectObject_(hndDeviceContext, FontID)
  Protected DrawRect.RECT
  DrawRect\left = x
  DrawRect\top = y
  DrawRect\right  = OutputWidth()
  DrawRect\bottom = OutputHeight()
  Box(x, y, OutputWidth() - x, OutputHeight() - y, GetSysColor_(#COLOR_MENU))
  SetBkColor_(hndDeviceContext, BackColor)
  SetTextColor_(hndDeviceContext, FrontColor)
  SetBkMode_(hndDeviceContext, Mode)
  DrawText_(hndDeviceContext, Text$, -1, @DrawRect, #DT_SINGLELINE | #DT_NOPREFIX)
  SelectObject_(hndDeviceContext, PrevFID)
  
  Protected xpos, ypos, pixel, alpha.c
  DrawingMode(#PB_2DDrawing_AlphaChannel)
  For ypos = y To OutputHeight() - 1
    For xpos = x To OutputWidth() - 1
      pixel = Point(xpos, ypos)
      If  pixel >> 24
        Plot(xpos, ypos, 0)
      Else
        alpha = 0.2126 * Red(pixel) + 0.7152 * Green(pixel) + 0.0722 * Blue(Pixel)      ; Work out luma...
        alpha = 255 * Pow(alpha / 255, 12)                                              ; ...adjust gamma...
        alpha = ~alpha                                                                  ; ...and invert for alpha
        Plot(xpos, ypos, alpha << 24)
      EndIf
    Next
  Next
  
EndProcedure

Procedure Rebuild()
  x = 10
  y = 10
  w = WindowWidth(0) - x << 1
  h = 20
  
  TestString.s = "Hello World!"
  
  Front.i = GetSysColor_(#COLOR_MENUTEXT)
  Back.i  = GetSysColor_(#COLOR_MENU)
  
  ButtonGadget(20, x, y, 100, 25, "Font...")
  y + 30
  
  TextGadget(0, x, y, w, h, TestString + " ... gadget font (for reference)")
  If (IsFont(0))
    SetGadgetFont(0, FontID(0))
  EndIf
  FID.i = GetGadgetFont(0)
  
  If (StartDrawing(WindowOutput(0)))
    DrawingFont(FID)
    h = TextHeight(TestString)
    ResizeGadget(0, x, y, w, h)
    y + h
    StopDrawing()
  EndIf
  
  ; Display DrawText_() ouput on 24-bit image and then 32-bit image, then repeat with a magenta background
  
  For i = 1 To 4
    If i % 2 : Depth = 24 : Else : Depth = 32 : EndIf
    If i > 2 : bgColor = #Magenta : Else : bgColor = #PB_Image_Transparent : EndIf
    If CreateImage(i, w, h, Depth, bgColor)
      hDC = StartDrawing(ImageOutput(i))
      If hDC
        DrawTextAPI(hDC, 0, 0, TestString + " ... DrawText_() API on " + Str(Depth) + "-bit image", FID, Front, Back, #TRANSPARENT)
        StopDrawing()
      EndIf
      ImageGadget(i, x, y, w, h, ImageID(i))
      y + h
    EndIf
  Next
    
EndProcedure

OpenWindow(0, 0, 0, 480, 360, "DrawText", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
Rebuild()
Repeat
  Event = WaitWindowEvent()
  If (Event = #PB_Event_CloseWindow)
    Done = #True
  ElseIf (Event = #PB_Event_Gadget) And (EventGadget() = 20)
    If FontRequester("Arial", 12, 0)
      LoadFont(0, SelectedFontName(), SelectedFontSize())
      Rebuild()
    EndIf
  EndIf
Until Done

The code I've added to the DrawTextAPI() procedure essentially makes opaque parts transparent and attempts to provide alpha values for what was the transparent parts to show the text.

As I said, this solution is nowhere near perfect.

Kind regards,

Francis

EDIT: I've added a line of code to improve the generation of the alpha values by adjusting the gamma curve. Although not quite 100% accurate, I cannot determine the difference by eye. This might actually be okay for what I am looking for (still need to try it out in a real test though), but I would still prefer a more elegant and simpler solution.

[Julian]

Is there a particular reason why you want/need to use DrawText_ ?

What are you trying to do, render your own buttons?

Have you tried DrawVectorText ?

[Dreamland Fantasy]

Is there a particular reason why you want/need to use DrawText_ ?

What are you trying to do, render your own buttons?

Have you tried DrawVectorText ?

I'm looking to use DrawText_() as it gives me a consistent look between UI elements. The PureBasic's own DrawText() and DrawVectorText() both render text differently from DrawText_() and, to me at least, looks odd when combined with the rest of the UI.

Kind regards,

Francis

[netmaestro]

The solution proposed by Danilo works fine here:

Code: Select all

  For i = 1 To 4
    If i % 2 : Depth = 24 : Else : Depth = 32 : EndIf
    If i > 2 : bgColor = #Magenta : Else : bgColor = Back : EndIf
    If CreateImage(i, w, h, Depth, bgColor)
      hDC = StartDrawing(ImageOutput(i))
      If hDC
        DrawTextAPI(hDC, 0, 0, TestString + " ... DrawText_() API on " + Str(Depth) + "-bit image", FID, Front, Back, #TRANSPARENT)
        
        ;////////////////////////////////////////////
        
        ; Danilo solution                        
        DrawingMode(#PB_2DDrawing_AlphaChannel) 
        Box(0,0,w,h, RGBA(0,0,0,255))           
        
        ;////////////////////////////////////////////                                        
                                               
        
        StopDrawing()
      EndIf
      ImageGadget(i, x, y, w, h, ImageID(i))
      y + h
    EndIf
  Next

I can't see anything wrong with it.

[Dreamland Fantasy]

The solution proposed by Danilo works fine here:

Danilo's solution doesn't work in my case as I'm trying to draw text onto a transparent background.

Code: Select all

  For i = 1 To 4
    If i % 2 : Depth = 24 : Else : Depth = 32 : EndIf
    If i > 2 : bgColor = #Magenta : Else : bgColor = #PB_Image_Transparent : EndIf
    If CreateImage(i, w, h, Depth, bgColor)
      hDC = StartDrawing(ImageOutput(i))
      If hDC
        DrawTextAPI(hDC, 0, 0, TestString + " ... DrawText_() API on " + Str(Depth) + "-bit image", FID, Front, Back, #TRANSPARENT)
        
        ;////////////////////////////////////////////
        
        ; Danilo solution                        
        DrawingMode(#PB_2DDrawing_AlphaChannel) 
        Box(0,0,w,h, RGBA(0,0,0,255))           
        
        ;////////////////////////////////////////////                                        
                                               
        
        StopDrawing()
      EndIf
      ImageGadget(i, x, y, w, h, ImageID(i))
      y + h
    EndIf
  Next

What happens in the case of 32-bit images is that transparent text ends up being drawn on a transparent background. Danilo's method draws a box on the alpha channel and all I end up with is a black box.

Kind regards,

Francis

[netmaestro]

Please post a snippet showing precisely your attempt to draw to a single 32bit transparent image and I'll see if I can do something with it. I have a couple of ideas.

[Dreamland Fantasy]

Thanks for looking at this netmaestro!

Here is a simplified snippet of the code I have. I have commented out my attempt at trying to fix it, which I've discovered doesn't work if I try to colour the text.

Code: Select all

EnableExplicit

;- Constants

#Dialog = 0
#Xml = 0

Enumeration
  #FONT_CAPTION
  #FONT_SMCAPTION
  #FONT_MENU
  #FONT_MESSAGE
EndEnumeration

Runtime Enumeration Gadget
  #Window_Main
  #Gadget1
  #Gadget2
EndEnumeration

;- XML Window Layouts

Define XML_MainWindow$

XML_MainWindow$ = "<window id = '#Window_Main' name = 'Test' text = 'Test' minwidth = 'auto' minheight = 'auto' flags = '#PB_Window_SystemMenu'>" +
                  "  <vbox expand = 'no'>" +
                  "    <frame text = 'Select profile:'>'" +
                  "      <vbox expand = 'no'>" +
                  "        <buttonimage id = '#Gadget1'/>" +
                  "        <buttonimage id = '#Gadget2'/>" +
                  "      </vbox>" +
                  "    </frame>" +
                  "  </vbox>" +
                  "</window>"

;- Procedures

Procedure.s GetSystemFont(FontType)
  Protected spInfo.NONCLIENTMETRICS
  spInfo\cbSize = SizeOf(spInfo)
  SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS,0,@spinfo,0)
  Select FontType
    Case #FONT_CAPTION
      ProcedureReturn PeekS(@spinfo\lfCaptionFont\lfFaceName[0])
    Case #FONT_SMCAPTION
      ProcedureReturn PeekS(@spinfo\lfSMCaptionFont\lfFaceName[0])
    Case #FONT_MENU
      ProcedureReturn PeekS(@spinfo\lfMenuFont\lfFaceName[0])
    Case #FONT_MESSAGE
      ProcedureReturn PeekS(@spinfo\lfMessageFont\lfFaceName[0])
  EndSelect
EndProcedure

Procedure.l GetSystemFontSize(FontType)
  Protected spInfo.NONCLIENTMETRICS
  spInfo\cbSize = SizeOf(spInfo)
  SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS,0,@spinfo,0)
  Select FontType
    Case #FONT_CAPTION
      ProcedureReturn - PeekL(@spinfo\lfCaptionFont\lfHeight) - 3
    Case #FONT_SMCAPTION
      ProcedureReturn - PeekL(@spinfo\lfSMCaptionFont\lfHeight) - 3
    Case #FONT_MENU
      ProcedureReturn - PeekL(@spinfo\lfMenuFont\lfHeight) - 3
    Case #FONT_MESSAGE
      ProcedureReturn - PeekL(@spinfo\lfMessageFont\lfHeight) - 3
  EndSelect
EndProcedure

Procedure DrawTextAPI(hndDeviceContext, x, y, Text$, FontID, FrontColor, BackColor, Mode = #OPAQUE)
  Protected PrevFID = SelectObject_(hndDeviceContext, FontID)
  Protected DrawRect.RECT
  DrawRect\left = x
  DrawRect\top = y
  DrawRect\right  = OutputWidth()
  DrawRect\bottom = OutputHeight()
  ;Box(x, y, OutputWidth() - x, OutputHeight() - y, $FFFFFFFF)
  SetBkColor_(hndDeviceContext, BackColor)
  SetTextColor_(hndDeviceContext, FrontColor)
  SetBkMode_(hndDeviceContext, Mode)
  DrawText_(hndDeviceContext, Text$, -1, @DrawRect, #DT_SINGLELINE | #DT_NOPREFIX)
  SelectObject_(hndDeviceContext, PrevFID)
  
  ;DrawingMode(#PB_2DDrawing_AlphaChannel)
  ;Protected xpos, ypos, pixel, alpha.c
  ;For ypos = y To OutputHeight() - 1
  ;  For xpos = x To OutputWidth() - 1
  ;    pixel = Point(xpos, ypos)
  ;    If  pixel >> 24
  ;      Plot(xpos, ypos, ~pixel)
  ;    Else
  ;      alpha = 0.2126 * Red(pixel) + 0.7152 * Green(pixel) + 0.0722 * Blue(Pixel)      ; Work out alpha...
  ;      alpha = 255 * Pow(alpha / 255, 12)                                              ; ...adjust gamma...
  ;      alpha = ~alpha                                                                  ; ...and invert
  ;      Plot(xpos, ypos, alpha << 24)
  ;    EndIf
  ;  Next
  ;Next
  
EndProcedure

Procedure GenerateProfile(ProfileName$)
    
  Protected FontName$ = GetSystemFont(#FONT_MENU)
  Protected FontSize = GetSystemFontSize(#FONT_MENU)
  Protected hndFont = LoadFont(#PB_Any, FontName$, FontSize * 1.2)
  
  Protected ImageWidth = 354
  Protected ImageHeight = (FontSize + 8) * 1.2 + (FontSize + 8) * 2 + 24
  
  Protected NewImageID = CreateImage(#PB_Any, ImageWidth, ImageHeight, 32, #PB_Image_Transparent)
  
  Protected hndImage = StartDrawing(ImageOutput(NewImageID))
  DrawTextAPI(hndImage, ImageHeight - 3, 8, ProfileName$, FontID(hndFont), 0, 0, #TRANSPARENT)

  StopDrawing()
  
  ProcedureReturn NewImageID
  
EndProcedure

Define image1 = GenerateProfile("This is Profile #1")
Define image2 = GenerateProfile("This is Profile #2")

If CatchXML(#Xml, @XML_MainWindow$, StringByteLength(XML_MainWindow$)) And XMLStatus(#Xml) <> #PB_XML_Success
  Debug "XML error: " + XMLError(#Xml) + " (Line: " + XMLErrorLine(#Xml) + ")"
EndIf

If CreateDialog(#Dialog) And OpenXMLDialog(#Dialog, #Xml, "Test", 100, 100, 0, 0) = 0
  Debug "Dialog error: " + DialogError(#Dialog)
EndIf
  
SetGadgetAttribute(#Gadget1, #PB_Button_Image, ImageID(image1))
SetGadgetAttribute(#Gadget2, #PB_Button_Image, ImageID(image2))

RefreshDialog(#Dialog)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver

In my original attempt I was actually aiming to use the dialog library to create the button layouts (the buttons include an image and a number of text fields) and save as an image for later use, but I don't think it is possible to create a window with a transparent background this way.

Kind regards,

Francis

[netmaestro]

Ok, I see what you're going for. Unfortunately, you're trying to use a gdi api that was never designed to perform this task. So you have to make a switch. Dipping into the gdiplus library for a couple of functions will solve your dilemma (actually quite well imho. The output looks very nice here.)

Basically this demo creates an image of 32bit depth with a transparent background, grabs the relevant functions from gdiplus and draws the text on it:

Code: Select all

; Demo: Draw text to 32bit output using gdiplus
; Lloyd Gallant (netmaestro), December 2016

Import "gdiplus.lib"
  GdiplusStartup(a,b,c)
  GdiplusShutdown(a)
  GdipCreateFromHDC(a,b)
  GdipDeleteGraphics(a)
  GdipSetTextRenderingHint(a,b)
  GdipReleaseDC(a,b)
  GdipDrawString(a, b$, c, d, e, f, g)
  GdipCreateFontFamilyFromName(a.p-unicode,b,c)
  GdipCreateFont(a,b.f, c, d, e)
  GdipCreateSolidFill(a,b)
EndImport

Declare SetRectF(a, b.f, c.f, d.f, e.f)

Structure RECTF
  left.f
  top.f
  width.f
  height.f
EndStructure

Structure GdiplusStartupInput
  GdiPlusVersion.l
  *DebugEventCallback.DEBUG_EVENT
  SuppressBackgroundThread.l
  SuppressExternalCodecs.l
EndStructure

#FontStyleRegular    = 0
#FontStyleBold       = 1
#FontStyleItalic     = 2
#FontStyleBoldItalic = 3
#FontStyleUnderline  = 4
#FontStyleStrikeout  = 8 

Enumeration TextRenderingHint
  #TextRenderingHintSystemDefault          
  #TextRenderingHintSingleBitPerPixelGridFit
  #TextRenderingHintSingleBitPerPixel       
  #TextRenderingHintAntiAliasGridFit        
  #TextRenderingHintAntiAlias               
  #TextRenderingHintClearTypeGridFit        
EndEnumeration

#UnitPoint = 3

Global *token, *stringbrush, rcOutput.RECTF

; Initialize GDIPlus
input.GdiplusStartupInput\GdiPlusVersion = 1
GdiplusStartup(@*token, @input, #Null)

GdipCreateFontFamilyFromName("Verdana", #Null, @*fontFamily)
GdipCreateFont(*fontFamily, 14.0, #FontStyleRegular, #UnitPoint, @*font1)
GdipCreateFont(*fontFamily, 14.0, #FontStyleItalic, #UnitPoint, @*font2)
GdipCreateFont(*fontFamily, 14.0, #FontStyleBold, #UnitPoint, @*font3)
GdipCreateFont(*fontFamily, 14.0, #FontStyleUnderline, #UnitPoint, @*font4)
GdipCreateFont(*fontFamily, 14.0, #FontStyleStrikeout, #UnitPoint, @*font5)
GdipCreateSolidFill($FF000000, @*stringbrush) ; Black but you can tweak the color if desired

CreateImage(0, 800, 180, 32, #PB_Image_Transparent)
hDC = StartDrawing(ImageOutput(0))
GdipCreateFromHDC(hDC, @*gfx)                               ; Obtain a gdiplus graphics context from the hDC
GdipSetTextRenderingHint(*gfx, #TextRenderingHintAntiAlias) ; Vital step: ask gdiplus to antialias the text output
SetRectF(rcOutput, 2,2, OutputWidth(), OutputHeight())      ; Must be at least as large as the output requires or you'll get artifacts
GdipDrawString(*gfx, "Text drawn on 32 bit transparent output", -1, *font1, @rcOutput, #Null, *stringbrush) ; Render the text
SetRectF(rcOutput, 2,30, OutputWidth(), OutputHeight())                                                             
GdipDrawString(*gfx, "Text drawn on 32 bit transparent output", -1, *font2, @rcOutput, #Null, *stringbrush) 
SetRectF(rcOutput, 2,60, OutputWidth(), OutputHeight())                                                             
GdipDrawString(*gfx, "Text drawn on 32 bit transparent output", -1, *font3, @rcOutput, #Null, *stringbrush) 
SetRectF(rcOutput, 2,90, OutputWidth(), OutputHeight())                                                             
GdipDrawString(*gfx, "Text drawn on 32 bit transparent output", -1, *font4, @rcOutput, #Null, *stringbrush) 
SetRectF(rcOutput, 2,120, OutputWidth(), OutputHeight())                                                            
GdipDrawString(*gfx, "Text drawn on 32 bit transparent output", -1, *font5, @rcOutput, #Null, *stringbrush) 
GdipReleaseDC(*gfx, hdc)                                                                                            ; Cleanup
GdipDeleteGraphics(*gfx)                                                                                            ; Cleanup
StopDrawing()                                                                                                       ; Cleanup
GdiplusShutdown(*token)

ShowLibraryViewer("image", 0)
CallDebugger

Procedure SetRectF(*r.RectF, x.f, y.f, w.f, h.f)
  *r\left   = x
  *r\top    = y
  *r\width  = w
  *r\height = h
  ProcedureReturn *r
EndProcedure

[Dreamland Fantasy]

Ok, I see what you're going for. Unfortunately, you're trying to use a gdi api that was never designed to perform this task. So you have to make a switch. Dipping into the gdiplus library for a couple of functions will solve your dilemma (actually quite well imho. The output looks very nice here.)

Thanks netmaestro. The output from this looks very similar to what I get using the DrawVectorText() function, so the buttons' text ends up looking different from the rest of the UI.

I may need to have a rethink on how I am doing this or just live with it.

Thanks again for your time looking at this.

Kind regards,

Francis

[netmaestro]

The output from this looks very similar to what I get using the DrawVectorText() function

I probably should have foreseen that since the vector library on Windows uses gdiplus.

[RASHAD]

Workaround

# 1:

Code: Select all

;EnableExplicit

;- Constants

#Dialog = 0
#Xml = 0

Enumeration
  #FONT_CAPTION
  #FONT_SMCAPTION
  #FONT_MENU
  #FONT_MESSAGE
EndEnumeration

Runtime Enumeration Gadget
  #Window_Main
  #Gadget1
  #Gadget2
EndEnumeration

;- XML Window Layouts

Define XML_MainWindow$

XML_MainWindow$ = "<window id = '#Window_Main' name = 'Test' text = 'Test' minwidth = 'auto' minheight = 'auto' flags = '#PB_Window_SystemMenu'>" +
                  "  <vbox expand = 'no'>" +
                  "    <frame text = 'Select profile:'>'" +
                  "      <vbox expand = 'no'>" +
                  "        <buttonimage id = '#Gadget1'/>" +
                  "        <buttonimage id = '#Gadget2'/>" +
                  "      </vbox>" +
                  "    </frame>" +
                  "  </vbox>" +
                  "</window>"

;- Procedures

Procedure.s GetSystemFont(FontType)
  Protected spInfo.NONCLIENTMETRICS
  spInfo\cbSize = SizeOf(spInfo)
  SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS,0,@spinfo,0)
  Select FontType
    Case #FONT_CAPTION
      ProcedureReturn PeekS(@spinfo\lfCaptionFont\lfFaceName[0])
    Case #FONT_SMCAPTION
      ProcedureReturn PeekS(@spinfo\lfSMCaptionFont\lfFaceName[0])
    Case #FONT_MENU
      ProcedureReturn PeekS(@spinfo\lfMenuFont\lfFaceName[0])
    Case #FONT_MESSAGE
      ProcedureReturn PeekS(@spinfo\lfMessageFont\lfFaceName[0])
  EndSelect
EndProcedure

Procedure.l GetSystemFontSize(FontType)
  Protected spInfo.NONCLIENTMETRICS
  spInfo\cbSize = SizeOf(spInfo)
  SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS,0,@spinfo,0)
  Select FontType
    Case #FONT_CAPTION
      ProcedureReturn - PeekL(@spinfo\lfCaptionFont\lfHeight) - 3
    Case #FONT_SMCAPTION
      ProcedureReturn - PeekL(@spinfo\lfSMCaptionFont\lfHeight) - 3
    Case #FONT_MENU
      ProcedureReturn - PeekL(@spinfo\lfMenuFont\lfHeight) - 3
    Case #FONT_MESSAGE
      ProcedureReturn - PeekL(@spinfo\lfMessageFont\lfHeight) - 3
  EndSelect
EndProcedure

Procedure _24_32(img,tempimg)
  CreateImage(tempimg,ImageWidth(img),ImageHeight(img),32,#PB_Image_Transparent)
  StartDrawing(ImageOutput(tempimg))
    DrawImage(ImageID(img),0,0)
    DrawingMode(#PB_2DDrawing_AlphaChannel ) 
    For y = 0 To ImageHeight(tempimg)-1
      For x= 0 To ImageWidth(tempimg)-1
         c = Point(x,y)
         If c = $FFFFFF
           Plot(x,y,c|$00000000)
         Else
           Plot(x,y,c|$FF000000)
         EndIf
      Next x
    Next y
  StopDrawing()
EndProcedure 

Procedure DrawTextAPI(hndDeviceContext, x, y, Text$, FontID, FrontColor, BackColor, Mode = #OPAQUE)
  Protected PrevFID = SelectObject_(hndDeviceContext, FontID)
  Protected DrawRect.RECT
  DrawRect\left = x
  DrawRect\top = y
  DrawRect\right  = OutputWidth()
  DrawRect\bottom = OutputHeight()
  Box(0,0, OutputWidth(), OutputHeight(), $FFFFFF)
  SetBkColor_(hndDeviceContext, BackColor)
  SetTextColor_(hndDeviceContext, FrontColor)
  SetBkMode_(hndDeviceContext, Mode)
  DrawText_(hndDeviceContext, Text$, -1, @DrawRect, #DT_SINGLELINE | #DT_NOPREFIX)
  SelectObject_(hndDeviceContext, PrevFID)
 
EndProcedure

Procedure GenerateProfile(ProfileName$)
   
  Protected FontName$ = GetSystemFont(#FONT_MENU)
  Protected FontSize = GetSystemFontSize(#FONT_MENU)
  Protected hndFont = LoadFont(#PB_Any, FontName$, FontSize * 1.2)
 
  Protected ImageWidth = 354
  Protected ImageHeight = (FontSize + 8) * 1.2 + (FontSize + 8) * 2 + 24
 
  Protected NewImageID = CreateImage(#PB_Any, ImageWidth, ImageHeight, 24);, #PB_Image_Transparent)
 
  Protected hndImage = StartDrawing(ImageOutput(NewImageID))
  DrawTextAPI(hndImage, ImageHeight - 3, 8, ProfileName$, FontID(hndFont), 0, 0, #TRANSPARENT)

  StopDrawing()
 
  ProcedureReturn NewImageID
 
EndProcedure

Define image1 = GenerateProfile("This is Profile #1")
Define image2 = GenerateProfile("This is Profile #2")

If CatchXML(#Xml, @XML_MainWindow$, StringByteLength(XML_MainWindow$)) And XMLStatus(#Xml) <> #PB_XML_Success
  Debug "XML error: " + XMLError(#Xml) + " (Line: " + XMLErrorLine(#Xml) + ")"
EndIf

If CreateDialog(#Dialog) And OpenXMLDialog(#Dialog, #Xml, "Test", 100, 100, 0, 0) = 0
  Debug "Dialog error: " + DialogError(#Dialog)
EndIf

_24_32(image1,10)
SetGadgetAttribute(#Gadget1, #PB_Button_Image, ImageID(10))
_24_32(image2,20)
SetGadgetAttribute(#Gadget2, #PB_Button_Image, ImageID(20))

RefreshDialog(#Dialog)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver

# 2:
Using Antialiased Font

Code: Select all

;EnableExplicit

Global Font,FontSize
FontSize = 20

;- Constants

#Dialog = 0
#Xml = 0

Enumeration
  #FONT_CAPTION
  #FONT_SMCAPTION
  #FONT_MENU
  #FONT_MESSAGE
EndEnumeration

Runtime Enumeration Gadget
  #Window_Main
  #Gadget1
  #Gadget2
EndEnumeration

#DEFAULT_QUALITY = 0
#DRAFT_QUALITY = 1
#PROOF_QUALITY = 2
#NONANTIALIASED_QUALITY = 3
#ANTIALIASED_QUALITY = 4
#CLEARTYPE_QUALITY = 5
#CLEARTYPE_NATURAL_QUALITY = 6


LF.LOGFONT
LF\lfHeight         = FontSize
LF\lfWidth          = 0
LF\lfEscapement     = 0
LF\lfOrientation    = 0
LF\lfWeight         = #FW_DONTCARE
LF\lfItalic         = 0
LF\lfUnderline      = 0
LF\lfStrikeOut      = 0
LF\lfCharSet        = #DEFAULT_CHARSET
LF\lfOutPrecision   = #OUT_DEFAULT_PRECIS
LF\lfClipPrecision  = #CLIP_DEFAULT_PRECIS
LF\lfQuality        = #ANTIALIASED_QUALITY
LF\lfPitchAndFamily = #DEFAULT_PITCH | #FF_DONTCARE
PokeS(@LF\lfFaceName[0], "Tahoma")

Font = CreateFontIndirect_(@LF)

;- XML Window Layouts

Define XML_MainWindow$

XML_MainWindow$ = "<window id = '#Window_Main' name = 'Test' text = 'Test' minwidth = 'auto' minheight = 'auto' flags = '#PB_Window_SystemMenu'>" +
                  ;"  <vbox expand = 'no'>" +
                  "    <frame text = 'Select profile:'>'" +
                  "      <vbox expand = 'no'>" +
                  "        <buttonimage id = '#Gadget1'/>" +
                  "        <buttonimage id = '#Gadget2'/>" +
                  "      </vbox>" +
                  "    </frame>" +
                  ;"  </vbox>" +
                  "</window>"

Procedure _24_32(img,tempimg)
  CreateImage(tempimg,ImageWidth(img),ImageHeight(img),32,#PB_Image_Transparent)
  StartDrawing(ImageOutput(tempimg))
    DrawImage(ImageID(img),0,0)
    DrawingMode(#PB_2DDrawing_AlphaChannel )
    For y = 0 To ImageHeight(tempimg)-1
      For x= 0 To ImageWidth(tempimg)-1
         c = Point(x,y)
         If c = $FFFFFF
           Plot(x,y,c|$00000000)
         Else
           Plot(x,y,c|$FF000000)
         EndIf
      Next x
    Next y
  StopDrawing()
EndProcedure

Procedure DrawTextAPI(hndDeviceContext, x, y, Text$, FontID, FrontColor, BackColor, Mode = #OPAQUE)
  Protected PrevFID = SelectObject_(hndDeviceContext, Font)
  Protected DrawRect.RECT
  DrawRect\left = x
  DrawRect\top = y
  DrawRect\right  = OutputWidth()
  DrawRect\bottom = OutputHeight()
  Box(0,0, OutputWidth(), OutputHeight(), $FFFFFF)
  SetBkColor_(hndDeviceContext, BackColor)
  SetTextColor_(hndDeviceContext, FrontColor)
  SetBkMode_(hndDeviceContext, Mode)
  DrawText_(hndDeviceContext, Text$, -1, @DrawRect, #DT_SINGLELINE | #DT_NOPREFIX)
  SelectObject_(hndDeviceContext, PrevFID)
 
EndProcedure

Procedure GenerateProfile(ProfileName$)
   
  Protected ImageWidth = 354
  Protected ImageHeight = (FontSize + 8) * 1.2 + (FontSize + 8) * 2 + 24
 
  Protected NewImageID = CreateImage(#PB_Any, ImageWidth, ImageHeight, 24);, #PB_Image_Transparent)
 
  Protected hndImage = StartDrawing(ImageOutput(NewImageID))
  DrawTextAPI(hndImage, ImageHeight - 20, 8, ProfileName$, Font, 0, 0, #TRANSPARENT)

  StopDrawing()
 
  ProcedureReturn NewImageID
 
EndProcedure

Define image1 = GenerateProfile("This is Profile #1")
Define image2 = GenerateProfile("This is Profile #2")

If CatchXML(#Xml, @XML_MainWindow$, StringByteLength(XML_MainWindow$)) And XMLStatus(#Xml) <> #PB_XML_Success
  Debug "XML error: " + XMLError(#Xml) + " (Line: " + XMLErrorLine(#Xml) + ")"
EndIf

If CreateDialog(#Dialog) And OpenXMLDialog(#Dialog, #Xml, "Test", 100, 100, 0, 0) = 0
  Debug "Dialog error: " + DialogError(#Dialog)
EndIf

_24_32(image1,10)
SetGadgetAttribute(#Gadget1, #PB_Button_Image, ImageID(10))
_24_32(image2,20)
SetGadgetAttribute(#Gadget2, #PB_Button_Image, ImageID(20))

RefreshDialog(#Dialog)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver

[RASHAD]

Previous post updated