g-aktionen-kugrp.w 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965
  1. &ANALYZE-SUSPEND _VERSION-NUMBER AB_v9r12 GUI ADM2
  2. &ANALYZE-RESUME
  3. &Scoped-define WINDOW-NAME CURRENT-WINDOW
  4. &Scoped-define FRAME-NAME gAAktionen
  5. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS gAAktionen
  6. /*------------------------------------------------------------------------
  7. File:
  8. Description: from cntnrdlg.w - ADM2 SmartDialog Template
  9. Input Parameters:
  10. <none>
  11. Output Parameters:
  12. <none>
  13. Author:
  14. Created:
  15. ------------------------------------------------------------------------*/
  16. /* This .W file was created with the Progress AppBuilder. */
  17. /*----------------------------------------------------------------------*/
  18. /* Create an unnamed pool to store all the widgets created
  19. by this procedure. This is a good default which assures
  20. that this procedure's triggers and internal procedures
  21. will execute in this procedure's storage, and that proper
  22. cleanup will occur on deletion of the procedure. */
  23. CREATE WIDGET-POOL.
  24. /* *************************** Definitions ************************** */
  25. /* Parameters Definitions --- */
  26. /* Local Variable Definitions --- */
  27. DEF VAR MaxPage AS INT NO-UNDO.
  28. DEF VAR AktSeite AS INT NO-UNDO.
  29. DEF VAR FMutFlag AS LOG NO-UNDO.
  30. DEF VAR Firma AS CHAR NO-UNDO.
  31. DEF VAR ProgName AS CHAR NO-UNDO.
  32. DEF TEMP-TABLE TExcel FIELD Feld AS CHAR EXTENT 20
  33. FIELD Zeile AS INT.
  34. /* _UIB-CODE-BLOCK-END */
  35. &ANALYZE-RESUME
  36. &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  37. /* ******************** Preprocessor Definitions ******************** */
  38. &Scoped-define PROCEDURE-TYPE SmartDialog
  39. &Scoped-define DB-AWARE no
  40. &Scoped-define ADM-CONTAINER DIALOG-BOX
  41. &Scoped-define ADM-SUPPORTED-LINKS Data-Target,Data-Source,Page-Target,Update-Source,Update-Target
  42. /* Name of first Frame and/or Browse and/or first Query */
  43. &Scoped-define FRAME-NAME gAAktionen
  44. /* Standard List Definitions */
  45. &Scoped-Define ENABLED-OBJECTS R_Art CB_Kundengruppe F_VonDatum F_BisDatum ~
  46. Btn_OK Btn_Cancel R_Preis Hersteller RECT-3
  47. &Scoped-Define DISPLAYED-OBJECTS R_Art CB_Kundengruppe F_VonDatum ~
  48. F_BisDatum R_Preis Hersteller
  49. /* Custom List Definitions */
  50. /* List-1,List-2,List-3,List-4,List-5,List-6 */
  51. &Scoped-define List-6 R_Art F_VonDatum F_BisDatum R_Preis Hersteller
  52. /* _UIB-PREPROCESSOR-BLOCK-END */
  53. &ANALYZE-RESUME
  54. /* *********************** Control Definitions ********************** */
  55. /* Define a dialog box */
  56. /* Definitions of the field level widgets */
  57. DEFINE BUTTON Btn_Cancel AUTO-END-KEY
  58. LABEL "Abbrechen"
  59. SIZE 14 BY 1.
  60. DEFINE BUTTON Btn_OK AUTO-GO
  61. LABEL "Start"
  62. SIZE 14 BY 1.
  63. DEFINE VARIABLE CB_Kundengruppe AS CHARACTER FORMAT "X(256)":U
  64. LABEL "Kundengruppe"
  65. VIEW-AS COMBO-BOX INNER-LINES 5
  66. LIST-ITEM-PAIRS "Item 1","Item 1"
  67. DROP-DOWN-LIST
  68. SIZE 35 BY 1
  69. BGCOLOR 15 NO-UNDO.
  70. DEFINE VARIABLE F_BisDatum AS DATE FORMAT "99.99.9999":U
  71. LABEL "-"
  72. VIEW-AS FILL-IN NATIVE
  73. SIZE 16 BY 1
  74. BGCOLOR 15 NO-UNDO.
  75. DEFINE VARIABLE F_VonDatum AS DATE FORMAT "99.99.9999":U
  76. LABEL "von - bis Datum"
  77. VIEW-AS FILL-IN NATIVE
  78. SIZE 16 BY 1
  79. BGCOLOR 15 NO-UNDO.
  80. DEFINE VARIABLE Hersteller AS CHARACTER FORMAT "X(256)":U
  81. LABEL "Hersteller"
  82. VIEW-AS FILL-IN NATIVE
  83. SIZE 46 BY 1
  84. BGCOLOR 15 NO-UNDO.
  85. DEFINE VARIABLE R_Art AS INTEGER
  86. VIEW-AS RADIO-SET VERTICAL
  87. RADIO-BUTTONS
  88. "Getränke", 1,
  89. "Wein", 2
  90. SIZE 25.2 BY 1.52 NO-UNDO.
  91. DEFINE VARIABLE R_Preis AS INTEGER
  92. VIEW-AS RADIO-SET VERTICAL
  93. RADIO-BUTTONS
  94. "Rabatt", 1,
  95. "Aktionspreis", 2
  96. SIZE 25.2 BY 1.52 NO-UNDO.
  97. DEFINE RECTANGLE RECT-3
  98. EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL
  99. SIZE 68 BY 10.48.
  100. /* ************************ Frame Definitions *********************** */
  101. DEFINE FRAME gAAktionen
  102. R_Art AT ROW 6 COL 19.8 NO-LABEL
  103. CB_Kundengruppe AT ROW 2 COL 18 COLON-ALIGNED
  104. F_VonDatum AT ROW 4.52 COL 18 COLON-ALIGNED
  105. F_BisDatum AT ROW 4.52 COL 37 COLON-ALIGNED
  106. Btn_OK AT ROW 10 COL 21
  107. Btn_Cancel AT ROW 10 COL 39.8
  108. R_Preis AT ROW 8 COL 19.8 NO-LABEL
  109. Hersteller AT ROW 3 COL 18 COLON-ALIGNED
  110. RECT-3 AT ROW 1.24 COL 2
  111. SPACE(0.99) SKIP(0.22)
  112. WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER
  113. SIDE-LABELS NO-UNDERLINE THREE-D SCROLLABLE
  114. TITLE "Aktionen"
  115. CANCEL-BUTTON Btn_Cancel.
  116. /* *********************** Procedure Settings ************************ */
  117. &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  118. /* Settings for THIS-PROCEDURE
  119. Type: SmartDialog
  120. Allow: Basic,Browse,DB-Fields,Query,Smart
  121. Container Links: Data-Target,Data-Source,Page-Target,Update-Source,Update-Target
  122. Design Page: 1
  123. Other Settings: COMPILE
  124. */
  125. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  126. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB gAAktionen
  127. /* ************************* Included-Libraries *********************** */
  128. {src/adm2/containr.i}
  129. /* _UIB-CODE-BLOCK-END */
  130. &ANALYZE-RESUME
  131. /* *********** Runtime Attributes and AppBuilder Settings *********** */
  132. &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
  133. /* SETTINGS FOR DIALOG-BOX gAAktionen
  134. Custom */
  135. ASSIGN
  136. FRAME gAAktionen:SCROLLABLE = FALSE
  137. FRAME gAAktionen:HIDDEN = TRUE.
  138. /* SETTINGS FOR FILL-IN F_BisDatum IN FRAME gAAktionen
  139. 6 */
  140. /* SETTINGS FOR FILL-IN F_VonDatum IN FRAME gAAktionen
  141. 6 */
  142. /* SETTINGS FOR FILL-IN Hersteller IN FRAME gAAktionen
  143. 6 */
  144. /* SETTINGS FOR RADIO-SET R_Art IN FRAME gAAktionen
  145. 6 */
  146. /* SETTINGS FOR RADIO-SET R_Preis IN FRAME gAAktionen
  147. 6 */
  148. /* _RUN-TIME-ATTRIBUTES-END */
  149. &ANALYZE-RESUME
  150. /* Setting information for Queries and Browse Widgets fields */
  151. &ANALYZE-SUSPEND _QUERY-BLOCK DIALOG-BOX gAAktionen
  152. /* Query rebuild information for DIALOG-BOX gAAktionen
  153. _Options = "SHARE-LOCK"
  154. _Query is NOT OPENED
  155. */ /* DIALOG-BOX gAAktionen */
  156. &ANALYZE-RESUME
  157. /* ************************ Control Triggers ************************ */
  158. &Scoped-define SELF-NAME gAAktionen
  159. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL gAAktionen gAAktionen
  160. ON END-ERROR OF FRAME gAAktionen /* Aktionen */
  161. DO:
  162. RUN ENDE.
  163. RETURN NO-APPLY.
  164. END.
  165. /* _UIB-CODE-BLOCK-END */
  166. &ANALYZE-RESUME
  167. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL gAAktionen gAAktionen
  168. ON GO OF FRAME gAAktionen /* Aktionen */
  169. DO:
  170. RUN ENDE_PROGRAMM ( INPUT THIS-PROCEDURE:FILE-NAME ) NO-ERROR.
  171. END.
  172. /* _UIB-CODE-BLOCK-END */
  173. &ANALYZE-RESUME
  174. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL gAAktionen gAAktionen
  175. ON WINDOW-CLOSE OF FRAME gAAktionen /* Aktionen */
  176. DO:
  177. RUN ENDE.
  178. RETURN NO-APPLY.
  179. END.
  180. /* _UIB-CODE-BLOCK-END */
  181. &ANALYZE-RESUME
  182. &Scoped-define SELF-NAME Btn_Cancel
  183. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Cancel gAAktionen
  184. ON CHOOSE OF Btn_Cancel IN FRAME gAAktionen /* Abbrechen */
  185. DO:
  186. RUN ENDE.
  187. RETURN NO-APPLY.
  188. END.
  189. /* _UIB-CODE-BLOCK-END */
  190. &ANALYZE-RESUME
  191. &Scoped-define SELF-NAME Btn_OK
  192. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_OK gAAktionen
  193. ON CHOOSE OF Btn_OK IN FRAME gAAktionen /* Start */
  194. DO:
  195. SESSION:SET-WAIT-STATE('GENERAL').
  196. RUN REPORT.
  197. SESSION:SET-WAIT-STATE('').
  198. ENABLE Btn_OK
  199. Btn_Cancel WITH FRAME {&FRAME-NAME}.
  200. RUN ENDE.
  201. RETURN NO-APPLY.
  202. END.
  203. /* _UIB-CODE-BLOCK-END */
  204. &ANALYZE-RESUME
  205. &Scoped-define SELF-NAME CB_Kundengruppe
  206. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL CB_Kundengruppe gAAktionen
  207. ON RETURN OF CB_Kundengruppe IN FRAME gAAktionen /* Kundengruppe */
  208. DO:
  209. APPLY 'TAB' TO SELF.
  210. RETURN NO-APPLY.
  211. END.
  212. /* _UIB-CODE-BLOCK-END */
  213. &ANALYZE-RESUME
  214. &Scoped-define SELF-NAME Hersteller
  215. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Hersteller gAAktionen
  216. ON HELP OF Hersteller IN FRAME gAAktionen /* Hersteller */
  217. DO:
  218. RUN g-auswahl-tabelle.w ( INPUT SELF:HANDLE, INPUT 'HERST' ).
  219. APPLY 'END' TO SELF.
  220. END.
  221. /* _UIB-CODE-BLOCK-END */
  222. &ANALYZE-RESUME
  223. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Hersteller gAAktionen
  224. ON LEFT-MOUSE-DBLCLICK OF Hersteller IN FRAME gAAktionen /* Hersteller */
  225. DO:
  226. RUN g-auswahl-tabelle.w ( INPUT SELF:HANDLE, INPUT 'HERST' ).
  227. APPLY 'END' TO SELF.
  228. END.
  229. /* _UIB-CODE-BLOCK-END */
  230. &ANALYZE-RESUME
  231. &UNDEFINE SELF-NAME
  232. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK gAAktionen
  233. /* *************************** Main Block *************************** */
  234. MaxPage = 1.
  235. AktSeite = 1.
  236. MaxPage = 1.
  237. AktSeite = 1.
  238. Firma = DYNAMIC-FUNCTION('GETMANDANT':U) NO-ERROR.
  239. ProgName = ENTRY(1, THIS-PROCEDURE:FILE-NAME, '.') NO-ERROR.
  240. SESSION:DATA-ENTRY-RETURN = TRUE.
  241. /* ------------------------------------------------------------------ */
  242. {src/adm2/dialogmn.i}
  243. /* _UIB-CODE-BLOCK-END */
  244. &ANALYZE-RESUME
  245. /* ********************** Internal Procedures *********************** */
  246. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects gAAktionen _ADM-CREATE-OBJECTS
  247. PROCEDURE adm-create-objects :
  248. /*------------------------------------------------------------------------------
  249. Purpose: Create handles for all SmartObjects used in this procedure.
  250. After SmartObjects are initialized, then SmartLinks are added.
  251. Parameters: <none>
  252. ------------------------------------------------------------------------------*/
  253. END PROCEDURE.
  254. /* _UIB-CODE-BLOCK-END */
  255. &ANALYZE-RESUME
  256. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN gAAktionen
  257. PROCEDURE BEREINIGEN :
  258. /*------------------------------------------------------------------------------
  259. Purpose:
  260. Parameters: <none>
  261. Notes:
  262. ------------------------------------------------------------------------------*/
  263. DEF INPUT-OUTPUT PARAMETER ipString AS CHAR NO-UNDO.
  264. DEF VAR cString AS CHAR NO-UNDO.
  265. DEF VAR ix AS INT NO-UNDO.
  266. DEF VAR ii AS INT NO-UNDO.
  267. cString = ''.
  268. ipString = REPLACE(ipString, ';', ',').
  269. ipString = REPLACE(ipString, '.', ',').
  270. ipString = REPLACE(ipString, ' ', ',').
  271. DO ix = 1 TO NUM-ENTRIES(ipString, ','):
  272. IF CString <> '' THEN cString = cString + ','.
  273. cString = cString + STRING(INTEGER(ENTRY(ix, ipString)),'999').
  274. END.
  275. ipString = cString.
  276. END PROCEDURE.
  277. /* _UIB-CODE-BLOCK-END */
  278. &ANALYZE-RESUME
  279. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE changePage gAAktionen
  280. PROCEDURE changePage :
  281. /*------------------------------------------------------------------------------
  282. Purpose: Super Override
  283. Parameters:
  284. Notes:
  285. ------------------------------------------------------------------------------*/
  286. /* Code placed here will execute PRIOR to standard behavior. */
  287. RUN SUPER.
  288. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U).
  289. CASE AktSeite:
  290. WHEN 1 THEN DO:
  291. /* RUN addLink ( h_dyntoolbar , 'TableIO':U , h_v-auftr ). */
  292. /* RUN addLink ( h_dyntoolbar , 'Navigation':U , h_d-auftr ). */
  293. /* RUN ToolbarInit ( INPUT h_d-auftr ). */
  294. RUN ENTRY_CURSOR.
  295. END.
  296. WHEN 2 THEN DO:
  297. RUN ENTRY_CURSOR.
  298. END.
  299. END CASE.
  300. END PROCEDURE.
  301. /* _UIB-CODE-BLOCK-END */
  302. &ANALYZE-RESUME
  303. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI gAAktionen _DEFAULT-DISABLE
  304. PROCEDURE disable_UI :
  305. /*------------------------------------------------------------------------------
  306. Purpose: DISABLE the User Interface
  307. Parameters: <none>
  308. Notes: Here we clean-up the user-interface by deleting
  309. dynamic widgets we have created and/or hide
  310. frames. This procedure is usually called when
  311. we are ready to "clean-up" after running.
  312. ------------------------------------------------------------------------------*/
  313. /* Hide all frames. */
  314. HIDE FRAME gAAktionen.
  315. END PROCEDURE.
  316. /* _UIB-CODE-BLOCK-END */
  317. &ANALYZE-RESUME
  318. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableObject gAAktionen
  319. PROCEDURE enableObject :
  320. /*------------------------------------------------------------------------------
  321. Purpose: Super Override
  322. Parameters:
  323. Notes:
  324. ------------------------------------------------------------------------------*/
  325. /* Code placed here will execute PRIOR to standard behavior. */
  326. DO WITH FRAME {&FRAME-NAME}:
  327. RUN COMBO_KUNDENGRP ( INPUT CB_Kundengruppe:HANDLE ).
  328. END.
  329. RUN SUPER.
  330. RUN FENSTER_TITEL ( INPUT FRAME {&FRAME-NAME}:HANDLE ) NO-ERROR.
  331. RUN LESENFWAUSWERTUNGEN ( INPUT ProgName,
  332. INPUT FRAME {&FRAME-NAME}:CURRENT-ITERATION ) NO-ERROR.
  333. END PROCEDURE.
  334. /* _UIB-CODE-BLOCK-END */
  335. &ANALYZE-RESUME
  336. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI gAAktionen _DEFAULT-ENABLE
  337. PROCEDURE enable_UI :
  338. /*------------------------------------------------------------------------------
  339. Purpose: ENABLE the User Interface
  340. Parameters: <none>
  341. Notes: Here we display/view/enable the widgets in the
  342. user-interface. In addition, OPEN all queries
  343. associated with each FRAME and BROWSE.
  344. These statements here are based on the "Other
  345. Settings" section of the widget Property Sheets.
  346. ------------------------------------------------------------------------------*/
  347. DISPLAY R_Art CB_Kundengruppe F_VonDatum F_BisDatum R_Preis Hersteller
  348. WITH FRAME gAAktionen.
  349. ENABLE R_Art CB_Kundengruppe F_VonDatum F_BisDatum Btn_OK Btn_Cancel R_Preis
  350. Hersteller RECT-3
  351. WITH FRAME gAAktionen.
  352. VIEW FRAME gAAktionen.
  353. {&OPEN-BROWSERS-IN-QUERY-gAAktionen}
  354. END PROCEDURE.
  355. /* _UIB-CODE-BLOCK-END */
  356. &ANALYZE-RESUME
  357. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ENDE gAAktionen
  358. PROCEDURE ENDE :
  359. /*------------------------------------------------------------------------------
  360. Purpose:
  361. Parameters: <none>
  362. Notes:
  363. ------------------------------------------------------------------------------*/
  364. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U) NO-ERROR.
  365. IF AktSeite > 1 THEN DO:
  366. RUN selectPage ( INPUT 1 ).
  367. RETURN NO-APPLY.
  368. END.
  369. RUN ENDE_PROGRAMM ( INPUT THIS-PROCEDURE:FILE-NAME ).
  370. APPLY 'GO' TO FRAME {&FRAME-NAME}.
  371. RETURN NO-APPLY.
  372. END PROCEDURE.
  373. /* _UIB-CODE-BLOCK-END */
  374. &ANALYZE-RESUME
  375. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ENTRY_CURSOR gAAktionen
  376. PROCEDURE ENTRY_CURSOR :
  377. /*------------------------------------------------------------------------------
  378. Purpose:
  379. Parameters: <none>
  380. Notes:
  381. ------------------------------------------------------------------------------*/
  382. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U).
  383. CASE AktSeite:
  384. /* WHEN 1 THEN RUN applyEntry IN h_v-adresse ( INPUT ? ). */
  385. /* WHEN 2 THEN RUN applyEntry IN h_f-adrkomm ( INPUT ? ). */
  386. /* WHEN 3 THEN RUN applyEntry IN h_b-auftbb ( INPUT ? ). */
  387. /* WHEN 4 THEN RUN applyEntry IN h_b-aufdet ( INPUT ? ). */
  388. /* WHEN 5 THEN RUN applyEntry IN h_b-aufstreu ( INPUT ? ). */
  389. /* WHEN 6 THEN RUN applyEntry IN h_b-auffak ( INPUT ? ). */
  390. /* WHEN 7 THEN RUN applyEntry IN h_b-position ( INPUT ? ). */
  391. END CASE.
  392. RETURN NO-APPLY.
  393. END PROCEDURE.
  394. /* _UIB-CODE-BLOCK-END */
  395. &ANALYZE-RESUME
  396. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE exitObject gAAktionen
  397. PROCEDURE exitObject :
  398. /*------------------------------------------------------------------------------
  399. Purpose: Super Override
  400. Parameters:
  401. Notes:
  402. ------------------------------------------------------------------------------*/
  403. RUN ENDE.
  404. RETURN NO-APPLY.
  405. END PROCEDURE.
  406. /* _UIB-CODE-BLOCK-END */
  407. &ANALYZE-RESUME
  408. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE KOPF gAAktionen
  409. PROCEDURE KOPF :
  410. /*------------------------------------------------------------------------------
  411. Purpose:
  412. Parameters: <none>
  413. Notes:
  414. ------------------------------------------------------------------------------*/
  415. DEF INPUT PARAMETER eh AS COM-HANDLE NO-UNDO.
  416. DEF VAR Zelle AS CHAR NO-UNDO.
  417. /*
  418. eh:APPLICATION:RUN('FormatKopf').
  419. */
  420. FIND Steuer USE-INDEX Steuer-k1
  421. WHERE Steuer.Firma = Firma NO-LOCK NO-ERROR.
  422. Zelle = 'A1'.
  423. eh:Range(Zelle):SELECT.
  424. eh:SELECTION:VALUE = Steuer.Firma1.
  425. Zelle = 'D1'.
  426. eh:Range(Zelle):SELECT.
  427. eh:SELECTION:VALUE = 'Aktionsliste'.
  428. Zelle = 'H1'.
  429. eh:Range(Zelle):SELECT.
  430. eh:SELECTION:VALUE = 'Datum : ' + STRING(TODAY,'99.99.9999').
  431. Zelle = 'A2'.
  432. eh:Range(Zelle):SELECT.
  433. eh:SELECTION:VALUE = Steuer.Ort.
  434. Zelle = 'D2'.
  435. eh:Range(Zelle):SELECT.
  436. eh:SELECTION:VALUE = ''.
  437. Zelle = 'H2'.
  438. eh:Range(Zelle):SELECT.
  439. eh:SELECTION:VALUE = 'Zeit : ' + STRING(TIME,'HH:MM:SS').
  440. END PROCEDURE.
  441. /* _UIB-CODE-BLOCK-END */
  442. &ANALYZE-RESUME
  443. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REPORT gAAktionen
  444. PROCEDURE REPORT :
  445. /*------------------------------------------------------------------------------
  446. Purpose:
  447. Parameters: <none>
  448. Notes:
  449. ------------------------------------------------------------------------------*/
  450. DEF VAR excelAppl AS COM-HANDLE NO-UNDO.
  451. DEF VAR DatenName AS CHAR NO-UNDO.
  452. DEF VAR DateiName AS CHAR NO-UNDO.
  453. DEF VAR Zelle AS CHAR NO-UNDO.
  454. DEF VAR xText AS CHAR NO-UNDO.
  455. DEF VAR Ja AS LOG NO-UNDO.
  456. DEF VAR KGeb AS CHAR NO-UNDO.
  457. DEF VAR VGeb AS CHAR NO-UNDO.
  458. DEF VAR sWgr AS CHAR NO-UNDO.
  459. DEF VAR sPgr AS CHAR NO-UNDO.
  460. DEF VAR sAgr AS CHAR NO-UNDO.
  461. DEF VAR Ku_Grp AS INT NO-UNDO.
  462. DEF VAR ExcelOpen AS LOG NO-UNDO.
  463. DEF VAR dPreis AS DEC NO-UNDO.
  464. DEF VAR fPreis AS LOG NO-UNDO.
  465. DEF VAR iPreisGrp AS INT NO-UNDO.
  466. DEF VAR xFarbe AS CHAR NO-UNDO.
  467. DEF VAR cString AS CHAR NO-UNDO.
  468. DEF VAR ix AS INT NO-UNDO.
  469. Firma = DYNAMIC-FUNCTION('GETMANDANT':U) NO-ERROR.
  470. DO WITH FRAME {&FRAME-NAME}:
  471. ASSIGN {&List-6}.
  472. IF F_VonDatum = ? THEN F_VonDatum = DATE(MONTH(TODAY),01,YEAR(TODAY)).
  473. IF F_BisDatum = ? THEN F_BisDatum = DATE(12,31,YEAR(TODAY)).
  474. Ku_Grp = INTEGER(CB_Kundengruppe:SCREEN-VALUE).
  475. FIND Tabel USE-INDEX Tabel-k1
  476. WHERE Tabel.Firma = Firma
  477. AND Tabel.RecArt = 'KUNDGRP'
  478. AND Tabel.CodeC = ''
  479. AND Tabel.CodeI = Ku_Grp
  480. AND Tabel.Sprcd = 1 NO-LOCK NO-ERROR.
  481. iPreisGrp = Tabel.Int_1.
  482. IF iPreisGrp = 0 THEN DO:
  483. MESSAGE 'Diese Kundengruppe hat keine Preisgruppe' SKIP
  484. 'Bitte bei den Debitortabellen vervollständigen' VIEW-AS ALERT-BOX.
  485. RETURN.
  486. END.
  487. FIND Tabel USE-INDEX Tabel-k1
  488. WHERE Tabel.Firma = Firma
  489. AND Tabel.RecArt = 'PREGRP'
  490. AND Tabel.CodeC = ''
  491. AND Tabel.CodeI = iPreisGrp
  492. AND Tabel.Sprcd = 1 NO-LOCK NO-ERROR.
  493. IF NOT AVAILABLE Tabel THEN DO:
  494. MESSAGE 'Diese Kundengruppe hat keine gültige Preisgruppe' SKIP
  495. 'Bitte bei den Debitortabellen berichtigen' VIEW-AS ALERT-BOX.
  496. RETURN.
  497. END.
  498. IF Tabel.Int_1 = 0 THEN fPreis = FALSE.
  499. ELSE fPreis = TRUE.
  500. RUN BEREINIGEN ( INPUT-OUTPUT Hersteller ).
  501. DISPLAY {&List-6}.
  502. DISABLE Btn_OK
  503. Btn_Cancel.
  504. RUN SCHREIBENFWAUSWERTUNGEN ( INPUT ProgName,
  505. INPUT FRAME {&FRAME-NAME}:CURRENT-ITERATION )
  506. NO-ERROR.
  507. DatenName = 'Aktionen_Rauch.txt'.
  508. IF R_Art = 1 THEN DateiName = 'Aktionen_Rauch.xls' + CHR(01) + 'Aktionen_Rauch.xls'.
  509. ELSE DateiName = 'Aktionen_Rauch.xls' + CHR(01) + 'Aktionen_Wein_Rauch.xls'.
  510. DO WHILE TRUE:
  511. excelAppl = DYNAMIC-FUNCTION('CREATEEXCEL':U) NO-ERROR.
  512. IF NOT VALID-HANDLE(excelAppl) THEN DO:
  513. RUN FEHLER ( INPUT 1035 ).
  514. RETURN NO-APPLY.
  515. END.
  516. LEAVE.
  517. END.
  518. DO WHILE TRUE:
  519. RUN CREATEDATEI ( INPUT DateiName ).
  520. IF NOT RETURN-VALUE BEGINS 'ERROR-' THEN LEAVE.
  521. CASE RETURN-VALUE:
  522. WHEN 'ERROR-PARAMETER' THEN DO:
  523. RUN FEHLER ( INPUT 1036 ).
  524. RETURN NO-APPLY.
  525. END.
  526. WHEN 'ERROR-LOESCHEN' THEN DO:
  527. RUN FEHLER ( INPUT 1037 ).
  528. RETURN NO-APPLY.
  529. END.
  530. WHEN 'ERROR-VORLAGE' THEN DO:
  531. RUN FEHLER ( INPUT 1038 ).
  532. RETURN NO-APPLY.
  533. END.
  534. OTHERWISE DO:
  535. MESSAGE RETURN-VALUE VIEW-AS ALERT-BOX ERROR.
  536. RETURN NO-APPLY.
  537. END.
  538. END CASE.
  539. LEAVE.
  540. END.
  541. DateiName = RETURN-VALUE.
  542. DO WHILE TRUE:
  543. RUN CREATEDATEI ( INPUT DatenName ).
  544. IF NOT RETURN-VALUE BEGINS 'ERROR-' THEN LEAVE.
  545. CASE RETURN-VALUE:
  546. WHEN 'ERROR-PARAMETER' THEN DO:
  547. RUN FEHLER ( INPUT 1036 ).
  548. RETURN NO-APPLY.
  549. END.
  550. WHEN 'ERROR-LOESCHEN' THEN DO:
  551. RUN FEHLER ( INPUT 1037 ).
  552. RETURN NO-APPLY.
  553. END.
  554. WHEN 'ERROR-VORLAGE' THEN DO:
  555. RUN FEHLER ( INPUT 1038 ).
  556. RETURN NO-APPLY.
  557. END.
  558. OTHERWISE DO:
  559. MESSAGE RETURN-VALUE VIEW-AS ALERT-BOX ERROR.
  560. RETURN NO-APPLY.
  561. END.
  562. END CASE.
  563. LEAVE.
  564. END.
  565. DatenName = RETURN-VALUE.
  566. OUTPUT TO VALUE(DatenName).
  567. ExcelOpen = FALSE.
  568. FOR EACH AktPreis WHERE AktPreis.Firma = Firma
  569. AND AktPreis.Grp = Ku_Grp
  570. AND ((AktPreis.Ab_Datum >= F_VonDatum AND
  571. AktPreis.Ab_Datum <= F_BisDatum) OR
  572. (AktPreis.Bis_Datum >= F_VonDatum AND
  573. AktPreis.Bis_Datum <= F_BisDatum)) NO-LOCK,
  574. FIRST Artst USE-INDEX Artst-k1
  575. WHERE Artst.Firma = AktPreis.Firma
  576. AND Artst.Artnr = AktPreis.Artnr
  577. AND Artst.Inhalt = AktPreis.Inhalt
  578. AND Artst.Jahr = AktPreis.Jahr
  579. AND ((Hersteller = '') OR
  580. (Hersteller <> '' AND
  581. LOOKUP(STRING(Artst.Herst,"999"), Hersteller , ',') > 0))
  582. AND Artst.Aktiv = TRUE
  583. AND Artst.Ausverk < 9 NO-LOCK,
  584. FIRST Artbez OF Artst NO-LOCK
  585. BREAK BY Artst.Wg_Grp
  586. BY Artst.Prod_Grp
  587. BY Artst.Art_Grp
  588. BY Artst.Suchbe
  589. BY Artst.KGeb_Cd :
  590. IF FIRST-OF ( Artst.Wg_Grp ) THEN DO:
  591. sWgr = '??????????'.
  592. RUN FIND_WARENGRP ( INPUT Artst.Wg_Grp, OUTPUT xText ).
  593. IF xText <> '' AND
  594. xText <> '?' THEN sWgr = ENTRY(2, xText, CHR(01)).
  595. PUT CONTROL sWgr CHR(10)
  596. '£' CHR(10).
  597. END.
  598. IF FIRST-OF ( Artst.Prod_Grp ) THEN DO:
  599. sPgr = '??????????'.
  600. RUN FIND_PRODGRP ( INPUT Artst.Wg_Grp ,
  601. INPUT Artst.Prod_Grp ,
  602. OUTPUT xText ).
  603. IF xText <> '' AND
  604. xText <> '?' THEN sPgr = ENTRY(2, xText, CHR(01)).
  605. PUT CONTROL sPgr CHR(10)
  606. '£' CHR(10).
  607. END.
  608. IF FIRST-OF ( Artst.Art_Grp ) THEN DO:
  609. sAgr = '??????????'.
  610. RUN FIND_ARTIKGRP ( INPUT Artst.Wg_Grp ,
  611. INPUT Artst.Prod_Grp ,
  612. INPUT Artst.Art_Grp ,
  613. OUTPUT xText ).
  614. IF xText <> '' AND
  615. xText <> '?' THEN sAgr = ENTRY(2, xText, CHR(01)).
  616. PUT CONTROL sAgr CHR(10).
  617. END.
  618. FIND KGebinde USE-INDEX KGebinde-k1
  619. WHERE KGebinde.Firma = Firma
  620. AND KGebinde.Geb_Cd = Artst.KGeb_Cd NO-LOCK NO-ERROR.
  621. IF AVAILABLE KGebinde THEN KGeb = KGebinde.KBez.
  622. ELSE KGeb = FILL('?', 10).
  623. FIND VGebinde USE-INDEX VGebinde-k1
  624. WHERE VGebinde.Firma = Firma
  625. AND VGebinde.Geb_Cd = Artst.VGeb_Cd NO-LOCK NO-ERROR.
  626. IF AVAILABLE VGebinde THEN VGeb = VGebinde.KBez.
  627. ELSE VGeb = FILL('?', 10).
  628. RUN FIND_FARBE ( INPUT Artst.Farbe, OUTPUT cString ).
  629. IF cString = '?' OR
  630. cString = '' THEN cString = CHR(01).
  631. cString = ENTRY(2, cString, CHR(01)).
  632. CASE cString:
  633. WHEN 'rot' THEN xFarbe = 'O'.
  634. WHEN 'weiss' THEN xFarbe = 'W'.
  635. WHEN 'rose' THEN xFarbe = 'R'.
  636. OTHERWISE xFarbe = ''.
  637. END CASE.
  638. PUT CONTROL '£'.
  639. PUT CONTROL STRING(Artst.Artnr ,'999999') '£'
  640. Artbez.Bez1 '£'.
  641. IF R_Art = 2 THEN PUT CONTROL TRIM(STRING(Artst.Jahr,'zzzz')) '£'
  642. xFarbe '£'.
  643. PUT CONTROL KGeb '£'
  644. VGeb '£'.
  645. IF R_Preis = 1 THEN DO:
  646. dPreis = AktPreis.Wert.
  647. IF AktPreis.Art = 0 THEN PUT CONTROL STRING(dPreis,'zz9.99 Fr').
  648. IF AktPreis.Art = 1 THEN PUT CONTROL STRING(dPreis,'z9.9 %').
  649. END.
  650. IF R_Preis = 2 THEN DO:
  651. FIND LAST ArtPreis USE-INDEX ArtPreis-k1
  652. WHERE ArtPreis.Firma = AktPreis.Firma
  653. AND ArtPreis.Artnr = AktPreis.Artnr
  654. AND ArtPreis.Inhalt = AktPreis.Inhalt
  655. AND ArtPreis.Jahr = AktPreis.Jahr
  656. AND ArtPreis.Preis_Grp = iPreisGrp
  657. AND ArtPreis.Ab_Datum <= F_VonDatum NO-LOCK NO-ERROR.
  658. IF NOT AVAILABLE ArtPreis THEN dPreis = 0.
  659. ELSE DO:
  660. IF fPreis THEN dPreis = ArtPreis.VK_Brutto.
  661. ELSE dPreis = ArtPreis.VK_Netto .
  662. IF AktPreis.Art = 0 THEN dPreis = dPreis - AktPreis.Wert.
  663. ELSE dPreis = dPreis * (100 - AktPreis.Wert) / 100.
  664. END.
  665. PUT CONTROL TRIM(STRING(dPreis,'zzzzz9.99 Fr')).
  666. END.
  667. PUT CONTROL '££'
  668. STRING(AktPreis.Ab_Datum ,'99.99.9999') '£'
  669. STRING(AktPreis.Bis_Datum,'99.99.9999') '££'
  670. AktPreis.Bemerkung.
  671. PUT CONTROL CHR(10).
  672. IF Artbez.Bez2 <> '' THEN DO:
  673. PUT CONTROL '££'
  674. Artbez.Bez2 CHR(10).
  675. END.
  676. ExcelOpen = TRUE.
  677. IF LAST-OF ( Artst.Wg_Grp ) OR
  678. LAST-OF ( Artst.Prod_Grp ) OR
  679. LAST-OF ( Artst.Art_Grp ) THEN PUT CONTROL '£' CHR(10).
  680. END.
  681. OUTPUT CLOSE.
  682. IF NOT ExcelOpen THEN DO:
  683. DYNAMIC-FUNCTION('RELEASEEXCEL':U, INPUT excelAppl ) NO-ERROR.
  684. RETURN.
  685. END.
  686. IF R_Art = 2 THEN DO:
  687. INPUT FROM VALUE(DatenName) NO-ECHO.
  688. EMPTY TEMP-TABLE TExcel.
  689. ix = 5.
  690. REPEAT TRANSACTION ON STOP UNDO, LEAVE
  691. ON ERROR UNDO, NEXT:
  692. ix = ix + 1.
  693. CREATE TExcel.
  694. IMPORT DELIMITER "£" TExcel.
  695. ASSIGN TExcel.Zeile = ix.
  696. END.
  697. INPUT CLOSE.
  698. END.
  699. RUN OPENEXCEL ( INPUT excelAppl,
  700. INPUT DateiName,
  701. INPUT '',
  702. OUTPUT Ja ).
  703. IF NOT Ja THEN DO:
  704. RUN FEHLER ( INPUT 1040 ).
  705. RETURN NO-APPLY.
  706. END.
  707. Zelle = 'A6'.
  708. excelAppl:Range(Zelle):SELECT.
  709. excelAppl:Selection:FormulaR1C1 = 'TEXT;' + DatenName.
  710. excelAppl:Application:RUN ( 'DateiEinfügen' ).
  711. /*
  712. RUN KOPF ( INPUT excelAppl ) NO-ERROR.
  713. */
  714. Zelle = 'A1'.
  715. excelAppl:Range(Zelle):SELECT.
  716. excelAppl:Selection:ColumnWidth = 0.3.
  717. ix = 0.
  718. excelAppl:Range(Zelle):SELECT.
  719. FOR EACH TExcel BY TExcel.Zeile:
  720. IF TExcel.Feld[05] = '' THEN NEXT.
  721. Zelle = 'E' + TRIM(STRING(TExcel.Zeile,'zzzzz9')).
  722. excelAppl:Range(Zelle):SELECT.
  723. excelAppl:Selection:Font:Name = "Wingdings".
  724. excelAppl:Selection:FormulaR1C1 = "n".
  725. CASE TExcel.Feld[05]:
  726. WHEN 'O' THEN DO:
  727. excelAppl:Selection:Font:Colorindex = 3.
  728. END.
  729. WHEN 'W' THEN DO:
  730. excelAppl:Selection:Font:Colorindex = 6.
  731. END.
  732. WHEN 'R' THEN DO:
  733. excelAppl:Selection:Font:Colorindex = 7.
  734. END.
  735. OTHERWISE excelAppl:Selection:FormulaR1C1 = "".
  736. END CASE.
  737. END.
  738. Zelle = 'A1'.
  739. excelAppl:Range(Zelle):SELECT.
  740. DYNAMIC-FUNCTION('RELEASEEXCEL':U, INPUT excelAppl ) NO-ERROR.
  741. END.
  742. END PROCEDURE.
  743. /* _UIB-CODE-BLOCK-END */
  744. &ANALYZE-RESUME
  745. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE selectPage gAAktionen
  746. PROCEDURE selectPage :
  747. /*------------------------------------------------------------------------------
  748. Purpose: Super Override
  749. Parameters:
  750. Notes:
  751. ------------------------------------------------------------------------------*/
  752. DEF INPUT PARAMETER piPageNum AS INT NO-UNDO.
  753. DEF VAR FMutFlag AS LOG NO-UNDO.
  754. DEF VAR MutProg AS CHAR NO-UNDO.
  755. FMutFlag = DYNAMIC-FUNCTION('getMutflagAlt':U) NO-ERROR.
  756. DO WHILE TRUE:
  757. IF NOT FMutFlag THEN LEAVE.
  758. MutProg = DYNAMIC-FUNCTION('GETMUTPROG':U).
  759. IF MutProg <> THIS-PROCEDURE:FILE-NAME THEN LEAVE.
  760. RETURN NO-APPLY.
  761. END.
  762. CASE piPageNum:
  763. END CASE.
  764. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U).
  765. CASE AktSeite:
  766. WHEN 1 THEN DO:
  767. /* RUN removeLink ( h_dyntoolbar , 'TableIO':U , h_v-auftr ). */
  768. /* RUN removeLink ( h_dyntoolbar , 'Navigation':U , h_d-auftr ). */
  769. END.
  770. END CASE.
  771. RUN SUPER( INPUT piPageNum).
  772. END PROCEDURE.
  773. /* _UIB-CODE-BLOCK-END */
  774. &ANALYZE-RESUME