// cToolsPalette.pkg // Tools Palette class definition. // by Sergey V. Natarov // Register_Object oTPPageScrollUp Register_Object oTPPageScrollDown Use cRealToolbar.pkg Use mPointer.pkg Use ctButton.pkg Use DrgNDrop.pkg Define CPALETTE_PAGE_GUIHEIGHT for 20 Define CPALETTE_BUTTON_GUIHEIGHT for 36 Define CPALETTE_BUTTON_GUIWIDTH for 1620 Class cTPImageList is a cImageList32 Procedure OnCreate String sBmp Integer iTrClr Integer iVoid Delegate Get Button_Bitmap To sBmp Delegate Get Button_Transparency to iTrClr Get AddImage sBmp to iVoid End_Procedure End_Class Class cTPButton is a cToolbarButton Procedure Construct_Object Forward Send Construct_Object Set psLabel to "Not Defined" Set pbAutoSize to False Set psTooltip to '' Set psStatusHelp to '' Set piImage to 0 End_Procedure Procedure OnClick Delegate Send OnClick End_Procedure End_Class Class cToolPaletteButton is a cRealToolBar Procedure Construct_Object Forward Send Construct_Object Property String Button_Bitmap "" Property Integer Button_Transparency clFuchsia Property Integer Button_Message 0 Property Integer piButtonData 0 Set Size to 20 198 Set peAlign to alNone Set peAnchors to anLeftRight Set pbNoDivider To True Set pbInMdiPanel To False Set pbShowLabels To True Set pbList to True //False Set piTextRowsMax To 3 Set piButtonHeight To 220 Set piButtonWidth To CPALETTE_BUTTON_GUIWIDTH Set piButtonWidthMax to CPALETTE_BUTTON_GUIWIDTH // Color Schemes for the Buttons Border... Set piclrBtnHighlight To clWHite Set piclrBtnShadow To clBlack Set piTextColor to clWhite Object oButton is a cTPButton End_Object End_Procedure Import_Class_Protocol cDragAndDrop_mx Function DragAndDrop_DataType Returns String Function_Return "DD_CLASS" End_Function Function DragAndDrop_GetData Returns String Integer iData String sData Get piButtonData to iData Delegate Get ButtonTemplate iData to sData Function_Return sData End_Function Procedure Set piMessage Integer iMsg Set Button_Message To iMsg End_Procedure Function piMessage Returns Integer Function_Return (Button_Message(oButton(Self))) End_Function Procedure Set Bitmap String sBitmap Integer iColor Set Button_Bitmap To sBitmap Set Button_Transparency To iColor End_Procedure Function Bitmap Returns String Function_Return (Button_Bitmap(oButton(Self))) End_Function Procedure Set Label String sLabel Set psLabel Of (oButton(Self)) To sLabel End_Procedure Function Label Returns String Function_Return (psLabel(oButton(Self))) End_Function Procedure Set ToolTip String sLabel Set psToolTip Of (oButton(Self)) To sLabel End_Procedure Function ToolTip Returns String Function_Return (psToolTip(oButton(Self))) End_Function Procedure Set StatusHelp String sStatus Set psStatusHelp Of (oButton(Self)) To sStatus End_Procedure Function StatusHelp Returns String Function_Return (psStatusHelp(oButton(Self))) End_Function Procedure OnClick Integer iMsg iData Get piButtonData to iData Get Button_Message to iMsg Delegate Send iMsg iData End_Procedure Procedure End_Construct_Object Integer iHL iSH iTXT iHLTXT iClr iFntWght iFntHght iFntIt iFntUnd iBtnClr String sBmp sFont Forward Send End_Construct_Object Object oImages is a cTPImageList End_Object If (Not(ImageCount(oImages(Self)))) Begin Send Destroy to (oImages(Self)) Object oImages is a cTPImageList End_Object End Set phoImageList To (oImages(Self)) Set phoImageListHot To (oImages(Self)) Delegate Get Button_Color to iBtnClr Delegate Get Button_Highlight_Color to iHL Delegate Get Button_Shadow_Color to iSh Delegate Get Button_Text_Color to iTXT Delegate Get Button_Text_HighLight_Color to iHLTXT Delegate Get Button_Pattern to sBmp Delegate Get Button_FontWeight to iFntWght Delegate Get Button_FontHeight to iFntHght Delegate Get Button_FontItalics to iFntIt Delegate Get Button_FontUnderline to iFntUnd Delegate Get Button_TypeFace to sFont Delegate Get Color to iClr Set piTextColor to iTXT Set ColorScheme to iHL iSH If (sBmp<>"") Begin Set piBkColor To iClr Set psBkPatternBmp To sBmp End If (iBtnClr<>CLR_DEFAULT) Set piBkColor To iBtnClr If ((sFont<>"")And(sFont<>"MS Sans Serif")) Set TypeFace To sFont If (iFntWght) Set FontWeight To iFntWght If (iFntHght) Set FontSize To iFntHght 0 If (iHLTXT<>-1) Set piTextHighlightColor To iHLTxt If (iFntIt) Set FontItalics To True If (iFntUnd) Set FontUnderline To True End_Procedure End_Class Class cTPPageScrollUp is a ctButton Procedure Construct_Object Forward Send Construct_Object Set Visible_State To False Set Bitmap to "up.bmp" Set Size To 8 10 Set Location To 14 63 End_Procedure Procedure Set Visible_State Integer bState Set Border_Style To Border_Dialog Forward Set Visible_State To bState End_Procedure Procedure OnClick Integer iPage iObj Delegate Get Current_Page to iPage Delegate Get Palette_Page iPage to iObj Send Scroll_Buttons_Up to iObj End_Procedure End_Class Class cTPPageScrollDown is a ctButton Procedure Construct_Object Forward Send Construct_Object Set Visible_State To False Set Bitmap to "down.bmp" Set Size To 8 10 Set Location To 179 63 End_Procedure Procedure Set Visible_State Integer bState Set Border_Style To Border_Dialog Forward Set Visible_State To bState End_Procedure Procedure OnClick Integer iPage iObj Delegate Get Current_Page to iPage Delegate Get Palette_Page iPage to iObj Send Scroll_Buttons_Down to iObj End_Procedure End_Class Class cTPPageLabel is a Textbox Procedure Construct_Object Forward Send Construct_Object Set Label To "Page 0 (Default)" // Set FontWeight to 800 // Set Auto_Size_State to False Set Transparent_State to True Set Location to -1 2 Set Size To 10 70 Set Justification_Mode to JMode_Left //(jMode_Center Ior jMode_vCenter) End_Procedure Procedure Mouse_Up Integer iWnd Delegate Send Mouse_Up iWnd End_Procedure Procedure OnResize Integer cxy cx cy Delegate Get GUISize To cxy // Size of Page Move (Hi(cxy)) To cy Move (Low(cxy)) To cx //Set TextColor To clNavy Set GUISize to (CPALETTE_PAGE_GUIHEIGHT-3) (cx-9) Send Adjust_Logicals Set Label To (Label(Self)) // refresh label End_Procedure End_Class Class cToolsPalettePage is a Container3d Procedure Construct_Object Forward Send Construct_Object Property Integer Palette_Page_Number 0 // Page Number inside the Bar Property Integer Top_Button 0 // INTERNAL USE ONLY! Property Integer Disabled_State False // INTERNAL USE ONLY! Property Integer piRedraw False Set Bitmap to "PalettePageBG.bmp" Set Bitmap_Style to Bitmap_Tile //Bitmap_Stretch Set Border_Style to Border_StaticEdge Set Size to 12 77 // 12 81 Set GUILocation to 0 0 Send Adjust_Logicals Object Page_Button_Id is an Array End_Object Object oPageLabel is a cTPPageLabel End_Object End_Procedure // Get/Set Page Button via button number. Accept/Returns Object_Id. Procedure Set Page_Button Integer iBtn Integer iObj Set Value of (Page_Button_Id(Self)) item iBtn to iObj End_Procedure Function Page_Button Integer iBtn Returns Integer Function_Return (Value(Page_Button_Id(Self),iBtn)) End_Function // Get/Set Page Label Procedure Set psLabel String sLabel Set Label Of (oPageLabel(Self)) To sLabel End_Procedure Function psLabel Returns String Function_Return (Label(oPageLabel(Self))) End_Function Procedure Init_Palette_Page Integer iPgNo iObj Move Self To iObj Get Register_Page Of (Parent(Self)) iObj To iPgNo Set Palette_Page_Number To iPgNo End_Procedure Procedure Mouse_Up Integer iWnd Integer iPage iBtns If (Not(Enabled_State(Self))) Procedure_Return Get Palette_Page_Number to iPage Send Show_Page to (Parent(Self)) iPage Forward Send Mouse_Up iWnd End_Procedure // Internal methods to hide/show page buttons. Ususally you should not use it. Procedure Hide_Page_Buttons Integer iBtn iObj If (Item_Count(Page_Button_Id(Self))=0) Procedure_Return For iBtn From 0 To (Item_Count(Page_Button_Id(Self))-1) Get Value Of (Page_Button_Id(Self)) Item iBtn To iObj If (iObj) Set Visible_state Of iObj To False Loop End_Procedure Procedure Show_Page_Buttons Integer iBtn iObj iAllowed iBtns iCnt iPage Delegate Get Page_Buttons_Number to iAllowed Move (Item_Count(Page_Button_Id(Self))) to iBtns Get Palette_Page_Number to iPage If (iBtns>iAllowed) Move iAllowed to iCnt Else Move iBtns to iCnt If (iCnt>0) Begin For iBtn from 0 to (iCnt-1) Get Value of (Page_Button_Id(Self)) item iBtn to iObj Set GUILocation of iObj to (18+(CPALETTE_PAGE_GUIHEIGHT*(iPage+1))+(iBtn*CPALETTE_BUTTON_GUIHEIGHT)) 1 Set Visible_state of iObj to True Loop End // Adjust scroll buttons Set Visible_State of oTPPageScrollUp to False If (iBtns>iAllowed) Set Visible_State Of oTPPageScrollDown To True Else Set Visible_State of oTPPageScrollDown to False Set Top_Button To 0 End_Procedure // To Disable/Enable all buttons on the page. Usage: // Set Page_Disabled_State to True Procedure Set Page_Disabled_State Integer bState Integer iBtn iObj If (Item_Count(Page_Button_Id(Self))>0) Begin For iBtn From 0 To (Item_Count(Page_Button_Id(Self))-1) Get Value Of (Page_Button_Id(Self)) Item iBtn To iObj Set pbEnabled Of iObj To (Not(bState)) Loop End Set Disabled_State To bState Set Enabled_State To (Not(bState)) End_Procedure Function Page_Disabled_State Returns Integer Function_Return (Disabled_State(Self)) End_Function Procedure Show_Buttons_Range Integer iButtons Integer iTop Integer iLimit Integer iCount iButton iPage Handle hoPage Get Palette_Page_Number to iPage If (iButtons>iLimit) Begin Send Hide_Page_Buttons Move 0 to iCount For iButton from iTop to iLimit Get Value of (Page_Button_Id(Self)) item iButton to hoPage Set Visible_state of hoPage to True Set GUILocation of hoPage to (18+(CPALETTE_PAGE_GUIHEIGHT*(iPage+1))+(iCount*CPALETTE_BUTTON_GUIHEIGHT)) 1 Increment iCount Set Top_Button to iTop Loop End End_Procedure Procedure Scroll_Buttons_Down Integer iTop iBtns iVsbl iBtn iLim Get Top_Button to iTop Get Item_Count of (Page_Button_Id(Self)) to iBtns Delegate Get Page_Buttons_Number to iVsbl Decrement iVsbl Increment iTop Move (iVsbl+iTop) to iLim If (iLim>(iBtns-1)) Move (iBtns-1) to iLim // Send Show_Buttons_Range iBtns iTop iLim // If ((iBtns-1)=iLim) Set Visible_State of oTPPageScrollDown to False If (iTop>0) Set Visible_State of oTPPageScrollUp to True End_Procedure Procedure Scroll_Buttons_Up Integer iTop iBtns iVsbl iBtn iLim Get Top_Button to iTop Get Item_Count of (Page_Button_Id(Self)) to iBtns Delegate Get Page_Buttons_Number to iVsbl Decrement iVsbl Decrement iTop Move (iVsbl+iTop) to iLim If (iLim>(iBtns-1)) Move (iBtns-1) to iLim // Send Show_Buttons_Range iBtns iTop iLim // If ((iBtns-1)>iLim) Set Visible_State of oTPPageScrollDown to True If (iTop=0) Set Visible_State of oTPPageScrollUp to False End_Procedure Procedure OnResize Integer cxy Delegate Get GUISize To cxy Set GUISize to CPALETTE_PAGE_GUIHEIGHT (Low(cxy)-2) Send Adjust_Logicals End_Procedure End_Class Class cToolsPalette is a Container3d Procedure Construct_Object Forward Send Construct_Object // Total pages placed on the palette Property Integer Button_Highlight_Color clNavy //clWhite Property Integer Button_Shadow_Color clNavy //clBlack Property Integer Button_Text_Color clBlack Property Integer Button_Text_HighLight_Color -1 Property Integer Button_Color CLR_DEFAULT Property String Button_TypeFace "MS Sans Serif" Property Integer Button_FontWeight 0 Property Integer Button_FontHeight 0 Property Integer Button_FontItalics False Property Integer Button_FontUnderline False Property String Button_Pattern "" Property Integer Total_Pages 0 // INTERNAL USE ONLY! Property Integer Current_Page 0 // INTERNAL USE ONLY! Property Integer piInitialized 0 Property String[] psClassList Property String[] psPackageList Object Palette_Pages_Id is an Array End_Object Object oTPPageScrollUp is a cTPPageScrollUp End_Object Object oTPPageScrollDown is a cTPPageScrollDown End_Object Set Size to 250 70 Set Location to -2 0 Set peAnchors to anAll Set Color to (Color(Parent(Self))) //clWhite //clGray Set Border_Style to Border_StaticEdge //Border_ClientEdge Set Button_Text_Color to clBlack End_Procedure // Internal property to assign/retrieve page object ID to internal page store. // INTERNAL USE ONLY! Procedure Set Palette_Page Integer iPage Integer iObj Set Value of (Palette_Pages_Id(Self)) item iPage to iObj End_Procedure Function Palette_Page Integer iPage Returns Integer Function_Return (Value(Palette_Pages_Id(Self),iPage)) End_Function // Public interface to register page within cToolsPalette. // Function returns page number of registered object Function Register_Page Integer iObj Returns Integer Integer iPage Get Item_Count Of (Palette_Pages_Id(Self)) To iPage Set Palette_Page iPage to iObj Set Total_Pages To iPage Function_Return iPage End_Function // Removes the specified palette page and all buttons related to Procedure Remove_Page Integer iPage Integer iPages iBtn iBtns iPgObj iBtObj iItm Get Item_Count Of (Palette_Pages_Id(Self)) To iPages Decrement iPages If (Not(iPage<=iPages)) Procedure_Return Get Value Of (Palette_Pages_Id(Self)) Item iPage To iPgObj If (iPgObj) Begin Send Hide_Page_Buttons To iPgObj Get Item_Count Of (Page_Button_Id(iPgObj)) To iBtns For iBtn From 0 To iBtns Get Value Of (Page_Button_Id(iPgObj)) Item iBtn To iBtObj If (iBtObj) Send Destroy To iBtObj Loop Send Destroy To iPgObj Send Delete_Item Of (Palette_Pages_Id(Self)) iPage End Set Current_Page To 0 Set Total_Pages To (Total_pages(Self)-1) // Adjust page numbers For iItm From iPage To (Total_Pages(Self)) Get Value of (Palette_Pages_Id(Self)) item iItm to iPgObj If (iPgObj) Set Palette_Page_Number Of iPgObj To (Palette_Page_Number(iPgObj)-1) Loop Send Refresh_Palette End_Procedure // Placed here for resize purposes. After cToolsPalette resizing, // do not forget send this message. Procedure Refresh_Palette Integer iCurPage Get Current_Page To iCurPage Send Show_Page (Total_Pages(Self)) //0 Send Show_Page iCurPage End_Procedure Procedure Remove_Page_Button Integer iPage Integer iBtn Integer iPgObj iObj Get Palette_Page iPage to iPgObj If (Not(iPgObj)) Procedure_Return Get Value Of (Page_Button_Id(iPgObj)) Item iBtn To iObj If (Not(iObj)) Procedure_Return Send Delete_Item To (Page_Button_Id(iPgObj)) iBtn Send Destroy To iObj End_Procedure Procedure Redraw_Page Handle hoPage Integer iY Integer iX // Redraw only once during re-initialization Set GUILocation of hoPage to iY iX If ((hoPage) and (not(piRedraw(hoPage))) )Begin If (piInitialized(Self)) Begin Send Page_Object to hoPage True Set Visible_State of (oPageLabel(hoPage)) to False Send Page_Object to (oPageLabel(hoPage)) True Send OnResize to hoPage Set Visible_State of (oPageLabel(hoPage)) to True Set piRedraw of hoPage to True End End End_Procedure Procedure Delete_Data Handle hoPage Integer iPage Integer iButton Set Visible_State to False Get Item_Count of Palette_Pages_Id to iPage While (iPage>0) Decrement iPage Get Palette_Page iPage to hoPage Get Item_Count of (Page_Button_Id(hoPage)) to iButton While (iButton>0) Decrement iButton Send Remove_Page_Button iPage iButton Loop Send Delete_Data to (Page_Button_Id(hoPage)) Send Remove_Page iPage Loop Send Delete_Data to Palette_Pages_Id Set Visible_State to True End_Procedure // "Opens" page on the Palette by internal Page number. Procedure Show_Page Integer iPage Integer iCurPage iObj iItm iCnt iCnt1 iPages iDnPages iFrst Integer cxy cx cy Get Total_Pages to iPages If (iPages<=0) Procedure_Return Send OnOpenPage iPage Get Current_Page to iCurPage Get Palette_Page iCurPage to iObj Move (iPages-iPage) To iDnPages If (iPage<>0) Send Hide_Page_Buttons To iObj Else Send Hide_All_Buttons To iObj Get Palette_Page 0 to iFrst Send Redraw_Page iFrst 0 0 If ((iObj)And(iCurPage<>iPage)) Begin // Move all pages up above selected. If (iPage>0) Begin For iItm From 0 To iPage Get Palette_Page iItm to iObj Send Redraw_Page iObj (iItm*CPALETTE_PAGE_GUIHEIGHT) 0 Loop End // Move all pages down below selected. If (iDnPages>0) Begin Get GUISize To cxy Move (Hi(cxy)) To cy Move (Low(cxy)) To cx Move iPages To iCnt Move 1 To iCnt1 For iItm From (iPage+1) To iPages Get Palette_Page iCnt To iObj Set GUILocation of iObj to (cy-(iCnt1*CPALETTE_PAGE_GUIHEIGHT)-2) 0 //-4 Increment iCnt1 Decrement iCnt Loop End Get Palette_Page iPage to iObj Set Current_Page To iPage End Send Show_Page_Buttons To iObj Send Adjust_Scroll_Buttons End_Procedure // INTERNAL USE ONLY! // Used for relocation of scroll buttons on the page. Procedure Adjust_Scroll_Buttons Integer iPage iPages iLoc Integer cxyUp cxyDn cxy cxyBn Get Total_Pages To iPages Get Current_Page To iPage Get GUILocation Of oTPPageScrollUp To cxyUp Get GUILocation Of oTPPageScrollDown To cxyDn // How many pages below selected. Move (iPages-iPage) To iLoc Get GUISize To cxy // Client size Get GUISize Of oTPPageScrollDown To cxyBn // Down Button size Set GUILocation of oTPPageScrollUp to (((iPage+1)*CPALETTE_PAGE_GUIHEIGHT)+3) (Low(cxy)-Low(cxybn)-8) Set GUILocation of oTPPageScrollDown to (Hi(cxy)-(iLoc*CPALETTE_PAGE_GUIHEIGHT)-Hi(cxybn)-8) (Low(cxy)-Low(cxybn)-8) End_Procedure // How many buttons could be located on every page. // Returns number of buttons. Function Page_Buttons_Number Returns Integer Integer iPages iSpace iButtons cxy BnCxy Move 0 To iButtons Get Total_Pages to iPages Get GUISize to cxy Get GUISize of oTPPageScrollDown to BnCxy Move (Hi(cxy)-(iPages*CPALETTE_PAGE_GUIHEIGHT)-(2*Hi(BnCxy))-23) to iSpace Move (iSpace/(CPALETTE_BUTTON_GUIHEIGHT+2)) to iButtons // /81 Function_Return iButtons End_Function Function Create_Palette_Button Integer iMsg String sLbl String sBmp Integer iData Returns Integer Handle hoButton Object OSB_Button is a cToolPaletteButton Set piMessage to iMsg Set Label to sLbl Set Bitmap sBmp to clWhite Set piButtonData to iData Move Self to hoButton End_Object If (piInitialized(Self)) Send Activate_Component hoButton True (Focus_Mode(hoButton)) Function_Return hoButton End_Function Function Create_Palette_Page String sLbl Returns Integer Handle hoPage Get Create U_cToolsPalettePage to hoPage Set psLabel of hoPage to sLbl Send Init_Palette_Page to hoPage Function_Return hoPage End_Function Procedure Set GUISize Integer iY Integer iX Forward Set GUISize To iY iX Broadcast Recursive Send OnResize End_Procedure Procedure Hide_All_Buttons Integer iPage iPages iObj Get Total_Pages To iPages If (iPages=0) Procedure_Return For iPAge From 0 To iPages Get Palette_Page iPage to iObj Send Hide_Page_Buttons To iObj Loop End_Procedure Procedure OnCreatePalette End_Procedure Procedure OnOpenPage Integer iPage End_Procedure // This cancels all activate routines Procedure activate End_Procedure Procedure mouse_down Integer i1 End_Procedure Procedure Add_Focus Handle hoParent Returns Integer Integer iRetVal Forward Get Msg_Add_Focus hoParent to iRetVal Set piInitialized to True Procedure_Return iRetVal End_Procedure Procedure End_Construct_Object Send OnCreatePalette Forward Send End_Construct_Object Send Show_Page 0 End_Procedure End_Class