/******************************************* Module DBdisplay Client Version: 1.0 Authors: Thierry LEFORT, Michel Paillet Last update: 05/28/2001 *******************************************/ /*********************************************************************************************/ /********** MAIN VARIABLES *******************/ /*********************************************************************************************/ /********** COMMUNICATION *******************/ defcom CqueryProduct=queryProduct;; defcom CpushClickOnProductInList = pushClickOnProductInList S;; defcom CpushDblclickOnProductInList = pushDblclickOnProductInList S;; /********** PATH AND PICTURES *******************/ typeof win=ObjWin;; /********** API 2D *******************/ typeof Step=I;; typeof Steph=I;; typeof font=ObjFont;; typeof color=[I I I];; typeof flagtext=I;; typeof flagedittext=I;; typeof flagmultiedittext=I;; typeof flagrollover=I;; typeof container=ObjContainer;; typeof conthead=ObjContainer;; typeof contproducts = ObjContainer;; typeof contdescription=ObjContainer;; typeof ListCont=[ObjContainer r1];; typeof PushNode =ObjNode ;; typeof PushDblNode = ObjNode;; typeof listProducts=CompList;; typeof compedit_product_description=CompText;; typeof PushCompRollOver=CompRollOver;; typeof PushDblCompRollOver=CompRollOver;; typeof SlideBmp = ObjBitmap;; typeof SlideBmp8 = ObjBitmap8;; typeof ListBmp = ObjBitmap;; typeof ListBmp8 = ObjBitmap8;; typeof ButtonBmp = ObjBitmap;; typeof ButtonBmp8 = ObjBitmap8;; typeof BmpText = ObjBitmap ;; /* source bitmap for the Slide Text*/ typeof Bmp8Text = ObjBitmap8 ;; /* source bitmap for the Slide Text*/ typeof Precision = [[S r1] r1];; typeof La_Liste_Produit = [[S r1] r1];; var productIndex=0;; var PRODUCT=3;; var COMPTEUR=0;; var RAZ=0;; var NO_RAZ=1;; var NUM="0";; var CHAR="1";; var NULL="arianenil";; var alreadyshown=0;; /********** PRODUCTS *******************/ typeof receivedpack=I;; var receivedpack=0;; typeof numberpack=I;; typeof List_Attributs = [S r1];; typeof StrList_produits =S;; typeof LLproducts=[[S r1]r1];; typeof products=[[S S S S S S S] r1];; typeof currentproducts=[S S S S S S S];; typeof indexName=I;; typeof Attr_Event = S;; typeof xi = I ;; typeof yi = I;; fun getCurrentRef() =/*La référence est en deuxième position en dur*/ hd tl nth_list La_Liste_Produit productIndex ;; /*********************************************************************************************/ /*********** Interactivité client-animateur *************/ /*********************************************************************************************/ /*button pushClik Callback */ fun _PushProduct(object,param,posx,posy,tn,mask)= let getCurrentRef -> reference in let strbuild ((strcat "#" strcat Attr_Event "#")::(getCurrentRef)::nil)::("#SessionId#"::nil)::nil -> param in _DMSsend this CpushClickOnProductInList [param] /* _DMSeventTag this "pushClickOnProductInList" param nil nil*/ ;; /*Button pushDblClick Button*/ fun _PushDblProduct(object,param,posx,posy,tn,mask)= let getCurrentRef -> reference in let strbuild ((strcat "#" strcat Attr_Event "#")::(getCurrentRef)::nil)::("#SessionId#"::nil)::nil -> param in _DMSsend this CpushDblclickOnProductInList [param] /*_DMSeventTag this "pushDblclickOnProductInList" param nil nil*/ ;; /*Paint a Container list*/ fun DrawCont(Lcontainer)= if Lcontainer==nil then 1 else ( _PAINTcontainer _SHOWcontainer (hd Lcontainer) CONTAINER_UNHIDDEN|CONTAINER_RESTORED; DrawCont tl Lcontainer ) ;; /******************************************************************************* Draw a vertical slide bar w -> I : width of the slide bar h -> I : height of the slide bar <- AlphaBitmap : the alphabitmap containing the slide bar *******************************************************************************/ fun DessineSlideV (w, h) = /* set the transparency color of the source file */ let make_rgb 0 0 255 -> trans in /* creation of the two destination bitmap */ let _CRbitmap _channel w h+18 -> tempBmp in let _CRbitmap8 _channel w h+18 -> tempBmp8 in ( /* construction of the two final bitmap with the elements of the file */ _SCPbitmap tempBmp 0 0 15 12 SlideBmp 34 16 49 28 nil; _SCPbitmap tempBmp 16 0 31 12 SlideBmp 51 16 66 28 nil; _SCPbitmap tempBmp 0 13 15 15 SlideBmp 2 16 17 17 nil; _SCPbitmap tempBmp 0 16 15 h-18 SlideBmp 2 18 17 23 nil; _SCPbitmap tempBmp 0 h-17 15 h-14 SlideBmp 2 24 17 27 nil; _SCPbitmap tempBmp 16 13 31 15 SlideBmp 2 16 17 17 nil; _SCPbitmap tempBmp 16 16 31 h-18 SlideBmp 2 18 17 23 nil; _SCPbitmap tempBmp 16 h-17 31 h-14 SlideBmp 2 24 17 27 nil; _SCPbitmap tempBmp 0 h-13 15 h-1 SlideBmp 34 30 49 42 nil; _SCPbitmap tempBmp 16 h-13 31 h-1 SlideBmp 51 30 66 42 nil; _SCPbitmap tempBmp 0 h 15 h+17 SlideBmp 18 16 33 33 nil; _SCPbitmap tempBmp 16 h 31 h+17 SlideBmp 18 16 33 33 nil; _SCPbitmap8 tempBmp8 0 0 15 12 SlideBmp8 34 16 49 28 nil; _SCPbitmap8 tempBmp8 16 0 31 12 SlideBmp8 51 16 66 28 nil; _SCPbitmap8 tempBmp8 0 13 15 15 SlideBmp8 2 16 17 17 nil; _SCPbitmap8 tempBmp8 0 16 15 h-18 SlideBmp8 2 18 17 23 nil; _SCPbitmap8 tempBmp8 0 h-17 15 h-14 SlideBmp8 2 24 17 27 nil; _SCPbitmap8 tempBmp8 16 13 31 15 SlideBmp8 2 16 17 17 nil; _SCPbitmap8 tempBmp8 16 16 31 h-18 SlideBmp8 2 18 17 23 nil; _SCPbitmap8 tempBmp8 16 h-17 31 h-14 SlideBmp8 2 24 17 27 nil; _SCPbitmap8 tempBmp8 0 h-13 15 h-1 SlideBmp8 34 30 49 42 nil; _SCPbitmap8 tempBmp8 16 h-13 31 h-1 SlideBmp8 51 30 66 42 nil; _SCPbitmap8 tempBmp8 0 h 15 h+17 SlideBmp8 18 16 33 33 nil; _SCPbitmap8 tempBmp8 16 h 31 h+17 SlideBmp8 18 16 33 33 nil; /* creation of the new alphabitmap */ let _CRalphaBitmap _channel tempBmp tempBmp8 make_rgb 255 255 255 trans -> alphaBmp in alphaBmp ) ;; fun DessineList (w, h) = let _CRbitmap _channel w h -> tempBmp in let _CRbitmap8 _channel w h -> tempBmp8 in ( _SCPbitmap tempBmp 0 0 13 13 ListBmp 0 0 13 13 nil; _SCPbitmap tempBmp 14 0 w-15 13 ListBmp 14 0 15 13 nil; _SCPbitmap tempBmp w-14 0 w-1 13 ListBmp 16 0 29 13 nil; _SCPbitmap tempBmp 0 14 13 h-15 ListBmp 0 14 13 15 nil; _SCPbitmap tempBmp 14 14 w-15 h-15 ListBmp 14 14 15 15 nil; _SCPbitmap tempBmp w-14 14 w-1 h-15 ListBmp 16 14 29 15 nil; _SCPbitmap tempBmp 0 h-14 13 h-1 ListBmp 0 16 13 29 nil; _SCPbitmap tempBmp 14 h-14 w-15 h-1 ListBmp 14 16 15 29 nil; _SCPbitmap tempBmp w-14 h-14 w-1 h-1 ListBmp 16 16 29 29 nil; _SCPbitmap8 tempBmp8 0 0 13 13 ListBmp8 0 0 13 13 nil; _SCPbitmap8 tempBmp8 14 0 w-15 13 ListBmp8 14 0 15 13 nil; _SCPbitmap8 tempBmp8 w-14 0 w-1 13 ListBmp8 16 0 29 13 nil; _SCPbitmap8 tempBmp8 0 14 13 h-15 ListBmp8 0 14 13 15 nil; _SCPbitmap8 tempBmp8 14 14 w-15 h-15 ListBmp8 14 14 15 15 nil; _SCPbitmap8 tempBmp8 w-14 14 w-1 h-15 ListBmp8 16 14 29 15 nil; _SCPbitmap8 tempBmp8 0 h-14 13 h-1 ListBmp8 0 16 13 29 nil; _SCPbitmap8 tempBmp8 14 h-14 w-15 h-1 ListBmp8 14 16 15 29 nil; _SCPbitmap8 tempBmp8 w-14 h-14 w-1 h-1 ListBmp8 16 16 29 29 nil; let _CRalphaBitmap _channel tempBmp tempBmp8 make_rgb 255 255 255 make_rgb 0 0 255 -> alphaBmp in alphaBmp ) ;; fun CreateBitmap (Cont, x, y, w, h) = _CRcompBitmap _channel Cont nil [x y] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_CLICK|OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_DBLCLICK|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_MOVE DessineList w h 0 0 w h ;; fun resizebitmap (bitmap, param, w, h, parambmp) = let DessineList w h -> alpha in let [alpha [0 0 w h]] -> resultat in resultat ;; /******************************************************************************* Callback of resize of the complist objslide -> CompSlideBar : object resized (not used here) param -> [I I] : height of the original image and number of items w -> I : weight of the new image h -> I : height of the new image bmpcoords -> [I I I] : offsets of the old image (not used here) <- [AlphaBitmap [I I I] ] : new image with offsets *******************************************************************************/ fun cbResize_List (objslide, param, w, h, bmpcoords) = [DessineSlideV w h [15 h-15 h]] ;; /*Create a compList Object with a Slide Bar*/ fun CreateList(container,x,y,w,h,xf,yf)= let ftoi ((itof h)/.(itof 15)) -> nbitem in let CreateBitmap container x y w-16 h -> cpbitmap in let _CONVERTcompBitmapToObjNode cpbitmap -> node in let _CRcompList _channel container node [14 14] OBJ_ENABLE|OBJ_VISIBLE|LST_LEFT|LST_HIGHLIGHT_CLICKED|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOVE w-44 h-28 nbitem LST_VERTICAL font 0 [(make_rgb 0 0 0) nil nil nil] [(make_rgb 229 7 4) 75] [[w-25 0-14] OBJ_MH_FLEX|OBJ_LW_FLEX DessineSlideV 16 h [15 h-15 h]] -> listtemp in ( _CBcompBitmapResizeResource cpbitmap @resizebitmap nil; _CBcompListResizeResource listtemp @cbResize_List nil ) ;; /******************************************************************************* Function that create a background alphabitmap w -> I : the width of the alphabitmap h -> I : the height of the alphabitmap <- AlphaBitmap : the final AlphaBitmap of the background *******************************************************************************/ fun DessineFond (w, h) = let _CRbitmap _channel w h -> tempBmp in let _CRbitmap8 _channel w h -> tempBmp8 in ( _SCPbitmap tempBmp 0 0 13 9 ButtonBmp 2 15 15 24 nil; _SCPbitmap tempBmp 14 0 w-15 9 ButtonBmp 16 15 21 24 nil; _SCPbitmap tempBmp w-14 0 w-1 9 ButtonBmp 22 15 35 24 nil; _SCPbitmap tempBmp 0 10 13 h-11 ButtonBmp 2 25 15 26 nil; _SCPbitmap tempBmp 14 10 w-15 h-11 ButtonBmp 16 25 21 26 nil; _SCPbitmap tempBmp w-14 10 w-1 h-11 ButtonBmp 22 25 35 26 nil; _SCPbitmap tempBmp 0 h-10 13 h-1 ButtonBmp 2 27 15 36 nil; _SCPbitmap tempBmp 14 h-10 w-15 h-1 ButtonBmp 16 27 21 36 nil; _SCPbitmap tempBmp w-14 h-10 w-1 h-1 ButtonBmp 22 27 35 36 nil; _SCPbitmap8 tempBmp8 0 0 13 9 ButtonBmp8 2 15 15 24 nil; _SCPbitmap8 tempBmp8 14 0 w-15 9 ButtonBmp8 16 15 21 24 nil; _SCPbitmap8 tempBmp8 w-14 0 w-1 9 ButtonBmp8 22 15 35 24 nil; _SCPbitmap8 tempBmp8 0 10 13 h-11 ButtonBmp8 2 25 15 26 nil; _SCPbitmap8 tempBmp8 14 10 w-15 h-11 ButtonBmp8 16 25 21 26 nil; _SCPbitmap8 tempBmp8 w-14 10 w-1 h-11 ButtonBmp8 22 25 35 26 nil; _SCPbitmap8 tempBmp8 0 h-10 13 h-1 ButtonBmp8 2 27 15 36 nil; _SCPbitmap8 tempBmp8 14 h-10 w-15 h-1 ButtonBmp8 16 27 21 36 nil; _SCPbitmap8 tempBmp8 w-14 h-10 w-1 h-1 ButtonBmp8 22 27 35 36 nil; let _CRalphaBitmap _channel tempBmp tempBmp8 make_rgb 255 255 255 make_rgb 0 0 255 -> alphaBmp in alphaBmp ) ;; /******************************************************************************* Function that create a text bitmap x -> I : x position of the text y -> I : y position of the text w -> I : the width of the text h -> I : the height of the text cont -> ObjContainer : container of the texte <- AlphaBitmap : the final CompBitmap of the text *******************************************************************************/ fun CreateBitmapTexte ( x, y, w, h, cont) = _CRcompBitmap _channel cont nil [x y] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_CLICK|OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_DBLCLICK|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_MOVE DessineFond w h 0 0 w h ;; fun resizebitmaptext (bitmap, param, w, h, parambmp) = let DessineFond w h -> alpha in let [alpha [0 0 w h]] -> resultat in resultat ;; fun cbResize_Text (objtext, param, w, h, bmpcoords) = [DessineSlideV w h [15 h-15 h]] ;; fun CreateText(container,x,y,w,h,flag,text)= let CreateBitmapTexte x y w-16 h container-> cpbitmap in let _CONVERTcompBitmapToObjNode cpbitmap -> node in let _CRcompText _channel container node [5 5] flag|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN w-26 h-10 text font [(make_rgb 0 0 0) nil nil nil] [(make_rgb 198 123 44) nil] [[w-16 0-5] OBJ_MH_FLEX|OBJ_LW_FLEX DessineSlideV 16 h [15 h-15 h]] nil -> texte in let _TOPobjNode _CONVERTcompTextToObjNode texte -> rien in ( _CBcompBitmapResizeResource cpbitmap @resizebitmaptext nil; _CBcompTextResizeResource texte @cbResize_Text nil nil nil; texte ) ;; /******************************************************************************* Function that add a state to the final bitmap of the button tmpBmp -> ObjBitmap : a temporary bitmap used for create the final alphabitmap hTmp -> I : the height of start for the _SCPbitmap function wBmp -> I : the weight of start of the state in the source bitmap hBmp -> I : the height of start of the state in the source bitmap w -> I : the weight of the final alphabitmap h -> I : the height of a state in the final alphabitmap (one fifth of the final alphabitmap for a 3 state button plus disable state and a mask <- nothing : *******************************************************************************/ fun AddBmp (tmpBmp, hTmp, wBmp, hBmp, w, h) = /* set the transparency color of the source file*/ let make_rgb 0 0 255 -> trans in let ButtonBmp -> Bmp in ( /* construction of a final bitmap with the elements of the file */ _SCPbitmap tmpBmp 0 hTmp 9 hTmp+9 Bmp wBmp hBmp wBmp+9 hBmp+9 trans; _SCPbitmap tmpBmp 9 hTmp w-10 hTmp+9 Bmp wBmp+10 hBmp wBmp+11 hBmp+9 trans; _SCPbitmap tmpBmp w-9 hTmp w hTmp+9 Bmp wBmp+12 hBmp wBmp+22 hBmp+9 trans; _SCPbitmap tmpBmp 0 hTmp+10 9 hTmp+h-10 Bmp wBmp hBmp+10 wBmp+9 hBmp+11 trans; _SCPbitmap tmpBmp 9 hTmp+10 w-10 hTmp+h-10 Bmp wBmp+10 hBmp+10 wBmp+11 hBmp+11 trans; _SCPbitmap tmpBmp w-9 hTmp+10 w hTmp+h-10 Bmp wBmp+12 hBmp+10 wBmp+22 hBmp+11 trans; _SCPbitmap tmpBmp 0 hTmp+h-9 9 hTmp+h Bmp wBmp hBmp+12 wBmp+9 hBmp+22 trans; _SCPbitmap tmpBmp 9 hTmp+h-9 w-10 hTmp+h Bmp wBmp+10 hBmp+12 wBmp+11 hBmp+22 trans; _SCPbitmap tmpBmp w-9 hTmp+h-9 w hTmp+h Bmp wBmp+12 hBmp+12 wBmp+22 hBmp+22 trans; ) ;; /******************************************************************************* Function that add a state to the final bitmap of the button tmpBmp8 -> ObjBitmap8 : a temporary bitmap8 used for create the final alphabitmap hTmp -> I : the height of start for the _SCPbitmap8 function wBmp -> I : the weight of start of the state in the source bitmap8 hBmp -> I : the height of start of the state in the source bitmap8 w -> I : the weight of the final alphabitmap h -> I : the height of a state in the final alphabitmap (one fifth of the final alphabitmap for a 3 state button plus disable state and a mask <- nothing : *******************************************************************************/ fun AddBmp8 (tmpBmp8, hTmp, wBmp, hBmp, w, h) = /* set the transparency color of the source file*/ let make_rgb 0 0 255 -> trans in let ButtonBmp8 -> Bmp8 in ( /* construction of a final bitmap with the elements of the file */ _SCPbitmap8 tmpBmp8 0 hTmp 9 hTmp+9 Bmp8 wBmp hBmp wBmp+9 hBmp+9 trans; _SCPbitmap8 tmpBmp8 9 hTmp w-10 hTmp+9 Bmp8 wBmp+10 hBmp wBmp+11 hBmp+9 trans; _SCPbitmap8 tmpBmp8 w-9 hTmp w hTmp+9 Bmp8 wBmp+12 hBmp wBmp+21 hBmp+9 trans; _SCPbitmap8 tmpBmp8 0 hTmp+10 9 hTmp+h-11 Bmp8 wBmp hBmp+10 wBmp+9 hBmp+11 trans; _SCPbitmap8 tmpBmp8 9 hTmp+10 w-10 hTmp+h-11 Bmp8 wBmp+10 hBmp+10 wBmp+11 hBmp+11 trans; _SCPbitmap8 tmpBmp8 w-9 hTmp+10 w hTmp+h-11 Bmp8 wBmp+12 hBmp+10 wBmp+21 hBmp+11 trans; _SCPbitmap8 tmpBmp8 0 hTmp+h-10 9 hTmp+h-1 Bmp8 wBmp hBmp+12 wBmp+9 hBmp+21 trans; _SCPbitmap8 tmpBmp8 9 hTmp+h-10 w-10 hTmp+h-1 Bmp8 wBmp+10 hBmp+12 wBmp+11 hBmp+21 trans; _SCPbitmap8 tmpBmp8 w-9 hTmp+h-10 w hTmp+h-1 Bmp8 wBmp+12 hBmp+12 wBmp+21 hBmp+21 trans; ) ;; /******************************************************************************* Function that create the button alphabitmap text -> S : the text written on the button w -> I : the weight of the button and the alphabitmap hght -> I : the height of the alphabitmap, 5 time the height of the button for a 3 states button plus disable state and a mask <- AlphaBitmap : the final AlphaBitmap of the button *******************************************************************************/ fun DrawRollOver (text, w, hght) = let hght/5 -> h in /* creation of the two destination bitmap */ let _CRbitmap _channel w 5*h -> tempBmp in let _CRbitmap8 _channel w 5*h -> tempBmp8 in ( AddBmp tempBmp 0 2 40 w h; AddBmp tempBmp h 25 40 w h; AddBmp tempBmp 2*h 48 40 w h; AddBmp tempBmp 3*h 2 88 w h; AddBmp tempBmp 4*h 25 88 w h; AddBmp8 tempBmp8 0 2 40 w h; AddBmp8 tempBmp8 h 25 40 w h; AddBmp8 tempBmp8 2*h 48 40 w h; AddBmp8 tempBmp8 3*h 2 88 w h; AddBmp8 tempBmp8 4*h 25 88 w h; let _GETstringSize Font text -> [wtxt htxt] in /* calculation of the position of the text */ let if w>wtxt then (w-wtxt)/2 else 0 -> xpos in let if h>htxt then (h-htxt)/2 else 0 -> ypos in ( /* draw of the text in the different state of the bitmap */ _DRAWtext tempBmp Font xpos ypos make_rgb 0 255 255 TD_TOP|TD_LEFT text; _DRAWtext tempBmp Font xpos ypos+h 0 TD_TOP|TD_LEFT text; _DRAWtext tempBmp Font xpos ypos+2*h 0 TD_TOP|TD_LEFT text; _DRAWtext tempBmp Font xpos ypos+3*h 0 TD_TOP|TD_LEFT text ); /* creation of the final alphabitmap */ let _CRalphaBitmap _channel tempBmp tempBmp8 make_rgb 255 255 255 make_rgb 0 0 0 -> alphaBmp in alphaBmp ) ;; fun CreateRollOverButton(container,x,y,flag,texte)= let 80 -> Width in let 20 -> Heigth in _CRcompRollOver _channel container nil [x y] flag OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOVE DrawRollOver texte Width 5*Heigth ;; /*********************************************************************************************/ /*********** EDITOR MANIPULATION *************/ /*********************************************************************************************/ /*renvoi une string décrivant le contenu d'un produit de manière formatée ...*/ fun getIndex (string) = let strlen string -> longueur in if (longueur) <= 0 then nil else let nth_char string longueur-1 -> last in let nth_char "," 0 -> virg in let nth_char "." 0 -> point in if (last == virg) || (last == point) then longueur-1 else getIndex substr string 0 longueur-1 ;; fun MkcompTextdisplay(list_attr, list) = /*Il faut éviter le name_index*/ if list == nil || list_attr ==nil then nil else let hd list -> elem in let hd list_attr -> nattr in let (getInfo Precision nattr) -> tmpPrec in if tmpPrec != nil then if (getIndex elem) !=nil then let substr elem 0 (getIndex elem)+(atoi tmpPrec)+1 -> telem in strcatn nattr::"\n"::telem::"\n\n"::(MkcompTextdisplay tl list_attr tl list)::nil else strcatn nattr::"\n"::elem::"\n\n"::(MkcompTextdisplay tl list_attr tl list)::nil else strcatn nattr::"\n"::elem::"\n\n"::(MkcompTextdisplay tl list_attr tl list)::nil ;; fun fillCompText(index) = let tl tl nth_list La_Liste_Produit index -> prod in /*Produit à afficher 2 tl pour éviter le name et la référence produit*/ let MkcompTextdisplay List_Attributs prod -> str in _SETcompText compedit_product_description str nil [nil nil nil nil] nil ;; /*********************************************************************************************/ /*********** EDITOR MANIPULATION: CLICK IN THE GLOBAL LIST OF PRODUCT *************/ /*********************************************************************************************/ fun getprodinfofromreference(ref,catalog_temp)= if catalog_temp==nil then nil else let hd catalog_temp -> [Scompteur productid reference name description sellingprice weight] in if (atoi reference)==ref then [Scompteur productid reference name description sellingprice weight] else getprodinfofromreference ref tl catalog_temp;; fun getprodinfofromindex(index,catalog_temp)= if catalog_temp==nil then nil else let hd catalog_temp -> [Scompteur productid reference name description sellingprice weight] in if (atoi Scompteur)==index then [Scompteur productid reference name description sellingprice weight] else getprodinfofromindex index tl catalog_temp;; /*********** DOUBLECLICK ON A PRODUCT IN PRODUCT LIST *************/ fun _DblclickProduct(list, param, index)= set productIndex = index; fillCompText index; DrawCont ListCont; /*let strbuild ("productid"::(getCurrentRef)::nil)::nil -> info in let strbuild ("action"::"doubleClickOnProductInList"::nil)::("object"::"product"::nil)::("info"::info::nil)::nil -> param in*/ let strbuild ((strcat "#" strcat Attr_Event "#")::(getCurrentRef)::nil)::("#SessionId#"::nil)::nil -> param in ( _DMSeventTag this "doubleClickOnProductInList" param nil nil );; /*********** CLICK ON A PRODUCT IN PRODUCT LIST *************/ fun _clickProduct(list, param, index)= set productIndex = index; fillCompText index; DrawCont ListCont; /*let strbuild ("productid"::(getCurrentRef)::nil)::nil -> info in let strbuild ("action"::"clickonproductinlist"::nil)::("object"::"product"::nil)::("info"::info::nil)::nil -> param in*/ /*let strbuild ("#"::Attr_Event::"#"::(getCurrentRef)::nil)::("#SessionId#"::nil)::nil -> param in*/ /*let strbuild ((linebuild ("#"::Attr_Event::"#"::(getCurrentRef)::nil))::nil)::("#SessionId#"::nil)::nil -> param in*/ let strbuild ((strcat "#" strcat Attr_Event "#")::(getCurrentRef)::nil)::("#SessionId#"::nil)::nil -> param in ( _DMSevent this "clickOnProductInList" param nil );; /*********************************************************************************************/ /*********** EDITOR MANIPULATION: CLICK IN THE LIST OF PRODUCT RELATIVE TO CATALOG *************/ /*********************************************************************************************/ fun listcompare(L1,L2)= if (hd L1)==nil then if (hd L2)==nil then 1 else 0 else if (hd L2)==nil then 0 else if (hd L1)==(hd L2) then listcompare (tl L1) (tl L2) else 0;; /*********************************************************************************************/ /*********** API2D PARAMETERS INITIALIZATION *************/ /*********************************************************************************************/ /*********** CONTAINERS SETTINGS *************/ /*parameters: left high corner, width, height, win, flags*/ fun CreateCont(x,y,w,h,win,flag,color,name)= let color->[red green blue] in ( /*_CRcontainerFromObjWin _channel win x y w h flag (make_rgb red green blue) name*/ _CRcontainerFromObjCont _channel win x y w h flag (make_rgb red green blue) name ) ;; /*********************************************************************************************/ /*********** WINDOWS SETTINGS AND GLOBAL API2D INITIALIZATION *************/ /*********************************************************************************************/ fun _quitter(cont,param)= _DScompRollOver PushCompRollOver; _DScompRollOver PushDblCompRollOver; _DScompList listProducts; _DSfont font; _DScontainer contproducts; _DScontainer contdescription; _DScontainer conthead; set PushCompRollOver = nil; set PushDblCompRollOver = nil; set listProducts = nil; set font = nil; set contproducts = nil; set contdescription = nil; set conthead = nil ;; fun _KeyDown(cont,param,key,keycode) = { let _GETcompListCount listProducts -> len in let len - 1 -> len in ( if key == 328 then /*Up*/ ( if productIndex-1 >= 0 then ( set productIndex=productIndex-1; _clickProduct nil nil productIndex; _SETcompListClicked listProducts productIndex; 0 ) else 0 ) else if key == 336 then /*Down*/ ( if productIndex+1 <= len then ( set productIndex=productIndex+1; _clickProduct nil nil productIndex; _SETcompListClicked listProducts productIndex; 0 ) else 0 ) else 0 ); _PAINTcontainer cont };; fun _KeyUp(cont,param,key) = { if key == 28 then /*Enter*/ ( _DblclickProduct nil nil productIndex; 0 ) else 0; _PAINTcontainer cont; };; fun cbReSize (tmp, iuy)= let tmp -> [_ x y w h] in let (itof w)/.(itof 24)->stepf in let (itof h)/.(itof 16)->stephf in let stepf/.(itof 5) -> ecartf in let stephf/.(itof 5) -> ecarthf in let ftoi stepf -> step in let ftoi ecartf -> ecart in let ftoi stephf -> steph in let ftoi ecarthf -> ecarth in let (step-ecart) -> h_button in let 2*step -> w_button in let h -> h_conthead in let w -> w_conthead in let ftoi ((itof w)/.(itof 3)) -> w_listtotal in let ftoi ((itof h)/.(itof 3)) -> h_listtotal in let w_listtotal-step ->w_list in let w_list ->w_text in let ftoi ((itof h)/.(itof 20)) ->nbitem in let 14 -> sizefont in let h/3 -> hprod in let h-hprod -> htext in let hprod - 25 -> hlist in ( _SIZEwindow win w h x y; _SIZEcontainer container x y w h; _SIZEcontainer contproducts 0 0 w hprod;/*Liste*/ _SIZEcontainer contdescription 0 hprod w htext /*Texte*/ ); 0 ;; fun InitAPI()= if win != nil then (_SHOWwindow win WINDOW_UNHIDDEN;0) else ( let _DMSgetZone this "DBDisplay" nil @cbReSize nil -> [wn x y w h] in let if wn ==nil then [_CRwindow _channel nil 0 0 300 400 WN_MENU|WN_MINBOX|WN_SIZEBOX "DBDisplay" 0 0 300 400] else [_CRwindow _channel wn x y w h WN_CHILDINSIDE|WN_NOBORDER "" x y w h] -> [wn x y w h] in let (itof w)/.(itof 24)->stepf in let (itof h)/.(itof 16)->stephf in let stepf/.(itof 5) -> ecartf in let stephf/.(itof 5) -> ecarthf in let ftoi stepf -> step in let ftoi ecartf -> ecart in let ftoi stephf -> steph in let ftoi ecarthf -> ecarth in let (step-ecart) -> h_button in let 2*step -> w_button in let h -> h_conthead in let w -> w_conthead in let ftoi ((itof w)/.(itof 3)) -> w_listtotal in let ftoi ((itof h)/.(itof 3)) -> h_listtotal in let w_listtotal-step ->w_list in let w_list ->w_text in let ftoi ((itof h)/.(itof 20)) ->nbitem in let 14 -> sizefont in ( let _DMSgetpath _DMSgetClass this -> tmpchemin in ( let _GETalphaBitmaps _LDalphaBitmap _channel _checkpack strcat tmpchemin "resources/Lifts.png" -> [tmpBmp tmpBmp8] in ( set SlideBmp = tmpBmp; set SlideBmp8 = tmpBmp8 ); let _GETalphaBitmaps _LDalphaBitmap _channel _checkpack strcat tmpchemin "resources/listframe.png" -> [tmpBmp tmpBmp8] in ( set ListBmp = tmpBmp; set ListBmp8 = tmpBmp8 ); let _GETalphaBitmaps _LDalphaBitmap _channel _checkpack strcat tmpchemin "resources/buttons.png" -> [tmpBmp tmpBmp8] in ( set ButtonBmp = tmpBmp; set ButtonBmp8 = tmpBmp8 ) ); set win=wn; set Step=step; set Steph=steph; set font = _CRfont _channel sizefont 0 FF_WEIGHT "Arial"; set color=[158 158 158]; set flagtext= OBJ_VISIBLE|OBJ_ENABLE|CT_LABEL; set flagedittext= OBJ_VISIBLE|OBJ_ENABLE|CT_EDITLINE|CT_LABEL; set flagmultiedittext= OBJ_VISIBLE|CT_MULTIEDITLINE|CT_WORDWRAP|CT_LEFT|OBJ_DISABLE; set flagrollover=ROL_MASK|OBJ_ENABLE|OBJ_HIDE|ROL_DISABLE; set container = _CRcontainerFromObjWin _channel win x y w h CO_CHILDINSIDE|CO_NOBORDER|CO_NOCAPTION (make_rgb 158 158 158) ""; set font=_CRfont _channel sizefont 0 0 "Arial"; let h/3 -> hprod in let h-hprod -> htext in let hprod - 25 -> hlist in ( set contproducts= CreateCont 0 0 w hprod container CO_CHILDINSIDE|CO_NOBORDER color "Products List"; set listProducts= CreateList contproducts 5 25 (w-15) (h_listtotal-steph) 0 0 /*(200-30) 30*/; set contdescription= CreateCont 0 hprod w htext container CO_CHILDINSIDE|CO_NOBORDER color "Product Description"; set compedit_product_description = CreateText contdescription 5 5 (w-15) (htext-10) flagmultiedittext (_loc this "KW_NO_SEL_P" nil) ); /* set contdescription=CreateCont 2*ecart (h_listtotal+steph+ecart+2*ecart) (w-4*ecart) (h-(h_listtotal+steph+ecart+4*ecart)) container CO_CHILDINSIDE|CO_NOBORDER color "Product Description";*/ set PushCompRollOver=CreateRollOverButton contproducts 5 2 flagrollover (_loc this "KW_PUSH" nil); set PushNode = _CONVERTcompRollOverToObjNode PushCompRollOver; _CBcompRollOverClick PushCompRollOver @_PushProduct nil; set PushDblCompRollOver=CreateRollOverButton contproducts 90 2 flagrollover (_loc this "KW_PUSHDBL" nil); set PushDblNode = _CONVERTcompRollOverToObjNode PushDblCompRollOver; _CBcompRollOverClick PushDblCompRollOver @_PushDblProduct nil; /* _CBcontainerSize container */ _CBcontainerPreDestroy container @_quitter nil; _CBcompListClick listProducts @_clickProduct nil; _CBcompListDblClick listProducts @_DblclickProduct nil; _CBcontainerKeyDown contproducts @_KeyDown nil; _CBcontainerKeyUp contproducts @_KeyUp nil; set ListCont=container::container::contdescription::contproducts::nil ); DrawCont ListCont; /*_fooS "Fin InitAPI";*/ 0 );; fun setproductIndexfromref(id, list, ind) = { if list ==nil then nil else let hd tl hd list -> prodid in/*La référence est le deuxième élément*/ if !strcmp prodid id then ind else setproductIndexfromref id tl list ind+1 };; /*********************************************************************************************/ /*************** EXTERNAL COMMUNICATIONS ***************************/ /*********************************************************************************************/ fun activate(from,action,param,reply)= if !strcmp action "clickOnProductInList" then let strextr param ->Lparam in let setproductIndexfromref hd tl hd Lparam La_Liste_Produit 0 -> index in ( _SETcompListClicked listProducts index; _clickProduct listProducts nil index; DrawCont ListCont; 0 ) else if !strcmp action "doubleClickOnProductInList" then /* let setproductIndexfromref param La_Liste_Produit 0 -> index in*/ let strextr param ->Lparam in let setproductIndexfromref hd tl hd Lparam La_Liste_Produit 0 -> index in ( _SETcompListClicked listProducts index; _DblclickProduct listProducts nil index; DrawCont ListCont; 0 ) else if !strcmp action "clickOnProductInShelves" then let strextr param ->Lparam in let setproductIndexfromref hd tl hd Lparam La_Liste_Produit 0 -> index in ( _SETcompListClicked listProducts index; _clickProduct listProducts nil index; DrawCont ListCont; 0 ) else if !strcmp action "doubleClickOnProductInShelves" then let strextr param ->Lparam in let setproductIndexfromref hd tl hd Lparam La_Liste_Produit 0 -> index in ( _SETcompListClicked listProducts index; _DblclickProduct listProducts nil index; DrawCont ListCont; 0 ) else if !strcmp action "hide" then ( /*_fooS "HIDE";*/ _CHANGEobjNodeFlags PushNode OBJ_HIDE 1; _CHANGEobjNodeFlags PushDblNode OBJ_HIDE 1; _SHOWwindow win WINDOW_HIDDEN; 0 ) else 1 ;; /*********************************************************************************************/ /*************** MODULE INSTANCE INITIALIZATION ***************************/ /*********************************************************************************************/ fun __showAdmin() = InitAPI; _SHOWwindow win WINDOW_UNHIDDEN; DrawCont ListCont; _CHANGEobjNodeFlags PushNode OBJ_VISIBLE|OBJ_ENABLE 1; _CHANGEobjNodeFlags PushDblNode OBJ_VISIBLE|OBJ_ENABLE 1; _DMSsend this CqueryProduct []; 0 ;; fun __showUser() = InitAPI; _SHOWwindow win WINDOW_UNHIDDEN; DrawCont ListCont; _CHANGEobjNodeFlags PushNode OBJ_HIDE 1; _CHANGEobjNodeFlags PushDblNode OBJ_HIDE 1; _DMSsend this CqueryProduct []; 0 ;; fun __refreshfromDB()= _DMSsend this CqueryProduct [];; fun logout()= _quitter nil nil; _DMSeventTag this "out" nil nil nil;; fun IniDMI(param)= set Precision = strextr param; _DMSregisterDMI this @activate @logout; _DMSeventTag this "in" nil nil nil; 0;; /*********************************************************************************************/ /*************** INTERNAL COMMUNICATIONS CALLBACKS ***************************/ /*******************************************************************************************/ fun listlength(l)= if l==nil then 0 else let l->[_ n] in 1+listlength n;; /*********************************************************************************************/ /*************** INTERNAL COMMUNICATIONS CALLBACKS FOR DB REQUEST ***********************/ /*******************************************************************************************/ fun fillcomplist(cplist, list, ind) = { if list == nil then 0 else let hd hd list -> tmp in ( _ADDcompList cplist ind [tmp nil]; _SETcompListClicked cplist ind; set productIndex=ind; fillcomplist cplist tl list ind+1; 0 ) };; fun __reponseFill(res,Type,raz)= { if Type == PRODUCT then ( if raz!=RAZ then ( set COMPTEUR = listlength products; 1 ) else ( _RSTcompList listProducts; set products=nil; set currentproducts=nil; set COMPTEUR=0; 0 ); set La_Liste_Produit = (strextr res); fillcomplist listProducts La_Liste_Produit 0; let _GETcompListClicked listProducts -> [ind [nom _]] in fillCompText ind; DrawCont ListCont; 0 ) else 0 };; fun findName(list, tofind, ind) = /*Renvoi nil si l'élément n'est pas présent et l'index de la liste qui le contient*/ if list == nil then nil else let hd list -> tmp in if !strcmp (hd tmp) tofind then ind else findName tl list tofind ind+1 ;; fun VIDE (liste) = if liste ==nil then nil else if !strcmp (hd liste) (_loc this "DB_VIDE" nil) then VIDE tl liste else (hd liste)::(VIDE tl liste) ;; /*Initialise la liste des attributs à afficher dans DBdisplay*/ fun __setAttributes(list_attr, event) = { /* _fooS strcat "§§§§§\n" list_attr;*/ set List_Attributs = VIDE lineextr list_attr; set Attr_Event = hd hd strextr event /* let findName List_Attributs "name" 0 -> tmp in if tmp == nil then set indexName = 0 else set indexName = tmp*/ };; fun __ErrorDB (message) = _DLGMessageBox _channel win (_loc this "KW_ERRORDB" nil) message 0 ;;