GUI "Tab_Demo",PIXELS 'BY IDC & MH Feb '09 'A proposed Tab and Slider Control for BCX by Mike Henning November 2004 ' '============================================================================== ' BCX_Tab Control: '============================================================================== 'While not quite as easy as other controls, I think it still makes it quite simple 'to create tab controls. I still have a couple of things I would like to implement 'but this should be enough to decide if we want it and what changes if any to be 'made. My intent is to add a parameter for an image list pointer and styles. ' ' RetVal = ' BCX_TAB(HWND, id, NumPages, HWND PageArray,String Array,X,Y,W,H[,HIMAGELIST,Style,StyleEx]) ' ' HWND - Handle to the Parent form ' id - Control ID ' NumPages - Number of Pages/Tabs the Tab Control will have ' HWND Array - An array of handles returned for each page. ' These handles will be the parent handles for any ' controls you place on a page. ' Str Array - An array of titles for each Page/Tab ' X,Y,W,H - Size of Tab Control ' HIMAGELIST - An Image list to be placed on each Page/Tab (Enter NULL for none) ' Style,StyleEx - Optional styles and extended styles ' 'Special note: ' ' Control ID's from #1 thru total pages + 1 are reserved for internal use. ' example: If you create 3 Tab Controls each having 6 Pages/Tabs then you ' should not use control ID #'s 1 - 19 for any control. ' '============================================================================== ' BCX_Slider Control: '============================================================================== ' ' RetVal = ' BCX_Slider(Text, HWND, id,X,Y,W,H [,Text position,Style,StyleEx]) ' ' Text - Text to display next to the Slide control ' HWND - Handle to the Parent form ' id - Control ID ' X,Y,W,H - Size of Tab Control ' Text position - Optional placement of text. 0-bottom,1-top,2-left,3-right ' Style,StyleEx - Optional styles and extended styles ' ' Note: ' No label will be created if "" is entered for the text. ' The handle to the label that is created is now stored in the data ' area of the Slide control and can be accessed as shown in this demo. ' The default Slider is horizontal. Entering TBS_VERT for style will ' indicate a vertical Slider. ' 'Have fun! CONST LHandle(A) = (HWND)GetWindowLong(A,GWL_USERDATA) CONST GetImageListFile(A,B) = ImageList_LoadImage(NULL,A,B,0,CLR_NONE,IMAGE_BITMAP,LR_LOADFROMFILE) ' A = Filename ' B = width of one image in list GLOBAL Form1 AS HWND GLOBAL Tabb1 AS HWND GLOBAL Button1 AS HWND GLOBAL Button2 AS HWND GLOBAL Button3 AS HWND GLOBAL Button4 AS HWND GLOBAL Button5 AS HWND GLOBAL Button6 AS HWND GLOBAL Button7 AS HWND GLOBAL Button8 AS HWND GLOBAL Button9 AS HWND GLOBAL Listview AS HWND GLOBAL Rich AS HWND GLOBAL Slide1 AS HWND GLOBAL Slide2 AS HWND GLOBAL Slide3 AS HWND GLOBAL Slide4 AS HWND GLOBAL Stc1 AS HWND GLOBAL Stc2 AS HWND GLOBAL StatusBar1 AS HWND GLOBAL Stc1_FC GLOBAL Stc1_BC GLOBAL ID_StatusBar1 GLOBAL Tab1Page[7] AS HWND SET Days$[7] "Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday" END SET '------------------------------------------------------------------------------ TYPE anchor IsSubForm XMin YMin PrevRC AS RECT END TYPE CONST StatusBar1_Styles = WS_CHILD|WS_VISIBLE|WS_TABSTOP|SBARS_SIZEGRIP CONST StatusBar1_XStyles = WS_EX_LEFT SUB FORMLOAD Form1 = BCX_FORM("BCX Tab Demo with sizing",0,0,428,355) Tabb1 = BCX_TAB(Form1,500, 7,Tab1Page,Days$, 12, 12,400,270) 'Notice these controls are assigned to the Tab Control Rich = BCX_RICHEDIT("A NEW TAB CONTROL",Tab1Page[0],502,50,10,300,200) Button2 = BCX_BUTTON ("Button 2 " ,Tab1Page[2],504, 330,220, 60,24) Button3 = BCX_BUTTON ("Button 3 " ,Tab1Page[2],504, 2,220, 60,24) Button4 = BCX_BUTTON ("Button 4 " ,Tab1Page[2],504, 73,220, 60,24) Button5 = BCX_BUTTON ("Button 5 " ,Tab1Page[2],504, 145,220, 60,24) Button6 = BCX_BUTTON ("Button 6 " ,Tab1Page[2],504, 216,220, 70,24) Button7 = BCX_BUTTON ("Button 7 " ,Tab1Page[2],504, 330,2, 60,24) Button8 = BCX_BUTTON ("Button 8 " ,Tab1Page[2],504, 330,105, 60,24) Stc1 = BCX_LABEL (CRLF$ & "Proportional Scaling to page size" ,Tab1Page[2],404, 2,2, 320,210) Stc1_FC = 16711680 : Stc1_BC = 8454143 BCX_SET_FONT Stc1,"Comic Sans MS",14,0,1 MODSTYLE(Stc1,SS_CENTER) Listview = BCX_LISTVIEW("" ,Tab1Page[1],505,10,10,370,230) Button9 = BCX_BUTTON("Okay, not the greatest demo...",Tab1Page[5],504,20,20) Slide1 = BCX_SLIDER("Text on bottom",Tab1Page[3],503, 40,20, 40,100,0,TBS_VERT) Slide2 = BCX_SLIDER("Text on top", Tab1Page[3],503,150,50,100, 40,1) Slide3 = BCX_SLIDER("Text on right", Tab1Page[4],503, 50,60, 30, 70,3,TBS_VERT) Slide4 = BCX_SLIDER("Text on left", Tab1Page[4],503, 90,10,150, 40,2) Stc2 = BCX_LABEL (CRLF$ & "TAKE A BREAK, " & CRLF$ &" IT'S SUNDAY AFTER ALL" ,Tab1Page[6],404, 1,1, 388,235) BCX_SET_FONT Stc2,"Comic Sans MS",16,0,1 MODSTYLE(Stc2,SS_CENTER) 'The main form Button1 = BCX_BUTTON("EXIT DEMO",Form1,506,10,285) StatusBar1 = BCX_CONTROL(STATUSCLASSNAME, Form1, "A StatusBar", ID_StatusBar1, 0, 433, 632, 20, StatusBar1_Styles, StatusBar1_XStyles) BCX_SET_FONT LHandle(Slide1),"Comic Sans MS",10,0,1 BCX_SET_FONT LHandle(Slide2),"Comic Sans MS",10,0,1 'I created a macro in the demo: Lhandle(slider handle) will give you the label handle. 'Of course if you wanted to make the font larger than the system default you would have 'to reposition the label or the slider. 'Set up sizing parameters InitAnchor(Form1) InitAnchor(Tabb1, 2) CALL LoadBuffer CENTER(Form1) SHOW(Form1) END SUB BEGIN EVENTS SELECT CASE CBMSG CASE WM_CTLCOLORSTATIC, WM_CTLCOLORBTN, WM_CTLCOLOREDIT,WM_CTLCOLORLISTBOX, WM_CTLCOLORSCROLLBAR SELECT CASE (HWND)CBLPARAM 'Get the control handle CASE Stc1, Stc2 FUNCTION = BCX_SETCOLOR(Stc1_FC, Stc1_BC) END SELECT CASE WM_COMMAND SELECT CASE LOWORD(wParam) CASE 504 MSGBOX "Yup, a button alright!" CASE 506 IF HIWORD(wParam) = BN_CLICKED THEN SendMessage(hWnd,WM_CLOSE,0,0) END IF END SELECT CASE WM_SIZE IF hWnd = Form1 THEN 'Skip if minimized, OS will handle it IF wParam NOT = SIZE_MINIMIZED THEN CALL ReSizeForm1() UpdateAnchor(Tabb1) UpdateAnchor(Form1) END IF END IF END SELECT END EVENTS SUB ReSizeForm1() 'Resize the controls 'Anchor Options: 'AnchorLeft | AnchorRight | AnchorTop | AnchorBottom | AnchorHCenter | AnchorVCenter MoveAnchorControl(Tabb1, AnchorLeft | AnchorRight | AnchorTop | AnchorBottom) MoveAnchorControl(Button1, AnchorLeft | AnchorBottom) MoveAnchorControl(StatusBar1,AnchorLeft | AnchorRight | AnchorBottom) 'Tabbed controls MoveAnchorControl(Rich, AnchorHCenter | AnchorVCenter) MoveAnchorControl(Listview, AnchorLeft | AnchorRight | AnchorTop | AnchorBottom) MoveAnchorControl(Stc1, AnchorLeft | AnchorHCenter | AnchorTop | AnchorVCenter) MoveAnchorControl(Button2, AnchorRight | AnchorHCenter | AnchorBottom | AnchorVCenter) MoveAnchorControl(Button3, AnchorLeft | AnchorHCenter| AnchorBottom | AnchorVCenter) MoveAnchorControl(Button4, AnchorLeft | AnchorRight | AnchorHCenter| AnchorBottom | AnchorVCenter) MoveAnchorControl(Button5, AnchorLeft | AnchorRight | AnchorHCenter| AnchorBottom | AnchorVCenter) MoveAnchorControl(Button6, AnchorLeft | AnchorRight | AnchorHCenter| AnchorBottom | AnchorVCenter) MoveAnchorControl(Button7, AnchorRight | AnchorHCenter | AnchorTop | AnchorVCenter) MoveAnchorControl(Button8, AnchorRight | AnchorHCenter | AnchorTop | AnchorBottom | AnchorVCenter) MoveAnchorControl(Button9, AnchorLeft | AnchorRight | AnchorHCenter | AnchorTop | AnchorBottom | AnchorVCenter) MoveAnchorControl(Stc2, AnchorLeft | AnchorHCenter |AnchorTop | AnchorVCenter) 'to stop flicker each control does not paint itself, so we must update the form here. REFRESH (Form1) END SUB 'ORIGINAL BY: IDC May 2007 'FEB 2009: Mike Henning helped me rewrite this. 'Mike added InitAnchor & UpdateAnchor 'Thanks Mike 'Notes: the MoveAnchorControl function is only expected to be called through ' the WM_SIZE event. 'To use MoveAnchorControl function you will need to call 'InitAnchor(myForm) for the form and for any sub form like 'a tab control in your FormLoad code. 'also see the Events loop: 'UpdateAnchor(Form1) needs to be called after each size event 'MoveAnchorControl Parameters 'hWnd - Control handle 'anchor - a combination of the Constants below 'Horizontal : AnchorLeft | AnchorRight | AnchorHCenter 'Vertical : AnchorTop | AnchorBottom | AnchorVCenter 'AnchorLeft will just left justify the ctrl 'AnchorRight will just right justify the ctrl 'AnchorLeft | AnchorRight will left justify the Left side of the ctrl and 'right justify the right side of the ctrl 'AnchorHCenter will justify toward the center proportionally to page size 'AnchorHCenter | AnchorLeft will left justify to the left and grow the width 'AnchorHCenter | AnchorRight will right justify to the right and grow the width 'AnchorHCenter | AnchorLeft | AnchorRight will scale the ctrls position and width ' ' Similar results for vertical sizes are obtained by using: 'AnchorTop AnchorBottom & AnchorVCenter parameters 'NOTES: AnchorLeft & AnchorTop will NOT do anything by themselves ' Make the original form the smallest size you want the user to use, ' InitAnchor will stop controls sizing smaller than the original ' IsSubForm - optional, use 2 if control parent is a Tab page. default = false CONST AnchorLeft = 1 CONST AnchorRight = 2 CONST AnchorTop = 4 CONST AnchorBottom = 8 CONST AnchorHCenter = 16 'this is left/right CONST AnchorVCenter = 32 'this is up/down FUNCTION MoveAnchorControl(hWnd AS HWND, anchor AS integer) AS RECT DIM RAW newRC AS RECT DIM RAW ctrlrc AS RECT DIM RAW prc AS RECT DIM RAW scalefactor AS DOUBLE DIM RAW hParent AS HWND DIM RAW pa AS LPANCHOR hParent = GetParent(hWnd) prc = GetScaledRect(hParent) pa = (LPANCHOR)GetProp(hParent,(LPCSTR)"Anchor") IF NOT pa THEN FUNCTION = prc ctrlrc = GetScaledRect(hWnd) IF prc.right < pa->XMin THEN prc.right = pa->XMin IF prc.bottom < pa->YMin THEN prc.bottom = pa->YMin IF pa->IsSubForm THEN ctrlrc.left = MAX(0, ctrlrc.left - prc.left) ctrlrc.top = MAX(0, ctrlrc.top - prc.top) ELSE ctrlrc.left = MAX(0, ctrlrc.left - prc.left - GetSystemMetrics(SM_CXSIZEFRAME)) ctrlrc.top = MAX(0, ctrlrc.top - prc.top - GetSystemMetrics(SM_CYCAPTION) - GetSystemMetrics(SM_CYSIZEFRAME)) END IF 'This checks for a menu, and subtracts the Menu size if required IF GetMenu(hParent) THEN ctrlrc.top = ctrlrc.top - (GetSystemMetrics(SM_CYMENUSIZE)+1) END IF '**************************************** newRC = ctrlrc scalefactor = CDBL(prc.right )/ CDBL(pa->PrevRC.right) SELECT CASE (anchor BAND (AnchorLeft + AnchorRight + AnchorHCenter)) '-------------------- CASE AnchorRight '-------------------- newRC.left = prc.right - (pa->PrevRC.right - ctrlrc.left) '-------------------- CASE AnchorLeft + AnchorRight '-------------------- newRC.right = prc.right - (pa->PrevRC.right - ctrlrc.right) '-------------------- CASE AnchorHCenter '-------------------- newRC.left = ctrlrc.left - ((pa->PrevRC.right - prc.right)/2) '-------------------- CASE AnchorRight + AnchorHCenter '-------------------- newRC.right = CINT(CDBL(ctrlrc.right) * scalefactor) newRC.left = prc.right - (pa->PrevRC.right - ctrlrc.left) newRC.left = newRC.left + ctrlrc.right - newRC.right '-------------------- CASE AnchorLeft + AnchorHCenter '-------------------- newRC.right = CINT(CDBL(ctrlrc.right) * scalefactor) '-------------------- CASE AnchorLeft + AnchorRight + AnchorHCenter '-------------------- newRC.right = CINT(CDBL(ctrlrc.right) * scalefactor) newRC.left = CINT(CDBL(ctrlrc.left) * scalefactor) END SELECT scalefactor = CDBL(prc.bottom )/ CDBL(pa->PrevRC.bottom) SELECT CASE (anchor BAND (AnchorTop + AnchorBottom + AnchorVCenter)) '-------------------- CASE AnchorBottom '-------------------- newRC.top = prc.bottom - (pa->PrevRC.bottom - ctrlrc.top) '-------------------- CASE AnchorTop + AnchorBottom '-------------------- newRC.bottom = prc.bottom - (pa->PrevRC.bottom - ctrlrc.bottom) '-------------------- CASE AnchorVCenter '-------------------- newRC.top = ctrlrc.top - ((pa->PrevRC.bottom - prc.bottom)/2) '-------------------- CASE AnchorBottom + AnchorVCenter '-------------------- newRC.bottom = CINT(CDBL(ctrlrc.bottom) * scalefactor) newRC.top = prc.bottom - (pa->PrevRC.bottom - ctrlrc.top) newRC.top = newRC.top + ctrlrc.bottom - newRC.bottom '-------------------- CASE AnchorTop + AnchorVCenter '-------------------- newRC.bottom = CINT(CDBL(ctrlrc.bottom ) * scalefactor) '-------------------- CASE (AnchorTop + AnchorBottom + AnchorVCenter) '-------------------- newRC.bottom = CINT(CDBL(ctrlrc.bottom) * scalefactor) newRC.top = CINT(CDBL(ctrlrc.top) * scalefactor) END SELECT 'Move/resize the window using API CALL MoveWindow(hWnd, newRC.left, newRC.top, newRC.right, newRC.bottom, 0) FUNCTION = newRC END FUNCTION 'IsSubForm 0 for normal form, 2 for tabbed control SUB InitAnchor OPTIONAL(hWnd AS HWND, IsSubForm=0) DIM RAW pa AS LPANCHOR DIM RAW tmphWnd AS HWND PTR DIM RAW i, cnt pa = malloc(SIZEOF(*pa)) IF IsSubForm = 2 THEN tmphWnd = (HWND*)GetWindowLong(hWnd, GWL_USERDATA) pa->PrevRC = GetScaledRect(tmphWnd[0]) ELSE pa->PrevRC = GetScaledRect(hWnd) END IF pa->XMin = pa->PrevRC.right pa->YMin = pa->PrevRC.bottom pa->IsSubForm = IsSubForm IF IsSubForm = 2 THEN cnt = TabCtrl_GetItemCount(hWnd) -1 FOR i = 0 TO cnt SetProp(tmphWnd[i],"Anchor",(HANDLE)pa) NEXT i END IF SetProp(hWnd,"Anchor",(HANDLE)pa) END SUB SUB UpdateAnchor (hWnd AS HWND) DIM RAW pa AS LPANCHOR DIM RAW tmphWnd AS HWND PTR pa = (LPANCHOR)GetProp(hWnd,(LPCSTR)"Anchor") IF pa THEN IF pa->IsSubForm = 2 THEN tmphWnd = (HWND*)GetWindowLong(hWnd, GWL_USERDATA) pa->PrevRC = GetScaledRect(tmphWnd[0]) ELSE pa->PrevRC = GetScaledRect(hWnd) END IF IF pa->PrevRC.right < pa->XMin THEN pa->PrevRC.right = pa->XMin IF pa->PrevRC.bottom < pa->YMin THEN pa->PrevRC.bottom = pa->YMin END IF END SUB FUNCTION GetScaledRect(hWnd AS HWND) AS RECT DIM tmp3RC AS RECT GetWindowRect (hWnd, &tmp3RC) tmp3RC.right = (tmp3RC.right - tmp3RC.left) tmp3RC.bottom = (tmp3RC.bottom - tmp3RC.top) FUNCTION = tmp3RC END FUNCTION SUB LoadBuffer() SendMessage(Rich, EM_SETBKGNDCOLOR, 0, 0) DIM RAW Buffer$ Buffer$="" Buffer$ = Buffer$ & "{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl" Buffer$ = Buffer$ & "{\f0\froman\fprq2\fcharset0 Times New Roman;}" Buffer$ = Buffer$ & "{\f1\froman\fprq2\fcharset0 Tahoma;}" Buffer$ = Buffer$ & "{\f2\fswiss\fprq2\fcharset0 Verdana;}}" Buffer$ = Buffer$ & "{\colortbl ;\red255\green255\blue0;" Buffer$ = Buffer$ & "\red0\green0\blue0;\red0\green255\blue255;" Buffer$ = Buffer$ & "\red128\green128\blue128;\red255\green0\blue0;" Buffer$ = Buffer$ & "\red0\green255\blue0;\red0\green0\blue255;" Buffer$ = Buffer$ & "\red255\green255\blue255;}" Buffer$ = Buffer$ & "\viewkind4\uc1\pard\qc\cf1\b\i\f0\" Buffer$ = Buffer$ & "fs72 BCX TAB\cf2\f1\par" Buffer$ = Buffer$ & "\cf3 Control\cf4\i0\f2\par" Buffer$ = Buffer$ & "\cf5\ul\b0 D\cf6 E\cf7 M\cf1 O\cf4\ulnone\par}" SETWINDOWRTFTEXT(Rich,Buffer$) END SUB