PBMiner

$PBExportHeader$u_borderpanel.sru
$PBExportComments$Panel object
forward
global type u_borderpanel from u_base_container
end type
type uo_gradient from u_st_gradient within u_borderpanel
end type
type st_1 from statictext within u_borderpanel
end type
end forward

global type u_borderpanel from u_base_container
integer width = 731
integer height = 464
boolean border = true
event ke_xclicked ( )
event ke_getfocus pbm_setfocus
uo_gradient uo_gradient
st_1 st_1
end type
global u_borderpanel u_borderpanel

type prototypes
FUNCTION boolean GetClientRect (ulong hWnd, ref RECT lpRect) Library "USER32.DLL" alias for "GetClientRect;Ansi"
end prototypes
type variables
Public:
string #ChildObject
boolean #ShowHeader, #ShowX
boolean #UseTheme
integer #ThemePanelStyle = 0
integer #HeaderHeight = 92
integer #HeaderFontSize = 14
string #HeaderText = "Edit Text"
boolean #HeaderBold
Protected:
DragObject ido_child
Private:
string SERVICE_OBJECT = "n_svc_borderpanel"
boolean IS_XP, IS_OVERX, MOUSECAPTURED, DRAW_RECT
long iul_xfont, il_originalparent
end variables

forward prototypes
public subroutine of_setchildobject (readonly string as_objectname)
public function dragobject of_getchildobject ()
protected function string of_getservicename ()
public subroutine of_showheader (readonly boolean ab_show)
public subroutine of_setheadertext (readonly string as_text)
public subroutine of_setheaderfontsize (readonly integer ai_size)
public function string of_getheadertext ()
public subroutine of_setheadericon (readonly long al_iconindex, readonly boolean ab_alignright)
public subroutine of_setheaderimagelist (readonly unsignedlong aul_himl, readonly integer ai_iconsize)
protected function long of_createxfont (ref n_svc_mgr anv_svc)
public subroutine of_showx (readonly boolean ab_show)
protected function rect of_getxrect ()
protected subroutine of_returnchild ()
public subroutine of_settheme (readonly str_theme astr_theme)
public subroutine of_setheaderbold (readonly boolean ab_bold)
public subroutine of_setoriginalparent (readonly long al_parent)
end prototypes

event ke_xclicked();//x clicked
end event

event ke_getfocus;IF ISVALID(ido_child) THEN ido_child.SetFocus()
end event

public subroutine of_setchildobject (readonly string as_objectname);n_svc_mgr lnv_svc
n_svc_isempty lnv_check
n_svc_borderpanel lnv_panel

#ChildObject = as_objectname

lnv_svc.of_LoadSvc(lnv_check, CSvc.ISEMPTY)
IF lnv_check.of_IsEmpty(#ChildObject) THEN RETURN

lnv_svc.of_LoadSvc(lnv_panel, of_getservicename())
ido_child = lnv_panel.of_SetChildObject(lnv_svc, this, #ChildObject)
end subroutine

public function dragobject of_getchildobject ();RETURN ido_child
end function

protected function string of_getservicename ();RETURN SERVICE_OBJECT
end function

public subroutine of_showheader (readonly boolean ab_show);#ShowHeader = ab_show
uo_gradient.Visible = #ShowHeader
IS_OVERX = FALSE
this.TriggerEvent("resize")
end subroutine

public subroutine of_setheadertext (readonly string as_text);#HeaderText = as_text
uo_gradient.of_settext(#HeaderText)
end subroutine

public subroutine of_setheaderfontsize (readonly integer ai_size);#HeaderFontSize = ai_size
uo_gradient.of_SetFontSize(#HeaderFontSize)
end subroutine

public function string of_getheadertext ();RETURN uo_gradient.#Text
end function

public subroutine of_setheadericon (readonly long al_iconindex, readonly boolean ab_alignright);uo_gradient.of_SetIcon(al_iconindex, ab_alignright)
end subroutine

public subroutine of_setheaderimagelist (readonly unsignedlong aul_himl, readonly integer ai_iconsize);uo_gradient.of_SetImageList(aul_himl, ai_iconsize)
end subroutine

protected function long of_createxfont (ref n_svc_mgr anv_svc);LogFont lstr_Lf
uLong lul_Font

IF iul_xfont <> 0 THEN RETURN iul_xfont

lstr_Lf.lffacename = "Marlett"
lstr_Lf.lfweight = 400
lstr_Lf.lfheight = -10
lstr_Lf.lfPitchAndFamily = '1'
lstr_Lf.lfClipPrecision = Char(2)
lstr_Lf.lfOutPrecision = Char(1)
lstr_Lf.lfQuality = Char(1)
lstr_Lf.lfCharset = Char(1)

//IF iul_xfont <> 0 THEN uo_gradient.DeleteObject(iul_xfont)

iul_xfont = uo_gradient.CreateFontIndirect( lstr_Lf )

RETURN iul_xfont
end function

public subroutine of_showx (readonly boolean ab_show);#ShowX = ab_show
uo_gradient.of_Refresh()
end subroutine

protected function rect of_getxrect ();RECT rc, rcret
CONSTANT long wh = 16

GetClientRect(Handle(uo_gradient), rc)

rcret.left = rc.right - 25
rcret.right = rcret.left + wh
rcret.top = ((rc.bottom - rc.top) / 2 )- (wh / 2)
rcret.bottom = rcret.top + wh - 1

RETURN rcret
end function

protected subroutine of_returnchild ();IF ISVALID(ido_child) THEN
   SetParent(Handle(ido_child), il_originalparent)
END IF
end subroutine

public subroutine of_settheme (readonly str_theme astr_theme);IF #ThemePanelStyle = 1 THEN
   uo_gradient.of_setcolors( &
      astr_theme.toolbargradientstart , &
      astr_theme.toolbargradientend)
      
   uo_gradient.of_SetFontcolor(astr_theme.TextColor)
ELSE
   uo_gradient.of_SetTheme(astr_theme)
END IF

uo_gradient.backcolor = astr_theme.PanelBorderColor
this.backcolor = astr_theme.PanelBorderColor
end subroutine

public subroutine of_setheaderbold (readonly boolean ab_bold);#HeaderBold = ab_bold

uo_gradient.of_Setfontbold(#HeaderBold)
end subroutine

public subroutine of_setoriginalparent (readonly long al_parent);il_originalparent = al_parent
end subroutine

on u_borderpanel.create
int iCurrent
call super::create
this.uo_gradient=create uo_gradient
this.st_1=create st_1
iCurrent=UpperBound(this.Control)
this.Control[iCurrent+1]=this.uo_gradient
this.Control[iCurrent+2]=this.st_1
end on

on u_borderpanel.destroy
call super::destroy
destroy(this.uo_gradient)
destroy(this.st_1)
end on

event ke_preopen;call super::ke_preopen;st_1.Visible = FALSE
this.Border = FALSE
end event

event ke_postopen;call super::ke_postopen;uo_gradient.of_SuspendDraw(TRUE)
of_SetChildObject(#ChildObject)
of_SetHeaderText(#HeaderText)
of_SetHeaderFontSize(#HeaderFontSize)
of_ShowHeader(#ShowHeader)
of_SetHeaderBold(#HeaderBold)

IF #UseTheme THEN
   n_svc_mgr lnv_svc
   n_svc_theme lnv_t
   str_theme lstr
   
   lnv_svc.of_LoadSvc(lnv_t, CSvc.THEME)
   lstr = lnv_t.of_GetTheme()
   of_SetTheme(lstr)
END IF

uo_gradient.of_SuspendDraw(FALSE)
end event

event ke_resize;call super::ke_resize;IF #ShowHeader THEN
   uo_gradient.Move(0, 0)
   uo_gradient.Resize(newwidth, #HeaderHeight)
END IF
IF ISVALID(ido_child) THEN
   long llx, lly
   str_resize lstr
   
   llx = PixelsToUnits(1, XPixelsToUnits!)
   lly = PixelsToUnits(1, YPixelsToUnits!)

   IF #ShowHeader THEN
      ido_child.Move(llx, uo_gradient.height)
      ido_child.Resize(newwidth - (llx * 2), &
                 newheight - (uo_gradient.height + lly))
   ELSE
      ido_child.Move(llx, lly)
      ido_child.Resize(newwidth - (llx * 2), &
                 newheight - (lly * 2))
   END IF
END IF
end event

event destructor;call super::destructor;IF iul_xfont <> 0 THEN uo_gradient.DeleteObject(iul_xfont)

of_ReturnChild()
end event

type uo_gradient from u_st_gradient within u_borderpanel
event ke_drawx ( ref n_svc_mgr anv_svc,  readonly unsignedlong hdc )
boolean visible = false
integer width = 0
integer height = 0
integer taborder = 20
boolean #showborder = true
integer #fontsize = 14
boolean #verticalgradient = true
end type

event ke_drawx(ref n_svc_mgr anv_svc, readonly unsignedlong hdc);//n_svc_win32 lnv_win32
RECT rc, rcinner
ulong ll_brush, ll_oldbrush, ll_font, ll_oldfont
string ls_x
//CONSTANT ulong DT_VCENTER = 4      //0x00000004

IF IS_OVERX AND DRAW_RECT THEN RETURN

//anv_svc.of_LoadSvc(lnv_win32, CSvc.WIN32)

rc = of_GetXRect()
ll_font = of_CreateXFont(anv_svc)
ll_oldfont = uo_gradient.SelectObject(hdc, ll_font)
uo_gradient.SetBkMode(hdc, 1)
ls_x = "r"

IF IS_OVERX THEN
   IF NOT DRAW_RECT THEN
      n_svc_theme lnv_t
      str_theme lstr
      
      //get theme
      anv_svc.of_LoadSvc(lnv_t, CSvc.THEME)
      lstr = lnv_t.of_GetTheme()
   
      ll_brush = CreateSolidBrush(lstr.buttonborder)
      FillRect(hdc, rc, ll_brush)
      DeleteObject(ll_brush)
   
      //inner
      rcinner = rc
      rcinner.left += 1
      rcinner.right -= 1
      rcinner.top += 1
      rcinner.bottom -=1
   
      ll_brush = CreateSolidBrush(lstr.pressedgradientstart)
      FillRect(hdc, rcinner, ll_brush)
      DeleteObject(ll_brush)
      
      //set pen color
      SetTextColor(hdc, CColor.BLACK)
      
      DRAW_RECT = TRUE
   END IF
ELSE
   DRAW_RECT = FALSE
END IF

rc.top += 3
rc.left += 3

uo_gradient.DrawText(hdc, ls_x, 1, rc, 4)

uo_gradient.SetBkMode(hdc, 2)
ll_font = uo_gradient.SelectObject(hdc, ll_oldfont)
//lnv_win32.DeleteObject(ll_font)

//IF IS_OVERX THEN
// lnv_win32.SetTextColor(hdc, #FontColor)   
//END IF

end event

on uo_gradient.destroy
call u_st_gradient::destroy
end on

event ke_paint;call super::ke_paint;IF #ShowHeader AND #ShowX THEN this.EVENT ke_drawx(anv_svc, hdc)
end event

event ke_mousemove;call super::ke_mousemove;IF #ShowX AND #ShowHeader THEN
   //track if the mouse is over the X
   RECT rc, rcp
   POINT pt
   boolean lb
   
   n_svc_mgr lnv_svc
   n_svc_win32 lnv_win32
   
   pt.px = UnitsToPixels(xpos, XUnitsToPixels!)
   pt.py = UnitsToPixels(ypos, YUnitsToPixels!)
   
   lnv_Svc.of_LoadSvc(lnv_win32, CSvc.WIN32)
   
   IF NOT MOUSECAPTURED THEN
      lnv_win32.SetCapture(Handle(this.uo_pbnicanvas))
      MOUSECAPTURED = TRUE
   END IF

   rc = of_GetXRect()
   lnv_Win32.GetClientRect(Handle(this), rcp)

   lb = (pt.px >= rc.left) &
            AND (pt.px <= rc.right) &
            AND (pt.py >= rc.top) &
            AND (pt.py <= rc.bottom)

   IF lb <> IS_OVERX THEN
      IS_OVERX = lb
      this.SetRedraw(TRUE)
   END IF

   IF pt.px >= rcp.right OR pt.px <= rcp.left OR pt.py <= rcp.top OR pt.py >= rcp.bottom THEN
      IF MOUSECAPTURED THEN
         lnv_win32.ReleaseCapture()
         MOUSECAPTURED = FALSE
      END IF
   END IF
ELSE
   //release mouse
   IF MOUSECAPTURED THEN
      lnv_Svc.of_LoadSvc(lnv_win32, CSvc.WIN32)
      lnv_win32.ReleaseCapture()
      MOUSECAPTURED = FALSE
   END IF
END IF

//this.SetRedraw(TRUE)

RETURN AncestorReturnValue
end event

event ke_lbuttondown;call super::ke_lbuttondown;IF IS_OVERX THEN 
   IS_OVERX = FALSE
   SetRedraw(TRUE)
   parent.EVENT ke_xclicked()
END IF

RETURN AncestorReturnValue
end event

event ke_getpadright;call super::ke_getpadright;IF #ShowHeader AND #ShowX THEN
   RETURN 20
ELSE
   RETURN 0
END IF
end event

type st_1 from statictext within u_borderpanel
integer x = 146
integer y = 176
integer width = 421
integer height = 60
integer textsize = -8
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
long backcolor = 67108864
string text = "Border Panel"
alignment alignment = center!
boolean focusrectangle = false
end type