PBMiner

$PBExportHeader$u_cst_statictext.sru
forward
global type u_cst_statictext from u_cst_canvas
end type
type st_name from statictext within u_cst_statictext
end type
type logfont from structure within u_cst_statictext
end type
type rect from structure within u_cst_statictext
end type
end forward

type logfont from structure
   long     lfheight
   long     lfwidth
   long     lfescapement
   long     lforientation
   long     lfweight
   integer     lfitalic_lfunderline
   integer     lfstrikeout_lfcharset
   integer     lfoutprecision_lfclipprecision
   integer     lfquality_lfpitchandfamily
   character      lffacename[32]
end type

type rect from structure
   long     left
   long     top
   long     right
   long     bottom
end type

global type u_cst_statictext from u_cst_canvas
integer width = 590
integer height = 100
long backcolor = 8421376
st_name st_name
end type
global u_cst_statictext u_cst_statictext

type prototypes
Function Boolean GetClientRect( &
   Long hWnd, &
   Ref RECT lpRect &
   ) Library "user32.dll"

Function ulong CreateFontIndirect( &
   Ref LOGFONT lplf &
   ) Library "gdi32.dll" Alias For "CreateFontIndirectA"

Function ulong DrawText( &
   ulong hDC, &
   Ref string lpchText, &
   long nCount, &
   Ref RECT lpRect, &
   ulong uFormat &
   ) Library "user32.dll" Alias For "DrawTextA"

Function ulong SelectObject( &
   ulong hdc, &
   ulong hgdiobj &
   ) Library "gdi32.dll"

Function boolean DeleteObject( &
   ulong hObject &
   ) Library "gdi32.dll"

Function ulong SetBkMode( &
   ulong hdc, &
   ulong iBkMode &
   ) Library "gdi32.dll" 

Function ulong SetTextColor( &
   ulong hdc, &
   ulong crColor &
   ) Library "gdi32.dll" 

Function ulong MulDiv( &
   ulong nNumber, &
   ulong nNumerator, &
   ulong nDenominator &
   ) Library "kernel32.dll" 

Function ulong GetDeviceCaps( &
   ulong hdc, &
   ulong nIndex &
   ) Library "gdi32.dll" 

end prototypes

type variables
Public:

String  TextValue
Boolean VertGradientFill
Boolean HorzGradientFill
Boolean Bold
Boolean Italic
Boolean Underline
Boolean Strikeout
Boolean WordWrap
Boolean Ellipsis
Alignment  HAlign = Left!
VTextAlign VAlign = Top!
String  FontName = "Tahoma"
Integer FontSize = 10
Long    FontColor
Integer Escapement

Private:

Integer OffsetTop
Integer OffsetLeft
Long    GradientColor1 = 12639424   // Mint
Long    GradientColor2 = 15780518   // Sky

Constant Long DT_TOP             = 0
Constant Long DT_LEFT            = 0
Constant Long DT_CENTER          = 1
Constant Long DT_RIGHT           = 2
Constant Long DT_VCENTER         = 4
Constant Long DT_BOTTOM          = 8
Constant Long DT_WORDBREAK       = 16
Constant Long DT_SINGLELINE      = 32
Constant Long DT_EXPANDTABS      = 64
Constant Long DT_TABSTOP         = 128
Constant Long DT_NOCLIP          = 256
Constant Long DT_EXTERNALLEADING = 512
Constant Long DT_CALCRECT        = 1024
Constant Long DT_NOPREFIX        = 2048
Constant Long DT_INTERNAL        = 4096
Constant Long DT_EDITCONTROL     = 8192
Constant Long DT_PATH_ELLIPSIS   = 16384
Constant Long DT_END_ELLIPSIS    = 32768
Constant Long DT_MODIFYSTRING    = 65536
Constant Long DT_RTLREADING      = 131072
Constant Long DT_WORD_ELLIPSIS   = 262144

end variables

forward prototypes
private function unsignedlong of_createfont (long hdc)
private function boolean of_drawtext (long hdc)
public function unsignedlong bitwiseor (unsignedlong aul_arg1, unsignedlong aul_arg2)
public subroutine setfontcolor (integer ai_red, integer ai_green, integer ai_blue)
public subroutine setbold (boolean ab_value)
public subroutine setitalic (boolean ab_value)
public subroutine setunderline (boolean ab_value)
public subroutine setstrikeout (boolean ab_value)
public subroutine sethalignment (alignment ae_value)
public subroutine setvalignment (vtextalign ae_value)
public subroutine setwordwrap (boolean ab_value)
public subroutine settextvalue (string as_value)
public subroutine setfontname (string as_value)
public subroutine setfontsize (integer ai_value)
public subroutine setescapement (integer ai_value)
public subroutine setfontcolor (long al_value)
public subroutine setellipsis (boolean ab_value)
public subroutine setborder (boolean ab_value)
public subroutine aligncenter ()
public subroutine alignleft ()
public subroutine alignright ()
public subroutine valigncenter ()
public subroutine valigntop ()
public subroutine valignbottom ()
public subroutine valignmultiline ()
public subroutine setoffsettop (integer ai_value)
public subroutine setoffsetleft (integer ai_value)
public subroutine setvertgradientfill (boolean ab_value)
public subroutine sethorzgradientfill (boolean ab_value)
protected subroutine of_paintbackcolor (long hdc)
public subroutine setgradientcolor (long al_color1, long al_color2)
end prototypes

private function unsignedlong of_createfont (long hdc);// create the font object

Constant ULong LOGPIXELSY = 90
LogFont lstr_lf

lstr_lf.lfHeight = -1 * ( MulDiv(FontSize, GetDeviceCaps(hdc, LOGPIXELSY), 72) )

lstr_lf.lfEscapement = Escapement * 10

If Bold Then
   lstr_lf.lfWeight = 700
Else
   lstr_lf.lfWeight = 400
End If

If Italic Then
   If Underline Then
      lstr_lf.lfItalic_lfUnderline = 257
   Else
      lstr_lf.lfItalic_lfUnderline = 1
   End If
Else
   If Underline Then
      lstr_lf.lfItalic_lfUnderline = 256
   Else
      lstr_lf.lfItalic_lfUnderline = 0
   End If
End If

If Strikeout Then
   lstr_lf.lfStrikeout_lfCharset = 1
End If

lstr_lf.lfFaceName = FontName

// create font
Return CreateFontIndirect(lstr_lf)

end function

private function boolean of_drawtext (long hdc);// draw the text

RECT lstr_Rect
ULong lul_font, lul_parm, lul_return

// create the font object
lul_font = of_CreateFont(hdc)
If lul_font > 0 Then

   // set the position and size of the drawing rectangle
   lstr_Rect.Left = OffsetLeft
   lstr_Rect.Top  = OffsetTop
   If Border Then
      If BorderStyle = StyleBox! Then
         lstr_Rect.Right  = UnitsToPixels(Width, XUnitsToPixels!) - 2
         lstr_Rect.Bottom = UnitsToPixels(Height, YUnitsToPixels!) - 2
      Else
         lstr_Rect.Right  = UnitsToPixels(Width, XUnitsToPixels!) - 4
         lstr_Rect.Bottom = UnitsToPixels(Height, YUnitsToPixels!) - 4
      End If
   Else
      lstr_Rect.Right  = UnitsToPixels(Width, XUnitsToPixels!)
      lstr_Rect.Bottom = UnitsToPixels(Height, YUnitsToPixels!)
   End If

   // DrawText is faster with clipping off
   lul_parm = DT_NOCLIP

   // horizontal alignment
   choose case HAlign
      case Left!
         lul_parm = BitWiseOr(lul_parm, DT_LEFT)
      case Center!
         lul_parm = BitWiseOr(lul_parm, DT_CENTER)
      case Right!
         lul_parm = BitWiseOr(lul_parm, DT_RIGHT)
   end choose

   // vertical alignment
   choose case VAlign
      case Top!
         lul_parm = BitWiseOr(lul_parm, DT_SINGLELINE)
         lul_parm = BitWiseOr(lul_parm, DT_TOP)
      case Bottom!
         lul_parm = BitWiseOr(lul_parm, DT_SINGLELINE)
         lul_parm = BitWiseOr(lul_parm, DT_BOTTOM)
      case VCenter!
         lul_parm = BitWiseOr(lul_parm, DT_SINGLELINE)
         lul_parm = BitWiseOr(lul_parm, DT_CENTER)
   end choose

   // word wrap
   If WordWrap Then
      lul_parm = BitWiseOr(lul_parm, DT_WORDBREAK)
   End If

   // ellipsis
   If Ellipsis Then
      lul_parm = BitWiseOr(lul_parm, DT_WORD_ELLIPSIS)
   End If

   // select font into the DC
   SelectObject(hdc, lul_font)

   // set font to transparent
   SetBkMode(hdc, 1)

   // set the font color
   SetTextColor(hdc, FontColor)

   // draw the text
   lul_return = DrawText(hdc, TextValue, Len(TextValue), lstr_Rect, lul_parm)

   // delete the font object
   DeleteObject(lul_font)

End If

If lul_return = 0 Then
   Return False
Else
   Return True
End If

end function

public function unsignedlong bitwiseor (unsignedlong aul_arg1, unsignedlong aul_arg2);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_statictext.BitwiseOr
//
// PURPOSE:    This function performs a Bitwise OR on two numbers.
//
// ARGUMENTS:  aul_arg1 - Number one
//             aul_arg2 - Number two
//
// RETURN:     Combined number
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/26/2013  RolandS     I copied this from Brad Wery's Advanced GUI library.
// -----------------------------------------------------------------------------

ULong ul_exp, ul_exp_last=1, ul_bit1, ul_bit2, ul_ret
Long ll_i

For ll_i = 1 To 31
   ul_exp=2^ll_i
   ul_bit1=mod(aul_arg1,ul_exp)
   ul_bit2=mod(aul_arg2,ul_exp)
   If ul_bit1 > 0 Or ul_bit2 > 0 Then
      ul_ret+=ul_exp_last
   End If
   ul_exp_last=ul_exp
   aul_arg1 -=ul_bit1
   aul_arg2 -=ul_bit2
Next

If aul_arg1 > 0 Or aul_arg2 > 0 Then
   ul_ret+=ul_exp_last
End If

Return ul_ret

end function

public subroutine setfontcolor (integer ai_red, integer ai_green, integer ai_blue);FontColor = RGB(ai_red, ai_green, ai_blue)

SetRedraw(True)

end subroutine

public subroutine setbold (boolean ab_value);Bold = ab_value

SetRedraw(True)

end subroutine

public subroutine setitalic (boolean ab_value);Italic = ab_value

SetRedraw(True)

end subroutine

public subroutine setunderline (boolean ab_value);Underline = ab_value

SetRedraw(True)

end subroutine

public subroutine setstrikeout (boolean ab_value);Strikeout = ab_value

SetRedraw(True)

end subroutine

public subroutine sethalignment (alignment ae_value);HAlign = ae_value

SetRedraw(True)

end subroutine

public subroutine setvalignment (vtextalign ae_value);VAlign = ae_value

SetRedraw(True)

end subroutine

public subroutine setwordwrap (boolean ab_value);WordWrap = ab_value

SetRedraw(True)

end subroutine

public subroutine settextvalue (string as_value);TextValue = as_value

SetRedraw(True)

end subroutine

public subroutine setfontname (string as_value);FontName = as_value

SetRedraw(True)

end subroutine

public subroutine setfontsize (integer ai_value);FontSize = ai_value

SetRedraw(True)

end subroutine

public subroutine setescapement (integer ai_value);Escapement = ai_value

SetRedraw(True)

end subroutine

public subroutine setfontcolor (long al_value);FontColor = al_value

SetRedraw(True)

end subroutine

public subroutine setellipsis (boolean ab_value);Ellipsis = ab_value

SetRedraw(True)

end subroutine

public subroutine setborder (boolean ab_value);Border = ab_value

SetRedraw(True)

end subroutine

public subroutine aligncenter ();HAlign = Center!

SetRedraw(True)

end subroutine

public subroutine alignleft ();HAlign = Left!

SetRedraw(True)

end subroutine

public subroutine alignright ();HAlign = Right!

SetRedraw(True)

end subroutine

public subroutine valigncenter ();VAlign = VCenter!

SetRedraw(True)

end subroutine

public subroutine valigntop ();VAlign = Top!

SetRedraw(True)

end subroutine

public subroutine valignbottom ();VAlign = Bottom!

SetRedraw(True)

end subroutine

public subroutine valignmultiline ();VAlign = Multiline!

SetRedraw(True)

end subroutine

public subroutine setoffsettop (integer ai_value);OffsetTop = ai_value

SetRedraw(True)

end subroutine

public subroutine setoffsetleft (integer ai_value);OffsetLeft = ai_value

SetRedraw(True)

end subroutine

public subroutine setvertgradientfill (boolean ab_value);VertGradientFill = ab_value

SetRedraw(True)

end subroutine

public subroutine sethorzgradientfill (boolean ab_value);HorzGradientFill = ab_value

SetRedraw(True)

end subroutine

protected subroutine of_paintbackcolor (long hdc);RECT rc
n_gradient ln_gradient
Integer li_Width, li_Height
Long ll_hWnd, ll_backcolor1, ll_backcolor2

// get control size
ll_hWnd = Handle(this)
GetClientRect(ll_hWnd, rc)

// determine background colors
If VertGradientFill Or HorzGradientFill Then
   ll_backcolor1 = GetPBColor(GradientColor1)
   ll_backcolor2 = GetPBColor(GradientColor2)
Else
   // normal background
   ll_backcolor1 = GetPBColor(BackColor)
   ll_backcolor2 = ll_backcolor1
End If

// draw the background
If VertGradientFill Then
   ln_gradient.Vertical(hdc, rc.Top, rc.Left, &
         rc.Right, rc.Bottom, ll_backcolor1, ll_backcolor2)
Else
   ln_gradient.Horizontal(hdc, rc.Top, rc.Left, &
         rc.Right, rc.Bottom, ll_backcolor1, ll_backcolor2)
End If

end subroutine

public subroutine setgradientcolor (long al_color1, long al_color2);GradientColor1 = al_color1
GradientColor2 = al_color2

SetRedraw(True)

end subroutine

on u_cst_statictext.create
int iCurrent
call super::create
this.st_name=create st_name
iCurrent=UpperBound(this.Control)
this.Control[iCurrent+1]=this.st_name
end on

on u_cst_statictext.destroy
call super::destroy
destroy(this.st_name)
end on

event constructor;call super::constructor;// set control transparency
of_SetTransparent(True)

end event

event onpaint;call super::onpaint;// draw the text
of_DrawText(hdc)

Return 0

end event

type st_name from statictext within u_cst_statictext
integer x = 37
integer y = 32
integer width = 517
integer height = 68
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 16777215
long backcolor = 8421376
string text = "StaticText"
boolean focusrectangle = false
end type

event constructor;this.Visible = False

end event