g-calanda.w 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976
  1. &ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2
  2. &ANALYZE-RESUME
  3. &Scoped-define WINDOW-NAME CURRENT-WINDOW
  4. &Scoped-define FRAME-NAME gCalanda
  5. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS gCalanda
  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 AdFirma AS CHAR NO-UNDO.
  32. DEF VAR ProgName AS CHAR NO-UNDO.
  33. DEF TEMP-TABLE TWork FIELD Knr AS INT
  34. FIELD Artnr AS INT
  35. FIELD Inhalt AS INT
  36. FIELD Jahr AS INT
  37. FIELD GebInhalt AS DEC DECIMALS 4
  38. FIELD Menge AS DEC DECIMALS 4
  39. FIELD Liter AS DEC DECIMALS 4
  40. FIELD Betr AS DEC DECIMALS 4
  41. FIELD MeKum AS DEC DECIMALS 4
  42. FIELD LiKum AS DEC DECIMALS 4
  43. FIELD BeKum AS DEC DECIMALS 4
  44. FIELD Bez AS CHAR
  45. FIELD GebCd AS CHAR
  46. FIELD RID AS RECID
  47. INDEX TWork-k1
  48. Knr
  49. Artnr
  50. Inhalt
  51. Jahr.
  52. DEF BUFFER BWork FOR TWork.
  53. /* _UIB-CODE-BLOCK-END */
  54. &ANALYZE-RESUME
  55. &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  56. /* ******************** Preprocessor Definitions ******************** */
  57. &Scoped-define PROCEDURE-TYPE SmartDialog
  58. &Scoped-define DB-AWARE no
  59. &Scoped-define ADM-CONTAINER DIALOG-BOX
  60. &Scoped-define ADM-SUPPORTED-LINKS Data-Target,Data-Source,Page-Target,Update-Source,Update-Target
  61. /* Name of designated FRAME-NAME and/or first browse and/or first query */
  62. &Scoped-define FRAME-NAME gCalanda
  63. /* Standard List Definitions */
  64. &Scoped-Define ENABLED-OBJECTS RECT-21 RECT-22 RECT-23 CB_Hersteller ~
  65. F_Warengrp F_Biercode F_Preisgrp F_VonDatum F_BisDatum Btn_Start ~
  66. Btn_Abbrechen
  67. &Scoped-Define DISPLAYED-OBJECTS CB_Hersteller F_Warengrp F_Biercode ~
  68. F_Preisgrp F_VonDatum F_BisDatum
  69. /* Custom List Definitions */
  70. /* List-1,List-2,List-3,List-4,List-5,List-6 */
  71. &Scoped-define List-1 CB_Hersteller Btn_Start Btn_Abbrechen
  72. &Scoped-define List-6 F_Warengrp F_Biercode F_Preisgrp F_VonDatum ~
  73. F_BisDatum
  74. /* _UIB-PREPROCESSOR-BLOCK-END */
  75. &ANALYZE-RESUME
  76. /* *********************** Control Definitions ********************** */
  77. /* Define a dialog box */
  78. /* Definitions of the field level widgets */
  79. DEFINE BUTTON Btn_Abbrechen
  80. LABEL "&Abbrechen"
  81. SIZE 16 BY 1.
  82. DEFINE BUTTON Btn_Start
  83. LABEL "&Starten"
  84. SIZE 16 BY 1.
  85. DEFINE VARIABLE CB_Hersteller AS CHARACTER FORMAT "X(256)":U
  86. LABEL "Hersteller"
  87. VIEW-AS COMBO-BOX SORT INNER-LINES 5
  88. DROP-DOWN-LIST
  89. SIZE 40 BY 1
  90. BGCOLOR 15 NO-UNDO.
  91. DEFINE VARIABLE F_Biercode AS CHARACTER FORMAT "X(256)":U
  92. LABEL "Vertragsarten"
  93. VIEW-AS FILL-IN NATIVE
  94. SIZE 40 BY 1
  95. BGCOLOR 15 NO-UNDO.
  96. DEFINE VARIABLE F_BisDatum AS DATE FORMAT "99.99.9999":U
  97. VIEW-AS FILL-IN NATIVE
  98. SIZE 16 BY 1
  99. BGCOLOR 15 NO-UNDO.
  100. DEFINE VARIABLE F_Preisgrp AS CHARACTER FORMAT "X(256)":U
  101. LABEL "Preisgruppen"
  102. VIEW-AS FILL-IN NATIVE
  103. SIZE 40 BY 1
  104. BGCOLOR 15 NO-UNDO.
  105. DEFINE VARIABLE F_VonDatum AS DATE FORMAT "99.99.9999":U
  106. LABEL "von - bis Datum"
  107. VIEW-AS FILL-IN NATIVE
  108. SIZE 16 BY 1
  109. BGCOLOR 15 NO-UNDO.
  110. DEFINE VARIABLE F_Warengrp AS CHARACTER FORMAT "X(256)":U
  111. LABEL "Warengruppen"
  112. VIEW-AS FILL-IN NATIVE
  113. SIZE 40 BY 1
  114. BGCOLOR 15 NO-UNDO.
  115. DEFINE RECTANGLE RECT-21
  116. EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL
  117. SIZE 88 BY 3.1.
  118. DEFINE RECTANGLE RECT-22
  119. EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL
  120. SIZE 88 BY 3.1.
  121. DEFINE RECTANGLE RECT-23
  122. EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL
  123. SIZE 88 BY 4.29.
  124. /* ************************ Frame Definitions *********************** */
  125. DEFINE FRAME gCalanda
  126. CB_Hersteller AT ROW 1.81 COL 42 COLON-ALIGNED
  127. F_Warengrp AT ROW 2.81 COL 42 COLON-ALIGNED
  128. F_Biercode AT ROW 5.81 COL 42 COLON-ALIGNED
  129. F_Preisgrp AT ROW 6.81 COL 42 COLON-ALIGNED
  130. F_VonDatum AT ROW 10 COL 42 COLON-ALIGNED AUTO-RETURN
  131. F_BisDatum AT ROW 10 COL 66 COLON-ALIGNED NO-LABEL AUTO-RETURN
  132. Btn_Start AT ROW 11.57 COL 44
  133. Btn_Abbrechen AT ROW 11.57 COL 68
  134. "Kundenselektion" VIEW-AS TEXT
  135. SIZE 21.2 BY 1 AT ROW 5.81 COL 5.2
  136. "Artikelselektion" VIEW-AS TEXT
  137. SIZE 21.2 BY 1 AT ROW 1.81 COL 5.2
  138. RECT-21 AT ROW 1.24 COL 2
  139. RECT-22 AT ROW 5.29 COL 2
  140. RECT-23 AT ROW 9.1 COL 2
  141. SPACE(0.99) SKIP(0.12)
  142. WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER
  143. SIDE-LABELS NO-UNDERLINE THREE-D SCROLLABLE
  144. TITLE "Verkaufszahlen Calanda-Kunden".
  145. /* *********************** Procedure Settings ************************ */
  146. &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  147. /* Settings for THIS-PROCEDURE
  148. Type: SmartDialog
  149. Allow: Basic,Browse,DB-Fields,Query,Smart
  150. Container Links: Data-Target,Data-Source,Page-Target,Update-Source,Update-Target
  151. Design Page: 1
  152. Other Settings: COMPILE
  153. */
  154. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  155. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB gCalanda
  156. /* ************************* Included-Libraries *********************** */
  157. {src/adm2/containr.i}
  158. /* _UIB-CODE-BLOCK-END */
  159. &ANALYZE-RESUME
  160. /* *********** Runtime Attributes and AppBuilder Settings *********** */
  161. &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
  162. /* SETTINGS FOR DIALOG-BOX gCalanda
  163. FRAME-NAME */
  164. ASSIGN
  165. FRAME gCalanda:SCROLLABLE = FALSE
  166. FRAME gCalanda:HIDDEN = TRUE.
  167. /* SETTINGS FOR BUTTON Btn_Abbrechen IN FRAME gCalanda
  168. 1 */
  169. /* SETTINGS FOR BUTTON Btn_Start IN FRAME gCalanda
  170. 1 */
  171. /* SETTINGS FOR COMBO-BOX CB_Hersteller IN FRAME gCalanda
  172. 1 */
  173. /* SETTINGS FOR FILL-IN F_Biercode IN FRAME gCalanda
  174. 6 */
  175. /* SETTINGS FOR FILL-IN F_BisDatum IN FRAME gCalanda
  176. 6 */
  177. /* SETTINGS FOR FILL-IN F_Preisgrp IN FRAME gCalanda
  178. 6 */
  179. /* SETTINGS FOR FILL-IN F_VonDatum IN FRAME gCalanda
  180. 6 */
  181. /* SETTINGS FOR FILL-IN F_Warengrp IN FRAME gCalanda
  182. 6 */
  183. /* _RUN-TIME-ATTRIBUTES-END */
  184. &ANALYZE-RESUME
  185. /* Setting information for Queries and Browse Widgets fields */
  186. &ANALYZE-SUSPEND _QUERY-BLOCK DIALOG-BOX gCalanda
  187. /* Query rebuild information for DIALOG-BOX gCalanda
  188. _Options = "SHARE-LOCK"
  189. _Query is NOT OPENED
  190. */ /* DIALOG-BOX gCalanda */
  191. &ANALYZE-RESUME
  192. /* ************************ Control Triggers ************************ */
  193. &Scoped-define SELF-NAME gCalanda
  194. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL gCalanda gCalanda
  195. ON END-ERROR OF FRAME gCalanda /* Verkaufszahlen Calanda-Kunden */
  196. DO:
  197. RUN ENDE.
  198. RETURN NO-APPLY.
  199. END.
  200. /* _UIB-CODE-BLOCK-END */
  201. &ANALYZE-RESUME
  202. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL gCalanda gCalanda
  203. ON GO OF FRAME gCalanda /* Verkaufszahlen Calanda-Kunden */
  204. DO:
  205. /*
  206. RUN ENDE_PROGRAMM ( INPUT THIS-PROCEDURE:FILE-NAME ) NO-ERROR.
  207. */
  208. END.
  209. /* _UIB-CODE-BLOCK-END */
  210. &ANALYZE-RESUME
  211. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL gCalanda gCalanda
  212. ON WINDOW-CLOSE OF FRAME gCalanda /* Verkaufszahlen Calanda-Kunden */
  213. DO:
  214. RUN ENDE.
  215. RETURN NO-APPLY.
  216. END.
  217. /* _UIB-CODE-BLOCK-END */
  218. &ANALYZE-RESUME
  219. &Scoped-define SELF-NAME Btn_Abbrechen
  220. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Abbrechen gCalanda
  221. ON CHOOSE OF Btn_Abbrechen IN FRAME gCalanda /* Abbrechen */
  222. DO:
  223. RUN ENDE.
  224. RETURN NO-APPLY.
  225. END.
  226. /* _UIB-CODE-BLOCK-END */
  227. &ANALYZE-RESUME
  228. &Scoped-define SELF-NAME Btn_Start
  229. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Start gCalanda
  230. ON CHOOSE OF Btn_Start IN FRAME gCalanda /* Starten */
  231. DO:
  232. DO WITH FRAME {&FRAME-NAME}:
  233. RUN BEREINIGEN ( F_Warengrp:HANDLE ).
  234. RUN BEREINIGEN ( F_Biercode:HANDLE ).
  235. RUN BEREINIGEN ( F_Preisgrp:HANDLE ).
  236. ASSIGN {&List-6}.
  237. IF F_VonDatum = ? THEN DO:
  238. APPLY 'ENTRY' TO F_VonDatum.
  239. RETURN NO-APPLY.
  240. END.
  241. IF F_BisDatum = ? THEN DO:
  242. APPLY 'ENTRY' TO F_BisDatum.
  243. RETURN NO-APPLY.
  244. END.
  245. IF F_BisDatum < F_VonDatum THEN DO:
  246. APPLY 'ENTRY' TO F_VonDatum.
  247. RETURN NO-APPLY.
  248. END.
  249. DISPLAY {&List-6}.
  250. RUN SCHREIBENFWAUSWERTUNGEN ( INPUT ProgName,
  251. INPUT FRAME {&FRAME-NAME}:CURRENT-ITERATION ) NO-ERROR.
  252. Btn_Start :SENSITIVE = FALSE.
  253. Btn_Abbrechen:SENSITIVE = FALSE.
  254. RUN REPORT.
  255. Btn_Start :SENSITIVE = TRUE.
  256. Btn_Abbrechen:SENSITIVE = TRUE.
  257. RUN ENDE.
  258. RETURN NO-APPLY.
  259. END.
  260. END.
  261. /* _UIB-CODE-BLOCK-END */
  262. &ANALYZE-RESUME
  263. &Scoped-define SELF-NAME F_Biercode
  264. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F_Biercode gCalanda
  265. ON RIGHT-MOUSE-CLICK OF F_Biercode IN FRAME gCalanda /* Vertragsarten */
  266. DO:
  267. RUN g-auswahl-tabelle.w ( INPUT SELF, INPUT 'BIER' ).
  268. END.
  269. /* _UIB-CODE-BLOCK-END */
  270. &ANALYZE-RESUME
  271. &Scoped-define SELF-NAME F_Preisgrp
  272. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F_Preisgrp gCalanda
  273. ON RIGHT-MOUSE-CLICK OF F_Preisgrp IN FRAME gCalanda /* Preisgruppen */
  274. DO:
  275. RUN g-auswahl-tabelle.w ( INPUT SELF, INPUT 'PREGRP' ).
  276. END.
  277. /* _UIB-CODE-BLOCK-END */
  278. &ANALYZE-RESUME
  279. &Scoped-define SELF-NAME F_Warengrp
  280. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F_Warengrp gCalanda
  281. ON RIGHT-MOUSE-CLICK OF F_Warengrp IN FRAME gCalanda /* Warengruppen */
  282. DO:
  283. RUN g-auswahl-wgr.w ( INPUT SELF ).
  284. END.
  285. /* _UIB-CODE-BLOCK-END */
  286. &ANALYZE-RESUME
  287. &UNDEFINE SELF-NAME
  288. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK gCalanda
  289. /* *************************** Main Block *************************** */
  290. MaxPage = 1.
  291. AktSeite = 1.
  292. Firma = DYNAMIC-FUNCTION('GETMANDANT':U) NO-ERROR.
  293. AdFirma = DYNAMIC-FUNCTION('GETADMANDANT':U) NO-ERROR.
  294. ProgName = ENTRY(1, THIS-PROCEDURE:FILE-NAME, '.') NO-ERROR.
  295. SESSION:DATA-ENTRY-RETURN = TRUE.
  296. /* TRIGGERS ------------------------------------------------------ */
  297. {src/adm2/dialogmn.i}
  298. /* _UIB-CODE-BLOCK-END */
  299. &ANALYZE-RESUME
  300. /* ********************** Internal Procedures *********************** */
  301. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects gCalanda _ADM-CREATE-OBJECTS
  302. PROCEDURE adm-create-objects :
  303. /*------------------------------------------------------------------------------
  304. Purpose: Create handles for all SmartObjects used in this procedure.
  305. After SmartObjects are initialized, then SmartLinks are added.
  306. Parameters: <none>
  307. ------------------------------------------------------------------------------*/
  308. END PROCEDURE.
  309. /* _UIB-CODE-BLOCK-END */
  310. &ANALYZE-RESUME
  311. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ADRESSE gCalanda
  312. PROCEDURE ADRESSE :
  313. /*------------------------------------------------------------------------------
  314. Purpose:
  315. Parameters: <none>
  316. Notes:
  317. ------------------------------------------------------------------------------*/
  318. DEF INPUT PARAMETER ipKnr AS INT NO-UNDO.
  319. DEF OUTPUT PARAMETER opAdresse AS CHAR NO-UNDO.
  320. DEF VAR ii AS INT NO-UNDO.
  321. opAdresse = ''.
  322. ii = 0.
  323. FIND Adresse USE-INDEX Adresse-k1
  324. WHERE Adresse.Firma = AdFirma
  325. AND Adresse.Knr = ipKnr NO-LOCK NO-ERROR.
  326. DO WHILE TRUE:
  327. IF NOT AVAILABLE Adresse THEN LEAVE.
  328. IF Adresse.Firma1 <> '' THEN DO:
  329. IF opAdresse <> '' THEN opAdresse = opAdresse + ', '.
  330. opAdresse = opAdresse + TRIM(Adresse.Firma1 + ' ' + Adresse.Firma2).
  331. END.
  332. IF Adresse.NAME <> '' THEN DO:
  333. IF opAdresse <> '' THEN opAdresse = opAdresse + ', '.
  334. opAdresse = opAdresse + TRIM(Adresse.Name + ' ' + Adresse.Vorname).
  335. END.
  336. opAdresse = opAdresse + ';'.
  337. IF Adresse.Strasse <> '' THEN DO:
  338. opAdresse = opAdresse + Adresse.Strasse + ', '.
  339. END.
  340. opAdresse = opAdresse + Adresse.Plz + ' ' + Adresse.Ort.
  341. LEAVE.
  342. END.
  343. opAdresse = STRING(ipKnr,"999999 / ") + opAdresse.
  344. END PROCEDURE.
  345. /* _UIB-CODE-BLOCK-END */
  346. &ANALYZE-RESUME
  347. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN gCalanda
  348. PROCEDURE BEREINIGEN :
  349. /*------------------------------------------------------------------------------
  350. Purpose:
  351. Parameters: <none>
  352. Notes:
  353. ------------------------------------------------------------------------------*/
  354. DEF INPUT PARAMETER ipHandle AS HANDLE NO-UNDO.
  355. DEF VAR cString AS CHAR NO-UNDO.
  356. DEF VAR i AS INT NO-UNDO.
  357. cString = ''.
  358. DO i = 1 TO LENGTH(ipHandle:SCREEN-VALUE):
  359. IF SUBSTRING(ipHandle:SCREEN-VALUE,i,1) < '0' OR
  360. SUBSTRING(ipHandle:SCREEN-VALUE,i,1) > '9' THEN DO:
  361. SUBSTRING(ipHandle:SCREEN-VALUE,i) = ','.
  362. END.
  363. END.
  364. DO i = 1 TO NUM-ENTRIES(ipHandle:SCREEN-VALUE, ','):
  365. IF cString <> '' THEN cString = cString + ','.
  366. cString = cString
  367. + STRING(INTEGER(ENTRY(i, ipHandle:SCREEN-VALUE, ',')),'999').
  368. END.
  369. ipHandle:SCREEN-VALUE = cString.
  370. RETURN.
  371. END PROCEDURE.
  372. /* _UIB-CODE-BLOCK-END */
  373. &ANALYZE-RESUME
  374. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE changePage gCalanda
  375. PROCEDURE changePage :
  376. /*------------------------------------------------------------------------------
  377. Purpose: Super Override
  378. Parameters:
  379. Notes:
  380. ------------------------------------------------------------------------------*/
  381. /* Code placed here will execute PRIOR to standard behavior. */
  382. RUN SUPER.
  383. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U).
  384. CASE AktSeite:
  385. WHEN 1 THEN DO:
  386. /* RUN addLink ( h_dyntoolbar , 'TableIO':U , h_v-auftr ). */
  387. /* RUN addLink ( h_dyntoolbar , 'Navigation':U , h_d-auftr ). */
  388. /* RUN ToolbarInit ( INPUT h_d-auftr ). */
  389. RUN ENTRY_CURSOR.
  390. END.
  391. WHEN 2 THEN DO:
  392. RUN ENTRY_CURSOR.
  393. END.
  394. END CASE.
  395. END PROCEDURE.
  396. /* _UIB-CODE-BLOCK-END */
  397. &ANALYZE-RESUME
  398. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI gCalanda _DEFAULT-DISABLE
  399. PROCEDURE disable_UI :
  400. /*------------------------------------------------------------------------------
  401. Purpose: DISABLE the User Interface
  402. Parameters: <none>
  403. Notes: Here we clean-up the user-interface by deleting
  404. dynamic widgets we have created and/or hide
  405. frames. This procedure is usually called when
  406. we are ready to "clean-up" after running.
  407. ------------------------------------------------------------------------------*/
  408. /* Hide all frames. */
  409. HIDE FRAME gCalanda.
  410. END PROCEDURE.
  411. /* _UIB-CODE-BLOCK-END */
  412. &ANALYZE-RESUME
  413. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableObject gCalanda
  414. PROCEDURE enableObject :
  415. /*------------------------------------------------------------------------------
  416. Purpose: Super Override
  417. Parameters:
  418. Notes:
  419. ------------------------------------------------------------------------------*/
  420. RUN COMBO_HERSTELLER ( CB_Hersteller:HANDLE IN FRAME {&FRAME-NAME} ).
  421. RUN SUPER.
  422. RUN FENSTER_TITEL ( INPUT FRAME {&FRAME-NAME}:HANDLE ) NO-ERROR.
  423. RUN LESENFWAUSWERTUNGEN ( INPUT ProgName,
  424. INPUT FRAME {&FRAME-NAME}:CURRENT-ITERATION ) NO-ERROR.
  425. END PROCEDURE.
  426. /* _UIB-CODE-BLOCK-END */
  427. &ANALYZE-RESUME
  428. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI gCalanda _DEFAULT-ENABLE
  429. PROCEDURE enable_UI :
  430. /*------------------------------------------------------------------------------
  431. Purpose: ENABLE the User Interface
  432. Parameters: <none>
  433. Notes: Here we display/view/enable the widgets in the
  434. user-interface. In addition, OPEN all queries
  435. associated with each FRAME and BROWSE.
  436. These statements here are based on the "Other
  437. Settings" section of the widget Property Sheets.
  438. ------------------------------------------------------------------------------*/
  439. DISPLAY CB_Hersteller F_Warengrp F_Biercode F_Preisgrp F_VonDatum F_BisDatum
  440. WITH FRAME gCalanda.
  441. ENABLE RECT-21 RECT-22 RECT-23 CB_Hersteller F_Warengrp F_Biercode F_Preisgrp
  442. F_VonDatum F_BisDatum Btn_Start Btn_Abbrechen
  443. WITH FRAME gCalanda.
  444. VIEW FRAME gCalanda.
  445. {&OPEN-BROWSERS-IN-QUERY-gCalanda}
  446. END PROCEDURE.
  447. /* _UIB-CODE-BLOCK-END */
  448. &ANALYZE-RESUME
  449. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ENDE gCalanda
  450. PROCEDURE ENDE :
  451. /*------------------------------------------------------------------------------
  452. Purpose:
  453. Parameters: <none>
  454. Notes:
  455. ------------------------------------------------------------------------------*/
  456. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U) NO-ERROR.
  457. IF AktSeite > 1 THEN DO:
  458. RUN selectPage ( INPUT 1 ).
  459. RETURN NO-APPLY.
  460. END.
  461. RUN ENDE_PROGRAMM ( INPUT THIS-PROCEDURE:FILE-NAME ).
  462. APPLY 'GO' TO FRAME {&FRAME-NAME}.
  463. RETURN NO-APPLY.
  464. END PROCEDURE.
  465. /* _UIB-CODE-BLOCK-END */
  466. &ANALYZE-RESUME
  467. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ENTRY_CURSOR gCalanda
  468. PROCEDURE ENTRY_CURSOR :
  469. /*------------------------------------------------------------------------------
  470. Purpose:
  471. Parameters: <none>
  472. Notes:
  473. ------------------------------------------------------------------------------*/
  474. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U).
  475. CASE AktSeite:
  476. /* WHEN 1 THEN RUN applyEntry IN h_v-adresse ( INPUT ? ). */
  477. /* WHEN 2 THEN RUN applyEntry IN h_f-adrkomm ( INPUT ? ). */
  478. /* WHEN 3 THEN RUN applyEntry IN h_b-auftbb ( INPUT ? ). */
  479. /* WHEN 4 THEN RUN applyEntry IN h_b-aufdet ( INPUT ? ). */
  480. /* WHEN 5 THEN RUN applyEntry IN h_b-aufstreu ( INPUT ? ). */
  481. /* WHEN 6 THEN RUN applyEntry IN h_b-auffak ( INPUT ? ). */
  482. /* WHEN 7 THEN RUN applyEntry IN h_b-position ( INPUT ? ). */
  483. END CASE.
  484. RETURN NO-APPLY.
  485. END PROCEDURE.
  486. /* _UIB-CODE-BLOCK-END */
  487. &ANALYZE-RESUME
  488. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE exitObject gCalanda
  489. PROCEDURE exitObject :
  490. /*------------------------------------------------------------------------------
  491. Purpose: Super Override
  492. Parameters:
  493. Notes:
  494. ------------------------------------------------------------------------------*/
  495. RUN ENDE.
  496. RETURN NO-APPLY.
  497. END PROCEDURE.
  498. /* _UIB-CODE-BLOCK-END */
  499. &ANALYZE-RESUME
  500. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE KOPF gCalanda
  501. PROCEDURE KOPF :
  502. /*------------------------------------------------------------------------------
  503. Purpose:
  504. Parameters: <none>
  505. Notes:
  506. ------------------------------------------------------------------------------*/
  507. DEF INPUT PARAMETER excelAppl AS COM-HANDLE NO-UNDO.
  508. DEF INPUT PARAMETER ipHerst AS INT NO-UNDO.
  509. DEF VAR Zelle AS CHAR NO-UNDO.
  510. DEF VAR cString AS CHAR NO-UNDO.
  511. RUN FIND_HERSTELLER ( INPUT ipHerst, OUTPUT cString ).
  512. Zelle = 'A2'.
  513. cString = ENTRY(2, cString, CHR(01))
  514. + ' - Umsätze für die Zeit vom '
  515. + STRING(F_VonDatum,'99.99.9999')
  516. + ' bis '
  517. + STRING(F_BisDatum,'99.99.9999').
  518. RUN ZELLEFUELLEN ( INPUT excelAppl, INPUT 'A', INPUT 2, INPUT cString ).
  519. END PROCEDURE.
  520. /* _UIB-CODE-BLOCK-END */
  521. &ANALYZE-RESUME
  522. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REPORT gCalanda
  523. PROCEDURE REPORT :
  524. /*------------------------------------------------------------------------------
  525. Purpose:
  526. Parameters: <none>
  527. Notes:
  528. ------------------------------------------------------------------------------*/
  529. DEF VAR StartDatum AS DATE NO-UNDO.
  530. DEF VAR iHerst AS INT NO-UNDO.
  531. DEF VAR cString AS CHAR NO-UNDO.
  532. DEF VAR cBiercd AS CHAR NO-UNDO.
  533. DEF VAR cPreis AS CHAR NO-UNDO.
  534. DEF VAR Rundbetr AS DEC DECIMALS 4 NO-UNDO.
  535. DEF VAR Totale AS DEC DECIMALS 4 NO-UNDO EXTENT 5.
  536. DEF VAR GTotale AS DEC DECIMALS 4 NO-UNDO EXTENT 5.
  537. DEF VAR Anzahl AS INT NO-UNDO.
  538. DEF VAR cVorlage AS CHAR NO-UNDO.
  539. DEF VAR cDaten AS CHAR NO-UNDO.
  540. DEF VAR cDokument AS CHAR NO-UNDO.
  541. DEF VAR cDateiName AS CHAR NO-UNDO.
  542. DEF VAR Zelle AS CHAR NO-UNDO.
  543. DEF VAR excelAppl AS COM-HANDLE NO-UNDO.
  544. DEF VAR ja AS LOG NO-UNDO.
  545. EMPTY TEMP-TABLE TWork.
  546. StartDatum = DATE(01,01,YEAR(F_VonDatum)).
  547. DO WITH FRAME {&FRAME-NAME}:
  548. iHerst = INTEGER(CB_Hersteller:SCREEN-VALUE).
  549. FOR EACH Artst USE-INDEX Artst-k1
  550. WHERE Artst.Firma = Firma
  551. AND Artst.Herst = iHerst NO-LOCK:
  552. IF F_Warengrp = '' THEN.
  553. ELSE DO:
  554. cString = STRING(Artst.Wg_Grp,'999').
  555. IF LOOKUP(cString, F_Warengrp, ',') = 0 THEN NEXT.
  556. END.
  557. FOR EACH Artbw USE-INDEX Artbw-k2
  558. WHERE Artbw.Firma = Artst.Firma
  559. AND Artbw.Artnr = Artst.Artnr
  560. AND Artbw.Inhalt = Artst.Inhalt
  561. AND Artbw.Jahr = Artst.Jahr
  562. AND Artbw.Datum >= StartDatum
  563. AND Artbw.Datum <= F_BisDatum
  564. AND Artbw.Tr_Art < 9 NO-LOCK,
  565. FIRST Debst NO-LOCK USE-INDEX Debst-k1
  566. WHERE Debst.Firma = Artbw.Firma
  567. AND Debst.Knr = Artbw.Knr :
  568. cBiercd = STRING(Debst.Bier_Cd ,'999').
  569. cPreis = STRING(Debst.Preis_Grp,'999').
  570. IF F_Biercode = '' THEN.
  571. ELSE DO:
  572. IF LOOKUP(cBiercd, F_Biercode, ',') = 0 THEN NEXT.
  573. END.
  574. IF F_Preisgrp = '' THEN.
  575. ELSE DO:
  576. IF LOOKUP(cPreis, F_Preisgrp, ',') = 0 THEN NEXT.
  577. END.
  578. FIND FIRST TWork USE-INDEX TWork-k1
  579. WHERE TWork.Knr = Artbw.Knr
  580. AND TWork.Artnr = Artbw.Artnr
  581. AND TWork.Inhalt = Artbw.Inhalt
  582. AND TWork.Jahr = Artbw.Jahr NO-ERROR.
  583. IF NOT AVAILABLE TWork THEN DO:
  584. FIND KGebinde USE-INDEX KGebinde-k1
  585. WHERE KGebinde.Firma = Artst.Firma
  586. AND KGebinde.Geb_Cd = Artst.KGeb_Cd NO-LOCK.
  587. CREATE TWork.
  588. ASSIGN TWork.Knr = Artbw.Knr
  589. TWork.Artnr = Artbw.Artnr
  590. TWork.Inhalt = Artbw.Inhalt
  591. TWork.Jahr = Artbw.Jahr
  592. TWork.GebInhalt = KGebinde.Inhalt
  593. TWork.GebCd = KGebinde.KBez
  594. TWork.Bez = Artst.Bez
  595. TWork.RID = RECID(Artst).
  596. END.
  597. Rundbetr = Artbw.Menge * TWork.GebInhalt.
  598. IF Artbw.Datum >= F_VonDatum THEN DO:
  599. TWork.Menge = TWork.Menge + Artbw.Menge.
  600. TWork.Liter = TWork.Liter + Rundbetr.
  601. TWork.Betr = TWork.Betr + Artbw.Net_Betr.
  602. END.
  603. TWork.MeKum = TWork.MeKum + Artbw.Menge.
  604. TWork.LiKum = TWork.LiKum + Rundbetr.
  605. TWork.BeKum = TWork.BeKum + Artbw.Net_Betr.
  606. END.
  607. END.
  608. FOR EACH TWork WHERE TWork.Menge = 0
  609. AND TWork.MeKum = 0:
  610. DELETE TWork.
  611. END.
  612. cVorlage = 'Calanda' + '.xls'.
  613. cDokument = 'Calanda' + '.xls'.
  614. cDaten = 'Calanda' + '.txt'.
  615. cDateiName = cDokument + CHR(01) + cVorlage.
  616. RUN CREATEDATEI ( INPUT cDateiName ).
  617. IF RETURN-VALUE BEGINS 'ERROR' THEN RETURN NO-APPLY.
  618. cDokument = RETURN-VALUE.
  619. RUN CREATEDATEI ( INPUT cDaten ).
  620. IF RETURN-VALUE BEGINS 'ERROR' THEN RETURN NO-APPLY.
  621. cDaten = RETURN-VALUE.
  622. OUTPUT TO VALUE(cDaten).
  623. GTotale = 0.
  624. FOR EACH TWork USE-INDEX TWork-k1
  625. BREAK BY TWork.Knr :
  626. IF FIRST-OF ( TWork.Knr ) THEN DO:
  627. Totale = 0.
  628. Anzahl = 0.
  629. RUN ADRESSE ( INPUT TWork.Knr, OUTPUT cString ).
  630. PUT CONTROL ENTRY(1, cString, ';') CHR(10)
  631. ENTRY(2, cString, ';') CHR(10).
  632. END.
  633. FIND Artst WHERE RECID(Artst) = TWork.RID NO-ERROR.
  634. PUT CONTROL '£'
  635. STRING(Artst.Artnr,'999999')
  636. STRING(Artst.Inhalt,'9999') '£'
  637. Artst.Bez '£'
  638. TWork.GebCd '£'.
  639. IF TWork.Menge <> 0
  640. THEN PUT CONTROL TRIM(STRING(TWork.Menge ,'->>>>>>>>>')).
  641. PUT CONTROL '£'.
  642. IF TWork.Liter <> 0
  643. THEN PUT CONTROL TRIM(STRING(TWork.Liter / 10000,'->>>>>>9.99')).
  644. PUT CONTROL '£'.
  645. IF TWork.LiKum <> 0
  646. THEN PUT CONTROL TRIM(STRING(TWork.LiKum / 10000,'->>>>>>9.99')).
  647. PUT CONTROL '£'.
  648. IF TWork.Betr <> 0
  649. THEN PUT CONTROL TRIM(STRING(TWork.Betr ,'->>>>>>9.99')).
  650. PUT CONTROL '£'.
  651. IF TWork.BeKum <> 0
  652. THEN PUT CONTROL TRIM(STRING(TWork.BeKum ,'->>>>>>9.99')).
  653. PUT CONTROL CHR(10).
  654. Totale[01] = Totale[01] + TWork.Menge.
  655. Totale[02] = Totale[02] + TWork.Liter.
  656. Totale[03] = Totale[03] + TWork.LiKum.
  657. Totale[04] = Totale[04] + TWork.Betr.
  658. Totale[05] = Totale[05] + TWork.BeKum.
  659. Anzahl = Anzahl + 1.
  660. IF NOT LAST-OF ( TWork.Knr ) THEN NEXT.
  661. IF Anzahl > 1 THEN DO:
  662. PUT CONTROL '££££'.
  663. IF Totale[01] <> 0
  664. THEN PUT CONTROL TRIM(STRING(Totale[01] ,'->>>>>>>>>')).
  665. PUT CONTROL '£'.
  666. IF Totale[02] <> 0
  667. THEN PUT CONTROL TRIM(STRING(Totale[02] / 10000,'->>>>>>9.99')).
  668. PUT CONTROL '£'.
  669. IF Totale[03] <> 0
  670. THEN PUT CONTROL TRIM(STRING(Totale[03] / 10000,'->>>>>>9.99')).
  671. PUT CONTROL '£'.
  672. IF Totale[04] <> 0
  673. THEN PUT CONTROL TRIM(STRING(Totale[04] ,'->>>>>>9.99')).
  674. PUT CONTROL '£'.
  675. IF Totale[05] <> 0
  676. THEN PUT CONTROL TRIM(STRING(Totale[05] ,'->>>>>>9.99')).
  677. PUT CONTROL CHR(10).
  678. END.
  679. PUT CONTROL '£' CHR(10).
  680. GTotale[01] = GTotale[01] + Totale[01].
  681. GTotale[02] = GTotale[02] + Totale[02].
  682. GTotale[03] = GTotale[03] + Totale[03].
  683. GTotale[04] = GTotale[04] + Totale[04].
  684. GTotale[05] = GTotale[05] + Totale[05].
  685. END.
  686. PUT CONTROL '££££'.
  687. PUT CONTROL TRIM(STRING(GTotale[01] ,'->>>>>>>>>')) '£'
  688. TRIM(STRING(GTotale[02] / 10000,'->>>>>>9.99')) '£'
  689. TRIM(STRING(GTotale[03] / 10000,'->>>>>>9.99')) '£'
  690. TRIM(STRING(GTotale[04] ,'->>>>>>9.99')) '£'
  691. TRIM(STRING(GTotale[05] ,'->>>>>>9.99')) CHR(10).
  692. OUTPUT CLOSE.
  693. excelAppl = DYNAMIC-FUNCTION('CREATEEXCEL':U) NO-ERROR.
  694. IF NOT VALID-HANDLE(excelAppl) THEN DO:
  695. RUN FEHLER ( INPUT 1035 ).
  696. RETURN.
  697. END.
  698. RUN OPENEXCEL ( INPUT excelAppl, INPUT cDokument, INPUT '', OUTPUT ja ).
  699. IF NOT ja THEN DO:
  700. RUN FEHLER ( INPUT 1040 ).
  701. DYNAMIC-FUNCTION('RELEASEEXCEL':U, INPUT excelAppl ) NO-ERROR.
  702. RETURN NO-APPLY.
  703. END.
  704. Zelle = 'A6'.
  705. excelAppl:Range(Zelle):SELECT.
  706. excelAppl:SELECTION:FormulaR1C1 = 'TEXT;' + cDaten.
  707. excelAppl:APPLICATION:RUN ( 'DateiEinfügen' ).
  708. RUN KOPF ( INPUT excelAppl, INPUT iHerst ).
  709. Zelle = 'A1'.
  710. excelAppl:Range(Zelle):SELECT.
  711. excelAppl:SELECTION:ColumnWidth = 0.3.
  712. DYNAMIC-FUNCTION('RELEASEEXCEL':U, INPUT excelAppl ) NO-ERROR.
  713. END.
  714. END PROCEDURE.
  715. /* _UIB-CODE-BLOCK-END */
  716. &ANALYZE-RESUME
  717. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE selectPage gCalanda
  718. PROCEDURE selectPage :
  719. /*------------------------------------------------------------------------------
  720. Purpose: Super Override
  721. Parameters:
  722. Notes:
  723. ------------------------------------------------------------------------------*/
  724. DEF INPUT PARAMETER piPageNum AS INT NO-UNDO.
  725. DEF VAR FMutFlag AS LOG NO-UNDO.
  726. DEF VAR MutProg AS CHAR NO-UNDO.
  727. FMutFlag = DYNAMIC-FUNCTION('getMutflagAlt':U) NO-ERROR.
  728. DO WHILE TRUE:
  729. IF NOT FMutFlag THEN LEAVE.
  730. MutProg = DYNAMIC-FUNCTION('GETMUTPROG':U).
  731. IF MutProg <> THIS-PROCEDURE:FILE-NAME THEN LEAVE.
  732. RETURN NO-APPLY.
  733. END.
  734. CASE piPageNum:
  735. END CASE.
  736. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U).
  737. CASE AktSeite:
  738. WHEN 1 THEN DO:
  739. /* RUN removeLink ( h_dyntoolbar , 'TableIO':U , h_v-auftr ). */
  740. /* RUN removeLink ( h_dyntoolbar , 'Navigation':U , h_d-auftr ). */
  741. END.
  742. END CASE.
  743. RUN SUPER( INPUT piPageNum).
  744. END PROCEDURE.
  745. /* _UIB-CODE-BLOCK-END */
  746. &ANALYZE-RESUME
  747. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE TOOLBAR gCalanda
  748. PROCEDURE TOOLBAR :
  749. /*------------------------------------------------------------------------------
  750. Purpose:
  751. Parameters: <none>
  752. Notes:
  753. ------------------------------------------------------------------------------*/
  754. DEF INPUT PARAMETER pcAction AS CHAR NO-UNDO.
  755. /*
  756. RUN TOOLBAR IN h_dyntoolbar ( INPUT pcAction ).
  757. */
  758. END PROCEDURE.
  759. /* _UIB-CODE-BLOCK-END */
  760. &ANALYZE-RESUME