/******************************************* Module DBeditor Client Version: 1.0 Author: Thierry LEFORT Last update: 05/28/2001 *******************************************/ /********** COMMUNICATION *******************/ defcom CModifyDBline=ModifyDBline S;; defcom CNewDBline=NewDBline S;; defcom CDelDBlines=DelDBlines S S;; /*This is used to get the table that can be read*/ defcom CqueryTable = queryTable ;; defcom CqueryMaxId = queryMaxId ;; defcom CcancelDBtransact = cancelDBtransact ;; defcom CSELECTquery = SELECTquery S ;; defcom Cquit = quit ;; /********** API 2D *******************/ typeof listeColumns = [[S r1] r1] ;; typeof MultiListe = ObjListTab ;; typeof WINDOW = ObjWin ;; typeof PopUpWindow = ObjWin ;; typeof contTop = ObjContainer ;; typeof contDown = ObjContainer ;; typeof tooltipContTop = ObjContainer ;; typeof tooltipTextTop = CompText ;; typeof tooltipContDown = ObjContainer ;; typeof tooltipTextDown = CompText ;; /* Tampon dans lequel on stocke les segments de messages déjà reçus */ typeof TempSendParam = S;; typeof Bmp = ObjBitmap ;; /* source bitmap for the button */ typeof Bmp8 = ObjBitmap8 ;; /* source bitmap8 fot the button */ typeof BmpText = ObjBitmap ;; /* source bitmap for the Slide Text*/ typeof Bmp8Text = ObjBitmap8 ;; /* source bitmap for the Slide Text*/ typeof listsel = [I r1] ;; typeof currentSel = [I r1] ;; typeof ModifiedElem = I ;; typeof Table = S ;; typeof CurrentBitmap = ObjBitmap ;; typeof ListPopUp = [[S S S ObjText] r1];; typeof font=ObjFont;; typeof color=[I I I];; typeof flagtext=I;; typeof flagedittext=I;; typeof flagmultiedittext=I;; typeof flagrollover=I;; typeof SELECTREQ = S ;; typeof conthead=ObjContainer;; typeof contpopup=ObjContainer;; typeof ListCont=[ObjContainer r1];; typeof listProducts=CompList;; typeof OkCompRollOver =CompRollOver ;; typeof CancelCompRollOver =CompRollOver ;; typeof AddCompRollOver =CompRollOver ;; typeof ModifyCompRollOver =CompRollOver ;; typeof DelCompRollOver =CompRollOver ;; typeof LoadSQLCompRollOver =CompRollOver ;; typeof RefreshCompRollOver =CompRollOver ;; typeof list_lines = [[S r1] r1];; typeof List_Attributs = [[S r1] r1];; typeof La_Liste_Produit = [[S r1] r1];; typeof supIndex =I;; typeof modif_line =I;; typeof List_compText = [[S S S CompText CompText] r1];; typeof ListViewIndex = I;; typeof productid_Modif = S;; typeof newAddLigne = [S r1];; /*proto Delprodfromindex=fun [I [[S S S S S S S] r1] I] [[S S S S S S S] r1];;*/ /********** PRODUCTS *******************/ typeof products=[[S S S S S S S] r1];; typeof currentproducts=[S S S S S S S];; var FULLACCESS = 0 ;; var READONLY = 1 ;; var NOACCESS = 2 ;; var KEY = 3 ;; var MessageMaxSize = 8192;;/*Taille du paquet limité à 10ko*/ var ADDLINE = 0 ;; var MODLINE = 1 ;; 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;; var VMax = 5;; fun icomp( i1, i2) = i1==i2 ;; fun mklist_tuple (list, res) = { if list ==nil then res else mklist_tuple (tl list) (listcat res [hd list nil]::nil) };; fun DrawCont(Lcontainer)= if Lcontainer==nil then 1 else ( _PAINTcontainer _SHOWcontainer (hd Lcontainer) CONTAINER_UNHIDDEN; DrawCont tl Lcontainer);; fun getRealSize (liste_text, font, taille, haut) = if liste_text ==nil then [taille haut] else let hd liste_text -> line in let linebuild line -> texte in let _GETstringSize font texte -> [tailleTexte hautTexte] in let if tailleTexte > taille then tailleTexte else taille -> tmpTaille in let if hautTexte > haut then hautTexte else haut -> tmpHaut in getRealSize tl liste_text font tmpTaille tmpHaut ;; fun _SHOWtooltip (ON, param, text, xi, yi) = let param -> [font cont compText] in ( let strextr text -> liste in let getRealSize liste font 0 0 -> [long tmp] in let (listlength liste)*tmp -> haut in ( _SIZEcontainer cont xi yi long haut; _SIZEobjNode _CONVERTcompTextToObjNode compText long haut 0 ); _SETcompText compText text font [0 0 0 0] CT_NOCHANGE; _PAINTcontainer _SHOWcontainer cont CONTAINER_UNHIDDEN ) ;; fun _HIDEtooltip (ON, cont, text) = _PAINTcontainer _SHOWcontainer cont CONTAINER_HIDDEN ;; fun ToolTip (ON , text , font, cont, compText) = _CRtoolTip ON 100 text @_SHOWtooltip [font cont compText]/*paramShow*/ @_HIDEtooltip cont /*paramHide*/ ;; /******************************************************************************* 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 ( /* 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 ( /* 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 70 -> 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 *************/ /*********************************************************************************************/ fun list_from_to (list, deb, fin) = { if deb > fin then nil else (nth_list list deb)::(list_from_to list deb+1 fin) };; fun RSTtext (list) = { if list == nil then 0 else ( let hd list -> [_ _ _ label text] in ( 0/*GRAPHICDRESSING_DScompText label; GRAPHICDRESSING_DScompText text*/ ); RSTtext tl list ) };; fun RSTlistText(listText) = { if listText ==nil then 0 else ( let hd listText -> [_ _ _ _ LeCompText] in _SETcompText LeCompText "" nil nil nil; RSTlistText tl listText; 0 ) };; fun SetTextFromList (AjouText, listCompText) = { if AjouText==nil || listCompText ==nil then 0 else ( let hd AjouText -> text in let hd listCompText -> [_ _ _ _ LeCompText] in _SETcompText LeCompText text nil nil nil; SetTextFromList tl AjouText tl listCompText; 0 ) };; fun GetTextTypeFromList (listText) = /*Prend un liste de tuple [Mot_clef Nom Type label comptext] et renvoi la liste des contenus des (type comptext)*/ { if listText == nil then nil else ( let hd listText -> debut in let debut -> [_ _ type _ texto] in (type::(_GETcompText texto)::nil)::(GetTextTypeFromList tl listText) ) };; fun GetTextFromList (listText) = /*Prend un liste de tuple [Mot_clef Nom Type label comptext] et renvoi la liste des contenus des comptext*/ { if listText == nil then nil else ( let hd listText -> debut in let debut -> [_ _ _ _ texto] in (_GETcompText texto)::(GetTextFromList tl listText) ) };; fun CreateListText (win, x, y,largeur, list, type) = /* Prend en entrée list : la liste des attributs et renvoi une liste de Tuple [label corps]*/ { if list == nil then nil else let hd list -> Attribut in let hd Attribut -> Nom in let hd tl Attribut -> Type in let hd tl tl Attribut -> cle in let largeur/3 -> Llabel in let Llabel*2-5 -> Ltext in let 25 -> step in ( if Nom == nil || (!strcmp Nom "") then nil else ( let _CRtext _channel win x y Llabel step ET_ALIGN_LEFT strcat Nom " :" -> label in ( if (!strcmp Type "SQL_BIGINT") || (!strcmp Type "SQL_BIT") || (!strcmp Type "SQL_DECIMAL") || (!strcmp Type "SQL_DOUBLE") || (!strcmp Type "SQL_FLOAT") || (!strcmp Type "SQL_INTEGER") || (!strcmp Type "SQL_NUMERIC") || (!strcmp Type "SQL_REAL") || (!strcmp Type "SQL_SMALLINT") || (!strcmp Type "SQL_TINYINT") then ( if ((atoi cle) == KEY) && type != -1 then let _CRtext _channel win x+Llabel y Ltext step ET_ALIGN_LEFT itoa type -> otext in [Nom Type cle otext]::(CreateListText win x y+step largeur tl list type) else if ( ((atoi cle) == READONLY) || ((atoi cle) == KEY) ) && type == -1 then let _CRtext _channel win x+Llabel y Ltext step ET_ALIGN_LEFT "" -> otext in [Nom Type cle otext]::(CreateListText win x y+step largeur tl list type) else let _CReditLine _channel win x+Llabel y Ltext step ET_BORDER|ET_TABFOCUS "" -> otext in [Nom Type cle otext]::(CreateListText win x y+step largeur tl list type) ) else if (!strcmp Type "SQL_DATE") || (!strcmp Type "SQL_TIME") || (!strcmp Type "SQL_TIMESTAMP") || (!strcmp Type "SQL_CHAR") /*Pour ces types là je n'ai pas prévu de limite de caractères*/ then ( if ( ((atoi cle) == KEY) || ((atoi cle) == READONLY) ) && type == -1 then let _CRtext _channel win x+Llabel y Ltext step ET_ALIGN_LEFT "" -> otext in [Nom Type cle otext]::(CreateListText win x y+step largeur tl list type) else let _CReditLine _channel win x+Llabel y Ltext step ET_BORDER|ET_TABFOCUS "" -> otext in [Nom Type cle otext]::(CreateListText win x y+step largeur tl list type) ) else if (!strcmp Type "SQL_VARCHAR") then ( if ( ((atoi cle) == KEY) || ((atoi cle) == READONLY) ) && type == -1 then let _CRtext _channel win x+Llabel y Ltext 2*step ET_ALIGN_LEFT "" -> otext in [Nom Type cle otext]::(CreateListText win x y+2*step largeur tl list type) else let _CReditText _channel win x+Llabel y Ltext 2*step ET_BORDER|ET_TABFOCUS|ET_VSCROLL "" -> otext in [Nom Type cle otext]::(CreateListText win x y+2*step largeur tl list type) ) else ( if ( ((atoi cle) == KEY) || ((atoi cle) == READONLY) ) && type == -1 then ( let _CRtext _channel win x+Llabel y Ltext 5*step ET_BORDER|ET_ALIGN_LEFT|ET_VSCROLL "" -> otext in [Nom Type cle otext]::(CreateListText win x y+5*step largeur tl list type) ) else let _CReditText _channel win x+Llabel y Ltext 5*step ET_BORDER|ET_TABFOCUS|ET_VSCROLL "" -> otext in [Nom Type cle otext]::(CreateListText win x y+5*step largeur tl list type) ) ) ) ) };; /*********************************************************************************************/ /*********** EDITOR MANIPULATION: CLICK IN THE GLOBAL LIST OF PRODUCT *************/ /*********************************************************************************************/ /*********** DOUBLECLICK ON A PRODUCT IN PRODUCT LIST *************/ fun _DblclickProduct(complist,param,index)= set productIndex=index ;; /*********** CLICK ON BUTTONS NEW, OK, DEL PRODUCTS FROM PRODUCT LIST *************/ fun getKey (list, ind) = if list == nil then nil else let hd list -> head in let hd head -> name in let hd tl tl head -> tmp in if (atoi tmp) == KEY then [name ind] else getKey tl list ind+1 ;; fun getInList (list, ind)= if list == nil then nil else if ind == 0 then hd list else getInList tl list ind-1 ;; fun getListID (list, ind, listsel)= if listsel ==nil then nil else let hd listsel -> tete in (getInList (getInList list tete) ind)::(getListID list ind tl listsel) ;; fun _OkSup (MsgBox, param, rep)= if rep == 1 then let getKey listeColumns 0 -> [name ind] in _DMSsend this CDelDBlines [name (linebuild getListID list_lines ind listsel)] else 0 ;; fun _DelProduct(object,param,posx,posy,tn,mask)= set currentSel = listsel; let listlength listsel -> tmp in _DLGrflmessage _DLGMessageBox _channel WINDOW (_loc this "KW_DEL_POPUP_TITLE" nil) strcatn (_loc this "KW_DEL_POPUP_LABEL1" nil)::" "::(itoa tmp)::" "::(_loc this "KW_DEL_POPUP_LABEL2" nil)::nil 2 @_OkSup nil ;; fun _DestroyPopUp (win, param) = _DSwindow PopUpWindow; set PopUpWindow =nil ;; fun getATTR (list) = if list == nil then nil else let hd list -> attr in let attr -> [nom type _ contenu] in (nom::type::(_GETtext contenu)::nil)::(getATTR tl list)/*Convert tuple : [S S S ObjText] in SR1R1 and ready to send for Insert or UpDate*/ ;; fun _OkModif (Bttn, param)= let getATTR param -> list in _DMSsend this CModifyDBline [strbuild list] ;; fun _OkAdd (Bttn, param)= let getATTR param -> list in _DMSsend this CNewDBline [strbuild list] ;; fun _CancelPopUp (Bttn, param)= _DMSsend this CcancelDBtransact nil; _DestroyPopUp PopUpWindow nil ;; fun GetPoPupAttr(list, h)= /*Elle prend la liste des attributs en paramètres, la largeur d'un ensemble label comptext et la hauteur maximale souhaité*/ { if list==nil then h else ( let 25 -> step in let hd list -> tmp in let ( if (!strcmp (hd tl tmp) "SQL_VARCHAR") then step*2 else ( if (!strcmp (hd tl tmp) "SQL_LONGVARCHAR") then step*5 else step)) -> hplus in GetPoPupAttr tl list h+hplus ) };; fun CRPOPUPWIN (type) = /*Création de la pop-up qui va recevoir les infos : Ajouter et Modifier*/ let 25 -> step in let 600 -> HwinPopUp in let (GetPoPupAttr listeColumns 0)+step+10 -> VwinPopUp in let _CRscrollWindow _channel WINDOW 100 100 600 600 HwinPopUp VwinPopUp WN_SIZEBOX|WN_HSCROLL|WN_VSCROLL|WN_MENU (_loc this "KW_POPUP_TITLE" nil) -> [RealWin VirtualWin] in ( _CBwinDestroy set PopUpWindow = RealWin @_DestroyPopUp nil; let CreateListText VirtualWin 0 0 HwinPopUp listeColumns type -> list in let 50 -> Lbtn in ( set ListPopUp = list; let _CRbutton _channel VirtualWin HwinPopUp/2-Lbtn-5 VwinPopUp-step-5 Lbtn step PB_DEFAULT (_loc this "KW_OK" nil) -> BtnOk in let _CBbutton _CRbutton _channel VirtualWin HwinPopUp/2+Lbtn+5 VwinPopUp-step-5 Lbtn step nil (_loc this "KW_CANCEL" nil) @_CancelPopUp nil -> BtnCancel in ( if type == -1 then _CBbutton BtnOk @_OkModif list else _CBbutton BtnOk @_OkAdd list ) ) ) ;; fun _AddProduct(object,param,posx,posy,tn,mask)= _DMSsend this CqueryMaxId [] ;; /*fill a line with a Sr1*/ fun fill_Line (theListe, listSR1, column, line, type) = if listSR1 == nil then 1 else ( if type == 1 then _ADDlistTabItem theListe line column hd listSR1 else _SETlistTabItem theListe line column hd listSR1; fill_Line theListe tl listSR1 column+1 line 0; 0 ) ;; /*Fill the ListTab with a Sr1r1*/ fun fill_Multi_Liste (TheListe, listSR1R1, column, line, type) = if listSR1R1 == nil then 1 else ( fill_Line TheListe hd listSR1R1 column line type; fill_Multi_Liste TheListe tl listSR1R1 column line+1 type; 0 ) ;; fun SETListeProduitsModif (list, id, list_modif) = { if list==nil then nil else ( let hd hd list -> tmpid in if id == atoi tmpid then (tmpid::list_modif)::(SETListeProduitsModif tl list id list_modif) else (hd list)::(SETListeProduitsModif tl list id list_modif) ) };; fun returnValue (list, value) = if (list == nil) then nil else if (value == 0) then hd list else returnValue tl list value-1 ;; fun fillPopUp (list, listelem) = if list ==nil then 1 else let hd list -> tmp in let tmp -> [_ _ _ oText] in let hd listelem -> elem in ( _SETtext oText elem; fillPopUp tl list tl listelem; 0 ) ;; fun _ModifyProduct(object,param,posx,posy,tn,mask)= if listsel != nil then ( CRPOPUPWIN -1; let hd listsel -> elem in let returnValue list_lines elem -> ModifElem in ( set ModifiedElem = elem; fillPopUp ListPopUp ModifElem ) ) else 0 ;; /*Double click in multiliste*/ fun _DbClickMListe (multiliste, param, ind, x1)= _ModifyProduct nil nil nil nil nil nil ;; fun getColumns (list) = if list ==nil then nil else (hd hd list)::(getColumns tl list) ;; fun receiveSQLreq(param, others) = set SELECTREQ = param; _DMSsend this CSELECTquery [param]; 0 ;; fun __MiseAjour()= if (!strcmp SELECTREQ "") || (SELECTREQ ==nil) then let linebuild Table::(getColumns listeColumns) -> tmp in _DMSeventTag this "querySQL" tmp nil [@receiveSQLreq 0 20000] else _DMSsend this CSELECTquery [SELECTREQ] ;; /*Callback on download event*/ fun _LoadSQL (object,param,posx,posy,tn,mask)= let linebuild Table::(getColumns listeColumns) -> tmp in _DMSeventTag this "querySQL" tmp nil [@receiveSQLreq 0 20000] ;; /*Callback on refresh button event*/ fun _RefreshProduct (object,param,posx,posy,tn,mask)= _DMSeventTag this "refresh" nil nil nil ;; /*********************************************************************************************/ /*********** WINDOWS SETTINGS AND GLOBAL API2D INITIALIZATION *************/ /*********************************************************************************************/ fun _quitter(cont,param)= /* _DMSsend this Cquit [];*/ _DMSeventTag this "hidden" nil nil nil; _DSwindow WINDOW; set WINDOW = nil ;; /*Fill the columns of the Multiliste*/ fun FillColumns (list, ind) = if list == nil then 1 else ( _ADDlistTabColumn MultiListe ind 100 ET_ALIGN_LEFT hd hd list; FillColumns tl list ind+1; 0 ) ;; fun multi_select ( list, int) = if is_in_list list int then removef_from_list list @icomp int else int::list ;; fun addSel (ind, list) = if is_in_list list ind then list else ind::list ;; fun shiftSelMaj (deb, fin, list) = if deb > fin then list else shiftSelMaj deb+1 fin addSel deb list ;; fun shiftSelInf (deb, fin, list) = if deb < fin then list else shiftSelInf deb-1 fin addSel deb list ;; fun _SelectMListe (Liste, param, i1) = set listsel = if i1 != -1 then /*Control*/ if _keybdstate == 2 then multi_select listsel i1 else /*Shift*/ if _keybdstate == 1 then ( let hd listsel -> lastone in ( set listsel = nil; if lastone <= i1 then shiftSelMaj lastone i1 listsel else shiftSelInf lastone i1 listsel ) ) else i1::nil else nil ;; fun _reSize(win, param, width, heigth)= let if width > 600 then width else 600 -> largeur in let if heigth > 400 then heigth else 400 -> hauteur in if (heigth < 400) || (width < 600) then ( _SIZEwindow WINDOW largeur hauteur nil nil ; 0 ) else ( _SIZElistTab MultiListe largeur hauteur-80 0 40; _SIZEcontainer contTop 0 0 largeur 38; _SIZEcontainer contDown 0 hauteur-40 largeur 40; 0 ) ;; fun InitAPI()= if WINDOW != nil then _SHOWwindow WINDOW WINDOW_UNHIDDEN else ( set font = _CRfont _channel 14 0 0 "Arial"; let 10 -> coord1_x in let 215 -> coord2_x in let 400 -> h_conthead in let 600 -> w_conthead in let 30 -> hbarre in let 10 -> marge in let 300 -> hlist in let 100 -> Xinit in let 100 -> Yinit in let 600 -> WinW in /*Width*/ let 400 -> WinH in /*Height*/ let 40 -> ZbtnH in /*Height for buttuns*/ let 10 -> step in let 20 -> h_button in let 70 -> w_button in let OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK -> flagrollover in let (make_rgb 15 34 139) -> colorCont in let (make_rgb 37 131 185) -> colorTooltip in let (make_rgb 255 255 255) -> colorTooltipText in let 5 -> step in ( let _DMSgetpath _DMSgetClass this -> tmpchemin in let _GETalphaBitmaps _LDalphaBitmap _channel _checkpack strcat tmpchemin "resources/buttons.png" -> [tmpBmp tmpBmp8] in ( set Bmp = tmpBmp; set Bmp8 = tmpBmp8 ); /*La fenetre mère*/ set WINDOW = _CRwindow _channel nil Xinit Yinit WinW WinH WN_MENU|WN_SIZEBOX|WN_MINBOX|WN_MAXBOX "DBEditor" ; /*Container en haut*/ set contTop = _CRcontainerFromObjWin _channel WINDOW 0 0 WinW ZbtnH-2 CO_CHILDINSIDE|CO_NOBORDER colorCont ""; set AddCompRollOver = CreateRollOverButton contTop marge step flagrollover (_loc this "KW_ADD" nil) ; set ModifyCompRollOver = CreateRollOverButton contTop (w_button+2*marge) step flagrollover (_loc this "KW_EDIT" nil) ; set DelCompRollOver = CreateRollOverButton contTop 2*w_button+3*marge step flagrollover (_loc this "KW_REMOVE" nil) ; set tooltipContTop = _CRcontainerFromObjCont _channel contTop 0 0 1 1/*0 0 <--- SINON BUG Lib2D!!*/ CO_NOCAPTION|CO_HIDE colorTooltip ""; set tooltipTextTop = _CRcompText _channel tooltipContTop nil [0 0] OBJ_VISIBLE|CT_LEFT|CT_LABEL|CT_MULTIEDITLINE|CT_WORDWRAP nil 50 30 "essai" font [colorTooltipText 0 0 0] nil nil nil; let _CONVERTcompRollOverToObjNode AddCompRollOver -> AddCompRollOverON in ToolTip AddCompRollOverON (_loc this "KW_ADD_TOOLTIP" nil) font tooltipContTop tooltipTextTop; let _CONVERTcompRollOverToObjNode DelCompRollOver -> DelCompRollOverON in ToolTip DelCompRollOverON (_loc this "KW_DEL_TOOLTIP" nil) font tooltipContTop tooltipTextTop; let _CONVERTcompRollOverToObjNode ModifyCompRollOver -> ModifyCompRollOverON in ToolTip ModifyCompRollOverON (_loc this "KW_EDIT_TOOLTIP" nil) font tooltipContTop tooltipTextTop; /*Container en bas*/ set contDown = _CRcontainerFromObjWin _channel WINDOW 0 WinH-ZbtnH WinW ZbtnH-2 CO_CHILDINSIDE|CO_NOBORDER colorCont ""; set RefreshCompRollOver = CreateRollOverButton contDown marge step flagrollover (_loc this "KW_REFRESH" nil) ; set LoadSQLCompRollOver = CreateRollOverButton contDown (w_button+2*marge) step flagrollover (_loc this "KW_LOADSQL" nil) ; set tooltipContDown = _CRcontainerFromObjCont _channel contDown 0 0 50 30 CO_NOCAPTION|CO_HIDE colorTooltip ""; set tooltipTextDown = _CRcompText _channel tooltipContDown nil [0 0] OBJ_VISIBLE|CT_LEFT|CT_LABEL|CT_MULTIEDITLINE|CT_WORDWRAP nil 50 30 "essai" font [colorTooltipText 0 0 0] nil nil nil; let _CONVERTcompRollOverToObjNode RefreshCompRollOver -> RefreshCompRollOverON in ToolTip RefreshCompRollOverON (_loc this "KW_REFRESH_TOOLTIP" nil) font tooltipContDown tooltipTextDown; let _CONVERTcompRollOverToObjNode LoadSQLCompRollOver -> LoadSQLCompRollOverON in ToolTip LoadSQLCompRollOverON (_loc this "KW_LOAD_TOOLTIP" nil) font tooltipContDown tooltipTextDown; /*Multi_Liste des attributs*/ set MultiListe = _CRlistTab _channel WINDOW step ZbtnH WinW-2*step WinH-2*ZbtnH LV_BORDER; FillColumns listeColumns 0; set ListCont=contTop::contDown::nil ); _CBlistTabSelect MultiListe @_SelectMListe nil ; _CBlistTabDClick MultiListe @_DbClickMListe nil ; _CBwinClose WINDOW @_quitter nil; _CBwinDestroy WINDOW @_quitter nil; _CBwinSize WINDOW @_reSize nil; _CBcompRollOverClick DelCompRollOver @_DelProduct nil; _CBcompRollOverClick AddCompRollOver @_AddProduct nil; _CBcompRollOverClick ModifyCompRollOver @_ModifyProduct nil; _CBcompRollOverClick LoadSQLCompRollOver @_LoadSQL nil; _CBcompRollOverClick RefreshCompRollOver @_RefreshProduct nil; _PAINTwindow _SHOWwindow WINDOW WINDOW_UNHIDDEN ); _DMSeventTag this "shown" nil nil nil; DrawCont ListCont ;; fun mkProdSend(prod, list_attr)= /*fonction qui prend un produit arriver le l'importation et colle à chacun des nouveaux élément du produit le type SQL lui correspondant.*/ if prod ==nil || list_attr==nil then nil else ( let hd prod -> attr in let hd tl tl hd list_attr -> typeSQL in /*L'ordre de la liste des attributs est supposé être dans le même que les attributs dans la requète SQL donné dans DBrequestBuilder*/ (typeSQL::attr::nil)::(mkProdSend tl prod tl list_attr) ) ;; /*********************************************************************************************/ /*************** MODULE INSTANCE INITIALIZATION ***************************/ /*********************************************************************************************/ fun __refreshfromDB()= 0 ;; /*Initialise la liste des attributs à afficher dans productDBeditor*/ fun __setAttributes(list_attr) = { set List_Attributs = strextr list_attr };; /******************************************************************************* open the admistration interface 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) = _SHOWwindow WINDOW WINDOW_HIDDEN; _DMSeventTag this "hidden" nil nil nil ;; /******************************************************************************* open the admistration interface 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) = _DMSsend this CqueryTable [] ;; fun IniDMI (parameter) = _DMSdefineActions this (["show" @cbShow]):: (["hide" @cbHide]):: nil; _DMSregister this nil; _DMSeventTag this "in" nil nil nil; 0 ;; /*********************************************************************************************/ /*************** INTERNAL COMMUNICATIONS CALLBACKS ***************************/ /*******************************************************************************************/ fun getList(List)= if List ==nil then nil else let hd List -> tete in let tete -> [_ _ _ oText] in (_GETtext oText)::(getList tl List) ;; fun InsertNew(List) = let getList List -> tmp in ( fill_Multi_Liste MultiListe tmp::nil 0 (_GETlistTabCount MultiListe) 1; set list_lines = listcat list_lines tmp::nil ) ;; fun __insertDB() = _DLGMessageBox _channel WINDOW (_loc this "KW_BD" nil) (_loc this "KW_INSERT_SUCCESS" nil) 0; InsertNew ListPopUp; _DSwindow PopUpWindow ;; fun ModifListLines (list, ind, elem) = if list == nil then nil else let hd list -> tmp in if ind == 0 then elem::(tl list) else tmp::(ModifListLines tl list ind -1 elem) ;; fun __modifDB() = let getList ListPopUp -> NewModif in set list_lines = ModifListLines list_lines ModifiedElem NewModif; _RSTlistTab MultiListe ; fill_Multi_Liste MultiListe list_lines 0 0 1; _DSwindow PopUpWindow ;; fun removelines (list, listind)= if listind == nil then list else removelines (remove_nth_from_list list hd listind) (tl listind) ;; fun __deleteDB() = set list_lines = removelines list_lines currentSel; _RSTlistTab MultiListe ; fill_Multi_Liste MultiListe list_lines 0 0 1 ;; fun __ErrorDB (message) = _DLGMessageBox _channel WINDOW (_loc this "KW_ERRORDB" nil) message 0 ;; fun __sendMaxId (MaxId) = CRPOPUPWIN atoi MaxId ;; /*this defcom is used to fill the columns*/ fun __sendColumns (columns) = let strextr columns -> list in let hd hd list -> t in let tl list -> tcolumns in ( set listeColumns = tcolumns; set Table = t ); InitAPI; _DMSeventTag this "shown" nil nil nil; /*_SHOWcursor _SETwinCursor WINDOW cursor 1;*/ let linebuild Table::(getColumns listeColumns) -> tmp in _DMSeventTag this "querySQL" tmp nil [@receiveSQLreq 0 20000] ;; /**************************** **************************** ******* COTE CLIENT ******* **************************** ****************************/ fun receiveLines(Lines) = _RSTlistTab MultiListe ; let strextr Lines -> list in ( set list_lines = list; fill_Multi_Liste MultiListe list 0 0 1 ); 0 ;; /* fonction qui récupère les messages ! */ fun __getstreamedmessage(message)= set TempSendParam = if (strlen message) == MessageMaxSize then strcat TempSendParam message else ( exec @receiveLines with [(strcat TempSendParam message)]; "" ); 0 ;; fun __RefreshNOSELECT() = let linebuild Table::(getColumns listeColumns) -> tmp in _DMSeventTag this "querySQL" tmp nil [@receiveSQLreq 0 20000] ;; fun __tooMuchLines(nbLines)= _DLGMessageBox _channel WINDOW (_loc this "KW_TOOLINES" nil) (_loc this "KW_TLINES" nil) 0; _DMSeventTag this "querySQL" nil nil [@receiveSQLreq 0 20000] ;; fun __errorSelectBDD()= _DMSeventTag this "querySQL" "error" nil [@receiveSQLreq 0 20000] ;;