PureBasic Forum

; "DrawTextAdvanced" by c4s  (v1.13, 06.02.2011)
;
;
;- Description
; It creates a transparent image with the specified text. Optionally the text can be
; wrapped if a defined width has been reached or #LF$ was found. The whole procedure
; will be configurated via the following structure. All settings, except the text of
; course, are optional and the returning value will be the newly created image, see:
;
;
;- Options
; "Text.s"
;  The text that should be displayed. Use #LF$ as a line-break. Must be set!
; "TextColor.l"
;  RGBA color of the text.
;   Default: $FF000000 (fully visible black)
; "TextFontID.i"
;  FontID for the text.
;   Default: #PB_Default
;
; "Position.l"
;  Position of the text: Left, Right, Center.
;   Default: #DTA_PositionLeft
; "PositionWidth.l"
;  Define the width of the wrapping area. The text will wrap either if this width is
;  reached or an #LF$ character was found. Set it to "0" to just watch for the #LF$.
;  Note that it will be filled with the width of the final created image anyway.
;   Default: 0
; "PositionHeight.l"
;  This is ignored but will be filled with the height of the created image.
;   Default: 0
; "PositionAngle.f"
;  Rotate the text counter-clockwise in degrees. A value of "0.0" means no rotation.
;   Default: 0.0
;
; "Wrap.l"
;  #DTA_True to enable, #DTA_False to disable the text wrapping.
;   Default: #DTA_True
; "WrapSpacing.l"
;  Space between each text line in pixels. Can be positive or negative.
;   Default: 0
;
; "Outline.l"
;  #DTA_True to enable, #DTA_False to disable the outline around the text.
;   Default: #DTA_False
; "OutlineColor.l"
;  RGBA color of the outline.
;   Default: $FFFFFFFF (fully visible white)
; "OutlineSize.l"
;  Size in pixels of the outline.
;   Default: 1
;
; "ImageNr.l"
;  Works as every (image) function of PureBasic. Either use a constant value or
;  #PB_Any. The procedure will then return the new image number or true/false.
;   Default: #PB_Any
; "ImageSimulate.l"
;  When it's #DTA_True, no image will be created. This could be useful if just the
;  returned width and height are needed.
;   Default: #DTA_False
;
;
;- Notes
; ·Important: The options in the passed structure will be corrected and replaced if
;  they are wrong, so reusing it might not work.
; ·Sometimes the text might be cropped because TextWidth() returns a wrong value. Is
;  this a bug of PureBasic?
; ·Outline doesn't work if color of text is $00000000 or both colors are the same,
;  however a primitive workaround is included.
; ·An ImageNr of 0 doesn't work because it will get the default #PB_Any.



EnableExplicit


#DTA_True = 1
#DTA_False = -1
#DTA_PositionLeft = 1
#DTA_PositionRight = 2
#DTA_PositionCenter = 3

Structure DrawTextAdvanced_Options
   Text.s
   TextColor.l
   TextFontID.i
   Position.l
   PositionWidth.l
   PositionHeight.l
   PositionAngle.f
   Wrap.l
   WrapSpacing.l
   Outline.l
   OutlineColor.l
   OutlineSize.l
   ImageNr.l
   ImageSimulate.l
EndStructure

Structure DrawTextAdvanced_Line
   Text.s
   X.l
   Y.l
   Width.l
   Height.l
EndStructure


Macro Center(Value, Max)
   (((Max) - (Value)) / 2)
EndMacro

Macro MidFast(String, StartPos, Length)
   PeekS(@String + ((StartPos - 1) * SizeOf(Character)), Length)
EndMacro

Procedure DrawTextAdvanced(*Options.DrawTextAdvanced_Options)
   Protected NewList Lines.DrawTextAdvanced_Line()
   Protected WrapCPosition, WrapC.s, WrapWord.s
   Protected WrapLineTemp1.s, WrapLineTemp1Width, WrapLineTemp2.s, WrapLineTemp2Width
   Protected WrapLine.s, WrapLineWidth, WrapLineHeight
   Protected LineWidthMax, LineHeightMax, LineYTemp
   Protected RotateOldX, RotateOldY, RotateOldWidth, RotateOldHeight
   Protected RotateSinR.f, RotateCosR.f, RotateX, RotateY
   Protected OutlineX, OutlineY, OutlineRangeUp, OutlineRangeDown, OutlineRangeRight
   Protected OutlineXScan, OutlineYScan, OutlineTrailingOffset, OutlineSkipped
   Protected ImageNr, ImageNrTemp

;{ Check, correct and set default options
;{ Text
   If Len(*Options\Text) = 0
      ProcedureReturn #False
   EndIf

   If *Options\TextColor = 0
      *Options\TextColor = $FF000000
   EndIf

   If *Options\TextFontID = 0
      *Options\TextFontID = #PB_Default
   EndIf
;}

;{ Position
   If *Options\Position <> #DTA_PositionLeft And *Options\Position <> #DTA_PositionRight And *Options\Position <> #DTA_PositionCenter
      *Options\Position = #DTA_PositionLeft
   EndIf

   If *Options\PositionWidth < 1
      *Options\PositionWidth = 0
   EndIf

   If *Options\PositionHeight < 1
      *Options\PositionHeight = 0
   EndIf

   If *Options\PositionAngle = 0
      *Options\PositionAngle = 0.0
   EndIf
;}

;{ Wrap
   If *Options\Wrap <> #DTA_True And *Options\Wrap <> #DTA_False
      *Options\Wrap = #DTA_True
   EndIf

   If *Options\WrapSpacing = 0
      *Options\WrapSpacing = 0
   EndIf
;}

;{ Outline
   If *Options\Outline <> #DTA_True And *Options\Outline <> #DTA_False
      *Options\Outline = #DTA_False
   EndIf

   If *Options\OutlineColor = 0
      *Options\OutlineColor = $FFFFFFFF
   EndIf

   If *Options\OutlineSize < 1
      *Options\OutlineSize = 1
   EndIf
;}

;{ Image
   If *Options\ImageNr = 0
      *Options\ImageNr = #PB_Any
   EndIf

   If *Options\ImageSimulate <> #DTA_True And *Options\ImageSimulate <> #DTA_False
      *Options\ImageSimulate = #DTA_False
   EndIf
;}


   ; Workaround (Otherwise Outline wouldn't work):
   If *Options\Outline = #DTA_True
      If Alpha(*Options\TextColor) = $00
         *Options\TextColor | $01000000
      EndIf
      If *Options\TextColor = *Options\OutlineColor
         *Options\OutlineColor - 1
      EndIf
   EndIf
;}


;{ Analyze text: Lines, Dimension, Position
;{ Get every line and their width & height
   ImageNrTemp = CreateImage(#PB_Any, 1, 1)  ; Needed for TextWidth() & TextHeight()
   If ImageNrTemp
      If StartDrawing(ImageOutput(ImageNrTemp))
         DrawingFont(*Options\TextFontID)

         Repeat
;{         Get line
            WrapLine = "" : WrapLineWidth = 0 : WrapLineHeight = 0

            If *Options\Wrap = #DTA_True
;{            Wrap
               Repeat
;{               Get word
                  WrapWord = "" : WrapC = ""

                  Repeat
                     WrapWord + WrapC
                     WrapCPosition + 1
                     WrapC = MidFast(*Options\Text, WrapCPosition, 1)
                  Until WrapC = " " Or WrapC = #LF$ Or WrapC = ""
;}

                  WrapLineTemp1 + WrapWord
                  WrapLineTemp1Width = TextWidth(WrapLineTemp1)

                  If *Options\PositionWidth <> 0 And WrapLineTemp1Width > *Options\PositionWidth And WrapLineTemp2  ; Break if width is defined and has been reached
                     WrapLine = WrapLineTemp2
                     WrapLineWidth = WrapLineTemp2Width
                     WrapLineHeight = TextHeight(WrapLineTemp2)
                     WrapLineTemp1 = WrapWord  ; Add "wrapped" word to next temp line
                     WrapLineTemp2 = ""
                     WrapC = " "  ; Don't go out of loop
                     WrapCPosition - 1  ; Do the previous step again
                     Break
                  ElseIf WrapC = #LF$ Or WrapC = ""  ; Regular line break
                     WrapLine = WrapLineTemp1
                     WrapLineWidth = WrapLineTemp1Width
                     WrapLineHeight = TextHeight(WrapLineTemp1 + #LF$)
                     WrapLineTemp1 = ""  ; Clear temp line
                     WrapLineTemp2 = ""
                     ;WrapC = WrapC
                     ;WrapCPosition = WrapCPosition
                     Break
                  Else
                     WrapLineTemp1 + " "
                  EndIf

                  WrapLineTemp2 = WrapLineTemp1
                  WrapLineTemp2Width = WrapLineTemp1Width
               ForEver
;}
            Else
;{            Normal
               WrapLine = *Options\Text
               WrapLineWidth = TextWidth(WrapLine)
               WrapLineHeight = TextHeight(WrapLine)
;}
            EndIf
;}

            ; Add line to list:
            If AddElement(Lines())
               With Lines()
                  \Text = WrapLine
                  \Width = WrapLineWidth
                  \Height = WrapLineHeight
               EndWith
            EndIf
         Until WrapC = ""  ; No characters left in "Get line" loop?

         StopDrawing()
      EndIf
      FreeImage(ImageNrTemp)
   EndIf
;}

;{ Get dimension of whole block (all lines)
   ForEach Lines()
      If Lines()\Width > LineWidthMax : LineWidthMax = Lines()\Width : EndIf
      LineHeightMax + Lines()\Height + *Options\WrapSpacing
   Next
   *Options\PositionWidth = LineWidthMax
   *Options\PositionHeight = LineHeightMax - *Options\WrapSpacing

   If *Options\Outline = #DTA_True
      *Options\PositionWidth + (*Options\OutlineSize * 2)
      *Options\PositionHeight + (*Options\OutlineSize * 2)
   EndIf
;}

;{ Set position of each line
   ForEach Lines()
      Select *Options\Position
         Case #DTA_PositionLeft
            Lines()\X = 0
            If *Options\Outline = #DTA_True : Lines()\X + *Options\OutlineSize : EndIf
         Case #DTA_PositionRight
            Lines()\X = *Options\PositionWidth - Lines()\Width
            If *Options\Outline = #DTA_True : Lines()\X - *Options\OutlineSize : EndIf
         Case #DTA_PositionCenter
            Lines()\X = Round(Center(Lines()\Width, *Options\PositionWidth), #PB_Round_Nearest)
      EndSelect

      Lines()\Y = LineYTemp
      If *Options\Outline = #DTA_True : Lines()\Y + *Options\OutlineSize : EndIf
      LineYTemp + Lines()\Height + *Options\WrapSpacing
   Next
;}

   If *Options\PositionAngle <> 0.0
;{   Apply rotation to block dimension and line position
      ; Based on code by STARGÅTE (http://www.purebasic.fr/german/viewtopic.php?p=285528#p285528)

      RotateSinR = Sin(Radian(*Options\PositionAngle))
      RotateCosR = Cos(Radian(*Options\PositionAngle))

      ; Correct dimension of block:
      RotateOldWidth = *Options\PositionWidth
      RotateOldHeight = *Options\PositionHeight
      *Options\PositionWidth = Abs(RotateCosR * RotateOldWidth) + Abs(RotateSinR * RotateOldHeight)
      *Options\PositionHeight = Abs(-RotateSinR * RotateOldWidth) + Abs(RotateCosR * RotateOldHeight)

      ; Correct position of each line:
      If RotateCosR < 0
         RotateX - (RotateCosR * RotateOldWidth)
      EndIf
      If RotateSinR < 0
         RotateX - (RotateSinR * RotateOldHeight)
      EndIf
      If RotateSinR > 0
         RotateY + (RotateSinR * RotateOldWidth)
      EndIf
      If RotateCosR < 0
         RotateY - (RotateCosR * RotateOldHeight)
      EndIf
      ForEach Lines()
         RotateOldX = Lines()\X
         RotateOldY = Lines()\Y
         Lines()\X = RotateX + ((RotateCosR * RotateOldX) + (RotateSinR * RotateOldY))
         Lines()\Y = RotateY + ((-RotateSinR * RotateOldX) + (RotateCosR * RotateOldY))
      Next
;}
   EndIf


   If *Options\PositionWidth < 1 Or *Options\PositionHeight < 1 Or ListSize(Lines()) = 0  ; Something went wrong
      ProcedureReturn #False
   EndIf
;}

   If *Options\ImageSimulate = #DTA_True
      ProcedureReturn #True
   EndIf


;{ Create image
   ImageNr = CreateImage(*Options\ImageNr, *Options\PositionWidth, *Options\PositionHeight, 32 | #PB_Image_Transparent)
   If *Options\ImageNr <> #PB_Any : ImageNr = *Options\ImageNr : EndIf
   If ImageNr
      If StartDrawing(ImageOutput(ImageNr))
         DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)

;{      Draw text
         DrawingFont(*Options\TextFontID)

         ForEach Lines()
            If *Options\PositionAngle = 0.0
               DrawText(Lines()\X, Lines()\Y, Lines()\Text, *Options\TextColor)
            Else
               DrawRotatedText(Lines()\X, Lines()\Y, Lines()\Text, *Options\PositionAngle, *Options\TextColor)
            EndIf
         Next
;}

         If *Options\Outline = #DTA_True
;{         Draw outline
            ; Based on code by Demivec  (http://www.purebasic.fr/english/viewtopic.php?p=345086#p345086)
            ; (Also check out his much faster procedure: http://www.purebasic.fr/english/viewtopic.php?p=345320#p345320)

            While OutlineY < *Options\PositionHeight
               ; Set ranges:
               OutlineRangeUp = OutlineY - *Options\OutlineSize
               If OutlineRangeUp < 0 : OutlineRangeUp = 0 : EndIf
               OutlineRangeDown = OutlineY + *Options\OutlineSize
               If OutlineRangeDown > *Options\PositionHeight - 1 : OutlineRangeDown = *Options\PositionHeight - 1 : EndIf

               OutlineSkipped = 0
               OutlineX = 0
               Repeat
                  If Point(OutlineX, OutlineY) = *Options\TextColor

                     If OutlineSkipped > *Options\OutlineSize : OutlineSkipped = *Options\OutlineSize : EndIf

                     OutlineTrailingOffset = 0
                     Repeat
                        ; Columns to be filled are always left of current column
                        For OutlineXScan = OutlineX - OutlineSkipped To OutlineX - OutlineTrailingOffset  ; Include current column if not trailing border
                           ; Plot scanline pixel if not in current column (x):
                           If OutlineXScan <> OutlineX
                              If Point(OutlineXScan, OutlineY) <> *Options\OutlineColor : Plot(OutlineXScan, OutlineY, *Options\OutlineColor) : EndIf
                           EndIf

                           ; Check up:
                           For OutlineYScan = OutlineY - 1 To OutlineRangeUp Step -1
                              If Point(OutlineXScan, OutlineYScan) <> *Options\TextColor
                                 If Point(OutlineXScan, OutlineYScan) <> *Options\OutlineColor : Plot(OutlineXScan, OutlineYScan, *Options\OutlineColor) : EndIf
                              EndIf
                           Next

                           ; Check down:
                           For OutlineYScan = OutlineY + 1 To OutlineRangeDown
                              If Point(OutlineXScan, OutlineYScan) <> *Options\TextColor
                                 If Point(OutlineXScan, OutlineYScan) <> *Options\OutlineColor : Plot(OutlineXScan, OutlineYScan, *Options\OutlineColor) : EndIf
                              EndIf
                           Next
                        Next

                        If OutlineTrailingOffset
                           OutlineX - 1  ; Adjust loop variable for next unscanned column
                           Break
                        EndIf

                        ; Check next (right) columns:
                        OutlineRangeRight = OutlineX + *Options\OutlineSize
                        If OutlineRangeRight > *Options\PositionWidth - 1
                           OutlineRangeRight = *Options\PositionWidth - 1
                        EndIf

                        OutlineSkipped = 0
                        OutlineTrailingOffset = 1
                        For OutlineXScan = OutlineX + 1 To OutlineRangeRight
                           If Point(OutlineXScan, OutlineY) = *Options\TextColor  ; Found a new current column
                              OutlineTrailingOffset = 0
                              Break
                           Else
                              OutlineSkipped + 1
                           EndIf
                        Next

                        If OutlineSkipped <> 0
                           OutlineX + OutlineSkipped + 1
                        EndIf
                     Until OutlineSkipped = 0

                  Else
                     OutlineSkipped + 1
                  EndIf

                  OutlineX + 1
               Until OutlineX = *Options\PositionWidth
               OutlineY + 1
            Wend
;}
         EndIf

         StopDrawing()
      EndIf
   EndIf
;}

   ProcedureReturn ImageNr
EndProcedure



;- Example
;{
Enumeration
   #Window
   #ImageGadget
   #Image
   #Option1
   #Option2
   #Option3
   #Option4
   #Font
   #Timer
EndEnumeration

#Width = 400
#Height = 400

#Text = "Test Line 1" + #LF$ + "Test test Line 2" + #LF$ + "Test test test Line 3"

LoadFont(#Font, "Arial", 24, #PB_Font_Bold | #PB_Font_HighQuality | #PB_Font_Italic)

Procedure CreateExampleImage1()
   Protected  DTAO.DrawTextAdvanced_Options, DTAImageNr, X, Y
   Static InitOptions
   Static Color, ColorStep, Angle.f, Spacing, SpacingStep

   ; "Animate" some options:
   If InitOptions = #False
      InitOptions = #True
      Color = $80 : ColorStep = 2
      Angle = 0
      Spacing = 0 : SpacingStep = 1
   EndIf

   Color + ColorStep
   If Color >= $FD : ColorStep = -2 : ElseIf Color <= $02 : ColorStep = 2 : EndIf

   Angle - 2

   Spacing + SpacingStep
   If Spacing >= 15 : SpacingStep = -1 : ElseIf Spacing <= -10 : SpacingStep = 1 : EndIf


   ; Set up the options:
   With DTAO
      \Text = #Text
      \TextColor = RGBA(Color / 2, Color / 2, $FF, $FF - Color)
      \TextFontID = FontID(#Font)
      \Position = #DTA_PositionCenter
      \PositionAngle = Angle
      \WrapSpacing = Spacing
      \Outline = #DTA_True
      \OutlineColor = RGBA(Color, Color, Color, $AA)
      \OutlineSize = 2
   EndWith


   ; Create DTA image and draw it on #Image:
   DTAImageNr = DrawTextAdvanced(@DTAO)
   If DTAImageNr
      CreateImage(#Image, #Width, #Height)
      StartDrawing(ImageOutput(#Image))
         ; Draw background gradient:
         DrawingMode(#PB_2DDrawing_Gradient)
         CircularGradient(#Width / 2, #Height / 2, #Width / 2)
         GradientColor(0.0, $F5CFBD)
         GradientColor(1.0, $E9926B)
         Box(0, 0, #Width, #Height)

         ; Draw centered DTA image:
         X = Center(DTAO\PositionWidth, #Width) : Y = Center(DTAO\PositionHeight, #Height)
         DrawAlphaImage(ImageID(DTAImageNr), X, Y)
      StopDrawing()

      FreeImage(DTAImageNr)
   EndIf
EndProcedure

Procedure CreateExampleImage2()
   Protected  DTA1O.DrawTextAdvanced_Options, DTA1ImageNr, DTA2O.DrawTextAdvanced_Options, DTA2ImageNr, X, Y
   Static InitOptions
   Static Angle.f, AngleStep

   ; "Animate" some options:
   If InitOptions = #False
      InitOptions = #True
      Angle = 0 : AngleStep = 0.5
   EndIf

   Angle + AngleStep
   If Angle >= 10 : AngleStep = -0.5 : ElseIf Angle <= -10 : AngleStep = 0.5 : EndIf


   ; Set up the options:
   With DTA1O
      \Text = #Text
      \TextColor = $FF202020
      \TextFontID = FontID(#Font)
      \Position = #DTA_PositionCenter
      \PositionAngle = Angle
   EndWith

   With DTA2O
      \Text = #Text
      \TextColor = $60202020
      \TextFontID = FontID(#Font)
      \Position = #DTA_PositionCenter
      \PositionAngle = Angle
      \Outline = #DTA_True
      \OutlineColor = $30202020
   EndWith


   ; Create DTA images and draw it on #Image:
   DTA1ImageNr = DrawTextAdvanced(@DTA1O)
   If DTA1ImageNr
      DTA2ImageNr = DrawTextAdvanced(@DTA2O)
      If DTA2ImageNr
         CreateImage(#Image, #Width, #Height)
         StartDrawing(ImageOutput(#Image))
            ; Draw background gradient:
            DrawingMode(#PB_2DDrawing_Gradient)
            CircularGradient(#Width / 2 + 5, #Height / 2 + 10, #Width / 2)
            GradientColor(0.0, $1381C7)
            GradientColor(1.0, $000000)
            Box(0, 0, #Width, #Height)

            ; Draw centered DTA images:
            X = Center(DTA1O\PositionWidth, #Width) : Y = Center(DTA1O\PositionHeight, #Height)
            DrawAlphaImage(ImageID(DTA2ImageNr), X + 1, Y + 2)  ; First the "shadow" image
            DrawAlphaImage(ImageID(DTA1ImageNr), X, Y)
         StopDrawing()

         FreeImage(DTA2ImageNr)
      EndIf
      FreeImage(DTA1ImageNr)
   EndIf
EndProcedure

Procedure CreateExampleImage3()
   Protected  DTAO.DrawTextAdvanced_Options, DTAImageNr, X, Y
   Static InitOptions
   Static Width, WidthStep

   ; "Animate" some options:
   If InitOptions = #False
      InitOptions = #True
      Width = 200 : WidthStep = -2
   EndIf

   Width + WidthStep
   If Width > 350 : WidthStep = -2 : ElseIf Width <= 2 : WidthStep = 2 : EndIf


   ; Set up the options:
   With DTAO
      \Text = #Text
      \TextFontID = FontID(#Font)
      \PositionWidth = Width
   EndWith


   ; Create DTA image and draw it on #Image:
   DTAImageNr = DrawTextAdvanced(@DTAO)
   If DTAImageNr
      CreateImage(#Image, #Width, #Height)
      StartDrawing(ImageOutput(#Image))
         ; Background:
         Box(0, 0, #Width, #Height, $FFFFFF)

         ; Draw line, info text, DTA image and its bounding box:
         X = 40 : Y = 50
         Box(X + Width, 0, 4, #Height, $808080)
         DrawingMode(#PB_2DDrawing_Transparent)
         DrawText(0, 0, "Input: " + Str(Width) + "x ?", $808080)
         DrawText(0, 20, "Result: " + Str(DTAO\PositionWidth) + "x" + Str(DTAO\PositionHeight), $808080)
         DrawAlphaImage(ImageID(DTAImageNr), X, Y)
         DrawingMode(#PB_2DDrawing_Outlined)
         Box(X - 1, Y - 1, DTAO\PositionWidth + 2, DTAO\PositionHeight + 2, $808080)
      StopDrawing()

      FreeImage(DTAImageNr)
   EndIf
EndProcedure


If OpenWindow(#Window, #PB_Ignore, #PB_Ignore, #Width + 20, #Height + 50, "DrawTextAdvanced Examples", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   ImageGadget(#ImageGadget, 10, 10, #Width, #Height, 0)
   OptionGadget(#Option1, 10, #Height + 20, 90, 20, "Example 1")
    SetGadgetState(#Option1, #True)
   OptionGadget(#Option2, 110, #Height + 20, 90, 20, "Example 2")
   OptionGadget(#Option3, 210, #Height + 20, 90, 20, "Example 3")
   OptionGadget(#Option4, 310, #Height + 20, 90, 20, "Pause")

   AddWindowTimer(#Window, #Timer, 50)

   Repeat
      Select WaitWindowEvent()
         Case #PB_Event_Timer
            If EventTimer() = #Timer
               Select (GetGadgetState(#Option1) * 1) + (GetGadgetState(#Option2) * 2) + (GetGadgetState(#Option3) * 3)
                  Case 1 : CreateExampleImage1()
                  Case 2 : CreateExampleImage2()
                  Case 3 : CreateExampleImage3()
               EndSelect
               SetGadgetState(#ImageGadget, ImageID(#Image))
            EndIf
         Case #PB_Event_CloseWindow
            Break
      EndSelect
   ForEver
EndIf
;}

;Draw a border of width 'owidth' using color 'ocol' around pixels of color 'dcol'
;Before calling procedure an output must be selected with StartDrawing().
;(x1,y1) (x2,y2) define a rectangle to search and where drawing occurs.
Procedure outlineDrawing(x1, y1, x2, y2, owidth, ocol, dcol)
  Protected iw = x2 - x1 + 1, ih = y2 - y1 + 1
  Protected upRange, downRange, rightRange, trailingBorderOffset, skipped, x, y, xScan, yScan
 
  ;vertical
  ;y = 0
  ;repeat
  While y < ih
    ;set ranges
    upRange = y - owidth
    If upRange < 0
      upRange = 0
    EndIf
    downRange = y + owidth
    If downRange > ih - 1
      downRange = ih - 1
    EndIf
   
    ;horizontal
    skipped = 0
    x = 0
    Repeat
      If Point(x, y) = dcol
       
        If skipped > owidth
          skipped = owidth
        EndIf
       
        trailingBorderOffset = 0
        Repeat
          ;columns to be filled are always to the left of the current column
          For xScan = x - skipped To x - trailingBorderOffset ;include current column if not a trailing border
            ;plot scanline pixel if not in the current column (x)
            If xScan <> x
              Plot(xScan, y, ocol)
            EndIf
           
                        ;check up
            For yScan = y - 1 To upRange Step -1
              If Point(xScan, yScan) <> dcol
                Plot(xScan, yScan, ocol)
              EndIf
            Next
           
            ;check down
            For yScan = y + 1 To downRange
              If Point(xScan, yScan) <> dcol
                Plot(xScan, yScan, ocol)
              EndIf
            Next
          Next
         
          If trailingBorderOffset
            x - 1 ;adjust loop variable for the next unscanned column
            Break ;exit Repeat/Until
          EndIf
         
          ;check next (right) columns
          rightRange = x + owidth
          If rightRange > iw - 1
            rightRange = iw - 1
          EndIf
         
          skipped = 0
          trailingBorderOffset = 1
          For xScan = x + 1 To rightRange
            If Point(xScan, y) = dcol
              ;found a new current column
              trailingBorderOffset = 0
              Break
            Else
              skipped + 1
            EndIf
          Next
         
          If skipped <> 0
            x + skipped + 1
          EndIf
        Until skipped = 0
       
      Else
        skipped + 1
      EndIf
     
      x + 1
    Until x = iw
    y + 1
    ;Until y = ih
  Wend
 
EndProcedure

If *Options\Outline = #DTA_True
  ;{         Draw outline
  ; Based on code by Trond (http://www.purebasic.fr/english/viewtopic.php?p=314663#p314663)
  For OutlineY1 = 0 To *Options\PositionHeight - 1
    For OutlineX1 = 0 To *Options\PositionWidth - 1
      If Point(OutlineX1, OutlineY1) <> *Options\textColor
       
        For OutlineY2 = -*Options\OutlineSize To *Options\OutlineSize
          OutlineY = OutlineY1 + OutlineY2
          If OutlineY >= 0 And OutlineY < *Options\PositionHeight
           
            For OutlineX2 = -*Options\OutlineSize To *Options\OutlineSize
              OutlineX = OutlineX1 + OutlineX2
              If OutlineX >= 0 And OutlineX < *Options\PositionWidth
                If Point(OutlineX, OutlineY) = *Options\textColor
                  Plot(OutlineX1, OutlineY1, *Options\OutlineColor)
                  Break 2
                EndIf
              EndIf
            Next
           
          EndIf
        Next
       
      EndIf
    Next
  Next
  ;}
EndIf

If *Options\Outline = #DTA_True
  ;{         Draw outline
  outlineDrawing(0,0,*Options\PositionWidth - 1, *Options\PositionHeight - 1, *Options\OutlineSize, *Options\OutlineColor,*Options\textColor)
  ;}
EndIf

;Draw a border of width 'owidth' using color 'ocol' around pixels of color 'dcol'
;Before calling procedure an output must be selected with StartDrawing().
;Requires a 32-bit output.
;(x1,y1) (x2,y2) define a rectangle to search and where drawing occurs.
Procedure outlineDrawing(x1, y1, x2, y2, owidth, ocol, dcol)
  Protected iw = x2 - x1 + 1, ih = y2 - y1 + 1
  Protected i, maxLineIndex = owidth * 2 - 1
  Dim b_dcol(maxLineIndex, iw - 1)
  Dim b_ocol(maxLineIndex, iw - 1)
  Dim b_index(maxLineIndex)
 
  Protected *dbuf, dbufPixForm, dbufPitch, pitchIncrement = 4, isDbufReverseY
  *dbuf = DrawingBuffer()
  dbufPixForm = DrawingBufferPixelFormat()
  dbufPitch = DrawingBufferPitch()

  If Not (dbufPixForm & (#PB_PixelFormat_32Bits_RGB | #PB_PixelFormat_32Bits_BGR))
    ProcedureReturn
  EndIf
  ;translate dcol value into correct format based on drawing buffer's pixel format
  If dbufPixForm & #PB_PixelFormat_32Bits_RGB
    dcol = Alpha(dcol) << 24 + Blue(dcol) << 16 + Green(dcol) << 8 + Red(dcol)
  Else
    dcol = Alpha(dcol) << 24 + Red(dcol) << 16 + Green(dcol) << 8 + Blue(dcol)
  EndIf
  isDbufReverseY = dbufPixForm & #PB_PixelFormat_ReversedY

  ;initialize indexes
  For i = 0 To maxLineIndex
    b_index(i) = i
  Next
 
  Protected scanLineCount, calcLineCount = -owidth, plotLineCount = -2 * owidth
  Protected upRange, downRange, rightRange, trailingBorderOffset, skipped, x, y, xScan, yScan
  Protected tempIndexValue
  ;vertical
  y = y1
  While y <= y2 Or plotLineCount < ih
   
    If scanLineCount < ih
      ;scan line data
      *dbuf = DrawingBuffer() ;an assumption is made that the pitch and pixel format will be the same each time
      For x = x1 To x2
        If PeekI(*dbuf + dbufPitch * (y - y1) + x * pitchIncrement) = dcol
          b_dcol(b_index(maxLineIndex), x - x1) = #True
        Else
          b_dcol(b_index(maxLineIndex), x - x1) = #False
        EndIf
      Next
      scanLineCount + 1
    Else
      FillMemory(@b_dcol(b_index(maxLineIndex), 0), iw * SizeOf(Integer), #False, #PB_Integer)
    EndIf
    FillMemory(@b_ocol(b_index(maxLineIndex), 0), iw * SizeOf(Integer), #False, #PB_Integer)
   
    If calcLineCount >= 0 And calcLineCount < ih
      ;set ranges
      upRange = owidth - calcLineCount
      If upRange < 0
        upRange = 0
      EndIf
      downRange = owidth + calcLineCount
      If downRange > maxLineIndex
        downRange = maxLineIndex
      EndIf

      ;horizontal
      skipped = 0
      x = 0
      Repeat
        If b_dcol(b_index(owidth), x)
         
          If skipped > owidth
            skipped = owidth
          EndIf
         
          trailingBorderOffset = 0
          Repeat
            ;columns to be filled are always to the left of the current column
            For xScan = x - skipped To x - trailingBorderOffset ;include current column if not a trailing border
              ;mark pixel for plotting if not in the current column (x)
              If xScan <> x
                b_ocol(b_index(owidth), xScan) = #True
              EndIf
             
              ;check up
              For yScan = owidth - 1 To upRange Step -1
                If b_dcol(b_index(yScan), xScan)
                  Break ;blocked
                Else
                  b_ocol(b_index(yScan), xScan) = #True
                EndIf
              Next
             
              ;check down
              For yScan = owidth + 1 To downRange
                If b_dcol(b_index(yScan), xScan)
                  Break ;blocked
                Else
                  b_ocol(b_index(yScan), xScan) = #True
                EndIf
              Next
            Next
           
            If trailingBorderOffset
              x - 1 ;adjust loop variable for the next unscanned column
              Break ;exit Repeat/Until
            EndIf
           
            ;check next (right) columns
            rightRange = x + owidth
            If rightRange > iw - 1
              rightRange = iw - 1
            EndIf
           
            skipped = 0
            trailingBorderOffset = 1
            For xScan = x + 1 To rightRange
              If b_dcol(b_index(owidth), xScan)
                ;found a new current column
                trailingBorderOffset = 0
                Break
              Else
                skipped + 1
              EndIf
            Next
           
            If skipped <> 0
              x + skipped + 1
            EndIf
          Until skipped = 0
         
        Else
          skipped + 1
        EndIf
       
        x + 1
      Until x = iw
    EndIf
    calcLineCount + 1
   
    ;plot finished scanline
    If plotLineCount >= 0
      For x = x1 To x2
        If b_ocol(b_index(0), x - x1)
          If isDbufReverseY
            Plot(x, y2 - plotLineCount - 1, ocol)
          Else
            Plot(x, plotLineCount, ocol)
          EndIf
        EndIf
      Next
    EndIf
    plotLineCount + 1

    ;shift line indexes
    tempIndexValue = b_index(0)
    For i = 1 To maxLineIndex
      b_index(i - 1) = b_index(i)
    Next
    b_index(maxLineIndex) = tempIndexValue
   
    y + 1
  Wend
EndProcedure