PBMiner

$PBExportHeader$u_icon.sru
forward
global type u_icon from u_paint
end type
type st_1 from statictext within u_icon
end type
end forward

global type u_icon from u_paint
integer width = 174
integer height = 128
long backcolor = 67108864
st_1 st_1
end type
global u_icon u_icon

type prototypes
FUNCTION long GetDCBrushColor(ulong hdc) LIBRARY "gdi32.dll"
FUNCTION long GetDC (ulong hWnd) Library "USER32.DLL"
FUNCTION int ReleaseDC (ulong hWnd, ulong hDC) Library "USER32.DLL"

end prototypes

type variables
Public:
boolean #StandardImages = TRUE
boolean #LargeImages = TRUE
string #ResourceName = "APP_ICON"
Boolean #Tooltip
string #TooltipText
Boolean #BalloonTooltip
icon #TooltipIcon = none!
string #TooltipTitle

Private:
ulong il_himl
long il_index, il_backcolor
end variables

forward prototypes
public subroutine of_setimage (readonly string as_name)
public subroutine of_setimage (readonly long al_index)
public subroutine of_setimagelist (readonly unsignedlong aul_himl)
end prototypes

public subroutine of_setimage (readonly string as_name);#Resourcename = Upper(as_name)

cresource lc
long ll_index, ll_count, n
boolean lb_found

lc = CREATE cresource
ll_count = UPPERBOUND(lc.BUTTONS)
FOR n = 1 to ll_count
   IF lc.BUTTONS[n] = #Resourcename THEN
      lb_found = TRUE
      EXIT
   END IF
NEXT

DESTROY lc

IF NOT lb_found THEN RETURN

of_SetImage(n)
end subroutine

public subroutine of_setimage (readonly long al_index);il_index = al_index
uo_pbnicanvas.SetRedraw(TRUE)
end subroutine

public subroutine of_setimagelist (readonly unsignedlong aul_himl);il_himl = aul_himl
end subroutine

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

on u_icon.destroy
call super::destroy
destroy(this.st_1)
end on

event ke_preopen;st_1.Visible = FALSE
this.Border = FALSE

n_svc_mgr lnv_svc

IF #StandardImages THEN
   n_svc_resource lnv_r
   
   lnv_svc.of_LoadSvc(lnv_r, CSvc.RESOURCE)
   IF #LargeImages THEN
      il_himl = lnv_r.of_getstandardimagelist24(lnv_svc)
   ELSE
      il_himl = lnv_r.of_getstandardimagelist16(lnv_svc)
   END IF
END IF

of_SetImage(#ResourceName)

n_svc_color lnv_color

lnv_svc.of_LoadSvc(lnv_color, CSvc.COLOR)
il_backcolor = lnv_color.of_colorfrompbcolor(lnv_svc, BackColor)
end event

event ke_paint;call super::ke_paint;IF il_himl <= 0 THEN RETURN

n_svc_imagelist lnv_img
n_svc_win32 lnv_win32
long llx, lly
ulong ll_backbrush
integer li_iconsize
rect lstr_rect

anv_svc.of_LoadSvc(lnv_img, CSvc.IMAGELIST)
anv_svc.of_LoadSvc(lnv_win32, CSvc.WIN32)

IF #LargeImages THEN
   li_iconsize = 24
ELSE
   li_iconsize = 16
END IF

llx = (UnitsToPixels(uo_pbnicanvas.width, XUnitsToPixels!) - li_iconsize) / 2
lly = (UnitsToPixels(uo_pbnicanvas.height, YUnitsToPixels!) - li_iconsize) / 2

ll_backbrush = lnv_win32.CreateSolidBrush(il_backcolor)
lnv_win32.Getclientrect(Handle(uo_pbnicanvas), lstr_rect)
lnv_win32.FillRect(hdc, lstr_rect, ll_backbrush)
lnv_win32.DeleteObject(ll_backbrush)

lnv_img.of_Draw(il_himl, il_index - 1, hdc, llx, lly, 1)
end event

event ke_postopen;call super::ke_postopen;uo_pbnicanvas.SetRedraw(TRUE)
end event

event ke_constructor;call super::ke_constructor;//determine cavas backcolor
//from background color
//ulong llh, lldc
//llh = Handle(this)
//lldc =GetDC(llh)
//#BackColor = GetDCBrushColor(lldc)
//ReleaseDC(llh, lldc)
//
end event

type uo_pbnicanvas from u_paint`uo_pbnicanvas within u_icon
end type

event uo_pbnicanvas::onmousemove;call super::onmousemove;IF #Tooltip AND #BalloonTooltip THEN
   parent.GetParent().DYNAMIC EVENT ke_balloonnotify(#TooltipIcon, #TooltipTitle)
END IF
end event

type st_1 from statictext within u_icon
integer y = 32
integer width = 160
integer height = 68
boolean bringtotop = true
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 = "Icon"
alignment alignment = center!
boolean focusrectangle = false
end type