Hi Euphorians,
Below is a small library coded in API that creates a custom control
called the hot buttons. i haven't added round button/roundrect but those
are very easy. the reason i'm submitting this is because i'm planning to
revamp the library for efficiency and speed.
for win32lib users you'll have to wait i wrap a wrapper over it.
experienced win32lib users will have no problems.....
HB_Create(atom parent,sequence text,atom x,atom y,atom cx,atom
cy,integer Style)
================================================================
This creates a hotbutton control. parent requires a real win32 handle so
for win32lib users you'll have to use getHandle() for the parent window.
Style can be HBS_RECT(HBS_ROUND/ROUNDRECT not yet
supported),HBS_TOGGLE(Button is toggle style),HBS_ENABLED,HBS_DISABLED
etc. You can use or_all() on these styles to get the final value. using
0 uses the default values
-------------------------------------------
HB_SetFont(atom hwnd,sequence fontname,integer height,atom fntdata)
-------------------------------------------
hwn should be the handle returned by HB_Create() fontname is the name of
the font.height is the font height needed. fntdata is the style. it can
be HBF_BOLD,HBF_ITALIC,HBF_UNDERLINE. u will have to use or_all() too
get the final style. when fntdata is 0 default values are used
-------------------------------------------
HB_SetImage(atom hwnd,atom image,integer State,integer Type,integer
bltForm,atom colorref)
===========================================
hwnd: is the value returned after HB_Create()
image: this is a handle to the image. it can be a bitmap or icon handle
State: this is for the button state inwhich this image will be shown.
it can be HBIS_HOT(when mouse is over button) HBIS_DISABLED(Button
is disabled),HBIS_COLD(Button has no focus)
Type: Type of image used HBI_ICO for an icon. HBI_BMP for a bitmap
bltForm: This is needed when drawing the bitmaps (HBI_BMP) using
HBLT_OPAQUE draws the image "as-is", HBLT_TRANSPARENT draws a bitmap
with a transparent background
colorref: This is the background color used when HBLT_TRANSPARENT is
specified
HB_SetAlignment(atom hwnd,integer style)
========================================
if style is HBA_LEFT image is drawn to the left of the text. if style is
HBA_BOTTOM image is drawn above the text
-----------------------------------------
HB_SetText(atom hwnd,sequence text)
=========================================
changes the current text of the hotbutton. hwnd is the value returned
from hb_create(). Note text with & prefix returns an underscore on the
character after the ampersand
-----------------------------------------
HB_GetText(atom hwnd)
=========================================
retuens the hotbutton's text
-----------------------------------------
HB_SetBackColor(atom hwnd,object clr)
=========================================
changes the background color of a button. clr can be a sequence of rgb
triads {r,g,b} or the COLORREF value.
-----------------------------------------
HB_GetBackColor(atom hwnd)
=========================================
returns the colorref value of the current buttons background color
-----------------------------------------
HB_SetTextColor(atom hwnd,object clr)
=========================================
Changes the text color
-----------------------------------------
HB_GetTextColor(atom hwnd)
=========================================
Returns the text color of the hot button
-----------------------------------------
--File : HotButtons Module --
--Version: 0.1.5 --
--Date : Thursday, October 10, 2002 --
--Author : Jordah Ferguson --
-----------------------------------------
--** Font heights vary
--** Check if we really need saveDC and RestoreDC
--** Make Drop down style
--** Parents should be noted in the structure
without warning
without type_check
include dll.e
include machine.e
include msgbox.e
constant
HBUSER32 = open_dll("user32.dll" ),
HBGDI32 = open_dll("gdi32.dll" ),
HBKRN32 = open_dll("kernel32.dll"),
-- kernel32.dll C routines
hlstrlen = define_c_func(HBKRN32 ,
"lstrlenA",{C_LONG},C_INT),
-- User32.dll C routines
hRegisterClassEx = define_c_func(HBUSER32, "RegisterClassExA",
{C_LONG}, C_LONG ),
hCreateWindowExA = define_c_func(HBUSER32, "CreateWindowExA",
{C_LONG, C_LONG, C_LONG, C_LONG, C_INT, C_INT, C_INT, C_INT, C_LONG,
C_LONG, C_LONG, C_LONG}, C_LONG ),
hCallWindowProcA = define_c_func(HBUSER32, "CallWindowProcA",
{C_POINTER, C_LONG, C_INT, C_INT, C_LONG}, C_LONG ),
hPostMessage = define_c_proc(HBUSER32, "PostMessageA",
{C_LONG, C_INT, C_INT, C_LONG}),
hGetClientRect = define_c_proc(HBUSER32, "GetClientRect",
{C_LONG, C_LONG}),
hSetPropA = define_c_proc(HBUSER32, "SetPropA", {C_LONG,
C_LONG, C_LONG}),
hGetPropA = define_c_func(HBUSER32, "GetPropA", {C_LONG,
C_LONG}, C_LONG ),
hDefWindowProcA = define_c_func(HBUSER32, "DefWindowProcA",
{C_LONG, C_INT, C_INT, C_LONG}, C_LONG ),
hGetWindowLongA = define_c_func(HBUSER32, "GetWindowLongA",
{C_LONG, C_INT}, C_LONG ),
hBeginPaint = define_c_func(HBUSER32, "BeginPaint", {C_LONG,
C_LONG}, C_LONG ),
hEndPaint = define_c_proc(HBUSER32, "EndPaint", {C_LONG,
C_LONG} ),
hInvalidateRect = define_c_proc(HBUSER32, "InvalidateRect",
{C_LONG, C_LONG, C_LONG}),
hGetDC = define_c_func(HBUSER32, "GetDC", {C_LONG},
C_LONG ),
hReleaseDC = define_c_proc(HBUSER32, "ReleaseDC", {C_LONG,
C_LONG}),
hDrawEdge = define_c_proc(HBUSER32, "DrawEdge", {C_LONG,
C_LONG, C_INT, C_INT} ),
hDrawTextA = define_c_proc(HBUSER32, "DrawTextA", {C_LONG,
C_LONG, C_INT, C_LONG, C_INT} ),
hSetWindowLongA = define_c_proc(HBUSER32, "SetWindowLongA",
{C_LONG, C_INT, C_LONG}),
hDrawIconEx = define_c_proc(HBUSER32, "DrawIconEx", {C_LONG,
C_INT, C_INT, C_LONG, C_INT, C_INT, C_INT, C_LONG, C_INT}),
hGetIconInfo = define_c_proc(HBUSER32, "GetIconInfo", {C_LONG,
C_POINTER}),
hGetUpdateRect = define_c_func(HBUSER32, "GetUpdateRect",
{C_LONG, C_LONG, C_LONG}, C_LONG ),
-- gdi32 C routines
hCreateCompatibleDC = define_c_func(HBGDI32, "CreateCompatibleDC",
{C_LONG}, C_LONG ),
hPatBlt = define_c_proc(HBGDI32, "PatBlt", {C_LONG,
C_INT, C_INT, C_INT, C_INT, C_LONG}),
hCreateCompatibleBitmap= define_c_func(HBGDI32,
"CreateCompatibleBitmap", {C_LONG, C_INT, C_INT}, C_LONG ),
hCreateBitmap = define_c_func(HBGDI32, "CreateBitmap", {C_INT,
C_INT, C_INT, C_INT, C_LONG}, C_LONG ),
hCreateSolidBrush = define_c_func(HBGDI32, "CreateSolidBrush",
{C_POINTER}, C_LONG ),
hCreateBrushIndirect = define_c_func(HBGDI32, "CreateBrushIndirect",
{C_LONG}, C_LONG ),
hGetStockObject = define_c_func(HBGDI32, "GetStockObject",
{C_INT}, C_LONG ),
hDeleteObject = define_c_func(HBGDI32, "DeleteObject",
{C_LONG},C_LONG ),
hBitBlt = define_c_proc(HBGDI32, "BitBlt", {C_LONG,
C_INT, C_INT, C_INT, C_INT, C_LONG, C_INT, C_INT, C_LONG}),
hDeleteDC = define_c_func(HBGDI32, "DeleteDC",
{C_LONG},C_LONG),
hSelectObject = define_c_func(HBGDI32, "SelectObject", {C_LONG,
C_LONG},C_LONG),
hSetTextColor = define_c_proc(HBGDI32, "SetTextColor", {C_LONG,
C_POINTER}),
hGetObject = define_c_func(HBGDI32, "GetObjectA", {C_LONG,
C_INT, C_LONG}, C_INT ),
hSaveDC = define_c_proc(HBGDI32, "SaveDC", {C_LONG} ),
hRestoreDC = define_c_proc(HBGDI32, "RestoreDC", {C_LONG,
C_INT}),
hSetPixel = define_c_proc(HBGDI32, "SetPixel", {C_LONG,
C_INT, C_INT, C_POINTER}),
hSetBkColor = define_c_func(HBGDI32, "SetBkColor", {C_LONG,
C_POINTER}, C_POINTER ),
hCreateFont = define_c_func(HBGDI32, "CreateFontA",{C_INT,
C_INT, C_INT, C_INT, C_INT, C_INT,C_INT, C_INT, C_INT, C_INT, C_INT,
C_INT, C_INT, C_POINTER}, C_INT),
hSetBkMode = define_c_proc(HBGDI32, "SetBkMode", {C_LONG,
C_INT})
---------------------------------------------------------
constant
WM_PAINT = #000F,
WM_LBUTTONDOWN= #0201,
WM_MOUSEMOVE = #0200,
WM_DESTROY = #0002,
WM_LBUTTONUP = #0202,
FW_NORMAL = 400,
BMask =
{{1,0,1,0,1,0,1,0},
{0,1,0,1,0,1,0,1},
{1,0,1,0,1,0,1,0},
{0,1,0,1,0,1,0,1},
{1,0,1,0,1,0,1,0},
{0,1,0,1,0,1,0,1},
{1,0,1,0,1,0,1,0},
{0,1,0,1,0,1,0,1}}
---------------------------------------------------------
constant
HBPROPCB = allocate_string("HotButton CallBack "),
HBPROPLP = allocate_string("HotButton Structure"),
WC_HBUTTON = allocate_string("HotButton"),
aRECT = allocate( 16 ),
aPS = allocate( 64 ),
aBmp = allocate( 32 ),
aLOGBRUSH = allocate( 12 ),
aICONINFO = allocate( 20 ),
WS_HBUTTON = #50000000,
WM_USER = #0400,
-- HB Ver and Error Msgs
HB_VER = "Hot Button 0.1.4",
HB_CREATE_FAIL = "Failed to create Hot Button",
HB_REG_FAIL = "Failed to Register Hot Button Class",
HB_DEL_BRUSH_FAIL= "Failed to delete brush!",
HB_DEL_DC_FAIL = "Failed to delete Compatible Device Context",
HB_BRSH_FAIL = "Failed to create brush",
HB_CDC_FAIL = "Failed to create Compatible Device Context",
HB_CBM_FAIL = "Failed to create Compatible Bitmap",
HB_CBM_DEL_FAIL = "Failed to delete Compatible Bitmap",
HB_GetDC_FAIL = "Failed to acquire the Device Context",
HB_BAD_SET = "Invalid Group Index Specified",
-- Font Structure
hbf_fntsz = 00,
hbf_fntstyle = 04,
hbf_fntheight = 05,
sizeof_hbf = 06,
-- Image Structure
hbi_onbitmap = 00,
hbi_disbitmap = 04,
hbi_offbitmap = 08,
hbi_ontransclr = 12,
hbi_offtransclr = 16,
hbi_distransclr = 20,
hbi_onbitprop = 24,
hbi_disbitprop = 25,
hbi_offbitprop = 26,
hbi_alignment = 27,
sizeof_hbi = 28,
-- Control Structure
hb_font = 00,
hb_image = 04,
hb_txtcolor = 08,
hb_text = 12,
hb_bkcolor = 16,
hb_active = 20,
hb_mstatus = 21,
hb_hover = 22,
hb_togstatus = 23,
hb_sstyle = 24,
hb_stype = 25,
hb_set = 26,
sizeof_hb = 27,
bit_pos = {#1,#2,#4,#8,#10,#20}
-- Global Button Styles
global constant
WM_HBCLICKED = WM_USER + 20,
HBS_ENABLED = #01, -- Btn Enabled
HBS_DISABLED = #02, -- Btn Disabled
HBS_TOGGLE = #04, -- Btn is toggled
HBS_ROUNDRECT = #08,
HBS_ELLIPSE = #10,
HBS_RECT = #20,
HBI_ICO = #01, -- HB_SetImage(); Type:Image Presented is
an icon
HBI_BMP = #02, -- HB_SetImage(); Type:Image Presented is a
bitmap
HBIS_DISABLED = #01, -- HB_SetImage(); Image is intended for
disabled view
HBIS_HOT = #02, -- HB_SetImage(); Image is intended for Hot
view ie has focus
HBIS_COLD = #03, -- HB_SetImage(); Image is intended for
Cold view ie lostfocus
HBLT_OPAQUE = #01, -- HB_SetImage(); Image bitblt uses OPAQUE
mode ie no blending
HBLT_TRANSPARENT = #02, -- HB_SetImage(); Transparent; image blends
with current brush
HBA_LEFT = #00, -- Text is to the left of image
HBA_BOTTOM = #01, -- Text is displayed below image
HBF_NORMAL = #01, -- Use Normal font width/style/underline
HBF_BOLD = #02, -- Use Bold Font
HBF_ITALIC = #04, -- Use Italics
HBF_UNDERLINE = #08 -- Use UnderlineStyle
---------------------------------------------------------
integer Type,Style,Void,ExcGrp
atom
ParentCB,CurParentCB,ACTIVE,Defaultfont,Struct,DefBrush,CurBrush,HDC
sequence rect,ExcSet
Void = -1
ACTIVE = -1
Struct = -1
Type = -1
Style = -1
ExcSet = {}
-------------------------------------------
procedure Report(sequence msg)
-------------------------------------------
Void = message_box(msg,HB_VER&" Error!",MB_ICONINFORMATION)
end procedure
-------------------------------------------
function RGB(sequence Triad)
-------------------------------------------
return Triad[1] * #1 +
Triad[2] * #100 +
Triad[3] * #10000
end function
-------------------------------------------
function LO_BIT(integer a)
-------------------------------------------
return and_bits(a,#F)
end function
-------------------------------------------
function HI_BIT(integer a)
-------------------------------------------
return floor(a/#10)
end function
-------------------------------------------
function MAKE_BYTE(integer a,integer b)
-------------------------------------------
a = and_bits(a,#F)
b = and_bits(b,#F)
return ((b*#10) + a)
end function
-------------------------------------------
function abs(atom a)
-------------------------------------------
if a > 0 then return a else return (-a) end if
end function
-------------------------------------------
procedure StoreBits(atom Struct,integer val)
-------------------------------------------
sequence bits
integer hibit,lobit
lobit = 0 hibit = 0 bits = {}
if not val then
bits = {HBS_ENABLED,HBS_RECT}
else
for n = 1 to length(bit_pos) do
Void = bit_pos[n]
if and_bits(val,Void) then
bits &= Void
end if
end for
end if
for n = 1 to length(bits) do
Void = bits[n]
if Void <= HBS_TOGGLE then
lobit = or_bits(lobit,Void)
else
hibit = or_bits(hibit,Void)
end if
end for
poke(Struct + hb_sstyle,hibit)
poke(Struct + hb_stype ,lobit)
end procedure
-------------------------------------------
function GetClientRect(atom hwnd)
-------------------------------------------
c_proc(hGetClientRect,{hwnd,aRECT})
return peek4u({aRECT,4})
end function
-------------------------------------------
function GetBmpSize(atom Bmp)
-------------------------------------------
if c_func(hGetObject,{Bmp,32,aBmp}) then
return peek4u({aBmp+04,2})
end if
return {0,0}
end function
-------------------------------------------
function GetIcoSize(atom icon)
-------------------------------------------
atom AndMask
c_proc(hGetIconInfo,{icon,aICONINFO})
AndMask = peek4u(aICONINFO + 16)
return GetBmpSize(AndMask)
end function
-------------------------------------------
function CreateSolidBrush(atom Clr)
-------------------------------------------
atom brush
brush = c_func(hCreateSolidBrush,{Clr})
if not brush then
Report(HB_BRSH_FAIL)
end if
return brush
end function
-------------------------------------------
procedure DeleteBrush(atom brush)
-------------------------------------------
if not c_func(hDeleteObject,{brush}) then
Report(HB_DEL_BRUSH_FAIL)
end if
end procedure
-------------------------------------------
function CreateFont(atom fntAddr)
-------------------------------------------
integer width,und,ita,fntheight,fntdata
atom fntname
sequence bits
bits = {}
fntname = peek4u(fntAddr + hbf_fntsz)
fntheight = peek(fntAddr + hbf_fntheight)
fntdata = peek(fntAddr + hbf_fntstyle)
if not fntdata then
width = FW_NORMAL
und = 0
ita = 0
else
for n = 1 to length(bit_pos) do
Void = bit_pos[n]
if and_bits(fntdata,Void) then
bits &= Void
end if
end for
if not find(HBF_BOLD,bits) then width = FW_NORMAL else width =
FW_NORMAL * 1.5 end if
if not find(HBF_ITALIC,bits) then ita = 0 else ita = 1 end if
if not find(HBF_UNDERLINE,bits) then und = 0 else und = 1 end if
end if
return
c_func(hCreateFont,{fntheight,0,0,0,width,ita,und,0,0,0,0,0,0,fntname})
end function
-------------------------------------------
function GetDC(atom hwnd)
-------------------------------------------
hwnd = c_func(hGetDC,{hwnd})
if not hwnd then
Report(HB_GetDC_FAIL)
end if
c_proc(hSaveDC,{hwnd})
return hwnd
end function
-------------------------------------------
procedure ReleaseDC(atom hwnd,atom HDC)
-------------------------------------------
c_proc(hRestoreDC,{HDC,-1})
c_proc(hReleaseDC,{hwnd,HDC})
end procedure
-------------------------------------------
function CreateCompatibleDC(atom HDC)
-------------------------------------------
HDC = c_func(hCreateCompatibleDC,{HDC})
if not HDC then
Report(HB_CDC_FAIL)
end if
return HDC
end function
-------------------------------------------
procedure DeleteDC(atom HDC)
-------------------------------------------
if not c_func(hDeleteDC,{HDC}) then
Report(HB_DEL_DC_FAIL)
end if
end procedure
-------------------------------------------
function CreateCompatibleBitmap(atom HDC,atom cx,atom cy)
-------------------------------------------
HDC = c_func(hCreateCompatibleBitmap,{HDC,cx,cy})
if not HDC then
Report(HB_CBM_FAIL)
end if
return HDC
end function
-------------------------------------------
procedure DeleteCompatibleBitmap(atom bm)
-------------------------------------------
if not c_func(hDeleteObject,{bm}) then
Report(HB_CBM_DEL_FAIL)
end if
end procedure
-------------------------------------------
function SelectObject(atom HDC,atom Obj)
-------------------------------------------
return c_func(hSelectObject,{HDC,Obj})
end function
-------------------------------------------
function CreatePatternBrush(atom HDC,atom clr)
-------------------------------------------
atom MbmBMP,MemDC,OldBm,Brush
MemDC = CreateCompatibleDC(HDC)
MbmBMP= CreateCompatibleBitmap(HDC,8,8)
OldBm = SelectObject(MemDC,MbmBMP)
c_proc(hPatBlt,{MemDC,0,0,8,8,#00F00021})
if clr = #FFFFFF then clr = #C0C0C0 end if
for n = 1 to 8 do
for m = 1 to 8 do
Void = BMask[n][m]
if Void then
c_proc(hSetPixel,{MemDC,n-1,m-1,clr})
end if
end for
end for
poke4(aLOGBRUSH,{3,0,MbmBMP})
Brush = c_func(hCreateBrushIndirect,{aLOGBRUSH})
OldBm = SelectObject(MemDC,OldBm)
DeleteCompatibleBitmap(MbmBMP)
DeleteDC(MemDC)
return Brush
end function
-------------------------------------------
procedure BltBitMap(atom HDC,atom bitmap,atom x,atom y,atom cx,atom cy)
-------------------------------------------
atom MemDC
MemDC = CreateCompatibleDC(HDC)
Void = SelectObject(MemDC,bitmap)
c_proc(hBitBlt,{HDC,x,y,cx,cy,MemDC,0,0,#00CC0020})
DeleteDC(MemDC)
end procedure
-------------------------------------------
procedure TransparentBlt(atom HDC,atom bitmap,atom x,atom y,atom cx,atom
cy,atom bkcolor)
-------------------------------------------
atom
SourceDC,SavedDC,InvertedDC,MaskDC,FinalDC,InvertedBmp,MaskBmp,FinalBmp,SavedBmp,
PrevInvBmp,PrevMaskBmp,PrevFinalBmp,PrevSavedBmp,PrevSourceBmp,PrevColor
SourceDC = CreateCompatibleDC(HDC)
SavedDC = CreateCompatibleDC(HDC)
InvertedDC = CreateCompatibleDC(HDC)
FinalDC = CreateCompatibleDC(HDC)
MaskDC = CreateCompatibleDC(HDC)
FinalBmp = CreateCompatibleBitmap(HDC,cx,cy)
SavedBmp = CreateCompatibleBitmap(HDC,cx,cy)
InvertedBmp= c_func(hCreateBitmap,{cx,cy,1,1,0})
MaskBmp = c_func(hCreateBitmap,{cx,cy,1,1,0})
PrevSourceBmp = SelectObject(SourceDC,bitmap )
PrevSavedBmp = SelectObject(SavedDC,SavedBmp)
PrevFinalBmp = SelectObject(FinalDC,FinalBmp)
PrevMaskBmp = SelectObject(MaskDC ,MaskBmp )
PrevInvBmp = SelectObject(InvertedDC,InvertedBmp)
c_proc(hBitBlt,{SavedDC,0,0,cx,cy,SourceDC,0,0,#00CC0020})
PrevColor = c_func(hSetBkColor,{SourceDC,bkcolor})
c_proc(hBitBlt,{MaskDC,0,0,cx,cy,SourceDC,0,0,#00CC0020})
PrevColor = c_func(hSetBkColor,{SourceDC,PrevColor})
c_proc(hBitBlt,{InvertedDC,0,0,cx,cy,MaskDC,0,0,#00330008})
c_proc(hBitBlt,{FinalDC,0,0,cx,cy,HDC,x,y,#00CC0020})
c_proc(hBitBlt,{FinalDC,0,0,cx,cy,MaskDC,0,0,#008800C6})
c_proc(hBitBlt,{SourceDC,0,0,cx,cy,InvertedDC,0,0,#008800C6})
c_proc(hBitBlt,{FinalDC,0,0,cx,cy,SourceDC,0,0,#00EE0086})
c_proc(hBitBlt,{HDC,x,y,cx,cy,FinalDC,0,0,#00CC0020})
c_proc(hBitBlt,{SourceDC,0,0,cx,cy,SavedDC,0,0,#00CC0020})
Void = SelectObject(SourceDC,PrevSourceBmp)
Void = SelectObject(SavedDC,PrevSavedBmp )
Void = SelectObject(FinalDC,PrevFinalBmp )
Void = SelectObject(MaskDC,PrevMaskBmp )
Void = SelectObject(InvertedDC,PrevInvBmp )
DeleteCompatibleBitmap(FinalBmp)
DeleteCompatibleBitmap(SavedBmp)
DeleteCompatibleBitmap(MaskBmp )
DeleteCompatibleBitmap(InvertedBmp)
DeleteDC(FinalDC)
DeleteDC(InvertedDC)
DeleteDC(MaskDC)
DeleteDC(SavedDC)
DeleteDC(SourceDC)
end procedure
-------------------------------------------
function PrepareDC(atom HDC,sequence rect,atom str)
-------------------------------------------
atom Oldfont,Oldbrush,fontAddr,hfont,brush hfont= 0
brush = peek4u(str+hb_bkcolor)
fontAddr = peek4u(str+hb_font)
if fontAddr then
hfont = CreateFont(fontAddr)
Oldfont = SelectObject(HDC,hfont)
else
Oldfont = SelectObject(HDC,Defaultfont)
end if
c_proc(hSetBkMode,{HDC,1})
brush = CreateSolidBrush(brush)
Oldbrush = SelectObject(HDC,brush)
c_proc(hSetTextColor,{HDC,peek4u(str+hb_txtcolor)})
c_proc(hPatBlt,{HDC,rect[1],rect[2],rect[3],rect[4],#00F00021})
Oldbrush = SelectObject(HDC,Oldbrush)
DeleteBrush(brush)
return {Oldfont,hfont}
end function
-------------------------------------------
function CalculateRect(sequence rect,sequence imgrect,integer
alignment,integer txtflag)
-------------------------------------------
atom X1,Y1,R1,R2,R3,R4,C,DT_Flag
if txtflag then
if not alignment then
Y1 = floor(abs(rect[4]-imgrect[2])/2)
X1 = 2
R1 = imgrect[1]+ X1 + 4
R2 = Y1 + floor((imgrect[2]/4))
R3 = rect[3]
R4 = rect[4]
DT_Flag = #20
else
X1 = floor(abs(rect[3]-imgrect[1])/2)
Y1 = 2
C = imgrect[2] + Y1 + 4
R1 = rect[1]
R2 = (C + floor(abs(rect[4]-C)/2))
R3 = rect[3]
R4 = rect[4]
DT_Flag = #125
end if
else
Y1 = floor(abs(rect[4]-imgrect[2])/2)
X1 = floor(abs(rect[3]-imgrect[1])/2)
R1 = 0 R2 = 0 R3 = 0 R4 = 0 DT_Flag = 0
end if
return {X1,Y1,R1,R2,R3,R4,DT_Flag}
end function
-------------------------------------------
procedure DisplayRectButton(atom str,atom HDC,sequence rect,atom
HImage,integer Style,integer tog,atom transclr,integer alignment)
-------------------------------------------
integer imgType,bltType,DT_Flag,len
atom PatBrush,OldBrush,pszAddr
sequence imgrect,frect,fnt
fnt = PrepareDC(HDC,rect,str)
pszAddr = peek4u(str + hb_text)
len = c_func(hlstrlen,{pszAddr})
if tog then
PatBrush = CreatePatternBrush(HDC,peek4u(str+hb_bkcolor))
OldBrush = SelectObject(HDC,PatBrush)
c_proc(hPatBlt,{HDC,0,0,rect[3],rect[4],#00F00021})
end if
if HImage then
imgType = HI_BIT(Style)
bltType = LO_BIT(Style)
if imgType = HBI_BMP then
imgrect = GetBmpSize(HImage)
frect = CalculateRect(rect,imgrect,alignment,len)
if tog then frect[1] += 2 frect[3] += 2 end if
poke4(aRECT,{frect[3],frect[4],frect[5],frect[6]})
if bltType = HBLT_OPAQUE then
BltBitMap(HDC,HImage,frect[1],frect[2],imgrect[1],imgrect[2])
elsif bltType = HBLT_TRANSPARENT then
TransparentBlt(HDC,HImage,frect[1],frect[2],imgrect[1],imgrect[2],transclr)
end if
DT_Flag = frect[7]
elsif imgType = HBI_ICO then
imgrect = GetIcoSize(HImage)
frect = CalculateRect(rect,imgrect,alignment,len)
if tog then frect[1] += 2 frect[3] += 2 end if
poke4(aRECT,{frect[3],frect[4],frect[5],frect[6]})
c_proc(hDrawIconEx,{HDC,frect[1],frect[2],HImage,imgrect[1],imgrect[2],0,0,3})
DT_Flag = frect[7]
end if
else
DT_Flag = #125
if tog then
poke4(aRECT,rect[1] + 3 & rect[2..4])
end if
end if
if tog then
OldBrush = SelectObject(HDC,OldBrush)
DeleteBrush(PatBrush)
end if
if len then
c_proc(hDrawTextA,{HDC,pszAddr,len,aRECT,DT_Flag})
end if
Void = SelectObject(HDC,fnt[1])
if fnt[2] then
Void = c_func(hDeleteObject,{fnt[2]})
end if
end procedure
-------------------------------------------
procedure BltOnImage_RECT(atom hwnd,atom HDC,atom str)
-------------------------------------------
sequence rect
atom ImageAddr
rect = GetClientRect(hwnd)
ImageAddr = peek4u(str + hb_image)
if ImageAddr then
DisplayRectButton(str,HDC,rect,
peek4u(ImageAddr + hbi_onbitmap),
peek(ImageAddr + hbi_onbitprop),0,
peek4u(ImageAddr+hbi_ontransclr),
peek(ImageAddr + hbi_alignment))
else
DisplayRectButton(str,HDC,rect,0,0,0,0,0)
end if
poke4(aRECT,rect)
c_proc(hDrawEdge,{HDC,aRECT,#4,15})
end procedure
-------------------------------------------
procedure BltOffImage_RECT(atom hwnd,atom HDC,atom str)
-------------------------------------------
sequence rect
atom ImageAddr
rect = GetClientRect(hwnd)
ImageAddr = peek4u(str + hb_image)
if ImageAddr then
DisplayRectButton(str,HDC,rect,
peek4u(ImageAddr + hbi_offbitmap),
peek(ImageAddr + hbi_offbitprop),0,
peek4u(ImageAddr+hbi_offtransclr),
peek(ImageAddr + hbi_alignment))
else
DisplayRectButton(str,HDC,rect,0,0,0,0,0)
end if
end procedure
-------------------------------------------
procedure BltTogImage_RECT(atom hwnd,atom HDC,atom str)
-------------------------------------------
sequence rect
atom ImageAddr
rect = GetClientRect(hwnd)
ImageAddr = peek4u(str + hb_image)
if ImageAddr then
DisplayRectButton(str,HDC,rect,
peek4u(ImageAddr + hbi_onbitmap),
peek(ImageAddr + hbi_onbitprop),1,
peek4u(ImageAddr+hbi_ontransclr),
peek(ImageAddr + hbi_alignment))
else
DisplayRectButton(str,HDC,rect,0,0,1,0,0)
end if
poke4(aRECT,rect)
c_proc(hDrawEdge,{HDC,aRECT,10,15})
end procedure
-------------------------------------------
procedure ReleaseToggle(integer grp,atom btn)
-------------------------------------------
atom hwnd,Struct
if grp >0 and grp <= length(ExcSet) then
hwnd = ExcSet[grp]
ExcSet[grp] = btn
if hwnd then
Struct = c_func(hGetPropA,{hwnd,HBPROPLP})
if Struct then
if peek(Struct + hb_togstatus) then
poke(Struct + hb_active , 1 )
poke(Struct + hb_mstatus , 0 )
poke(Struct + hb_togstatus, 0 )
c_proc(hInvalidateRect,{hwnd,0,1})
end if
end if
end if
end if
end procedure
-------------------------------------------
global function HB_Create(atom parent,sequence text,atom x,atom y,atom
cx,atom cy,integer Style)
-------------------------------------------
atom hwnd,sz,CallBackA,str
sequence r
hwnd =
c_func(hCreateWindowExA,{0,WC_HBUTTON,0,WS_HBUTTON,x,y,cx,cy,parent,0,instance(),0})
if not hwnd then
Report(HB_CREATE_FAIL)
return hwnd
end if
CallBackA = c_func(hGetWindowLongA,{parent,-4})
if CallBackA != CurParentCB then
c_proc(hSetPropA,{parent,HBPROPCB,CallBackA})
c_proc(hSetWindowLongA,{parent,-4,CurParentCB})
end if
str = allocate(sizeof_hb)
sz = allocate_string(text)
mem_set(str,0,sizeof_hb)
poke4(str+hb_bkcolor ,#C0C0C0)
poke4(str+hb_text ,sz )
StoreBits(str,Style)
c_proc(hSetPropA,{hwnd,HBPROPLP,str})
return hwnd
end function
-------------------------------------------
global procedure HB_SetFont(atom hwnd,sequence fontname,integer
height,atom fntdata)
-------------------------------------------
atom str,sz,fntname,fntAddr
str = c_func(hGetPropA,{hwnd,HBPROPLP})
if str then
sz = peek4u(str + hb_font)
if sz then
fntname = peek4u(sz + hbf_fntsz)
if fntname then
free(fntname)
end if
poke4(sz + hbf_fntsz,allocate_string(fontname))
poke(sz + hbf_fntheight,height)
poke(sz + hbf_fntstyle,fntdata)
return
end if
fntAddr = allocate(sizeof_hbf)
mem_set(fntAddr,0,sizeof_hbf)
poke4(fntAddr + hbf_fntsz,allocate_string(fontname))
poke(fntAddr + hbf_fntheight,height)
poke(fntAddr + hbf_fntstyle,fntdata)
poke4(str + hb_font,fntAddr)
end if
end procedure
-------------------------------------------
global procedure HB_SetText(atom hwnd,sequence text)
-------------------------------------------
atom str,sz,psz
str = c_func(hGetPropA,{hwnd,HBPROPLP})
if str then
psz = peek4u(str + hb_text)
if psz then
free(psz)
end if
poke4(str+hb_text,allocate_string(text))
end if
end procedure
-------------------------------------------
global function HB_GetText(atom hwnd)
-------------------------------------------
atom str,sz
str = c_func(hGetPropA,{hwnd,HBPROPLP})
if str then
sz = peek4u(str+hb_text)
return peek({sz,c_func(hlstrlen,{sz})})
end if
return {}
end function
-------------------------------------------
global procedure HB_SetTextColor(atom hwnd,object clr)
-------------------------------------------
atom colorref,str
if sequence(clr) then
colorref = RGB(clr)
else
colorref = clr
end if
str = c_func(hGetPropA,{hwnd,HBPROPLP})
if str then
poke4(str+hb_txtcolor,colorref)
end if
end procedure
-------------------------------------------
global function HB_GetTextColor(atom hwnd)
-------------------------------------------
atom str
str = c_func(hGetPropA,{hwnd,HBPROPLP})
if str then
return peek4u(str + hb_txtcolor)
end if
return -1
end function
-------------------------------------------
global procedure HB_SetBackColor(atom hwnd,object clr)
-------------------------------------------
atom colorref,str
if sequence(clr) then
colorref = RGB(clr)
else
colorref = clr
end if
str = c_func(hGetPropA,{hwnd,HBPROPLP})
if str then
poke4(str+hb_bkcolor,colorref)
end if
end procedure
-------------------------------------------
global function HB_GetBackColor(atom hwnd)
-------------------------------------------
atom str
str = c_func(hGetPropA,{hwnd,HBPROPLP})
if str then
return peek4u(str + hb_bkcolor)
end if
return -1
end function
-------------------------------------------
global procedure HB_SetAlignment(atom hwnd,integer flag)
-------------------------------------------
atom str,image str = c_func(hGetPropA,{hwnd,HBPROPLP})
if str then
image = peek4u(str + hb_image)
if image then
poke(image + hbi_alignment,flag)
end if
end if
end procedure
-------------------------------------------
global procedure HB_SetImage(atom hwnd,atom image,integer State,integer
Type,integer bltForm,atom colorref)
-------------------------------------------
atom str,imgAddr
integer pack,x x = 0
str = c_func(hGetPropA,{hwnd,HBPROPLP})
if str then
pack = MAKE_BYTE(bltForm,Type)
imgAddr = peek4u(str + hb_image)
if not imgAddr then
imgAddr = allocate(sizeof_hbi)
mem_set(imgAddr,0,sizeof_hbi)
x = 1
end if
if State = HBIS_DISABLED then
poke4(imgAddr + hbi_disbitmap,image)
poke4(imgAddr + hbi_distransclr,colorref)
poke (imgAddr + hbi_disbitprop,pack)
elsif State = HBIS_HOT then
poke4(imgAddr + hbi_onbitmap,image)
poke4(imgAddr + hbi_ontransclr,colorref)
poke (imgAddr + hbi_onbitprop,pack)
elsif State = HBIS_COLD then
poke4(imgAddr + hbi_offbitmap,image)
poke4(imgAddr + hbi_offtransclr,colorref)
poke (imgAddr + hbi_offbitprop,pack)
end if
if x then poke4(str + hb_image,imgAddr) end if
end if
end procedure
-------------------------------------------
global function HB_MakeToggleGroup()
-------------------------------------------
ExcSet &= 0
return length(ExcSet)
end function
-------------------------------------------
global procedure HB_AddToGroup(integer grp,object Btn)
-------------------------------------------
atom Str
if grp < 1 and grp > length(ExcSet) then
Report(HB_BAD_SET)
end if
if atom(Btn) then
Str = c_func(hGetPropA,{Btn,HBPROPLP})
if Str then
poke(Str + hb_set,grp)
end if
else
for n = 1 to length(Btn) do
HB_AddToGroup(grp,Btn[n])
end for
end if
end procedure
-------------------------------------------
procedure HB_BtnCleanup(atom hwnd)
-------------------------------------------
atom StrAddr,fontAddr,imgAddr
Struct = c_func(hGetPropA,{hwnd,HBPROPLP})
if Struct then
StrAddr = peek4u(Struct + hb_text)
if StrAddr then
free(StrAddr)
end if
fontAddr = peek4u(Struct + hb_font)
if fontAddr then
StrAddr = peek4u(fontAddr + hbf_fntsz)
if StrAddr then free(StrAddr) end if
free(fontAddr)
end if
imgAddr = peek4u(Struct + hb_image)
if imgAddr then
free(imgAddr)
end if
free(Struct)
end if
end procedure
-------------------------------------------
procedure HB_Cleanup()
-------------------------------------------
free(HBPROPCB)
free(HBPROPLP)
free(WC_HBUTTON)
free(aRECT)
free(aPS)
free(aBmp)
free(aLOGBRUSH)
free(aICONINFO)
DeleteBrush(Defaultfont)
end procedure
-------------------------------------------
function HBWndProc(atom hwnd,atom msg,atom wParam,atom lParam)
-------------------------------------------
if msg = WM_PAINT then
if c_func(hGetUpdateRect,{hwnd,0,0}) then
HDC = c_func(hBeginPaint,{hwnd,aPS})
c_proc(hSaveDC,{HDC})
Struct = c_func(hGetPropA,{hwnd,HBPROPLP})
Type = peek(Struct + hb_stype)
Style = peek(Struct + hb_sstyle)
if Style = HBS_RECT then
if Type = HBS_ENABLED then
BltOffImage_RECT(hwnd,HDC,Struct)
elsif Type = HBS_TOGGLE then
if peek(Struct + hb_togstatus) then
BltTogImage_RECT(hwnd,HDC,Struct)
else
BltOffImage_RECT(hwnd,HDC,Struct)
end if
elsif Type = HBS_DISABLED then
end if
elsif Style = HBS_ROUNDRECT then
elsif Style = HBS_ELLIPSE then
end if
c_proc(hRestoreDC,{HDC,-1})
c_proc(hEndPaint,{hwnd,aPS})
end if
elsif msg = WM_LBUTTONDOWN then
Struct = c_func(hGetPropA,{hwnd,HBPROPLP})
HDC = GetDC(hwnd)
Type = peek(Struct + hb_stype)
Style = peek(Struct + hb_sstyle)
poke(Struct + hb_active , 1 )
poke(Struct + hb_mstatus, 1 )
poke(Struct + hb_hover , 1 )
if Style = HBS_RECT then
if Type = HBS_TOGGLE then
if peek(Struct + hb_togstatus) then
poke(Struct + hb_togstatus, 0 )
else
poke(Struct + hb_togstatus, 1 )
ExcGrp = peek(Struct + hb_set)
if ExcGrp then
ReleaseToggle(ExcGrp,hwnd)
end if
end if
elsif Type = HBS_DISABLED then
end if
BltTogImage_RECT(hwnd,HDC,Struct)
elsif Style = HBS_ROUNDRECT then
elsif Style = HBS_DISABLED then
end if
ACTIVE = hwnd
ReleaseDC(hwnd,HDC)
elsif msg = WM_MOUSEMOVE then
if ACTIVE != hwnd then
if ACTIVE > 0 then
Struct = c_func(hGetPropA,{ACTIVE,HBPROPLP})
poke(Struct + hb_active, 0 )
poke(Struct + hb_mstatus,0 )
poke(Struct + hb_hover ,0 )
c_proc(hInvalidateRect,{ACTIVE,0,1})
ACTIVE = hwnd
return 0
end if
end if
Struct = c_func(hGetPropA,{hwnd,HBPROPLP})
if not peek(Struct + hb_hover) then
poke(Struct + hb_active , 1 )
poke(Struct + hb_hover , 1 )
HDC = GetDC(hwnd)
Type = peek(Struct + hb_stype)
Style = peek(Struct + hb_sstyle)
if Style = HBS_RECT then
if Type = HBS_TOGGLE then
if peek(Struct + hb_togstatus) then
BltTogImage_RECT(hwnd,HDC,Struct)
else
BltOnImage_RECT(hwnd,HDC,Struct)
end if
elsif Type = HBS_ENABLED then
BltOnImage_RECT(hwnd,HDC,Struct)
elsif Type = HBS_DISABLED then
end if
elsif Style = HBS_ROUNDRECT then
elsif Style = HBS_ELLIPSE then
end if
ReleaseDC(hwnd,HDC)
end if
ACTIVE = hwnd
elsif msg = WM_LBUTTONUP then
Struct = c_func(hGetPropA,{hwnd,HBPROPLP})
poke(Struct + hb_active , 1 )
poke(Struct + hb_mstatus, 0 )
Type = peek(Struct + hb_stype)
Style = peek(Struct + hb_sstyle)
HDC = GetDC(hwnd)
if Style = HBS_RECT then
if Type = HBS_TOGGLE then
if not peek(Struct + hb_togstatus) then
BltOnImage_RECT(hwnd,HDC,Struct)
end if
elsif Type = HBS_ENABLED then
BltOnImage_RECT(hwnd,HDC,Struct)
elsif Type = HBS_DISABLED then
end if
elsif Style = HBS_ROUNDRECT then
elsif Style = HBS_ELLIPSE then
end if
ReleaseDC(hwnd,HDC)
c_proc(hPostMessage,{#FFFF,WM_HBCLICKED,0,hwnd})
c_proc(hPostMessage,{hwnd,WM_HBCLICKED,0,hwnd})
elsif msg = WM_DESTROY then
HB_BtnCleanup(hwnd)
end if
return c_func(hCallWindowProcA,{CurParentCB,hwnd,msg,wParam,lParam})
end function
-------------------------------------------
function ParentWndProc(atom hwnd,atom msg,atom wParam,atom lParam)
-------------------------------------------
ParentCB = c_func(hGetPropA,{hwnd,HBPROPCB})
if not ParentCB then
return c_func(hDefWindowProcA,{hwnd,msg,wParam,lParam})
end if
if msg = WM_MOUSEMOVE then
if ACTIVE then
Struct = c_func(hGetPropA,{ACTIVE,HBPROPLP})
if Struct then
poke(Struct + hb_active , 0 )
poke(Struct + hb_hover , 0 )
if not peek(Struct + hb_mstatus) then
c_proc(hInvalidateRect,{ACTIVE,0,1})
ACTIVE = 0
end if
end if
end if
elsif msg = WM_LBUTTONUP then
if ACTIVE then
Struct = c_func(hGetPropA,{ACTIVE,HBPROPLP})
if Struct then
if peek(Struct + hb_mstatus) then
c_proc(hInvalidateRect,{ACTIVE,0,1})
poke(Struct + hb_mstatus, 0 )
ACTIVE = 0
end if
end if
end if
elsif msg = WM_DESTROY then
HB_Cleanup()
end if
return c_func(hCallWindowProcA,{ParentCB,hwnd,msg,wParam,lParam})
end function
CurParentCB = call_back(routine_id("ParentWndProc"))
-------------------------------------------
procedure StartHBClass()
-------------------------------------------
atom wca,hInst,HBCBA
HBCBA = call_back(routine_id("HBWndProc"))
hInst = instance()
wca = allocate(48)
Defaultfont = c_func(hGetStockObject, { 12 } )
mem_set(wca,0,48)
poke4(wca+00,48 )
poke4(wca+08,HBCBA)
poke4(wca+20,hInst)
poke4(wca+32,16 )
poke4(wca+40,WC_HBUTTON)
if not c_func(hRegisterClassEx,{wca}) then
Report(HB_REG_FAIL)
end if
free(wca)
end procedure
StartHBClass()
---------------------------------------------------------
|
Not Categorized, Please Help
|
|
