/***************************************************************************************/ /* */ /* SCS 2 TEAM PRESENTS : */ /* File : GraphicDressing.pkg */ /* Version : 28 août 2000 */ /* Graphical design support */ /* */ /***************************************************************************************/ /* Internal functions are prefixed by "GD_", while public ones are prefixed by "GRAPHICDRESSING_" */ /*proto _STRETCHalphaBitmap = fun [ObjBitmap AlphaBitmap [[I I] r1] [[I I] r1]] ObjBitmap ;;*/ /* Constants */ var GD_DEFAULT_HANDLEDEVENTS = 0 ;; typeof GD_DEFAULT_DIRECTORYPATH = S ;; typeof GD_FUNCTIONHANDLER_LOADBITMAP = fun [S Chn] AlphaBitmap ;; typeof GD_FUNCTIONHANDLER_DESTROYBITMAP = fun [AlphaBitmap] I ;; typeof GD_FUNCTIONHANDLER_LOCALE = fun [S [S r1]] S ;; typeof Font = ObjFont ;; /* Named like that for compatibility with DHDMS */ typeof GD_FONT_BOLD = ObjFont ;; typeof GD_FONT_NORMAL = ObjFont ;; typeof GD_DEFAULT_BACKGROUNDCOLOR = I;; /* Default background color for window. */ /* Will be used as background color when copying */ /* alphabitmaps to objbitmaps */ typeof GD_FONT_LABEL = ObjFont;; typeof GD_FONT_EDIT = ObjFont;; typeof GD_THEME = THEME ;; typeof OBJ_KEYBOARD = I ;; typeof GDObjectList = [ [ObjNode CompBitmap I] r1] ;; /* used to manage addittional bitmaps related to graphic component creations */ fun GD_DefaultLocaleFunction(sKey,sParamList) = { if (strcmp "buttonname-OK" sKey) == 0 then "OK" else if (strcmp "buttonname-CANCEL" sKey) == 0 then "CANCEL" else if (strcmp "buttonname-NO" sKey) == 0 then "NO" else if (strcmp "buttonname-YES" sKey) == 0 then "YES" else if (strcmp "graphicdressing-LOADINGWAIT" sKey) == 0 then "Loading, please wait..." else "locale Error" ; } ;; fun GD_DefaultLoadBitmap(filepath,chan) = /* function aiming to load alphabitmap into memory, given a file and a channel */ /* either replace this function call by yours in setting properly the GD_FUNCTIONHANDLER_LOADBITMAP variable, or replace this function definition by a different set of intructions */ { _LDalphaBitmap chan _checkpack filepath ; } ;; fun GD_DefaultDestroyBitmap (alpha)= _DSalphaBitmap alpha;; fun GRAPHICDRESSING_InitDressing() = /* Entry point of whole GraphicDressing package : must be called within your project at an early state, for instance in entry point function of your project */ /* Each line allows the setting of custom variables : - GD_THEME is the graphic thema (ie .THM file) of your components - GD_DEFAULT_HANDLEDEVENTS defines the events that must be passed to the container when creating graphic components - GD_DEFAULT_DIRECTORYPATH is the path usually written at the beginning of your THM definition file - it must point to your bitmap resources storage directory - GD_DEFAULT_TRANSPARENCYCOLOR is the RGB definition of the default transparency color in your bitmap resources - GD_FUNCTIONHANDLER_LOADBITMAP must points to a [fun [S S] alphaBitmap] function (one is given by default that you must change) */ { set GD_DEFAULT_HANDLEDEVENTS = OBJ_CONTAINER_CLICK|OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_DBLCLICK|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_MOVE ; set GD_FUNCTIONHANDLER_LOADBITMAP = @GD_DefaultLoadBitmap ; /* function handle of type fun [S S] alphaBitmap */ set GD_FUNCTIONHANDLER_DESTROYBITMAP = @GD_DefaultDestroyBitmap; set GD_FUNCTIONHANDLER_LOCALE = @GD_DefaultLocaleFunction ; set GD_THEME = nil ; set GD_DEFAULT_TRANSPARENCYCOLOR =nil; set GD_WINDOWS_TITLE_COLOR1 =nil; set GD_DEFAULT_TEXT_HIGHLIGHT_COLOR =nil; set GD_DEFAULT_TEXT_COLOR =nil; set GD_DEFAULT_TITLE_TEXT_HIGHLIGHT_COLOR =nil; set GD_DEFAULT_TITLE_TEXT_COLOR =nil; set GD_COMPLIST_HIGHLIGHT_COLOR = nil; set GD_COMPLIST_TEXT_COLOR = nil; set GD_COMPLIST_HIGHLIGHT_TRANSPARENCY = nil; set GD_COMPTREE_HIGHLIGHT_COLOR = nil; set GD_COMPTREE_TEXT_COLOR = nil; set GD_COMPTREE_HIGHLIGHT_TRANSPARENCY = nil; set GD_COMBO_HIGHLIGHT_COLOR = nil; set GD_COMBO_TEXT_COLOR = nil; set GD_TOOLTIP_TEXT_COLOR = nil; set GD_DEFAULT_TEXT_BUTTON_COLOR = nil; set GD_DEFAULT_DIRECTORYPATH = nil ; set Font = _CRfont _channel 14 0 0 "Arial" ; set GD_FONT_BOLD = _CRfont _channel 14 0 FF_WEIGHT "Arial" ; set GD_FONT_NORMAL = _CRfont _channel 14 0 0 "Arial" ; /* Init keyboard params */ set OBJ_KEYBOARD = (OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN) ; } ;; fun GRAPHICDRESSING_SetHandleEvents (events)= set GD_DEFAULT_HANDLEDEVENTS = events;; fun GRAPHICDRESSING_SetTheme (themeFile)= { set GD_THEME = THEME_loadtheme _checkpack themeFile; let THEME_getInfos GD_THEME "DEFAULT_TRANSPARENCY_RGB" -> [c1 [c2 [c3 _]]] in set GD_DEFAULT_TRANSPARENCYCOLOR = make_rgb atoi c1 atoi c2 atoi c3; let THEME_getInfos GD_THEME "BACKGROUND_COLOR" -> [c1 [c2 [c3 _]]] in set GD_DEFAULT_BACKGROUNDCOLOR = make_rgb atoi c1 atoi c2 atoi c3; let THEME_getInfos GD_THEME "FONT_LABEL" -> [name [size _]] in set GD_FONT_LABEL = _CRfont _channel atoi size 0 0 name; let THEME_getInfos GD_THEME "FONT_EDIT" -> [name [size _]] in set GD_FONT_EDIT = _CRfont _channel atoi size 0 0 name; let THEME_getInfos GD_THEME "WINDOWS_TITLE_COLOR1" -> [c1 [c2 [c3 _]]] in set GD_WINDOWS_TITLE_COLOR1 = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "DEFAULT_TEXT_HIGHLIGHT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_DEFAULT_TEXT_HIGHLIGHT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "DEFAULT_TEXT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_DEFAULT_TEXT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "DEFAULT_TITLE_TEXT_HIGHLIGHT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_DEFAULT_TITLE_TEXT_HIGHLIGHT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "DEFAULT_TITLE_TEXT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_DEFAULT_TITLE_TEXT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "COMPLIST_TEXT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_COMPLIST_TEXT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "COMPLIST_HIGHLIGHT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_COMPLIST_HIGHLIGHT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "COMPLIST_HIGHLIGHT_TRANSPARENCY" -> [c1 _] in set GD_COMPLIST_HIGHLIGHT_TRANSPARENCY = atoi c1; let THEME_getInfos GD_THEME "COMBO_HIGHLIGHT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_COMBO_HIGHLIGHT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "COMBO_TEXT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_COMBO_TEXT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "TOOLTIP_TEXT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_TOOLTIP_TEXT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "DEFAULT_TEXT_BUTTON_COLOR" -> [c1 [c2 [c3 _]]] in set GD_DEFAULT_TEXT_BUTTON_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "COMPTREE_TEXT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_COMPTREE_TEXT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "COMPTREE_HIGHLIGHT_COLOR" -> [c1 [c2 [c3 _]]] in set GD_COMPTREE_HIGHLIGHT_COLOR = make_rgb atoi c1 atoi c2 atoi c3 ; let THEME_getInfos GD_THEME "COMPTREE_HIGHLIGHT_TRANSPARENCY" -> [c1 _] in set GD_COMPTREE_HIGHLIGHT_TRANSPARENCY = atoi c1; set GD_DEFAULT_DIRECTORYPATH = (THEME_GetDirectory GD_THEME) ; };; fun GRAPHICDRESSING_SetLocaleFunction (funvar) = { set GD_FUNCTIONHANDLER_LOCALE = funvar ; } ;; fun GRAPHICDRESSING_SetBackgroundColor(rgbcolor) = { set GD_DEFAULT_BACKGROUNDCOLOR = rgbcolor ; } ;; fun GRAPHICDRESSING_GetCurrentBackgroundColor() = { GD_DEFAULT_BACKGROUNDCOLOR ; } ;; fun GRAPHICDRESSING_CBloadBitmap (loadbitmapfun)= set GD_FUNCTIONHANDLER_LOADBITMAP = loadbitmapfun ;; fun GRAPHICDRESSING_CBdestroyBitmap (dsbitmapfun)= set GD_FUNCTIONHANDLER_DESTROYBITMAP = dsbitmapfun;; fun GRAPHICDRESSING_SetTransparencyColor (color)= set GD_DEFAULT_TRANSPARENCYCOLOR = color;; fun GRAPHICDRESSING_SetDefaultFont (font) = { _DSfont Font ; set Font = font ; } ;; fun GRAPHICDRESSING_GetCurrentDefaultHandleEvents ()= { GD_DEFAULT_HANDLEDEVENTS ; };; fun GRAPHICDRESSING_GetCurrentTheme ()= { GD_THEME ; } ;; fun GRAPHICDRESSING_GetCurrentTransparencyColor ()= { GD_DEFAULT_TRANSPARENCYCOLOR ; };; fun GRAPHICDRESSING_SetCurrentDirectoryPath (path)= { GD_DEFAULT_DIRECTORYPATH ; } ;; fun GRAPHICDRESSING_GetCurrentDefaultFont () = { Font ; } ;; fun GRAPHICDRESSING_GetNormalFont() = { GD_FONT_NORMAL ; } ;; fun GRAPHICDRESSING_GetBoldFont() = { GD_FONT_BOLD ; } ;; /* --------- END OF USER SPECIFIC FUNCTIONS ------------------------------------------------------- */ fun GD_GetResizeFlags(flags) = { (flags & OBJ_LW_FLEX) | (flags & OBJ_MW_FLEX) | (flags & OBJ_RW_FLEX) | (flags & OBJ_LH_FLEX) | (flags & OBJ_MH_FLEX) | (flags & OBJ_RH_FLEX) ; } ;; fun GD_StoreGraphicObject(objnode1, objnode2, flags) = /* private function */ /* Stores a pair of objnodes in the main list */ { set GDObjectList = [objnode1 objnode2 flags]::GDObjectList ; } ;; fun GD_CompareObjects(a,x) = /* private function */ /* Comparing function which returns TRUE if the objnode x is equal to the list element a, FALSE otherwise */ { let a -> [obj1 _ _] in (x == obj1) ; } ;; fun GD_HideGraphicObject(objnode) = /* private function */ /* called to hide an objnode and its bitmap counterpart if it exists */ { let search_in_list GDObjectList @GD_CompareObjects objnode -> [obj bmpnode flags] in { _CHANGEobjNodeFlags objnode OBJ_HIDE 1 ; if bmpnode != nil then (_CHANGEobjNodeFlags _CONVERTcompBitmapToObjNode bmpnode OBJ_HIDE 1; 1) else nil ; } ; objnode ; } ;; fun GD_ShowGraphicObject(objnode) = /* private function */ /* called to show an objnode and its bitmap counterpart if it exists */ { let search_in_list GDObjectList @GD_CompareObjects objnode -> [obj bmpnode flags] in { _CHANGEobjNodeFlags objnode flags 1 ; if bmpnode != nil then (_CHANGEobjNodeFlags _CONVERTcompBitmapToObjNode bmpnode OBJ_VISIBLE|OBJ_ENABLE 1; 1) else nil ; } ; objnode ; } ;; fun GD_DestroyGraphicObject(objnode) = /* private function */ /* Destroys object and return 0 */ { let search_in_list GDObjectList @GD_CompareObjects objnode -> [obj bmpnode _] in { if bmpnode != nil then (_DScompBitmap bmpnode ; 0) else nil ; removef_from_list GDObjectList @GD_CompareObjects objnode ; } ; 0 ; } ;; fun GRAPHICDRESSING_ShowCompText(comptext, bool) = /* public fonction */ /* Call this function to make visible or to hide a graphic component. IN parameters : - comptext (the CompText object you want to make visible or invisible - bool (bool is a boolean value : TRUE if comptext must become visible, FALSE otherwise RETURN VALUE : returns bool */ { if !bool then GD_HideGraphicObject _CONVERTcompTextToObjNode comptext else GD_ShowGraphicObject _CONVERTcompTextToObjNode comptext ; } ;; fun GRAPHICDRESSING_ShowCompRollOver(comprollover, bool) = /* public fonction */ /* Call this function to make visible or to hide a graphic component. IN parameters : - comprollover (the comprollover object you want to make visible or invisible - bool (bool is a boolean value : TRUE if comprollover must become visible, FALSE otherwise RETURN VALUE : returns bool */ { if !bool then GD_HideGraphicObject _CONVERTcompRollOverToObjNode comprollover else GD_ShowGraphicObject _CONVERTcompRollOverToObjNode comprollover ; } ;; fun GRAPHICDRESSING_ShowCompList(complist, bool) = /* public fonction */ /* Call this function to make visible or to hide a graphic component. IN parameters : - complist (the complist object you want to make visible or invisible - bool (bool is a boolean value : TRUE if component must become visible, FALSE otherwise RETURN VALUE : returns bool */ { if !bool then GD_HideGraphicObject _CONVERTcompListToObjNode complist else GD_ShowGraphicObject _CONVERTcompListToObjNode complist ; } ;; fun GRAPHICDRESSING_ShowCompCombo(compcombo, bool) = /* public fonction */ /* Call this function to make visible or to hide a graphic component. IN parameters : - compcombo (the compcombo object you want to make visible or invisible - bool (bool is a boolean value : TRUE if component must become visible, FALSE otherwise RETURN VALUE : returns bool */ { if !bool then GD_HideGraphicObject _CONVERTcompComboToObjNode compcombo else GD_ShowGraphicObject _CONVERTcompComboToObjNode compcombo ; } ;; fun GRAPHICDRESSING_ShowCompTree(comptree, bool) = /* public fonction */ /* Call this function to make visible or to hide a graphic component. IN parameters : - comptree (the comptree object you want to make visible or invisible - bool (bool is a boolean value : TRUE if component must become visible, FALSE otherwise RETURN VALUE : returns bool */ { if !bool then GD_HideGraphicObject _CONVERTcompTreeToObjNode comptree else GD_ShowGraphicObject _CONVERTcompTreeToObjNode comptree ; } ;; fun GRAPHICDRESSING_ShowCompCheck(compcheck, bool) = /* public fonction */ /* Call this function to make visible or to hide a graphic component. IN parameters : - compcheck (the compcheck object you want to make visible or invisible - bool (bool is a boolean value : TRUE if component must become visible, FALSE otherwise RETURN VALUE : returns bool */ { if !bool then GD_HideGraphicObject _CONVERTcompCheckToObjNode compcheck else GD_ShowGraphicObject _CONVERTcompCheckToObjNode compcheck ; } ;; fun GRAPHICDRESSING_DScompCheck(compcheck) = /* public fonction */ /* Destroy the graphic component */ { GD_DestroyGraphicObject _CONVERTcompCheckToObjNode compcheck ; _DScompCheck compcheck ; } ;; fun GRAPHICDRESSING_DScompCombo(compobj) = /* public fonction */ /* Destroy the graphic component */ { GD_DestroyGraphicObject _CONVERTcompComboToObjNode compobj ; _DScompCombo compobj ; } ;; fun GRAPHICDRESSING_DScompList(compobj) = /* public fonction */ /* Destroy the graphic component */ { GD_DestroyGraphicObject _CONVERTcompListToObjNode compobj ; _DScompList compobj ; } ;; fun GRAPHICDRESSING_DScompRollOver(compobj) = /* public fonction */ /* Destroy the graphic component */ { GD_DestroyGraphicObject _CONVERTcompRollOverToObjNode compobj ; _DScompRollOver compobj ; } ;; fun GRAPHICDRESSING_DScompText(compobj) = /* public fonction */ /* Destroy the graphic component */ { GD_DestroyGraphicObject _CONVERTcompTextToObjNode compobj ; _DScompText compobj ; } ;; fun GRAPHICDRESSING_DScompTree(compobj) = /* public fonction */ /* Destroy the graphic component */ { GD_DestroyGraphicObject _CONVERTcompTreeToObjNode compobj ; _DScompTree compobj ; } ;; fun GD_ExecLoadBitmap(filename,chan) = /* private function launching the proper load bitmap function given its reference in GD_FUNCTIONHANDLER_LOADBITMAP Returns an alphabitmap */ { exec GD_FUNCTIONHANDLER_LOADBITMAP with [strcat GD_DEFAULT_DIRECTORYPATH filename chan] ; } ;; fun GD_ExecLocaleFunction(sKey, sParamList) = /* private function launching the proper load bitmap function given its reference in GD_FUNCTIONHANDLER_LOADBITMAP Returns an alphabitmap */ { exec GD_FUNCTIONHANDLER_LOCALE with [sKey sParamList] ; } ;; /*************************************************************************************** Fonction renvoyant le nombre d'etats d'un boutons ****************************************************************************************/ fun GD_nbState(disable,mask)= 3+ (if disable then 1 else 0)+ (if mask then 1 else 0);; fun GD_GetStretchList(coord, sourcesizelist, destsizelist) = /* private function */ /* Converts lists of bitmap chunk sizes (either horizontal or vertical) into a parameter list usable by _STRETCHalphabitmap function - coord : [I I] is the x (resp. y) coord of left hand corner of source and its corresponding x (resp. y) destination coord - sourcesizelist is a [I I I] triplet defining the size of three contiguous bitmap chunks in a cartesian direction in source bitmap - destsizelist is a [I I I] triplet defining the size of the three contiguous corresponding bitmap chunks in dest bitmap */ /* Returns a list that can be passed to the _STRETCHalphabitmap function */ { let sourcesizelist -> [s1 s2 s3] in let destsizelist -> [d1 d2 d3] in let coord -> [sourcecoord destcoord] in [sourcecoord destcoord]:: [s1+sourcecoord d1+destcoord]:: [s1+s2+sourcecoord d1+d2+destcoord]:: [s1+s2+s3+sourcecoord d1+d2+d3+destcoord]:: nil ; };; /**************************************************************************************** * * This function stretch a bitmap according to the xList and yList which are lists * of [I I] where the first I is the coordinate in the motif and the second I * is the corresponding coordinate in the streched bmp. * ****************************************************************************************/ fun GD_STRETCHbmp16 (bmp, motif, xList, yList, oxList) = let xList -> [x1 [x2 nextx]] in let yList -> [y1 [y2 nexty]] in if y2 == nil then bmp else let x1 -> [ox1 nx1] in let x2 -> [ox2 nx2] in let y1 -> [oy1 ny1] in let y2 -> [oy2 ny2] in ( _SCPbitmap bmp nx1 ny1 nx2-1 ny2-1 motif ox1 oy1 ox2-1 oy2-1 nil; if (hd nextx)!=nil then GD_STRETCHbmp16 bmp motif (tl xList) yList oxList else GD_STRETCHbmp16 bmp motif oxList (tl yList) oxList );; fun GD_STRETCHbmp8 (bmp, motif, xList, yList, oxList) = let xList -> [x1 [x2 nextx]] in let yList -> [y1 [y2 nexty]] in if y2 == nil then bmp else let x1 -> [ox1 nx1] in let x2 -> [ox2 nx2] in let y1 -> [oy1 ny1] in let y2 -> [oy2 ny2] in ( _SCPbitmap8 bmp nx1 ny1 nx2-1 ny2-1 motif ox1 oy1 ox2-1 oy2-1 nil; if (hd nextx)!=nil then GD_STRETCHbmp8 bmp motif (tl xList) yList oxList else GD_STRETCHbmp8 bmp motif oxList (tl yList) oxList );; fun GD_STRETCHalphaBitmap (bmp, bmp8, motif, xList, yList) = let _GETalphaBitmaps motif -> [mbmp mbmp8] in { GD_STRETCHbmp8 bmp8 mbmp8 xList yList xList; GD_STRETCHbmp16 bmp mbmp xList yList xList; };; fun GD_PasteGraphicObject (theme, grobjname, chan, destbmp, destbmp8, xdest, ydest, dwidth, dheight) = let THEME_getParamsByTheme theme grobjname -> [path x1 y1 h1 h2 h3 v1 v2 v3] in let exec GD_FUNCTIONHANDLER_LOADBITMAP with [path chan] -> motif in let if (dwidth-h1-h3<0) then 0 else (dwidth-h1-h3) -> midwidth in let if (dheight-v1-v3<0) then 0 else (dheight-v1-v3) -> midheight in let _CRbitmap chan dwidth dheight -> tempbmp in let _CRbitmap8 chan dwidth dheight -> tempbmp8 in let GD_GetStretchList [x1 0] [h1 h2 h3] [h1 midwidth h3] -> xList in let GD_GetStretchList [y1 0] [v1 v2 v3] [v1 midheight v3] -> yList in { GD_STRETCHalphaBitmap tempbmp tempbmp8 motif xList yList ; _SCPbitmap8 destbmp8 xdest ydest xdest+dwidth-1 ydest+dheight-1 tempbmp8 0 0 dwidth-1 dheight-1 nil; _SCPbitmap destbmp xdest ydest xdest+dwidth-1 ydest+dheight-1 tempbmp 0 0 dwidth-1 dheight-1 nil; _DSbitmap tempbmp ; _DSbitmap8 tempbmp8 ; exec GD_FUNCTIONHANDLER_DESTROYBITMAP with [motif]; [h1+midwidth+h3 v1+midheight+v3] ; };; fun GD_STRETCHalphaBitmap16 (bmp, motif, xList, yList) = let _GETalphaBitmaps motif -> [mbmp _] in GD_STRETCHbmp16 bmp mbmp xList yList xList;; fun GD_PasteGraphicObject16 (theme, grobjname, chan, destbmp, xdest, ydest, dwidth, dheight) = let THEME_getParamsByTheme theme grobjname -> [path x1 y1 h1 h2 h3 v1 v2 v3] in let exec GD_FUNCTIONHANDLER_LOADBITMAP with [path chan] -> motif in let if (dwidth-h1-h3<0) then 0 else (dwidth-h1-h3) -> midwidth in let if (dheight-v1-v3<0) then 0 else (dheight-v1-v3) -> midheight in let _CRbitmap chan dwidth dheight -> tempbmp in let GD_GetStretchList [x1 0] [h1 h2 h3] [h1 midwidth h3] -> xList in let GD_GetStretchList [y1 0] [v1 v2 v3] [v1 midheight v3] -> yList in { GD_STRETCHalphaBitmap16 tempbmp motif xList yList ; _SCPbitmap destbmp xdest ydest xdest+dwidth-1 ydest+dheight-1 tempbmp 0 0 dwidth-1 dheight-1 nil; _DSbitmap tempbmp ; exec GD_FUNCTIONHANDLER_DESTROYBITMAP with [motif]; [h1+midwidth+h3 v1+midheight+v3] ; };; /*************************************************************************************** * * Creates a dressed horizontal slideBar * ***************************************************************************************/ fun GD_SLIDEBAR_CreateBitmapH(chan, width, height, prefix) = /* private function */ /* creates a bitmap suitable for SlideBar creation */ /* returns [ alphabitmap width [off1 off2 off3] ] */ { let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_CURSOR_OFF" -> [res _ _ a b c _ _ _] in if res==nil then [nil 0 nil] else let _CRbitmap chan width+a+b+c (3*height) -> newbmp in let _CRbitmap8 chan width+a+b+c (3*height) -> newbmp8 in /* Load in graphic objects properties for BAR 1*/ let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_UP_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_DOWN_OFF" -> [_ _ _ h21 h22 h23 v21 v22 v23] in let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_BAR_OFF" -> [_ _ _ h31 h32 h33 v31 v32 v33] in let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_CURSOR_OFF" -> [_ _ _ h41 h42 h43 v41 v42 v43] in /* Bar 1 : Top button */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_UP_OFF" chan newbmp newbmp8 0 0 h11+h12+h13 height -> [h1 _] in /* Bar 1 : Middle container frame */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_BAR_OFF" chan newbmp newbmp8 h1 0 width-(h11+h12+h13)-(h21+h22+h23) height -> [h2 _] in /* Bar 1 : Bottom button */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_DOWN_OFF" chan newbmp newbmp8 h1+h2 0 h21+h22+h23 height -> [_ _] in /* Bar 1 : sliding cursor */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_CURSOR_OFF" chan newbmp newbmp8 width 0 h41+h42+h43 height -> [_ _] in /* Load in graphic objects properties for BAR 2*/ let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_UP_HIGHLIGHT" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_DOWN_HIGHLIGHT" -> [_ _ _ h21 h22 h23 v21 v22 v23] in let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_BAR_HIGHLIGHT" -> [_ _ _ h31 h32 h33 v31 v32 v33] in let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_CURSOR_HIGHLIGHT" -> [_ _ _ h41 h42 h43 v41 v42 v43] in /* Bar 2 : Top button */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_UP_HIGHLIGHT" chan newbmp newbmp8 0 height h11+h12+h13 height -> [h1 _] in /* Bar 2 : Middle container frame */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_BAR_HIGHLIGHT" chan newbmp newbmp8 h1 height width-(h11+h12+h13)-(h21+h22+h23) height -> [h2 _] in /* Bar 2 : Bottom button */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_DOWN_HIGHLIGHT" chan newbmp newbmp8 h1+h2 height h21+h22+h23 height -> [h3 _] in /* Bar 2 : sliding cursor */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_CURSOR_HIGHLIGHT" chan newbmp newbmp8 width height h41+h42+h43 height -> [_ _] in /* Load in graphic objects properties for BAR 3*/ let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_UP_PUSHED" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_DOWN_PUSHED" -> [_ _ _ h21 h22 h23 v21 v22 v23] in let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_BAR_PUSHED" -> [_ _ _ h31 h32 h33 v31 v32 v33] in let THEME_getParamsByTheme GD_THEME strcat prefix "H_LIFT_CURSOR_PUSHED" -> [_ _ _ h41 h42 h43 v41 v42 v43] in /* Bar 3 : Top button */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_UP_PUSHED" chan newbmp newbmp8 0 2*height h11+h12+h13 height -> [h1 _] in /* Bar 3 : Middle container frame */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_BAR_PUSHED" chan newbmp newbmp8 h1 2*height width-(h11+h12+h13)-(h21+h22+h23) height -> [h2 _] in /* Bar 3 : Bottom button */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_DOWN_PUSHED" chan newbmp newbmp8 h1+h2 2*height h21+h22+h23 height -> [_ _] in /* Bar 3 : sliding cursor */ let GD_PasteGraphicObject GD_THEME strcat prefix "H_LIFT_CURSOR_PUSHED" chan newbmp newbmp8 width 2*height h41+h42+h43 height -> [_ _] in let (_CRalphaBitmap chan newbmp newbmp8 GD_DEFAULT_BACKGROUNDCOLOR GD_DEFAULT_TRANSPARENCYCOLOR) -> returnabmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp ; [returnabmp height [h11+h12+h13 h1+h2 width ] ]; } ; } ;; /*************************************************************************************** * * Creates a dressed vertical slideBar bitmap * ***************************************************************************************/ fun GD_SLIDEBAR_CreateBitmapV(chan, width, height, prefix) = /* private function */ /* creates a bitmap suitable for SlideBar creation */ /* returns [ alphabitmap width [off1 off2 off3] ] */ { let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_CURSOR_OFF" -> [res _ _ _ _ _ a b c] in if res==nil then [nil 0 nil] else let _CRbitmap chan (3*width) height+a+b+c -> newbmp in let _CRbitmap8 chan (3*width) height+a+b+c -> newbmp8 in /* Load in graphic objects properties for BAR 1*/ let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_UP_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_DOWN_OFF" -> [_ _ _ h21 h22 h23 v21 v22 v23] in let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_BAR_OFF" -> [_ _ _ h31 h32 h33 v31 v32 v33] in let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_CURSOR_OFF" -> [_ _ _ h41 h42 h43 v41 v42 v43] in /* Bar 1 : Top button */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_UP_OFF" chan newbmp newbmp8 0 0 width v11+v12+v13 -> [_ v1] in /* Bar 1 : Middle container frame */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_BAR_OFF" chan newbmp newbmp8 0 v1 width height-(v11+v12+v13)-(v21+v22+v23) -> [_ v2] in /* Bar 1 : Bottom button */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_DOWN_OFF" chan newbmp newbmp8 0 v1+v2 width v21+v22+v23 -> [_ _] in /* Bar 1 : sliding cursor */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_CURSOR_OFF" chan newbmp newbmp8 0 height width v41+v42+v43 -> [_ _] in /* Load in graphic objects properties for BAR 2*/ let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_UP_HIGHLIGHT" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_DOWN_HIGHLIGHT" -> [_ _ _ h21 h22 h23 v21 v22 v23] in let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_BAR_HIGHLIGHT" -> [_ _ _ h31 h32 h33 v31 v32 v33] in let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_CURSOR_HIGHLIGHT" -> [_ _ _ h41 h42 h43 v41 v42 v43] in /* Bar 2 : Top button */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_UP_HIGHLIGHT" chan newbmp newbmp8 width 0 width v11+v12+v13 -> [_ v1] in /* Bar 2 : Middle container frame */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_BAR_HIGHLIGHT" chan newbmp newbmp8 width v1 width height-(v11+v12+v13)-(v21+v22+v23) -> [_ v2] in /* Bar 2 : Bottom button */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_DOWN_HIGHLIGHT" chan newbmp newbmp8 width v1+v2 width v21+v22+v23 -> [_ v3] in /* Bar 2 : sliding cursor */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_CURSOR_HIGHLIGHT" chan newbmp newbmp8 width height width v41+v42+v43 -> [_ _] in /* Load in graphic objects properties for BAR 3*/ let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_UP_PUSHED" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_DOWN_PUSHED" -> [_ _ _ h21 h22 h23 v21 v22 v23] in let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_BAR_PUSHED" -> [_ _ _ h31 h32 h33 v31 v32 v33] in let THEME_getParamsByTheme GD_THEME strcat prefix "V_LIFT_CURSOR_PUSHED" -> [_ _ _ h41 h42 h43 v41 v42 v43] in /* Bar 3 : Top button */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_UP_PUSHED" chan newbmp newbmp8 2*width 0 width v11+v12+v13 -> [_ v1] in /* Bar 3 : Middle container frame */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_BAR_PUSHED" chan newbmp newbmp8 2*width v1 width height-(v11+v12+v13)-(v21+v22+v23) -> [_ v2] in /* Bar 3 : Bottom button */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_DOWN_PUSHED" chan newbmp newbmp8 2*width v1+v2 width v21+v22+v23 -> [_ _] in /* Bar 3 : sliding cursor */ let GD_PasteGraphicObject GD_THEME strcat prefix "V_LIFT_CURSOR_PUSHED" chan newbmp newbmp8 2*width height width v41+v42+v43 -> [_ _] in let (_CRalphaBitmap chan newbmp newbmp8 GD_DEFAULT_BACKGROUNDCOLOR GD_DEFAULT_TRANSPARENCYCOLOR) -> returnabmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp ; [returnabmp width [v11+v12+v13 v1+v2 height ] ]; } ; } ;; /*************************************************************************************** * * Creates a list frame bitmap, given width and height * ***************************************************************************************/ fun GD_COMPLIST_CreateFrameBitmap(chan, wdth, hght) = /* private function */ /* Creates a frame bitmap suitable for CompList creation */ /* returns a compBitmap */ { let THEME_getParamsByTheme GD_THEME "LISTFRAME" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let (if hght height in let (if wdth width in let _CRbitmap chan width height -> newbmp in let _CRbitmap8 chan width height -> newbmp8 in { /* Create frame */ GD_PasteGraphicObject GD_THEME "LISTFRAME" chan newbmp newbmp8 0 0 width height ; let (_CRalphaBitmap chan newbmp newbmp8 nil GD_DEFAULT_TRANSPARENCYCOLOR) -> abmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp ; abmp ; } ; }; } ;; /*************************************************************************************** * * Creates a tree bitmap * ***************************************************************************************/ fun GD_COMPTREE_CreateBitmap(chan, cont, fathernode, coord, wdth, hght) = /* private function */ /* Creates a bitmap suitable for CompTree creation */ /* returns an alphabitmap */ { let THEME_getParamsByTheme GD_THEME "TREENODES" -> [path _ _ h11 h12 h13 v11 v12 v13] in let exec GD_FUNCTIONHANDLER_LOADBITMAP with [path chan] -> comptreebmp in { _SETalphaBitmapTransparency comptreebmp GD_DEFAULT_TRANSPARENCYCOLOR ; comptreebmp ; } ; } ;; /*************************************************************************************** * * Creates a comprollover bitmap * ***************************************************************************************/ fun GD_COMPROLLOVER_CreateBitmap(chan, cont, wdth, hght, flags, prefix) = /* private function */ /* Creates a bitmap suitable for CompRollOver creation */ { let (flags&ROL_DISABLE) -> bIsDisableState in let (flags&ROL_MASK) -> bIsMaskState in let THEME_getParamsByTheme GD_THEME strcat prefix "ROLLOVER_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getParamsByTheme GD_THEME strcat prefix "ROLLOVER_HIGHLIGHT" -> [_ _ _ h21 h22 h23 v21 v22 v23] in let THEME_getParamsByTheme GD_THEME strcat prefix "ROLLOVER_PUSHED" -> [_ _ _ h31 h32 h33 v31 v32 v33] in let THEME_getParamsByTheme GD_THEME strcat prefix "ROLLOVER_DISABLED" -> [_ _ _ h41 h42 h43 v41 v42 v43] in let THEME_getParamsByTheme GD_THEME strcat prefix "ROLLOVER_MASK" -> [_ _ _ h51 h52 h53 v51 v52 v53] in let (if wdth width in let (if hght height in let _CRbitmap chan width height*(GD_nbState bIsDisableState bIsMaskState) -> newbmp in let _CRbitmap8 chan width height*(GD_nbState bIsDisableState bIsMaskState) -> newbmp8 in /* Create button states bar */ let GD_PasteGraphicObject GD_THEME strcat prefix "ROLLOVER_OFF" chan newbmp newbmp8 0 0 width height -> [h1 v1] in let GD_PasteGraphicObject GD_THEME strcat prefix "ROLLOVER_HIGHLIGHT" chan newbmp newbmp8 0 v1 width height -> [h2 v2] in let GD_PasteGraphicObject GD_THEME strcat prefix "ROLLOVER_PUSHED" chan newbmp newbmp8 0 v1+v2 width height -> [h3 v3] in let if bIsDisableState then { GD_PasteGraphicObject GD_THEME strcat prefix "ROLLOVER_DISABLED" chan newbmp newbmp8 0 v1+v2+v3 width height } else [0 0] -> [h4 v4] in let if bIsMaskState then { GD_PasteGraphicObject GD_THEME strcat prefix "ROLLOVER_MASK" chan newbmp newbmp8 0 v1+v2+v3+v4 width height } else [0 0] -> [h5 v5] in let (_CRalphaBitmap chan newbmp newbmp8 nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp ; retabmp ; } ; } ;; /*************************************************************************************** * * Creates a compCheck bitmap * ***************************************************************************************/ fun GD_COMPCHECK_CreateBitmap(chan, flags, prefix) = /* private function */ /* Creates a bitmap suitable for Compcheck creation */ { let (flags&ROL_DISABLE) -> bIsDisableState in let (flags&ROL_MASK) -> bIsMaskState in let THEME_getParamsByTheme GD_THEME strcat prefix "UNCHECK_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let h11+h13 -> width in let v11+v13 -> height in let _CRbitmap chan width*2 height*(GD_nbState bIsDisableState bIsMaskState) -> newbmp in let _CRbitmap8 chan width*2 height*(GD_nbState bIsDisableState bIsMaskState) -> newbmp8 in /* Create first column */ let GD_PasteGraphicObject GD_THEME strcat prefix "UNCHECK_OFF" chan newbmp newbmp8 0 0 width height -> [h1 v1] in let GD_PasteGraphicObject GD_THEME strcat prefix "UNCHECK_HIGHLIGHT" chan newbmp newbmp8 0 v1 width height -> [h2 v2] in let GD_PasteGraphicObject GD_THEME strcat prefix "UNCHECK_PUSHED" chan newbmp newbmp8 0 v1+v2 width height -> [h3 v3] in let if bIsDisableState then { GD_PasteGraphicObject GD_THEME strcat prefix "UNCHECK_DISABLED" chan newbmp newbmp8 0 v1+v2+v3 width height } else [0 0] -> [h4 v4] in let if bIsMaskState then { GD_PasteGraphicObject GD_THEME strcat prefix "UNCHECK_MASK" chan newbmp newbmp8 0 v1+v2+v3+v4 width height } else [0 0] -> [h5 v5] in /* Create second column */ let GD_PasteGraphicObject GD_THEME strcat prefix "CHECK_OFF" chan newbmp newbmp8 width 0 width height -> [h6 v6] in let GD_PasteGraphicObject GD_THEME strcat prefix "CHECK_HIGHLIGHT" chan newbmp newbmp8 width v6 width height -> [h7 v7] in let GD_PasteGraphicObject GD_THEME strcat prefix "CHECK_PUSHED" chan newbmp newbmp8 width v6+v7 width height -> [h8 v8] in let if bIsDisableState then { GD_PasteGraphicObject GD_THEME strcat prefix "CHECK_DISABLED" chan newbmp newbmp8 width v6+v7+v8 width height } else [0 0] -> [h9 v9] in let if bIsMaskState then { GD_PasteGraphicObject GD_THEME strcat prefix "CHECK_MASK" chan newbmp newbmp8 width v6+v7+v8+v9 width height } else [0 0] -> [h10 v10] in let (_CRalphaBitmap chan newbmp newbmp8 nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp ; retabmp ; } } ;; fun addIcon(abmp,dx,dy,icon,sx,sy,sw,sh)= let _GETalphaBitmaps abmp -> [dbmp _] in { _CPalphaBitmap dbmp dx dy icon sx sy sw sh; abmp; };; /******************************************************************************************** * * Add An Icon to a alpha of a button * ********************************************************************************************/ fun GD_AddIcon(abmp,type,flags,icon)= if icon==nil then nil else let (flags&ROL_DISABLE) -> bIsDisableState in let (flags&ROL_MASK) -> bIsMaskState in let _GETalphaBitmapSize abmp -> [dw dh] in let [dw/type dh/(GD_nbState bIsDisableState bIsMaskState)] -> [w h] in let _GETalphaBitmapSize icon -> [tw sh] in let tw/2 -> sw in { addIcon abmp 0 0 icon 0 0 sw sh; /* etat off */ addIcon abmp 0 h icon 0 0 sw sh; /* etat highlight */ addIcon abmp 1 2*h+1 icon 0 0 sw sh; /* etat pushed */ if flags&ROL_DISABLE then /* etat disable */ addIcon abmp 0 3*h+1 icon sw 0 sw sh else nil; if type==2 then { /* check btn */ addIcon abmp w 0 icon 0 0 sw sh; /* etat off */ addIcon abmp w h icon 0 0 sw sh; /* etat highlight */ addIcon abmp w+1 2*h+1 icon 0 0 sw sh ; /* etat pushed */ if flags&ROL_DISABLE then /* etat disable */ addIcon abmp w 3*h+1 icon sw 0 sw sh else nil } else nil; }; abmp;; /*************************************************************************************** * * Creates a stretchedcomprollover bitmap * ***************************************************************************************/ fun GD_COMPROLLOVER_CreateStretchedBitmap(chan, wdth, hght, flags, font, slabel, txtcolor) = /* private function */ /* Creates a stretched bitmap suitable for CompRollOver creation, and maps a text message onto it */ { let (flags&ROL_DISABLE) -> bIsDisableState in let (flags&ROL_MASK) -> bIsMaskState in let THEME_getParamsByTheme GD_THEME "SROLLOVER_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getParamsByTheme GD_THEME "SROLLOVER_HIGHLIGHT" -> [_ _ _ h21 h22 h23 v21 v22 v23] in let THEME_getParamsByTheme GD_THEME "SROLLOVER_PUSHED" -> [_ _ _ h31 h32 h33 v31 v32 v33] in let THEME_getParamsByTheme GD_THEME "SROLLOVER_DISABLED" -> [_ _ _ h41 h42 h43 v41 v42 v43] in let THEME_getParamsByTheme GD_THEME "SROLLOVER_MASK" -> [_ _ _ h51 h52 h53 v51 v52 v53] in let (if wdth width in let (if hght height in let _CRbitmap chan width height*(GD_nbState bIsDisableState bIsMaskState) -> newbmp in let _CRbitmap8 chan width height*(GD_nbState bIsDisableState bIsMaskState) -> newbmp8 in /* Create button states bar */ let GD_PasteGraphicObject GD_THEME "SROLLOVER_OFF" chan newbmp newbmp8 0 0 width height -> [h1 v1] in let GD_PasteGraphicObject GD_THEME "SROLLOVER_HIGHLIGHT" chan newbmp newbmp8 0 v1 width height -> [h2 v2] in let GD_PasteGraphicObject GD_THEME "SROLLOVER_PUSHED" chan newbmp newbmp8 0 v1+v2 width height -> [h3 v3] in let if bIsDisableState then { GD_PasteGraphicObject GD_THEME "SROLLOVER_DISABLED" chan newbmp newbmp8 0 v1+v2+v3 width height } else [0 0] -> [h4 v4] in let if bIsMaskState then { GD_PasteGraphicObject GD_THEME "SROLLOVER_MASK" chan newbmp newbmp8 0 v1+v2+v3+v4 width height } else [0 0] -> [h5 v5] in /* Draw text */ let _GETstringSize font slabel -> [lfont hfont] in let if width>lfont then (width-lfont)/2 else 0 -> xpos in let if height>hfont then (height-hfont)/2 else 0 -> ypos in { _DRAWtext newbmp font xpos ypos TD_LEFT|TD_TOP txtcolor slabel ; _DRAWtext newbmp font xpos ypos+height TD_LEFT|TD_TOP txtcolor slabel ; _DRAWtext newbmp font xpos ypos+1+height*2 TD_LEFT|TD_TOP txtcolor slabel ; let (_CRalphaBitmap chan newbmp newbmp8 nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp ; retabmp ; } } } ;; /*************************************************************************************** * * Creates a comptext bitmap * ***************************************************************************************/ fun GD_COMPTEXT_CreateBitmap(chan, wdth, hght, prefix) = /* private function */ /* Creates a bitmap suitable for editable CompText creation */ /* returns a compBitmap */ { let THEME_getParamsByTheme GD_THEME strcat prefix "EDITBOX" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let (if wdth width in let (if hght height in let _CRbitmap chan width height -> newbmp in let _CRbitmap8 chan width height -> newbmp8 in { /* Create frame */ GD_PasteGraphicObject GD_THEME strcat prefix "EDITBOX" chan newbmp newbmp8 0 0 width height ; let (_CRalphaBitmap chan newbmp newbmp8 nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp ; [ retabmp width height] ; } }; } ;; /*************************************************************************************** * * Creates combo bitmaps * ***************************************************************************************/ fun GD_COMBO_CreateEditBoxBitmap(chan, wdth, hght) = /* private function */ /* returns infos used in combo creation */ /* return value format : [buttonbmpinfovector framebmpinfovector slidebarbmpinfovector] */ { let THEME_getParamsByTheme GD_THEME "COMBOBAR" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let (if wdth width in let (if hght height in let _CRbitmap chan width height -> newbmp in let _CRbitmap8 chan width height -> newbmp8 in { GD_PasteGraphicObject GD_THEME "COMBOBAR" chan newbmp newbmp8 0 0 width height ; let (_CRalphaBitmap chan newbmp newbmp8 nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp ; [ retabmp width height] ; } }; } ;; /* { let _CRbitmap chan wdth hght -> newbmp3 in let GD_PasteGraphicObject GD_THEME "COMBOBAR" chan newbmp3 0 0 wdth hght -> [h7 v7] in let (_CRalphaBitmap chan newbmp3 nil nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap newbmp3 ; [retabmp h7 v7] ; } } ;; */ /*************************************************************************************** * * Creates combo bitmaps * ***************************************************************************************/ fun GD_COMBO_CreateFrameBitmap(chan, wdth, hght) = /* private function */ /* returns infos used in combo creation */ /* return value format : [buttonbmpinfovector framebmpinfovector slidebarbmpinfovector] */ { /* Creates combo frame */ let _CRbitmap chan wdth hght -> newbmp2 in let _CRbitmap8 chan wdth hght -> newbmp8 in let GD_PasteGraphicObject GD_THEME "COMBOFRAME" chan newbmp2 newbmp8 0 0 wdth hght -> [h8 v8] in let (_CRalphaBitmap chan newbmp2 nil nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp2 ; retabmp ; } ; } ;; /*************************************************************************************** * * Creates combo bitmaps * ***************************************************************************************/ fun GD_COMBO_CreateCheckButtonBitmap(chan, wdth, hght) = /* private function */ /* returns infos used in combo creation */ /* return value format : [buttonbmpinfovector framebmpinfovector slidebarbmpinfovector] */ { let _CRbitmap chan wdth*2 hght*3 -> newbmp in let _CRbitmap8 chan wdth*2 hght*3 -> newbmp8 in /* Bar 1 : push button */ let GD_PasteGraphicObject GD_THEME "COMBOBUTTON" chan newbmp newbmp8 0 0 wdth hght -> [h1 v1] in let GD_PasteGraphicObject GD_THEME "COMBOBUTTON" chan newbmp newbmp8 0 v1 wdth hght -> [h2 v2] in let GD_PasteGraphicObject GD_THEME "COMBOBUTTON" chan newbmp newbmp8 0 v1+v2 wdth hght -> [h3 v3] in /* Bar 2 : push button */ let GD_PasteGraphicObject GD_THEME "COMBOBUTTON" chan newbmp newbmp8 wdth 0 wdth hght -> [h4 v4] in let GD_PasteGraphicObject GD_THEME "COMBOBUTTON" chan newbmp newbmp8 wdth v1 wdth hght -> [h5 v5] in let GD_PasteGraphicObject GD_THEME "COMBOBUTTON" chan newbmp newbmp8 wdth v1+v2 wdth hght -> [h6 v6] in let (_CRalphaBitmap chan newbmp newbmp8 nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp ; retabmp ; } } ;; fun GD_SIZEBAR_CreateBitmap(chan,w,h,flags,dir)= let if flags&SB_SHADOW then if dir&SB_HORIZONTAL then [0 h w 2*h] else [w 0 2*w h] else [0 0 w h] -> [xs ys rw rh]in let _FILLbitmap _CRbitmap chan rw rh make_rgb 255 255 255-> newbmp in let _FILLbitmap8 _CRbitmap8 chan rw rh make_rgb 255 255 255-> newbmp8 in let GD_PasteGraphicObject GD_THEME "SIZEBAR" chan newbmp newbmp8 0 0 w h -> [w1 h1] in /*let if flags&SB_SHADOW then GD_PasteGraphicObject GD_THEME "SIZEBAR_SHADOW" chan newbmp newbmp8 xs ys w h else nil -> blurp in*/ let (_CRalphaBitmap chan newbmp newbmp8 nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap8 newbmp8 ; _DSbitmap newbmp ; retabmp ; };; /*************************************************************************************** * * Creates combo bitmaps * ***************************************************************************************/ fun GD_COMBO_CreateBitmaps(chan, cont, fathernode, coord, flags, wdth, hght, hfont,reservedbmpspace) = /* private function */ /* returns infos used in combo creation */ /* return value format : [buttonbmpinfovector framebmpinfovector slidebarbmpinfovector] */ { let THEME_getParamsByTheme GD_THEME "COMBOBUTTON_UNCHECK_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getParamsByTheme GD_THEME "COMBOBAR" -> [_ _ _ h21 h22 h23 v21 v22 v23] in let THEME_getParamsByTheme GD_THEME "COMBOFRAME" -> [_ _ _ h31 h32 h33 v31 v32 v33] in let (if wdth width in let (if hght height in let if (GD_GetResizeFlags flags)&OBJ_MW_FLEX != 0 then ((GD_GetResizeFlags flags)^OBJ_MW_FLEX|OBJ_LW_FLEX) else (GD_GetResizeFlags flags) -> CHECKFLEXFLAGS in /* Creates combo check button */ let GD_COMPCHECK_CreateBitmap chan CHECKFLEXFLAGS "COMBOBUTTON_" -> checkbmp in let [CHECKFLEXFLAGS checkbmp] -> buttonbmpinfovector in let (h11+h12+h13) -> h1 in let (v11+v12+v13) -> v1 in /* Creates combo editbox */ let GD_COMBO_CreateEditBoxBitmap chan width-h1-1 v1 -> [editboxbmp h7 v7] in /* Creates Slide Bar */ let THEME_getParamsByTheme GD_THEME "V_LIFT_CURSOR_OFF" -> [_ _ _ h41 h42 h43 v41 v42 v43] in let GD_SLIDEBAR_CreateBitmapV chan h41+h42+h43 height-v7 "" -> [ slidebarbmp slidewidth offvector ] in /* Creates combo frame */ let GD_COMBO_CreateFrameBitmap chan h7 height-v7 -> framebmp in let ((height-5)/(hfont+5)) -> itemsvisibletmp in let if itemsvisibletmp < 2 then 2 else itemsvisibletmp -> itemsvisible in let [OBJ_ENABLE|OBJ_VISIBLE|LST_LEFT|LST_HIGHLIGHT_SELECTED|(GD_GetResizeFlags flags) itemsvisible reservedbmpspace framebmp] -> framebmpinfovector in let if (GD_GetResizeFlags flags)&OBJ_MW_FLEX != 0 then ((GD_GetResizeFlags flags)^OBJ_MW_FLEX|OBJ_LW_FLEX) else (GD_GetResizeFlags flags) -> SLIDEFLEXFLAGS in /* Returns result */ [ buttonbmpinfovector framebmpinfovector [SLB_ROLLOVER|SLIDEFLEXFLAGS slidebarbmp offvector] [editboxbmp h7 v7] ] ; } ;; fun GD_OnResizeCompSlideBarResourceV(compslidebar, chan, width, height, bmpcoords) = /* handler function upon complist resizeresource event */ /* - compslidebar is the lib2d graphic component - param is a user defined parameter - width & height is the new size of component - bmpcoords is of format [I I I] */ { let THEME_getParamsByTheme GD_THEME "V_LIFT_CURSOR_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let GD_SLIDEBAR_CreateBitmapV chan h11+h12+h13 height "" -> [ bmp wth voffsets ] in { [bmp voffsets] ; } ; } ;; fun GD_OnResizeCompSlideBarResourceH(compslidebar, chan, width, height, bmpcoords) = /* handler function upon complist resizeresource event */ /* - compslidebar is the lib2d graphic component - param is a user defined parameter - width & height is the new size of component - bmpcoords is of format [I I I] */ { let THEME_getParamsByTheme GD_THEME "H_LIFT_CURSOR_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let GD_SLIDEBAR_CreateBitmapH chan width v11+v12+v13 "" -> [ bmp wth hoffsets ] in { [bmp hoffsets] ; } ; } ;; fun GD_OnResizeCompListFrameResource(compbitmap, chan, width, height, parambmp) = /* handler function upon complist resizeresource event */ /* - compslidebar is the lib2d graphic component - param is a user defined parameter - width & height is the new size of component - bmpcoords is of format [I I I] */ { let GD_COMPLIST_CreateFrameBitmap chan width height -> framebmp in { [framebmp [0 0 width height] ] ; } ; } ;; fun GD_OnResizeComboFrameResource(compbitmap, chan, width, height, parambmp) = /* handler function upon complist resizeresource event */ /* - compbitmap is the lib2d graphic component - param is a user defined parameter - width & height is the new size of component - bmpcoords is of format [I I I] */ { let GD_COMBO_CreateFrameBitmap chan width height -> framebmp in { [framebmp [0 0 width height] ] ; } ; } ;; fun GD_OnResizeComboEditBoxResource(compbitmap, chan, width, height, parambmp) = /* handler function upon complist resizeresource event */ /* - compslidebar is the lib2d graphic component - param is a user defined parameter - width & height is the new size of component - bmpcoords is of format [I I I] */ { let GD_COMBO_CreateEditBoxBitmap chan width height -> [editboxbmp h7 v7] in { [editboxbmp [0 0 h7 v7] ] ; } ; } ;; fun GD_OnResizeComboCheckButtonResource(compcheck, chan, width, height) = /* handler function upon complist resizeresource event */ /* - compcheck is the lib2d graphic component - chan is a user defined parameter - width & height is the new size of component */ { GD_COMBO_CreateCheckButtonBitmap chan width height ; } ;; fun GD_OnResizeCompTextResource(compbitmap, prefix_chan, width, height, parambmp) = /* handler function upon complist resizeresource event */ /* - compcheck is the lib2d graphic component - chan is a user defined parameter - width & height is the new size of component */ { let prefix_chan -> [prefix chan] in let GD_COMPTEXT_CreateBitmap chan width height prefix -> [bmp w h] in { [bmp [0 0 w h] ] ; } ; } ;; fun GD_OnResizeCompRollOverWithTextResource(comprollover, param, width, height) = /* handler function upon complist resizeresource event */ /* - comprollover is the lib2d graphic component - param is a user defined parameter - width & height is the new size of component */ { let param -> [chan flags font slabel txtcolor] in let height/(GD_nbState flags&ROL_DISABLE flags&ROL_MASK) -> hght in GD_COMPROLLOVER_CreateStretchedBitmap chan width hght flags font slabel txtcolor ; } ;; fun GD_OnResizeCompSizeBarResource(compsizebar,param,width,height)= let param -> [chan sh dir] in let if sh then 2 else 1 -> nbstate in let if dir&SB_HORIZONTAL then [width height/nbstate] else [width/nbstate height] -> [w h] in GD_SIZEBAR_CreateBitmap chan w h if sh then SB_SHADOW else 0 dir;; /*************************************************************************************** * * Creates a dressed SlideBar (PUBLIC FUNCTION) * ***************************************************************************************/ fun GRAPHICDRESSING_CRcompSlideBar (chan, cont, objpere, coordinates, flags, filtrageflags, direction, minvalue, maxvalue, step, prefix) = let coordinates -> [x y w h] in let THEME_getParamsByTheme GD_THEME "V_LIFT_CURSOR_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getParamsByTheme GD_THEME "H_LIFT_CURSOR_OFF" -> [_ _ _ h21 h22 h23 v21 v22 v23] in let if (SLB_VERTICAL & direction) == SLB_VERTICAL then GD_SLIDEBAR_CreateBitmapV chan h11+h12+h13 h prefix else GD_SLIDEBAR_CreateBitmapH chan w v21+v22+v23 prefix -> [alphabmp _ bmpcoords] in let _CRcompSlideBar chan cont objpere [x y] flags filtrageflags alphabmp bmpcoords direction minvalue maxvalue step -> slideBar in ( if (SLB_VERTICAL & direction) == SLB_VERTICAL then _CBcompSlideBarResizeResource slideBar @GD_OnResizeCompSlideBarResourceV chan else _CBcompSlideBarResizeResource slideBar @GD_OnResizeCompSlideBarResourceH chan; slideBar ) ;; /*************************************************************************************** * * Creates a dressed compList * ***************************************************************************************/ fun GRAPHICDRESSING_CRcompList(chan, cont, fathernode, coord, flags, filterflags, width, height, nbvisibleitems, direction, font, iconspace, textinfo, transparencyinfo) = /* Encapsulation of _CRcompList function of Lib2D */ { let THEME_getParamsByTheme GD_THEME "V_LIFT_CURSOR_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let THEME_getInfos GD_THEME "LIST_OFFSETS" -> l in let [atoi nth_list l 0 atoi nth_list l 1 atoi nth_list l 2 atoi nth_list l 3 atoi nth_list l 4] -> [tx1 ty1 tx2 ty2 esc] in let GD_SLIDEBAR_CreateBitmapV chan h11+h12+h13 height "" -> [ bmp wth voffsets ] in let GD_COMPLIST_CreateFrameBitmap chan width-wth-esc height -> framebmp in { let _CRcompBitmap chan cont fathernode coord OBJ_ENABLE|OBJ_VISIBLE|(GD_GetResizeFlags flags) GD_DEFAULT_HANDLEDEVENTS framebmp 0 0 width-wth-esc height -> cpbitmap in let if (GD_GetResizeFlags flags)&OBJ_MW_FLEX != 0 then ((GD_GetResizeFlags flags)^OBJ_MW_FLEX|OBJ_LW_FLEX) else (GD_GetResizeFlags flags) -> FLEXFLAGS in let _CRcompList chan cont _CONVERTcompBitmapToObjNode cpbitmap [tx1 ty1] flags filterflags width-wth-tx1-tx2-esc height-ty1-ty2 nbvisibleitems direction font iconspace textinfo transparencyinfo [ [(width-wth-tx1-1) (-ty1)] SLB_ROLLOVER|FLEXFLAGS bmp voffsets ] -> obj in { _CBcompBitmapResizeResource cpbitmap @GD_OnResizeCompListFrameResource chan ; GD_StoreGraphicObject (_CONVERTcompListToObjNode obj) ( cpbitmap) flags ; _CBcompListResizeResource obj @GD_OnResizeCompSlideBarResourceV chan ; obj ; } } } ;; /*************************************************************************************** * * Creates a dressed compTree * ***************************************************************************************/ fun GRAPHICDRESSING_CRcompTree(chan, cont, fathernode, coord, flags, filterflags, width, height, nbvisibleitems, direction, font, reservedspace, levelshift, textinfo , transparencyinfo) = /* Encapsulation of _CRcompTree function of Lib2D */ { let THEME_getInfos GD_THEME "TREE_OFFSETS" -> l in let [atoi nth_list l 0 atoi nth_list l 1 atoi nth_list l 2 atoi nth_list l 3 atoi nth_list l 4] -> [tx1 ty1 tx2 ty2 esc] in let GD_COMPTREE_CreateBitmap chan cont fathernode coord width height -> comptreebmp in let THEME_getParamsByTheme GD_THEME "V_LIFT_CURSOR_OFF" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let GD_SLIDEBAR_CreateBitmapV chan h11+h12+h13 height "" -> [ vslidebmp wth voffsets ] in let GD_COMPLIST_CreateFrameBitmap chan width-wth-esc height -> framebmp in { let _CRcompBitmap chan cont fathernode coord OBJ_ENABLE|OBJ_VISIBLE|(GD_GetResizeFlags flags) GD_DEFAULT_HANDLEDEVENTS framebmp 0 0 width-wth-esc height -> cpbitmap in let if (GD_GetResizeFlags flags)&OBJ_MW_FLEX != 0 then ((GD_GetResizeFlags flags)^OBJ_MW_FLEX|OBJ_LW_FLEX) else (GD_GetResizeFlags flags) -> FLEXFLAGS in let THEME_getParamsByTheme GD_THEME "TREENODES" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let _CRcompTree chan cont _CONVERTcompBitmapToObjNode cpbitmap [tx1 ty1] flags filterflags width-wth-tx1-tx2-esc height-ty1-ty2 nbvisibleitems direction font h11+h12+h13 levelshift textinfo transparencyinfo [ [(width-wth-tx1-1) (-ty1)] SLB_ROLLOVER|FLEXFLAGS vslidebmp voffsets] nil comptreebmp -> comptree in { GD_StoreGraphicObject (_CONVERTcompTreeToObjNode comptree) cpbitmap flags; _CBcompBitmapResizeResource cpbitmap @GD_OnResizeCompListFrameResource chan ; _CBcompTreeResizeResource comptree @GD_OnResizeCompSlideBarResourceV chan nil nil ; comptree ; } } } ;; /*************************************************************************************** * * Creates a dressed compCheck * ***************************************************************************************/ fun GD_CRcompCheck (chan, cont, fathernode, coord, flags, filterflags, prefix,alphaicon)= /* Encapsulation of _CRcompCheck function of Lib2D */ { let if prefix!=nil then GD_AddIcon GD_COMPCHECK_CreateBitmap chan flags prefix 2 flags alphaicon else let _GETalphaBitmaps alphaicon -> [bmp bmp8] in _CRalphaBitmap _channel bmp bmp8 _GETalphaBitmapBackground alphaicon _GETalphaBitmapTransparency alphaicon -> cpbmp in let _CRcompCheck chan cont fathernode coord flags filterflags cpbmp -> obj in { GD_StoreGraphicObject (_CONVERTcompCheckToObjNode obj) nil flags; obj ; } } ;; fun GRAPHICDRESSING_CRcompCheck(chan, cont, fathernode, coord, flags, filterflags) = GD_CRcompCheck chan cont fathernode coord flags filterflags "" nil;; fun GRAPHICDRESSING_CRcompCheckMini(chan, cont, fathernode, coord, flags, filterflags, alphaicone) = GD_CRcompCheck chan cont fathernode coord flags filterflags "MINI_" alphaicone;; fun GRAPHICDRESSING_CRcompCheckMiddle(chan, cont, fathernode, coord, flags, filterflags, alphaicone) = GD_CRcompCheck chan cont fathernode coord flags filterflags "MIDDLE_" alphaicone;; fun GRAPHICDRESSING_CRcompCheckMaxi(chan, cont, fathernode, coord, flags, filterflags, alphaicone) = GD_CRcompCheck chan cont fathernode coord flags filterflags "MAXI_" alphaicone;; fun GRAPHICDRESSING_CRcompCheckOval(chan, cont, fathernode, coord, flags, filterflags, alphaicone) = GD_CRcompCheck chan cont fathernode coord flags filterflags "OVAL_" alphaicone;; fun GRAPHICDRESSING_CRcompCheckTransparent(chan, cont,fathernode, coord, flags, filterflags, alphaicone)= GD_CRcompCheck chan cont fathernode coord flags filterflags nil alphaicone;; fun GRAPHICDRESSING_CRcompCheckCustom(chan, cont,fathernode, coord, flags, filterflags, alphaicone, prefix)= GD_CRcompCheck chan cont fathernode coord flags filterflags prefix alphaicone;; /*************************************************************************************** * * Creates a dressed compRollOver (push button) * ***************************************************************************************/ fun GD_CRcompRollOver(chan, cont, fathernode, coord, flags, filterflags, prefix , alphaicon) = /* Encapsulation of _CRcompRollOver function of Lib2D */ { let GD_AddIcon GD_COMPROLLOVER_CreateBitmap chan cont 0 0 flags prefix 1 flags alphaicon -> alphabmp in let _CRcompRollOver chan cont fathernode coord flags filterflags alphabmp -> obj in { GD_StoreGraphicObject (_CONVERTcompRollOverToObjNode obj) nil flags ; obj ; } } ;; fun GRAPHICDRESSING_CRcompRollOver(chan, cont, fathernode, coord, flags, filterflags) = GD_CRcompRollOver chan cont fathernode coord flags filterflags "" nil;; fun GRAPHICDRESSING_CRcompRollOverMini(chan, cont, fathernode, coord, flags, filterflags, alphaicone) = GD_CRcompRollOver chan cont fathernode coord flags filterflags "MINI_" alphaicone;; fun GRAPHICDRESSING_CRcompRollOverMiddle(chan, cont, fathernode, coord, flags, filterflags, alphaicone) = GD_CRcompRollOver chan cont fathernode coord flags filterflags "MIDDLE_" alphaicone;; fun GRAPHICDRESSING_CRcompRollOverMaxi(chan, cont, fathernode, coord, flags, filterflags, alphaicone) = GD_CRcompRollOver chan cont fathernode coord flags filterflags "MAXI_" alphaicone;; fun GRAPHICDRESSING_CRcompRollOverOval(chan, cont, fathernode, coord, flags, filterflags, alphaicone) = GD_CRcompRollOver chan cont fathernode coord flags filterflags "OVAL_" alphaicone;; fun GRAPHICDRESSING_CRcompRollOverCustom(chan, cont, fathernode, coord, flags, filterflags, alphaicone, prefix) = GD_CRcompRollOver chan cont fathernode coord flags filterflags prefix alphaicone;; /*************************************************************************************** * * Creates a dressed stretched compRollOver (push button) * ***************************************************************************************/ fun GRAPHICDRESSING_CRcompRollOverWithText(chan, cont, fathernode, coord, flags, filterflags,width, height, font, slabel, txtcolor) = /* Encapsulation of _CRcompRollOver function of Lib2D, plus a text message */ { let GD_COMPROLLOVER_CreateStretchedBitmap chan width height flags font slabel txtcolor-> alphabmp in let _CRcompRollOver chan cont fathernode coord flags filterflags alphabmp -> obj in { GD_StoreGraphicObject (_CONVERTcompRollOverToObjNode obj) nil flags ; _CBcompRollOverResizeResource obj @GD_OnResizeCompRollOverWithTextResource [chan flags font slabel txtcolor] ; obj ; } } ;; /*************************************************************************************** * * Creates a dressed compCombo * ***************************************************************************************/ fun GRAPHICDRESSING_CRcompCombo(chan, cont, fathernode, coord, flags, filterflags, width, height, font, textinfo , transparencyinfo,reservedbmpspace) = /* Encapsulation of _CRcompCombo function of Lib2D */ { let _GETstringSize font "ABCDEFGHIJKLMOPQRSTUVWXYZ0123456789/!}abcdefghijklmnopqrstuvwxyz" -> [_ hfont] in let GD_COMBO_CreateBitmaps chan cont fathernode coord flags width height hfont reservedbmpspace -> [ buttonbmpinfo [frameflags itemvisible reservedbmpspace framebmp] [slidebarflags slidebarbmp slidebaroffset] [editboxbmp ebbmp_width ebbmp_height] ] in let buttonbmpinfo -> [_ bmp] in let THEME_getInfos GD_THEME "COMBO_OFFSETS" -> l in let [atoi nth_list l 0 atoi nth_list l 1 atoi nth_list l 2 atoi nth_list l 3 atoi nth_list l 4] -> [tx1 ty1 tx2 ty2 esc] in let _CRcompBitmap chan cont fathernode coord OBJ_ENABLE|OBJ_VISIBLE|(GD_GetResizeFlags flags) GD_DEFAULT_HANDLEDEVENTS editboxbmp 0 0 ebbmp_width ebbmp_height -> labelbmp in { let _CRcompCombo chan cont _CONVERTcompBitmapToObjNode labelbmp [0 0] flags filterflags width height font textinfo transparencyinfo buttonbmpinfo [frameflags itemvisible reservedbmpspace framebmp] [slidebarflags slidebarbmp slidebaroffset] -> obj in { GD_StoreGraphicObject (_CONVERTcompComboToObjNode obj) labelbmp flags ; _CBcompBitmapResizeResource labelbmp @GD_OnResizeComboEditBoxResource chan ; _CBcompComboResizeResource obj @GD_OnResizeComboCheckButtonResource chan @GD_OnResizeComboFrameResource chan @GD_OnResizeCompSlideBarResourceV chan ; obj ; } } } ;; /*************************************************************************************** * * Creates a dressed compText * ***************************************************************************************/ fun GRAPHICDRESSING_CRcompText(chan, cont, fathernode, coord, flags, filterflags, width, height, textmessage, font, textinfo , transparencyinfo) = /* Encapsulation of _CRcompText function of Lib2D */ { let THEME_getInfos GD_THEME "MULTIEDITLINE_OFFSETS" -> l in let THEME_getInfos GD_THEME "LINE_OFFSETS" -> l2 in let [atoi nth_list l 0 atoi nth_list l 1 atoi nth_list l 2 atoi nth_list l 3 atoi nth_list l 4] -> [tx1 ty1 tx2 ty2 esc] in let [atoi nth_list l2 0 atoi nth_list l2 1 atoi nth_list l2 2 atoi nth_list l2 3 atoi nth_list l2 4] -> [txl1 tyl1 txl2 tyl2 escl] in let if (GD_GetResizeFlags flags)&OBJ_MW_FLEX != 0 then ((GD_GetResizeFlags flags)^OBJ_MW_FLEX|OBJ_LW_FLEX) else (GD_GetResizeFlags flags) -> FLEXFLAGS in let if (flags&CT_EDITLINE)||(flags&CT_SELECT) then [ GD_COMPTEXT_CreateBitmap chan width height "" nil nil nil ] else if (flags&CT_MULTIEDITLINE) then let THEME_getParamsByTheme GD_THEME "TXT_V_LIFT_CURSOR_OFF" -> [_ _ _ i1 i2 i3 a b c] in let GD_SLIDEBAR_CreateBitmapV chan i1+i2+i3 height "TXT_" -> [ slb slbw voffsets ] in [ GD_COMPTEXT_CreateBitmap chan width-slbw-esc height "MULTI" slb slbw voffsets ] else [[nil 0 0] nil nil nil] -> [[aframebmp framew frameh] slb slbw slbo] in let if aframebmp != nil then _CRcompBitmap chan cont fathernode coord OBJ_ENABLE|OBJ_VISIBLE|(GD_GetResizeFlags flags) GD_DEFAULT_HANDLEDEVENTS aframebmp 0 0 framew frameh else nil -> cpbitmap in let _CRcompText chan cont if (cpbitmap!=nil) then _CONVERTcompBitmapToObjNode cpbitmap else fathernode if (cpbitmap!=nil) then if (flags&CT_MULTIEDITLINE) then [tx1 ty1] else [txl1 tyl1] else coord flags filterflags if (cpbitmap!=nil) then if (flags&CT_MULTIEDITLINE) then width-slbw-tx1-tx2-esc else width-txl1-txl2 else width if (cpbitmap!=nil) then if (flags&CT_MULTIEDITLINE) then height-ty1-ty2 else height-tyl1-tyl2 else height textmessage font textinfo transparencyinfo if slb==nil then nil else [[(width-slbw) (-ty1)] SLB_ROLLOVER|FLEXFLAGS slb slbo] nil -> obj in /* let _CRcompText chan cont if cpbitmap==nil then fathernode else _CONVERTcompBitmapToObjNode cpbitmap if cpbitmap==nil then coord else [7 4] flags filterflags if cpbitmap==nil then width else width-14 if cpbitmap==nil then height else height-8 textmessage font textinfo transparencyinfo if slb==nil then nil else [[(width-slbw-1) (-4)] SLB_ROLLOVER slb slbo] nil -> obj in */ { GD_StoreGraphicObject (_CONVERTcompTextToObjNode obj) cpbitmap flags ; _CBcompBitmapResizeResource cpbitmap @GD_OnResizeCompTextResource [if (flags&CT_MULTIEDITLINE) then "MULTI" else "" chan] ; _CBcompTextResizeResource obj @GD_OnResizeCompSlideBarResourceV chan @GD_OnResizeCompSlideBarResourceH chan; obj ; } } ;; /*************************************************************************************** * * Creates a dressed sizebar * ***************************************************************************************/ fun GRAPHICDRESSING_CRsizeBar(chan,cont,node,coord,flags,filtrageflags,w,h,dir)= let THEME_getParamsByTheme GD_THEME "SIZEBAR" -> [_ _ _ h1 h2 h3 v1 v2 v3] in let (if w width in let (if h height in let GD_SIZEBAR_CreateBitmap chan width height flags dir -> abmp in let _CRcompSizeBar chan cont node coord flags filtrageflags dir abmp -> sizebar in { _CBcompSizeBarResizeResource sizebar @GD_OnResizeCompSizeBarResource [chan flags&SB_SHADOW dir]; sizebar };; /**************************************************************************************/ /* OK, Loïc, ne râle pas... j'ai mis ça là pour nous permettre d'avancer un peu en */ /* attendant de faire quelque chose en commun qui soit vraiment définitif. */ /* Pour l'instant, j'aimerais qu'on garde ce bout de code en place. Sinon, Joss va me */ /* sauter dessus et j'aime pas trop la perspective de l'entendre râler à chaque modif */ /* de graphicdressing.... */ /**************************************************************************************/ var TITLEBAR_MIN=1;; var TITLEBAR_MAX=2;; var TITLEBAR_CLOSE=4;; fun GD_TITLEBAR_CreateCloseButtonBitmap(chan) = /* private function */ /* Creates close button bitmap used in title bars */ { let THEME_getParamsByTheme GD_THEME "TITLEBUTTON_CLOSE" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let _CRbitmap chan h11+h12+h13 v11+v12+v13 -> newbmp in let _CRbitmap8 chan h11+h12+h13 v11+v12+v13 -> newbmp8 in let GD_PasteGraphicObject GD_THEME "TITLEBUTTON_CLOSE" chan newbmp newbmp8 0 0 h11+h12+h13 v11+v12+v13 -> [h1 v1] in let (_CRalphaBitmap chan newbmp newbmp8 nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap newbmp ; _DSbitmap8 newbmp8 ; retabmp ; } } ;; fun GD_TITLEBAR_CreateMaximizeButtonBitmap(chan) = /* private function */ /* Creates close button bitmap used in title bars */ { let THEME_getParamsByTheme GD_THEME "TITLEBUTTON_MAX" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let _CRbitmap chan h11+h12+h13 v11+v12+v13 -> newbmp in let _CRbitmap8 chan h11+h12+h13 v11+v12+v13 -> newbmp8 in let GD_PasteGraphicObject GD_THEME "TITLEBUTTON_MAX" chan newbmp newbmp8 0 0 h11+h12+h13 v11+v12+v13 -> [h1 v1] in let (_CRalphaBitmap chan newbmp nil nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap newbmp ; _DSbitmap8 newbmp8 ; retabmp ; } } ;; fun GD_TITLEBAR_CreateMinimizeButtonBitmap(chan) = /* private function */ /* Creates close button bitmap used in title bars */ { let THEME_getParamsByTheme GD_THEME "TITLEBUTTON_MIN" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let _CRbitmap chan h11+h12+h13 v11+v12+v13 -> newbmp in let _CRbitmap8 chan h11+h12+h13 v11+v12+v13 -> newbmp8 in let GD_PasteGraphicObject GD_THEME "TITLEBUTTON_MIN" chan newbmp newbmp8 0 0 h11+h12+h13 v11+v12+v13 -> [h1 v1] in let (_CRalphaBitmap chan newbmp nil nil GD_DEFAULT_TRANSPARENCYCOLOR) -> retabmp in { _DSbitmap newbmp ; _DSbitmap8 newbmp8 ; retabmp ; } } ;; /*************************************************************************************** * * Creates a dressed titlebar * ***************************************************************************************/ fun GD_TITLEBAR_CreateTitleBarBitmap(chan) = /* private function */ /* returns a tuple which can be passed to window creation function */ /* return format : [ abmp sresourcename [leftspace rightspace topspace bottomspace] ] (rightspace and bottomspace are related to the container borders when minimized */ { let THEME_getParamsByTheme GD_THEME "TITLEBAR" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let _CRbitmap chan h11+h12+h13 v11+v12+v13 -> newbmp in let _CRbitmap8 chan h11+h12+h13 v11+v12+v13 -> newbmp8 in { GD_PasteGraphicObject GD_THEME "TITLEBAR" chan newbmp newbmp8 0 0 h11+h12+h13 v11+v12+v13 ; let (_CRalphaBitmap chan newbmp nil GD_DEFAULT_TRANSPARENCYCOLOR nil) -> abmp in /* JOOL ICI - i inverted the 2 last parameters of _CRalphaBitmap!! */ { _DSbitmap newbmp ; _DSbitmap8 newbmp8 ; /* return value */ let THEME_getInfos GD_THEME "FRAMEBORDERS_SIZE" -> l in [ abmp "TITLEBAR" [atoi nth_list l 0 atoi nth_list l 1 atoi nth_list l 2 atoi nth_list l 3] ] ; } ; }; } ;; fun GRAPHICDRESSING_CRtitleBar(chan,cont,minmaxsize,font,text,textinfo,flag,fmin,fmax,fclose)= /* le bouton de femeture */ let if flag&TITLEBAR_CLOSE then let THEME_getParamsByTheme GD_THEME "TITLEBUTTON_CLOSE" -> [_ _ _ w _ _ h _ _] in let _CRbitmap chan w h -> bmp in let _CRbitmap8 chan w h -> bmp8 in { GD_PasteGraphicObject GD_THEME "TITLEBUTTON_CLOSE" chan bmp bmp8 0 0 w h; let _CRalphaBitmap chan bmp nil nil nil -> abmp in { _DSbitmap8 bmp8; _DSbitmap bmp; abmp } } else nil -> bclose in let THEME_getParamsByTheme GD_THEME "TITLEBAR" -> [_ _ _ a b c d _ _] in let _CRbitmap chan (a+b+c) d -> bmp in let _CRbitmap8 chan (a+b+c) d -> bmp8 in { GD_PasteGraphicObject GD_THEME "TITLEBAR" chan bmp bmp8 0 0 (a+b+c) d; let _CRalphaBitmap chan bmp nil nil nil -> abmp in { _DSbitmap8 bmp8; _DSbitmap bmp; _CRtitleBar chan cont nil minmaxsize [abmp a a+b 0 0 0 d] [nil fmin nil fmax bclose fclose] nil TITLEBAR_ROLL_OFF text 10 font textinfo CT_LEFT|CT_LABEL nil; } };; /*************************************************************************************** * * Creates Window Borders * ***************************************************************************************/ fun GD_CONTAINER_CreateBordersBitmap(chan) = /* private function */ /* returns a tuple which can be passed to window creation function */ /* return format : [ abmp sresourcename ] */ { let THEME_getParamsByTheme GD_THEME "FRAMEBORDERS" -> [_ _ _ h11 h12 h13 v11 v12 v13] in let _CRbitmap chan h11+h12+h13 v11+v12+v13 -> newbmp in let _CRbitmap8 chan h11+h12+h13 v11+v12+v13 -> newbmp8 in { GD_PasteGraphicObject GD_THEME "FRAMEBORDERS" chan newbmp newbmp8 0 0 h11+h12+h13 v11+v12+v13 ; let (_CRalphaBitmap chan newbmp nil nil GD_DEFAULT_TRANSPARENCYCOLOR) -> abmp in { _DSbitmap newbmp ; _DSbitmap8 newbmp8 ; /* return value */ [ abmp "FRAMEBORDERS" ] ; } ; }; } ;; /* Flags for the creation of containers (windows) */ var GDWIN_ROLL_OFF = 0b0000000000;; /* la fenêtre ne s'enroule pas */ var GDWIN_ROLL_DBLCLICK = 0b0000000001;; /* la fenêtre s'enroule si on double click sur la barre de titre */ var GDWIN_ROLL_CURHOVER = 0b0000000010;; /* la fenêtre s'enroule si le curseur quitte le container */ var GDWIN_ROLL_MINBUT = 0b0000000011;; /* la fenêtre s'enroule si on clicke sur le bouton minimiser */ var GDWIN_NO_CALLBACKS = 0b0000000100;; /* aucune callback n'est définie sur le container */ var GDWIN_BORDERS = 0b0000001000;; /* add a border to the container */ var GDWIN_TITLE_BAR = 0b0000010000;; /* add title bar to the container */ var GDWIN_CLOSE_BUTTON = 0b0000110000;; /* add a close button to the titlebar */ var GDWIN_MAX_BUTTON = 0b0001010000;; /* add a max/restore button to the titlebar */ var GDWIN_MIN_BUTTON = 0b0010010000;; /* add a minimize button to the titlebar */ var GDWIN_ROLL_MASK = 0b0000000111;; /* la fenêtre ne s'enroule pas */ var GDWIN_CLOSE_BUTTON_MASK = 0b0000100000;; /* add a close button to the titlebar */ var GDWIN_MAX_BUTTON_MASK = 0b0001000000;; /* add a max/restore button to the titlebar */ var GDWIN_MIN_BUTTON_MASK = 0b0010000000;; /* add a minimize button to the titlebar */ var GDWIN_CENTER_TITLE = 0b0000000000;; /* position of the title (centered by default)*/ var GDWIN_LEFT_TITLE = 0b0100000000;; var GDWIN_RIGHT_TITLE = 0b1000000000;; var GDWIN_SIZEBOX = 0b0011111000;; /* complete window with borders and buttons */ /* PRIVATE */ /* this function create a container with borders, title bar and buttons according to the flag in argument (see their definitions) */ /* parameters: - Channel - win: when the container must be created on an objwin (for old API2D compatibility) - father: the ObjContainer father of the new created container. - fromobjwin : the ObjWin is the mother if 1 else created in ObjWin - possize: contains x, y, w, and h for the new created window(container). - minmaxsize: contains min width, min height, max width and max height of the container (if min and max sizes are equal the window is not resizable) - bgcolor: is the integer for the background color. - font: is the ObjFont for the title text. - flags: specify the kind of window to create. - reflexes: are 3 callbacks for the three buttons (min,max,close). return (in a tuple): - the created container - the three buttons object (CompRollOver for the min button, CompCheck for the max/restore button and a CompRollOver for the close button) */ fun GD_CRcontainer (Channel, win, father, fromobjwin, possize, minmaxsize, bgcolor, title, font, textcol, flags, reflexes) = /* buttons bitmaps and reflexes */ let if (flags&GDWIN_CLOSE_BUTTON_MASK) then GD_TITLEBAR_CreateCloseButtonBitmap Channel else nil -> closeBmp in let if (flags&GDWIN_MAX_BUTTON_MASK) then GD_TITLEBAR_CreateMaximizeButtonBitmap Channel else nil -> maxBmp in let if (flags&GDWIN_MIN_BUTTON_MASK) then GD_TITLEBAR_CreateMinimizeButtonBitmap Channel else nil -> minBmp in let reflexes -> [minRfl maxRfl closeRfl] in let [minBmp minRfl maxBmp maxRfl closeBmp closeRfl] -> buttons in /* container borders */ let if flags&GDWIN_BORDERS then GD_CONTAINER_CreateBordersBitmap Channel else nil -> [bordersBmp sborders] in let if sborders != nil then THEME_getParamsByTheme GRAPHICDRESSING_GetCurrentTheme sborders else [nil nil nil 0 nil 0 0 nil 0] -> [_ _ _ h21 h22 h23 v21 v22 v23] in let [bordersBmp h21 (h21+h22) v21 (v21+v22)] -> borders in /* titlebar bitmap and positions */ let if flags&GDWIN_TITLE_BAR then GD_TITLEBAR_CreateTitleBarBitmap Channel else [nil nil [h21 h23 v21 v23]] -> [titlebarBmp stbar [left right top bottom]] in let THEME_getParamsByTheme GRAPHICDRESSING_GetCurrentTheme stbar -> [_ _ _ h11 h12 h13 vsize _ _] in let [titlebarBmp h11 (h11+h12) left right top bottom] -> bar in /* flag for contanier shrink */ let flags&GDWIN_ROLL_MASK -> rollflag in /* transparency color */ let GRAPHICDRESSING_GetCurrentTransparencyColor -> trans in /* corner */ let THEME_getParamsByTheme GRAPHICDRESSING_GetCurrentTheme "FRAME_RESIZABLE_CORNER" -> [cornerFile x y w _ _ h _ _] in let exec GD_FUNCTIONHANDLER_LOADBITMAP with [cornerFile Channel] -> corner in /* client area size and position in the created container */ let possize -> [_ _ cw ch] in let if flags&GDWIN_TITLE_BAR then vsize+top else top -> clienttop in /* let [h21 clienttop cw-(h21+h23) ch-(clienttop+v23)] -> clientArea in */ let [left clienttop cw-(left+right) ch-(clienttop+bottom)] -> clientArea in /* title position */ let if flags&GDWIN_RIGHT_TITLE then CT_RIGHT else if flags&GDWIN_LEFT_TITLE then CT_LEFT else CT_CENTER -> titleFlag in let mkWindowTemplate [bar rollflag corner borders buttons titleFlag font textcol trans bgcolor] -> template in let if win == nil then WINDOW_Create Channel father template possize minmaxsize title else if fromobjwin then WINDOW_CreateFromObjWin Channel win template possize minmaxsize title else WINDOW_CreateWithObjWin Channel win template possize minmaxsize title -> [cont title minb maxb closeb] in ( [cont title minb maxb closeb clientArea] ) ;; /* PUBLIC */ /* proto GRAPHICDRESSING_CRcontainer = fun [Chn ObjContainer [I I I I] [I I I I] I S ObjFOnt [I I I I] I [fun[]I fun[]I fun[]I] ] [ObjContainer CompText CompRollOver CompCheck CompRollOver ClientSizePos] see the GD_CRcontainer function description for the parameters and return values description */ fun GRAPHICDRESSING_CRcontainer (Channel, father, possize, minmaxsize, bgcolor, title, font, textcol, flags, reflexes) = GD_CRcontainer Channel nil father 0 possize minmaxsize bgcolor title font textcol flags reflexes;; /* PUBLIC */ /* proto GRAPHICDRESSING_CRcontainerFromObjWin = fun [Chn ObjWin [I I I I] [I I I I] I S ObjFOnt [I I I I] I [fun[]I fun[]I fun[]I] ] [ObjContainer CompText CompRollOver CompCheck CompRollOver ClientSizePos] see the GD_CRcontainer function description for the parameters and return values description */ fun GRAPHICDRESSING_CRcontainerFromObjWin (Channel, father, possize, minmaxsize, bgcolor, title, font, textcol, flags, reflexes) = GD_CRcontainer Channel father nil 1 possize minmaxsize bgcolor title font textcol flags reflexes;; /* PUBLIC */ /* proto GRAPHICDRESSING_CRcontainerWithObjWin = fun [Chn ObjWin [I I I I] [I I I I] I S ObjFOnt [I I I I] I [fun[]I fun[]I fun[]I] ] [ObjContainer CompText CompRollOver CompCheck CompRollOver ClientSizePos] see the GD_CRcontainer function description for the parameters and return values description */ fun GRAPHICDRESSING_CRcontainerWithObjWin (Channel, win, possize, minmaxsize, bgcolor, title, font, textcol, flags, reflexes) = GD_CRcontainer Channel win nil 0 possize minmaxsize bgcolor title font textcol flags reflexes;; /* PUBLIC */ /* function to get the window external size according to the desired client area */ fun GRAPHICDRESSING_ExSizeFromClientSize (w,h,flags) = let if flags&GDWIN_BORDERS then THEME_getParamsByTheme GD_THEME "FRAMEBORDERS" else [nil nil nil 0 0 0 0 0 0] -> [_ _ _ h11 h12 h13 v11 v12 v13] in let if flags&GDWIN_TITLE_BAR then THEME_getParamsByTheme GD_THEME "TITLEBAR" else [nil nil nil 0 0 0 0 0 0] -> [_ _ _ h21 h22 h23 v21 v22 v23] in let THEME_getInfos GD_THEME "FRAMEBORDERS_SIZE" -> l in let [atoi nth_list l 0 atoi nth_list l 1 atoi nth_list l 2 atoi nth_list l 3] -> [left right top bottom] in /* [w+h11+h13 h+v11+v13+v21+v22+v23]*/ [w+left+right h+top+bottom+v21+v22+v23] ;; /* dialog box functions */ fun GD_OnCancelMessageBox(obj, cont, posx, posy, btn, mask) = { _DScontainer cont ; } ;; fun GRAPHICDRESSING_MessageBox(fatherCont, sTitle, sSubTitle, sTextMessage) = { let _GETscreenSize -> [wscreen hscreen] in let 350 -> wbox in let 290 -> hbox in let (wscreen-wbox)/2 -> posx in let (hscreen-hbox)/2 -> posy in let _channel -> chan in let THEME_getParamsByTheme GD_THEME "DBOX_LOGO" -> [pathlogo _ _ _ _ _ _ _ _ ]in let exec GD_FUNCTIONHANDLER_LOADBITMAP with [pathlogo chan] -> dboxlogo in let GRAPHICDRESSING_CRcontainer chan fatherCont [posx posy wbox hbox] [wbox hbox wbox hbox] GD_DEFAULT_BACKGROUNDCOLOR sTitle GD_FONT_BOLD [GD_WINDOWS_TITLE_COLOR1 0 1 0x50] GDWIN_CLOSE_BUTTON|GDWIN_BORDERS [nil nil nil] -> [cont compTitle compMin compMax compClose _] in let _CRcompBitmap chan cont nil [10 40] OBJ_ENABLE|OBJ_VISIBLE GD_DEFAULT_HANDLEDEVENTS dboxlogo 0 0 85 235 -> cpbitmap in let GRAPHICDRESSING_CRcompRollOverWithText chan cont nil [100+(wbox-200)/2 hbox-40] OBJ_VISIBLE|OBJ_ENABLE GD_DEFAULT_HANDLEDEVENTS 100 25 GD_FONT_NORMAL "OK" GD_DEFAULT_TEXT_BUTTON_COLOR -> buttonOK in let GRAPHICDRESSING_CRcompText chan cont nil [110 40] OBJ_ENABLE|OBJ_VISIBLE|CT_LEFT|CT_LABEL|CT_WORDWRAP GD_DEFAULT_HANDLEDEVENTS wbox-110 25 sSubTitle GD_FONT_BOLD [GD_DEFAULT_TITLE_TEXT_COLOR nil 0 0] [GD_DEFAULT_TITLE_TEXT_HIGHLIGHT_COLOR 50] -> cptxt1 in let GRAPHICDRESSING_CRcompText chan cont nil [110 75] OBJ_ENABLE|OBJ_VISIBLE|CT_LEFT|CT_LABEL|CT_WORDWRAP GD_DEFAULT_HANDLEDEVENTS wbox-110 hbox-75-50 sTextMessage GD_FONT_NORMAL [GD_DEFAULT_TEXT_COLOR nil 0 0] [GD_DEFAULT_TEXT_HIGHLIGHT_COLOR 50] -> cptxt2 in { _CBcompRollOverClick compClose @GD_OnCancelMessageBox cont ; _CBcompRollOverClick buttonOK @GD_OnCancelMessageBox cont ; _PAINTcontainer _SHOWcontainer cont CONTAINER_UNHIDDEN ; /* return value */ cont; } } ;; fun GRAPHICDRESSING_ChildDialogBox(fathercont, sTitle, sSubTitle, sTextMessage, nCreationFlags, funcallback, param) = { let _GETscreenSize -> [wscreen hscreen] in let 350 -> wbox in let 290 -> hbox in let (wscreen-wbox)/2 -> posx in let (hscreen-hbox)/2 -> posy in let _channel -> chan in let THEME_getParamsByTheme GD_THEME "DBOX_LOGO" -> [pathlogo _ _ _ _ _ _ _ _ ]in let exec GD_FUNCTIONHANDLER_LOADBITMAP with [pathlogo chan] -> dboxlogo in let GRAPHICDRESSING_CRcontainer chan fathercont [posx posy wbox hbox] [wbox hbox wbox hbox] GD_DEFAULT_BACKGROUNDCOLOR sTitle GD_FONT_BOLD [GD_WINDOWS_TITLE_COLOR1 0 1 0x50] GDWIN_CLOSE_BUTTON|GDWIN_BORDERS [nil nil nil] -> [cont compTitle compMin compMax compClose _] in let _CRcompBitmap chan cont nil [10 40] OBJ_ENABLE|OBJ_VISIBLE GD_DEFAULT_HANDLEDEVENTS dboxlogo 0 0 85 235 -> cpbitmap in let GRAPHICDRESSING_CRcompText chan cont nil [110 40] OBJ_ENABLE|OBJ_VISIBLE|CT_LEFT|CT_LABEL|CT_WORDWRAP GD_DEFAULT_HANDLEDEVENTS wbox-110 25 sSubTitle GD_FONT_BOLD [GD_DEFAULT_TITLE_TEXT_COLOR nil 0 0] [GD_DEFAULT_TITLE_TEXT_HIGHLIGHT_COLOR 50] -> cptxt1 in let GRAPHICDRESSING_CRcompText chan cont nil [110 65] OBJ_ENABLE|OBJ_VISIBLE|CT_LEFT|CT_LABEL|CT_WORDWRAP GD_DEFAULT_HANDLEDEVENTS wbox-115 hbox-65-30 sTextMessage GD_FONT_NORMAL [GD_DEFAULT_TEXT_COLOR nil 0 0] [GD_DEFAULT_TEXT_HIGHLIGHT_COLOR 50] -> cptxt2 in /* Process GDBOXFLAGS_YESNO*/ if nCreationFlags&GDBOXFLAGS_YESNO then { let (wbox-100-160)/3 -> bspace in let GRAPHICDRESSING_CRcompRollOverWithText chan cont nil [100+bspace hbox-40] OBJ_VISIBLE|OBJ_ENABLE GD_DEFAULT_HANDLEDEVENTS 80 25 GD_FONT_NORMAL (GD_ExecLocaleFunction "buttonname-YES" nil) GD_DEFAULT_TEXT_BUTTON_COLOR -> buttonYES in let GRAPHICDRESSING_CRcompRollOverWithText chan cont nil [100+2*bspace+80 hbox-40] OBJ_VISIBLE|OBJ_ENABLE GD_DEFAULT_HANDLEDEVENTS 80 25 GD_FONT_NORMAL (GD_ExecLocaleFunction "buttonname-NO" nil) GD_DEFAULT_TEXT_BUTTON_COLOR -> buttonNO in { _CBcompRollOverClick compClose funcallback [cont GDBOX_NO param]; _CBcompRollOverClick buttonNO funcallback [cont GDBOX_NO param] ; _CBcompRollOverClick buttonYES funcallback [cont GDBOX_YES param] ; _PAINTcontainer _SHOWcontainer cont CONTAINER_UNHIDDEN ; /* return value */ cont ; } ; } else /* Process GDBOXFLAGS_OKCANCEL*/ if nCreationFlags&GDBOXFLAGS_OKCANCEL then { let (wbox-100-160)/3 -> bspace in let GRAPHICDRESSING_CRcompRollOverWithText chan cont nil [100+bspace hbox-40] OBJ_VISIBLE|OBJ_ENABLE GD_DEFAULT_HANDLEDEVENTS 80 25 GD_FONT_NORMAL (GD_ExecLocaleFunction "buttonname-OK" nil) GD_DEFAULT_TEXT_BUTTON_COLOR -> buttonOK in let GRAPHICDRESSING_CRcompRollOverWithText chan cont nil [100+2*bspace+80 hbox-40] OBJ_VISIBLE|OBJ_ENABLE GD_DEFAULT_HANDLEDEVENTS 80 25 GD_FONT_NORMAL (GD_ExecLocaleFunction "buttonname-CANCEL" nil) GD_DEFAULT_TEXT_BUTTON_COLOR -> buttonCANCEL in { _CBcompRollOverClick compClose funcallback [cont GDBOX_CANCEL param]; _CBcompRollOverClick buttonOK funcallback [cont GDBOX_OK param] ; _CBcompRollOverClick buttonCANCEL funcallback [cont GDBOX_CANCEL param] ; _PAINTcontainer _SHOWcontainer cont CONTAINER_UNHIDDEN ; /* return value */ cont ; } ; } else /* Process GDBOXFLAGS_YESNOCANCEL*/ if nCreationFlags&GDBOXFLAGS_YESNOCANCEL then { let (wbox-100-210)/4 -> bspace in let GRAPHICDRESSING_CRcompRollOverWithText chan cont nil [100+bspace hbox-40] OBJ_VISIBLE|OBJ_ENABLE GD_DEFAULT_HANDLEDEVENTS 70 25 GD_FONT_NORMAL (GD_ExecLocaleFunction "buttonname-YES" nil) GD_DEFAULT_TEXT_BUTTON_COLOR -> buttonYES in let GRAPHICDRESSING_CRcompRollOverWithText chan cont nil [100+2*bspace+70 hbox-40] OBJ_VISIBLE|OBJ_ENABLE GD_DEFAULT_HANDLEDEVENTS 70 25 GD_FONT_NORMAL (GD_ExecLocaleFunction "buttonname-NO" nil) GD_DEFAULT_TEXT_BUTTON_COLOR -> buttonNO in let GRAPHICDRESSING_CRcompRollOverWithText chan cont nil [100+3*bspace+140 hbox-40] OBJ_VISIBLE|OBJ_ENABLE GD_DEFAULT_HANDLEDEVENTS 70 25 GD_FONT_NORMAL (GD_ExecLocaleFunction "buttonname-CANCEL" nil) GD_DEFAULT_TEXT_BUTTON_COLOR -> buttonCANCEL in { _CBcompRollOverClick compClose funcallback [cont GDBOX_CANCEL param]; _CBcompRollOverClick buttonNO funcallback [cont GDBOX_NO param] ; _CBcompRollOverClick buttonYES funcallback [cont GDBOX_YES param] ; _CBcompRollOverClick buttonCANCEL funcallback [cont GDBOX_CANCEL param] ; _PAINTcontainer _SHOWcontainer cont CONTAINER_UNHIDDEN ; /* return value */ cont ; } ; } else /* Process GDBOXFLAGS_OK*/ if nCreationFlags&GDBOXFLAGS_OK then { let (wbox-100-100)/2 -> bspace in let GRAPHICDRESSING_CRcompRollOverWithText chan cont nil [100+bspace hbox-40] OBJ_VISIBLE|OBJ_ENABLE GD_DEFAULT_HANDLEDEVENTS 100 25 GD_FONT_NORMAL (GD_ExecLocaleFunction "buttonname-OK" nil) GD_DEFAULT_TEXT_BUTTON_COLOR -> buttonOK in { _CBcompRollOverClick compClose funcallback [cont GDBOX_CANCEL param]; _CBcompRollOverClick buttonOK funcallback [cont GDBOX_OK param] ; _PAINTcontainer _SHOWcontainer cont CONTAINER_UNHIDDEN ; /* return value */ cont ; } ; } else cont ; } ;; fun GRAPHICDRESSING_GetIcone (ref)= strcat GD_THEME.THEMEdir nth_list THEME_getInfos GD_THEME ref 0;; fun GRAPHICDRESSING_OpenLoadingDialogBox (chan, contfather, sTitle, flags) = /* Opens a dialog box with title sTitle and displays a message 'Loading, pease wait...' the parameter flags is not used yet - reserved for futher compatibility, you must pass NIL. returns : the new created container */ { let _GETscreenSize -> [wscreen hscreen] in let _CRfont chan 15 0 0 "Comic Sans MS" -> MyFont in let 250 -> wbox in let 80 -> hbox in let (wscreen-wbox)/2 -> posx in let (hscreen-hbox)/2 -> posy in let (GD_ExecLocaleFunction "graphicdressing-LOADINGWAIT" nil) -> sText in let (GRAPHICDRESSING_CRcontainer chan contfather [posx posy wbox hbox] [wbox hbox wbox hbox] GD_DEFAULT_BACKGROUNDCOLOR sText GD_FONT_BOLD [GD_WINDOWS_TITLE_COLOR1 0 1 0x50] GDWIN_BORDERS|GDWIN_TITLE_BAR [nil nil nil]) -> [cont compTitle compMin compMax compClose _] in let GRAPHICDRESSING_CRcompText chan cont nil [10 hbox/2] OBJ_ENABLE|OBJ_VISIBLE|CT_CENTER|CT_LABEL|CT_WORDWRAP GD_DEFAULT_HANDLEDEVENTS wbox-20 hbox/2-10 sTitle MyFont [GD_DEFAULT_TEXT_COLOR nil 0 0] [GD_DEFAULT_TEXT_HIGHLIGHT_COLOR 50] -> cptxt2 in { _PAINTcontainer _SHOWcontainer cont CONTAINER_UNHIDDEN ; _TOPcontainer cont ; /* return value */ [cont cptxt2]; } ; } ;; fun GRAPHICDRESSING_CloseLoadingDialogBox (cont) = { _DScontainer cont ; 0 };; /*************************************************************************************** * * The following section allows to create a button bar * ***************************************************************************************/ var BUTTONBAR_VERTICAL = 0b0001;; var BUTTONBAR_HORIZONTAL = 0b0010;; var BUTTONBAR_INVX = 0b0100;; /* les boutons sont ajoutés les un à la suite des autres vers la gauches et posx désigne le côté gauche de l'ensemble des boutons */ var BUTTONBAR_INVY = 0b1000;; /* les boutons sont ajoutés les un à la suite des autres vers le haut et posy désigne le bas de l'ensemble des boutons */ struct ButtonBar = [ BUTTONBARchannel : Chn , BUTTONBARcontainer : ObjContainer , BUTTONBARfather : ObjNode , /* noeud à partir duquel sont définis posx et posy (si ce noeud est déplacé les boutons suivent, voir comportement de la lib2D)*/ BUTTONBARposx : I , /* désigne par défaut le coin supérieur gauche, voir les flags ci-dessus pour d'autres possibilités */ BUTTONBARposy : I , BUTTONBARedgeWidths: [I I I I] , /* espace entre le texte et le bord du bouton [left right top bottom] */ BUTTONBARfixed : [I I] , /* mettre des dimensions différentes de 0 pour les dimensions que l'on veut fixer */ BUTTONBARcb : fun[S I I I I]I , /* callback (the string parameter is the action called by the button)*/ BUTTONBARbuttons : [[ObjFont I S S] r1] , /* buttons */ BUTTONBARbarFlags : I , /* combinaison des flags ci-dessus */ BUTTONBARbutFlags : I , /* flags for the compRollOvers */ BUTTONBAReventFlags: I /* flags for the comprollover events */ ] mkButtonBar;; fun GD_MenuGetMaxStringSize (bList, w, h) = let bList -> [first next] in if first == nil then [w h] else let first -> [font _ text _] in let realGETstringSize font text -> [nw nh] in GD_MenuGetMaxStringSize next (if nw>w then nw else w) (if nh>h then nh else h) ;; fun GD_rflCLICKbuttonBar (rollOver, param, posx, posy, btn, mask) = let param -> [action mb] in let _GETobjNodePositionSizeInContainerRef _CONVERTcompRollOverToObjNode rollOver -> [x y w h] in exec mb.BUTTONBARcb with [action x y w h];; fun GD_CRbuttonBar (bList, buttonBar, posx, posy, sens) = let bList -> [first next] in if first == nil then nil else let first -> [font color text action] in let buttonBar.BUTTONBARedgeWidths -> [l r t b] in let realGETstringSize font text -> [rtw rth] in let buttonBar.BUTTONBARfixed -> [zw zh]in let [(if zw==0 then rtw else zw) (if zh==0 then rth else zh)] -> [tw th] in let [tw+l+r th+t+b] -> [nw nh] in let sens -> [sensx sensy] in let if sensx==-1 then posx-nw else posx -> x in let if sensy==-1 then posy-nh else posy -> y in let GRAPHICDRESSING_CRcompRollOverWithText buttonBar.BUTTONBARchannel buttonBar.BUTTONBARcontainer buttonBar.BUTTONBARfather [x y] buttonBar.BUTTONBARbutFlags buttonBar.BUTTONBAReventFlags nw nh font text color -> button in ( if @BUTTONBARcb == nil then nil else _CBcompRollOverClick button @GD_rflCLICKbuttonBar [action buttonBar]; button::( GD_CRbuttonBar next buttonBar (if buttonBar.BUTTONBARbarFlags&BUTTONBAR_HORIZONTAL then posx+sensx*nw else posx) (if buttonBar.BUTTONBARbarFlags&BUTTONBAR_VERTICAL then posy+sensy*nh else posy) sens ) );; /**************************************************************************************** * * Functions which allow to create a button bar (button bar with text) * * * [CompRollOver r1] GRAPHICDRESSING_CRbuttonBar * [ * Chn channel, * ObjContainer container, * ObjNode father, * I posx, * I posy, * [I I I I] edgeWidths, * [I I] fixbutsize, * I fun[S I I] reflex, with [S action , I x, I y, I w, I h] action for the button and its positionand size * [[ObjFont I S S] r1] buttonList (liste de [font color text action]), * I barFlags * I buttonFlags * I eventFlags * ] * * to destroy a button bar create it in a new channel that you destroy when you want * destroy the button bar or with a father that you kill or killing each * comprollover of the list returned. * * move it moving the father or the container. * * no resize ****************************************************************************************/ fun GRAPHICDRESSING_CRbuttonBar (channel, cont, father, posx, posy, edgeWidths, fixbutsize, reflex, buttonList, barFlags, buttonFlags, eventFlags ) = if buttonList == nil then nil else let GD_MenuGetMaxStringSize buttonList 0 0 -> [w h] in let if barFlags == nil then 0 else barFlags -> _barFlags in let if buttonFlags == nil then OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK else buttonFlags -> _buttonFlags in let if eventFlags == nil then OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_MOVE else eventFlags -> _eventFlags in let if _barFlags&BUTTONBAR_INVX then -1 else 1 -> sensx in let if _barFlags&BUTTONBAR_INVY then -1 else 1 -> sensy in let [(if _barFlags&BUTTONBAR_VERTICAL then w else 0) (if _barFlags&BUTTONBAR_HORIZONTAL then h else 0)] -> autoZone in let if fixbutsize != nil then let fixbutsize -> [fw fh] in let autoZone -> [aw ah] in let edgeWidths -> [l r t b] in [(if fw==0 then aw else fw-r-l) (if fh==0 then ah else fh-t-b)] else autoZone -> zone in let mkButtonBar [ channel cont father posx posy edgeWidths zone reflex buttonList _barFlags _buttonFlags _eventFlags ] -> bb in GD_CRbuttonBar buttonList bb posx posy [sensx sensy] ;;