/******************************************* Module DBimport Client Version: 1.0 Author: Thierry LEFORT Last update: 06/16/2001 *******************************************/ /********** COMMUNICATION *******************/ defcom CSELECTquery = SELECTquery S ;; defcom CcbInsertAll = cbInsertAll ;; defcom CcbUpdateAll = cbUpdateAll ;; defcom CcbInsertOnce = cbInsertOnce ;; defcom CcbUpdateOnce = cbUpdateOnce ;; defcom CkillClient = killClient ;; /********** API 2D *******************/ typeof MultiListeNewLine = ObjListTab ;; typeof MultiListeOldLine = ObjListTab ;; typeof WINDOW = ObjWin ;; typeof ERRWINDOW = ObjWin ;; typeof PopUpWindow = ObjWin ;; /* Tampon dans lequel on stocke les segments de messages déjà reçus */ typeof TempSendParam = S;; typeof font=ObjFont;; typeof SELECTREQ = S ;; typeof listeColumns = [S r1];; typeof labelOldLine = ObjText ;; typeof labelNewLine = ObjText ;; typeof ERRTEXT = ObjText;; typeof labelEnd = ObjText ;; typeof BtnYes = ObjButton;; typeof BtnNo = ObjButton;; typeof UpdateAll = ObjButton;; typeof InsertAll = ObjButton;; typeof Cancel = ObjButton;; /********** PRODUCTS *******************/ /*********** CLICK ON BUTTONS NEW, OK, DEL PRODUCTS FROM PRODUCT LIST *************/ 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 receiveSQLreq(param, others) = set SELECTREQ = param; _DMSsend this CSELECTquery [param]; 0 ;; /*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)= _DMSevent this "windestroyed" nil nil; _DSwindow WINDOW ;; fun getColumns (list) = if list ==nil then nil else (hd hd list)::(getColumns tl list) ;; /*Fill the columns of the Multiliste*/ fun FillColumns ( MultiListe, list, ind) = if list == nil then 1 else ( _ADDlistTabColumn MultiListe ind 100 ET_ALIGN_LEFT hd hd list; FillColumns MultiListe tl list ind+1; 0 ) ;; fun cbYes(bttn, param) = _DMSsend this CcbUpdateOnce []; _SHOWwindow WINDOW WINDOW_HIDDEN ;; fun cbNo(bttn, param) = _SHOWwindow WINDOW WINDOW_HIDDEN; _DMSsend this CcbInsertOnce [] ;; fun cbUpdate(bttn, param) = /*_SHOWwindow WINDOW WINDOW_HIDDEN;*/ _DMSsend this CcbUpdateAll [] ;; fun cbInsert(bttn, param) = /*_SHOWwindow WINDOW WINDOW_HIDDEN;*/ _DMSsend this CcbInsertAll [] ;; fun _Cancel (msb, param, ind) = if ind == 1 then ( _DMSsend this CkillClient []; _DSwindow WINDOW; set WINDOW =nil ) else nil ;; fun cbCancel(bttn, param) = _DLGrflmessage _DLGMessageBox _channel WINDOW (_loc this "DB_END_TITLE" nil) (_loc this "DB_END" nil) 2 @_Cancel nil ;; fun cbClose(win, param)= if param == 1 then cbCancel nil nil else nil ;; fun CRCONFLICTBOX (aliasDestination, aliasSource, attrDest) = let 300 -> Hwin in let 600 -> Lwin in let 5 -> step in let 60 -> Hlist in let 40 -> Hlabel in let Lwin-10 -> Llabel in let Hwin/5 -> Htext in let 25 -> Hbtn in let 75 -> Lbtn in ( set listeColumns = getColumns attrDest ; set WINDOW = _CRwindow _channel nil 500 100 Lwin Hwin WN_MENU|WN_HIDDEN "DBImport" ; set labelNewLine = _CRtext _channel WINDOW step step Lwin Hlabel ET_ALIGN_LEFT strcatn (_loc this "DB_LABELDEB" nil)::" "::aliasDestination::nil; set MultiListeNewLine = _CRlistTab _channel WINDOW 0 Hlabel+step Lwin Hlist LV_BORDER; FillColumns MultiListeNewLine attrDest 0; set labelOldLine = _CRtext _channel WINDOW step 2*step+Hlabel+Hlist Lwin Hlabel ET_ALIGN_LEFT strcatn (_loc this "DB_LABELMED" nil)::" "::aliasSource::"\n"::(_loc this "DB_LABELMEDSUITE" nil)::nil; set MultiListeOldLine = _CRlistTab _channel WINDOW 0 3*step+2*Hlabel+Hlist Lwin Hlist LV_BORDER; FillColumns MultiListeOldLine attrDest 0; set labelEnd = _CRtext _channel WINDOW step 4*step+2*Hlabel+2*Hlist Lwin Hlabel ET_ALIGN_LEFT (_loc this "DB_LABELFIN" nil); let 6*step+3*Hlabel+2*Hlist -> ybottom in ( _CBbutton set BtnYes = _CRbutton _channel WINDOW step ybottom Lbtn Hbtn PB_TABFOCUS (_loc this "DBI_YES" nil) @cbYes nil; _CBbutton set BtnNo = _CRbutton _channel WINDOW 2*step+Lbtn ybottom Lbtn Hbtn PB_TABFOCUS (_loc this "DBI_NO" nil) @cbNo nil; _CBbutton set UpdateAll = _CRbutton _channel WINDOW 3*step+2*Lbtn ybottom Lbtn Hbtn PB_TABFOCUS (_loc this "DBI_UPDATE" nil) @cbUpdate nil; _CBbutton set InsertAll = _CRbutton _channel WINDOW 4*step+3*Lbtn ybottom Lbtn Hbtn PB_TABFOCUS (_loc this "DBI_INSERT" nil) @cbInsert nil; _CBbutton set Cancel = _CRbutton _channel WINDOW 5*step+4*Lbtn ybottom Lbtn Hbtn PB_TABFOCUS (_loc this "DBI_CANCEL" nil) @cbCancel nil ); _CBwinClose WINDOW @cbClose 1 ); 0 ;; fun IniDMI (parameter) = let strextr parameter -> liste in let hd hd liste -> aliasDestination in let hd hd tl liste -> aliasSource in let tl tl liste -> attrDest in CRCONFLICTBOX aliasDestination aliasSource attrDest; _DMSregister this nil; _DMSeventTag this "in" nil nil nil; 0 ;; /*********************************************************************************************/ /*************** INTERNAL COMMUNICATIONS CALLBACKS ***************************/ /*******************************************************************************************/ fun removelines (list, listind)= if listind == nil then list else removelines (remove_nth_from_list list hd listind) (tl listind) ;; fun ERRSIZE (window, param, wd, hg) = _SIZEtext ERRTEXT wd hg 0 0 ;; fun __ErrorDB (mes, id) = let strcatn (_loc this "KW_LINE" nil)::" "::id::"\n"::mes::nil -> message in if ERRWINDOW ==nil then ( set ERRWINDOW = _CBwinSize _CRwindow _channel nil 100 100 300 300 WN_MENU|WN_SIZEBOX/*|WN_MAX*/|WN_MINBOX (_loc this "KW_ERRORDB" nil) @ERRSIZE nil; set ERRTEXT = _CReditText _channel ERRWINDOW 0 0 300 300 ET_HSCROLL|ET_VSCROLL|ET_ALIGN_LEFT|ET_AHSCROLL|ET_AVSCROLL message ) else ( _SHOWwindow ERRWINDOW WINDOW_RESTORED|WINDOW_UNHIDDEN; _ADDtext ERRTEXT strcatn "\n\n"::message::nil ) /* _DLGMessageBox _channel WINDOW (_loc this "KW_ERRORDB" nil) message 0*/ ;; fun __conflict(param, liste, line) = _RSTlistTab MultiListeOldLine; _RSTlistTab MultiListeNewLine; fill_Multi_Liste MultiListeOldLine (lineextr param)::nil 0 0 1; fill_Multi_Liste MultiListeNewLine (lineextr line)::nil 0 0 1; _SHOWwindow WINDOW WINDOW_UNHIDDEN ;; fun __errorSelectBDD()= _DMSeventTag this "querySQL" "error" nil [@receiveSQLreq 0 20000] ;; fun _TheEnd(MessageBox, param, int) = _DSwindow WINDOW; set WINDOW = nil; _DMSsend this CkillClient [] ;; fun __fini() = _DLGrflmessage _DLGMessageBox _channel WINDOW (_loc this "DB_END_TITLE" nil) (_loc this "DB_ENDD" nil) 0 @_TheEnd nil ;; fun __SNoMore() = _DLGMessageBox _channel WINDOW (_loc this "DB_NOMOREUSER_TITLE" nil) (_loc this "DB_NOMOREUSER" nil) 0 ;;