Oh ha, didn't notice the ZIP did not attach.

TYPE StatusItems sText AS ASCIIZ * 128 sWidth AS LONG sType AS LONG sStyle AS LONG END TYPE %SBU_FIXED = 0 %SBU_SPRING = 1 %SBU_REMAIN = 2 %SBU_MAXPANELS = 25 %SBT_NORMAL = 0
CLASS STATUSBARCLASS INSTANCE hStatusBar AS DWORD INSTANCE idStatusBar AS DWORD INSTANCE hParent AS DWORD INSTANCE pCount AS LONG INSTANCE sPanels() AS StatusItems INSTANCE GripWidth AS LONG INSTANCE Divider AS LONG INSTANCE DefaultWidth AS LONG INSTANCE FillLast AS LONG
CLASS METHOD CREATE() pCount = 0 REDIM sPanels(pCount) sPanels(pCount).sText = "StatusBar" sPanels(pCount).sWidth = ME.SpringWidth(0) sPanels(pCount).sType = %SBU_SPRING sPanels(pCount).sStyle = %SBT_NORMAL DefaultWidth = 50 FillLast = %TRUE END METHOD CLASS METHOD DESTROY() END METHOD
CLASS METHOD ReCalculateWidths() LOCAL pIndex AS LONG LOCAL rIndex AS LONG LOCAL sbWidth AS LONG LOCAL sRect AS RECT DIM pParts(pCount) AS LONG GetClientRect hStatusBar, sRect sRect.nRight = sRect.nRight - GripWidth - (Divider * pCount) sbWidth = sRect.nRight
FOR pIndex = 0 TO pCount sbWidth = sbWidth - sPanels(pIndex).sWidth IF sbWidth < 0 THEN EXIT FOR NEXT pIndex IF sbWidth < 0 THEN ' change of tatics ' convert everything into a percentage of width and apply sbWidth = 0 rIndex = 0 FOR pIndex = 0 TO pCount rIndex = rIndex + sPanels(pIndex).sWidth NEXT pIndex FOR pIndex = 0 TO pCount sbWidth = sbWidth + _ (sRect.nRight * (sPanels(pIndex).sWidth / rIndex)) pParts(pIndex) = sbWidth NEXT pIndex ELSE ' default sizes fit into space, find the Remaining then allocate sbWidth = 0 FOR pIndex = 0 TO pCount IF (sPanels(pIndex).sType = %SBU_REMAIN) THEN EXIT FOR sbWidth = sbWidth + sPanels(pIndex).sWidth + Divider pParts(pIndex) = sbWidth NEXT pIndex ' note we bust out on finding the first %SBU_REMAIN, if there's none ' then pIndex will be greater than pCount. ' if pIndex happens to equal pCount, that just means that the last ' element is a %SBU_REMAIN, acts like FillLast. IF pIndex < pCount THEN ' need to calculate the remaining, if any ' then subtract it from the width sbWidth = sRect.nRight FOR rIndex = pIndex + 1 TO pCount sbWidth = sbWidth - (sPanels(rIndex).sWidth) NEXT rIndex pParts(pIndex) = sbWidth ' calculate the remaining parts FOR rIndex = pIndex + 1 TO pCount sbWidth = sbWidth + sPanels(rIndex).sWidth + Divider pParts(rIndex) = sbWidth NEXT rIndex END IF IF (ISTRUE FillLast) OR (pIndex = pCount) THEN ' we execute a fake if last panel is %SBU_REMAIN pParts(pCount) = -1 END IF END IF SendMessage hStatusBar, %SB_SETPARTS, pCount + 1, VARPTR(pParts(0)) END METHOD
CLASS METHOD SpringWidth(vPart AS LONG) AS LONG LOCAL tSize AS SIZEL LOCAL hDC, hFont, oFont AS DWORD hFont = SendMessage(hStatusBar, %WM_GETFONT, 0, 0) hDC = CreateCompatibleDC(0) oFont = SelectObject(hDC, hFont) GetTextExtentPoint32 hDC, sPanels(vPart).sText, LEN(sPanels(vPart).sText), tSize SelectObject hDC, oFont DeleteDC hDC METHOD = tSize.cx + (Divider * 2) END METHOD
INTERFACE STATUSBARINTERFACE INHERIT IUNKNOWN PROPERTY GET FillMode() AS LONG PROPERTY = FillLast END PROPERTY PROPERTY SET FillMode(BYVAL nFill AS LONG) FillLast = nFill END PROPERTY PROPERTY GET PanelCount() AS LONG PROPERTY = pCount END PROPERTY PROPERTY GET SetStyle(BYVAL pIndex AS LONG) AS LONG IF pIndex <= pCount THEN _ PROPERTY = sPanels(pIndex).sStyle END PROPERTY PROPERTY SET SetStyle(BYVAL pIndex AS LONG, BYVAL nStyle AS LONG) IF pIndex <= pCount THEN _ sPanels(pIndex).sStyle = nStyle END PROPERTY PROPERTY GET SetType(BYVAL pIndex AS LONG) AS LONG IF pIndex <= pCount THEN _ PROPERTY = sPanels(pIndex).sType END PROPERTY PROPERTY SET SetType(BYVAL pIndex AS LONG, BYVAL nType AS LONG) IF pIndex <= pCount THEN _ sPanels(pIndex).sType = nType END PROPERTY
METHOD AddPanel(OPTIONAL BYREF vText AS STRING, BYREF vStyle AS LONG, _ BYREF vType AS LONG, BYREF vWidth AS LONG) AS LONG LOCAL pError AS LONG IF pCount < %SBU_MAXPANELS THEN INCR pCount REDIM PRESERVE sPanels(pCount) IF ISMISSING(vStyle) THEN sPanels(pCount).sStyle = vStyle IF NOT ISMISSING(vType) THEN sPanels(pCount).sType = vType IF NOT ISMISSING(vText) THEN sPanels(pCount).sText = vText IF sPanels(pCount).sType > 0 THEN sPanels(pCount).sWidth = ME.SpringWidth(pCount) ELSE IF ISMISSING(vWidth) THEN sPanels(pCount).sWidth = DefaultWidth ELSE sPanels(pCount).sWidth = vWidth END IF END IF ' recalculate sizes and set the text ME.ReCalculateWidths SendMessage hStatusBar, %SB_SETTEXT, _ sPanels(pCount).sStyle OR pCount, VARPTR(sPanels(pCount).sText) METHOD = pCount ELSE METHOD = -1 END IF END METHOD
METHOD Move(wMsg AS DWORD, wParam AS LONG, lParam AS LONG) SendMessage hStatusBar, wMsg, wParam, lParam ME.ReCalculateWidths END METHOD
METHOD SetControl(hOwner AS DWORD, hControl AS DWORD, idControl AS DWORD) DIM sBorders(2) AS LONG LOCAL sRect AS RECT idStatusBar = idControl hParent = hOwner hStatusBar = hControl SendMessage hStatusBar, %SB_SETTEXT, _ sPanels(0).sStyle OR 0, VARPTR(sPanels(0).sText) SendMessage hStatusBar, %SB_GETBORDERS, 0, VARPTR(sBorders(0)) Divider = sBorders(2) GetClientRect hStatusBar, sRect GripWidth = sRect.nRight SendMessage hStatusBar, %SB_GETRECT, 0, VARPTR(sRect) GripWidth = GripWidth - sRect.nRight END METHOD
METHOD SetText(BYREF vText AS STRING, OPTIONAL BYVAL pIndex AS LONG) IF pIndex <= pCount THEN sPanels(pIndex).sText = vText SendMessage hStatusBar, %SB_SETTEXT, _ sPanels(pIndex).sStyle OR pIndex, VARPTR(sPanels(pIndex).sText) ' recalculate size if the element is a spring IF sPanels(pIndex).sType > 0 THEN sPanels(pIndex).sWidth = ME.SpringWidth(pIndex) ME.ReCalculateWidths END IF END IF END METHOD END INTERFACE END CLASS
We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.
By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.
Leave a comment: