/************************************************** Module GraphicCheckBox Client part Version: 1.0 Author: Julien Zorko Last update: 01/08/2001 CheckBox with customisable bitmap **************************************************/ typeof ZoneCont = ObjContainer;; /* Main container of the module interface */ typeof ZoneSize = [I I];; /* [width height] */ typeof Button = CompCheck;; /* Button */ typeof Skin = AlphaBitmap;; /* bitmap for the compcheck */ typeof sBitmap = S;; /* bitmap file name */ typeof sText = S;; /* button text reference */ typeof iTextSize = I;; /* button text font size */ typeof iTextColor = I;; /* button text font color */ typeof fontText = ObjFont;; /* text font */ typeof sText2 = S;; /* button text reference */ typeof iTextSize2 = I;; /* button text font size */ typeof iTextColor2 = I;; /* button text font color */ typeof fontText2 = ObjFont;; /* text font */ typeof sBubble = S;; /* bubble text reference */ typeof iBubbleColor = I;; /* bubble text font color */ typeof iBubbleBackColor = I;; /* bubble back color */ typeof fontBubble = ObjFont;; /* bubble font */ typeof iDisable = I;; /* option disable or not */ typeof image = S;; typeof bulle = S;; typeof locBulle = [[S r1] r1];; typeof font = ObjFont;; var beforeToolTipDelay=250;; var hideToolTipDelay=4000;; /*path*/ typeof modulePath = S;; var allArrive = 0;; var XLeftBorderSize = 4;; var XRightBorderSize = 4;; var YLeftBorderSize = 4;; var YRightBorderSize = 4;; var DEFAULT_SKIN = "ressources/defaultskin.png";; /******************************************************************************* Functions *******************************************************************************/ /* fun cbClickButton (obj, param, posx, posy, etat, mask) = _DMSevent this "click" nil nil; 0 ;; */ fun cbChangeState (compCheck, param, state) = if state == CHK_CHECKED then _DMSevent this "check" nil nil else _DMSevent this "uncheck" nil nil; 0 ;; fun cbHideToolTip (node, toolTipChannel, txt) = _killchannel toolTipChannel ;; /* fun _CBtimerHideToolTip(t,b)= _deltimer t; _killchannel b ;; */ fun GetCheckBoxStretchLists (w, h, nw, nh) = if iDisable then [ [0 0]::[XLeftBorderSize XLeftBorderSize]:: [w-XRightBorderSize nw-XRightBorderSize]:: [w+XLeftBorderSize nw+XLeftBorderSize ]:: [2*w-XRightBorderSize 2*nw-XRightBorderSize]:: [2*w 2*nw]::nil [0 0]::[YLeftBorderSize YLeftBorderSize]:: [h-YRightBorderSize nh-YRightBorderSize]:: [h+YLeftBorderSize nh+YLeftBorderSize ]:: [2*h-XRightBorderSize 2*nh-XRightBorderSize]:: [2*h+YLeftBorderSize 2*nh+YLeftBorderSize ]:: [3*h-XRightBorderSize 3*nh-XRightBorderSize]:: [3*h+YLeftBorderSize 3*nh+YLeftBorderSize ]:: [4*h-XRightBorderSize 4*nh-XRightBorderSize]:: [4*h+YLeftBorderSize 4*nh+YLeftBorderSize ]:: [5*h-XRightBorderSize 5*nh-XRightBorderSize]:: [5*h 5*nh]::nil ] else [ [0 0]::[XLeftBorderSize XLeftBorderSize]:: [w-XRightBorderSize nw-XRightBorderSize]:: [w+XLeftBorderSize nw+XLeftBorderSize ]:: [2*w-XRightBorderSize 2*nw-XRightBorderSize]:: [2*w 2*nw]::nil [0 0]::[YLeftBorderSize YLeftBorderSize]:: [h-YRightBorderSize nh-YRightBorderSize]:: [h+YLeftBorderSize nh+YLeftBorderSize ]:: [2*h-XRightBorderSize 2*nh-XRightBorderSize]:: [2*h+YLeftBorderSize 2*nh+YLeftBorderSize ]:: [3*h-XRightBorderSize 3*nh-XRightBorderSize]:: [3*h+YLeftBorderSize 3*nh+YLeftBorderSize ]:: [4*h-XRightBorderSize 4*nh-XRightBorderSize]:: [4*h 4*nh]::nil ] ;; /******************************************************************************* This function stretches a bitmap according to the xList and yList which are lists if [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 STRETCHalphaBitmap2 (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 ( _SCPalphaBitmap bmp nx1 ny1 nx2-1 ny2-1 motif ox1 oy1 ox2-1 oy2-1; if (hd nextx)!=nil then STRETCHalphaBitmap2 bmp motif (tl xList) yList oxList else STRETCHalphaBitmap2 bmp motif oxList (tl yList) oxList );; /* here is the function to use */ fun STRETCHalphaBitmap (bmp, motif, xList, yList) = STRETCHalphaBitmap2 bmp motif xList yList xList ;; /******************************************************************************* Display the button tooltip *******************************************************************************/ fun cbShowToopTip(node,b,txt,x,y)= let b -> [toolTipChannel cont param] in ( let _GETwindowPositionSize DMSwin -> [xp yp wp hp] in let _GETcursorPos DMSwin -> [xx yy] in let (xp + xx) + 30 -> x in let (yp + yy) + 30 -> y in if txt==nil || (!strcmp txt "") then nil else let _GETstringSize fontBubble txt -> [w h] in let [w+1 h+1] -> [w h] in let [((w*3)/4) h*2] -> [w h] in let _GETscreenSize -> [sw sh] in let if (x+w)>sw-10 then sw-w-10 else x -> x in /*si depassement ecran, on decale à gauche*/ let 4 -> dw in let 4 -> dh in let _CRcontainerFromObjCont toolTipChannel cont x y w+dw h+dh CO_NOCAPTION iBubbleBackColor nil -> cont in ( _CRcompText toolTipChannel cont nil [dw/2+1 dh/2] OBJ_ENABLE|OBJ_VISIBLE|CT_CENTER|CT_WORDWRAP 0 w h txt fontBubble [iBubbleColor nil nil nil] nil nil nil; _PAINTcontainer cont; _TOPcontainer cont; /* _rfltimer _starttimer toolTipChannel hideToolTipDelay @_CBtimerHideToolTip toolTipChannel */ ); ) ;; fun CreateToolTip (cont, node, txt, param) = let _openchannel nil nil nil -> toolTipChannel in ( _CRtoolTip node beforeToolTipDelay txt @cbShowToopTip [toolTipChannel cont param] @cbHideToolTip toolTipChannel; toolTipChannel ) ;; /******************************************************************************* Get the flag for the font style according to the combobox index *******************************************************************************/ fun fontFlag(iValue) = if(iValue == 1) then FF_WEIGHT else if(iValue == 2) then FF_ITALIC else if(iValue == 3) then FF_UNDERLINE else if(iValue == 4) then FF_STRIKED else 0 ;; /******************************************************************************* Draw a text line on a bitmap bmp -> ObjBitmap : bitamp destination font -> ObjFont : text font x -> I : horizontal position y -> I : vertical position marge -> I : space between lines space -> [[S r1]r1]: line string list <- ObjBimap : the modified bitmap *******************************************************************************/ fun DrawTextLines (bmp, font, color, x, y, space, list) = if list == nil then bmp else let list -> [first next] in ( _DRAWtext bmp font x y TD_BASELINE|TD_CENTER color first; DrawTextLines bmp font color x y+space space next ) ;; /******************************************************************************* Write text on button bitmap bmp -> ObjBitmap : destination bitmap text -> [S S] : text to write <- ObjBitmap : modified bitmap *******************************************************************************/ fun locBitmap(bmp, text)= let text -> [text1 text2] in let _GETbitmapSize bmp -> [w h] in /* calcule la hauteur d'une case, et le centrage horizontal et vertical du texte dans la case */ let if iDisable == 0 then 4 else 5 -> divis in let h/(2*(divis+1)) + iTextSize/2 -> h2 in let [(h/divis) (w/4) 3*w/4] -> [h1 w2 w4] in ( let lineextr text1 -> liste in let sizelist liste -> lenght in let ( (h/(divis+1)) - lenght*iTextSize)/(lenght+1) -> reste in ( /* Draw the text on bitmap for the different button states */ DrawTextLines bmp fontText iTextColor w2 (reste+iTextSize) (reste+iTextSize) liste; DrawTextLines bmp fontText iTextColor w2 (h1+reste+iTextSize) (reste+iTextSize) liste; DrawTextLines bmp fontText iTextColor w2 (2*h1+reste+iTextSize) (reste+iTextSize) liste; if divis == 5 then DrawTextLines bmp fontText iTextColor w2 (3*h1+reste+iTextSize) (reste+iTextSize) liste else bmp ); let lineextr text2 -> liste in let sizelist liste -> lenght in let ( (h/(divis+1)) - lenght*iTextSize2)/(lenght+1) -> reste in ( /* Draw the text on bitmap for the different button states */ DrawTextLines bmp fontText2 iTextColor2 w4 (reste+iTextSize2) (reste+iTextSize2) liste; DrawTextLines bmp fontText2 iTextColor2 w4 (h1+reste+iTextSize2) (reste+iTextSize2) liste; DrawTextLines bmp fontText2 iTextColor2 w4 (2*h1+reste+iTextSize2) (reste+iTextSize2) liste; if divis == 5 then DrawTextLines bmp fontText iTextColor2 w4 (3*h1+reste+iTextSize2) (reste+iTextSize2) liste else bmp ) ) ;; /******************************************************************************* Zone resize management *******************************************************************************/ fun cbResizeZone (coord, zone) = let coord -> [win x y w h] in _SIZEcontainer ZoneCont x y w h; 0 ;; /******************************************************************************* Button destruction *******************************************************************************/ fun DestroyButton () = _DMSreleaseZone this "button"; _DMSdelete this; 0 ;; /******************************************************************************* Load the button bimat and write text on it fileName -> S : bitmap file name (.jpg, .jpeg or .png) text -> S : text to write on the button *******************************************************************************/ fun LoadBitmap (fileName, text) = let substr fileName (strlen fileName)-4 4 -> extension in let substr fileName (strlen fileName)-5 5 -> extension2 in if !(strcmpi extension ".jpg") || !(strcmpi extension2 ".jpeg") then let _LDjpeg _channel _checkpack fileName -> bmp in set Skin = _CRalphaBitmap _channel bmp nil nil nil else if !(strcmpi extension ".bmp") then let _LDbitmap _channel _checkpack fileName -> bmp in set Skin = _CRalphaBitmap _channel bmp nil nil nil else if !(strcmpi extension ".png") then set Skin = _LDalphaBitmap _channel _checkpack fileName else nil; if Skin == nil then ( set iDisable = 1; let strcat _DMSgetpath _DMSgetClass this DEFAULT_SKIN -> file in set Skin = _LDalphaBitmap _channel _checkpack file ) else nil; let ZoneSize -> [nw nh] in let if iDisable then 5 else 4 -> coeff in let _CRbitmap _channel nw*2 nh*coeff -> bmp in let _GETalphaBitmapSize Skin -> [sw sh] in let [(sw/2) (if iDisable then sh/5 else sh/4)] -> [w h] in let GetCheckBoxStretchLists w h nw nh -> [xList yList] in let STRETCHalphaBitmap bmp Skin xList yList -> finalBmp in let _CRalphaBitmap _channel (locBitmap finalBmp text) nil nil nil -> abmp in ( _DSbitmap finalBmp; abmp ) ;; fun cbResizeCheckBoxRessource (cCheckBox, text, nnw, nnh) = let [nnw/2 (if iDisable then nnh/5 else nnh/4)] -> [nw nh] in let _CRbitmap _channel nnw nnh -> bmp in let _GETalphaBitmapSize Skin -> [sw sh] in let [sw/2 (if iDisable then sh/5 else sh/4)] -> [w h] in let GetCheckBoxStretchLists w h nw nh -> [xList yList] in let STRETCHalphaBitmap bmp Skin xList yList -> finalBmp in let _CRalphaBitmap _channel (locBitmap finalBmp text) nil nil nil -> abmp in ( _DSbitmap finalBmp; abmp ) ;; /******************************************************************************* Interface creation (rollover component creation + tooltip creation) <- I: unused *******************************************************************************/ fun CreateInterface()= let _DMSgetZone this "button" nil @cbResizeZone nil ->[win x y w h] in if win==nil then /* the client module instance is destroyed if there's not an alocated zone */ DestroyButton else ( set ZoneSize = [w h]; let _CRcontainerFromObjWin _channel win x y w h CO_CHILDINSIDE|CO_NOBORDER|CO_NOCAPTION 0 "" -> cont in let LoadBitmap sBitmap [sText sText2] -> alphaBmp in let if iDisable == 0 then _CRcompCheck _channel cont nil [0 0] ROL_MASK|OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_CLICK alphaBmp else _CRcompCheck _channel cont nil [0 0] ROL_MASK|OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_CLICK alphaBmp -> rotmp in if rotmp == nil then /* button can not be created */ DestroyButton else ( set Button = rotmp; set ZoneCont = cont; if (sBubble == nil) || (!strcmp sBubble "") then nil else CreateToolTip cont (_CONVERTcompCheckToObjNode rotmp) sBubble nil; _CBcompCheckStateChanged rotmp @cbChangeState 0; _CBcompCheckResizeResource rotmp @cbResizeCheckBoxRessource [sText sText2]; _PAINTcontainer cont; 0 ) ) ;; /* Callback caled when the button picture is loaded */ fun cbEndDownloadButtonPicture (s) = CreateInterface; 0 ;; /* */ fun cbBeforeClose () = _DMSreleaseZone this "button"; 0 ;; /******************************************************************************* Hide the check box from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbHide (from, action, param, others, tag) = _SHOWcontainer ZoneCont CONTAINER_HIDDEN; _DMSeventTag this "hidden" nil nil nil; 0 ;; /******************************************************************************* Show the check box from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbShow (from, action, param, others, tag) = _SHOWcontainer ZoneCont CONTAINER_UNHIDDEN; _DMSeventTag this "shown" nil nil nil; 0 ;; /******************************************************************************* Check the checkbox from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbCheck (from, action, param, others, tag) = _SETcompCheckState Button CHK_CHECKED; _PAINTcontainer ZoneCont; 0 ;; /******************************************************************************* Uncheck the checkbox from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbUncheck (from, action, param, others, tag) = _SETcompCheckState Button CHK_UNCHECKED; _PAINTcontainer ZoneCont; 0 ;; /******************************************************************************* Enable the checkbox from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbEnable (from, action, param, others, tag) = _CHANGEobjNodeFlags _CONVERTcompCheckToObjNode Button ROL_MASK|OBJ_ENABLE|OBJ_VISIBLE 1; _DMSeventTag this "enabled" nil nil nil; 0 ;; /******************************************************************************* Disable the checkbox from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbDisable (from, action, param, others, tag) = _CHANGEobjNodeFlags _CONVERTcompCheckToObjNode Button ROL_MASK|OBJ_DISABLE|OBJ_VISIBLE 1; _DMSeventTag this "disabled" nil nil nil; 0 ;; /******************************************************************************* Module client part initialisation *******************************************************************************/ fun IniDMI(param)= _DMSregister this @cbBeforeClose; _DMSdefineActions this (["show" @cbShow]):: (["hide" @cbHide]):: (["check" @cbCheck]):: (["uncheck" @cbUncheck]):: (["enable" @cbEnable]):: (["disable" @cbDisable])::nil; let strextr param -> params in let atoi getInfo params "textType" -> textType in let atoi getInfo params "textType2" -> textType2 in let atoi getInfo params "bubbleSize" -> bubbleSize in let atoi getInfo params "bubbleType" -> bubbleType in ( set sBitmap = getInfo params "picture"; set sText = getInfo params "text"; set iTextSize = atoi getInfo params "textSize"; set iTextColor = htoi getInfo params "textColor"; set fontText = _CRfont _channel iTextSize 0 (fontFlag textType) "Arial"; set sText2 = getInfo params "text2"; set iTextSize2 = atoi getInfo params "textSize2"; set iTextColor2 = htoi getInfo params "textColor2"; set fontText2 = _CRfont _channel iTextSize2 0 (fontFlag textType2) "Arial"; set sBubble = getInfo params "bubble"; set iBubbleColor = htoi getInfo params "bubbleColor"; set iBubbleBackColor = htoi getInfo params "bubbleBackColor"; set fontBubble = _CRfont _channel bubbleSize 0 (fontFlag bubbleType) "Arial"; set iDisable = atoi getInfo params "disable"; set image = sBitmap; _RSCdownload this image image @cbEndDownloadButtonPicture 1; _DMSeventTag this "in" nil nil nil; ); 0 ;;