g-adresse-exp.w 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959
  1. &ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2
  2. &ANALYZE-RESUME
  3. /* Connected Databases
  4. anadat PROGRESS
  5. */
  6. &Scoped-define WINDOW-NAME CURRENT-WINDOW
  7. &Scoped-define FRAME-NAME gExportfelder
  8. /* Temp-Table and Buffer definitions */
  9. DEFINE TEMP-TABLE TTabel NO-UNDO LIKE Tabel.
  10. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS gExportfelder
  11. /*------------------------------------------------------------------------
  12. File:
  13. Description: from cntnrdlg.w - ADM2 SmartDialog Template
  14. Input Parameters:
  15. <none>
  16. Output Parameters:
  17. <none>
  18. Author:
  19. Created:
  20. ------------------------------------------------------------------------*/
  21. /* This .W file was created with the Progress AppBuilder. */
  22. /*----------------------------------------------------------------------*/
  23. /* Create an unnamed pool to store all the widgets created
  24. by this procedure. This is a good default which assures
  25. that this procedure's triggers and internal procedures
  26. will execute in this procedure's storage, and that proper
  27. cleanup will occur on deletion of the procedure. */
  28. CREATE WIDGET-POOL.
  29. /* *************************** Definitions ************************** */
  30. /* Parameters Definitions --- */
  31. DEF OUTPUT PARAMETER opExport AS LOG NO-UNDO.
  32. /* Local Variable Definitions --- */
  33. DEF VAR MaxPage AS INT NO-UNDO.
  34. DEF VAR AktSeite AS INT NO-UNDO.
  35. DEF VAR FMutFlag AS LOG NO-UNDO.
  36. DEF VAR ProgName AS CHAR NO-UNDO.
  37. DEF VAR SAktiv AS LOG NO-UNDO.
  38. DEF VAR Firma AS CHAR NO-UNDO.
  39. DEF VAR AdFirma AS CHAR NO-UNDO.
  40. DEF VAR FEntry AS LOG NO-UNDO.
  41. DEF BUFFER BTabel FOR TTabel.
  42. /* _UIB-CODE-BLOCK-END */
  43. &ANALYZE-RESUME
  44. &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  45. /* ******************** Preprocessor Definitions ******************** */
  46. &Scoped-define PROCEDURE-TYPE SmartDialog
  47. &Scoped-define DB-AWARE no
  48. &Scoped-define ADM-CONTAINER DIALOG-BOX
  49. &Scoped-define ADM-SUPPORTED-LINKS Data-Target,Data-Source,Page-Target,Update-Source,Update-Target
  50. /* Name of designated FRAME-NAME and/or first browse and/or first query */
  51. &Scoped-define FRAME-NAME gExportfelder
  52. &Scoped-define BROWSE-NAME Br-Felder
  53. /* Internal Tables (found by Frame, Query & Browse Queries) */
  54. &Scoped-define INTERNAL-TABLES TTabel
  55. /* Definitions for BROWSE Br-Felder */
  56. &Scoped-define FIELDS-IN-QUERY-Br-Felder TTabel.Bez1 TTabel.Flag_1 ~
  57. TTabel.Bez2
  58. &Scoped-define ENABLED-FIELDS-IN-QUERY-Br-Felder TTabel.Flag_1
  59. &Scoped-define ENABLED-TABLES-IN-QUERY-Br-Felder TTabel
  60. &Scoped-define FIRST-ENABLED-TABLE-IN-QUERY-Br-Felder TTabel
  61. &Scoped-define QUERY-STRING-Br-Felder FOR EACH TTabel NO-LOCK ~
  62. BY TTabel.Bez1 INDEXED-REPOSITION
  63. &Scoped-define OPEN-QUERY-Br-Felder OPEN QUERY Br-Felder FOR EACH TTabel NO-LOCK ~
  64. BY TTabel.Bez1 INDEXED-REPOSITION.
  65. &Scoped-define TABLES-IN-QUERY-Br-Felder TTabel
  66. &Scoped-define FIRST-TABLE-IN-QUERY-Br-Felder TTabel
  67. /* Definitions for DIALOG-BOX gExportfelder */
  68. &Scoped-define OPEN-BROWSERS-IN-QUERY-gExportfelder ~
  69. ~{&OPEN-QUERY-Br-Felder}
  70. /* Standard List Definitions */
  71. &Scoped-Define ENABLED-OBJECTS RECT-40 RECT-41 Br-Felder F_Dateiname ~
  72. Btn_OpenFile Btn_OK Btn_Cancel
  73. &Scoped-Define DISPLAYED-OBJECTS F_Dateiname
  74. /* Custom List Definitions */
  75. /* List-1,List-2,List-3,List-4,List-5,List-6 */
  76. /* _UIB-PREPROCESSOR-BLOCK-END */
  77. &ANALYZE-RESUME
  78. /* *********************** Control Definitions ********************** */
  79. /* Define a dialog box */
  80. /* Menu Definitions */
  81. DEFINE MENU POPUP-MENU-Br-Felder
  82. MENU-ITEM m_alle_ausgeben LABEL "alle ausgeben"
  83. MENU-ITEM m_keine_ausgeben LABEL "keine ausgeben".
  84. /* Definitions of the field level widgets */
  85. DEFINE BUTTON Btn_Cancel AUTO-END-KEY
  86. LABEL "&Abbrechen"
  87. SIZE 15 BY 1.
  88. DEFINE BUTTON Btn_OK
  89. LABEL "&Start"
  90. SIZE 15 BY 1.
  91. DEFINE BUTTON Btn_OpenFile
  92. IMAGE-UP FILE "grafik/select.bmp":U
  93. LABEL "suchen in"
  94. SIZE 4.4 BY 1.05 TOOLTIP "Starten neue Selektion".
  95. DEFINE VARIABLE F_Dateiname AS CHARACTER FORMAT "X(256)":U
  96. LABEL "Speichern unter"
  97. VIEW-AS FILL-IN NATIVE
  98. SIZE 40 BY 1
  99. BGCOLOR 15 NO-UNDO.
  100. DEFINE RECTANGLE RECT-40
  101. EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL
  102. SIZE 80 BY 10.95.
  103. DEFINE RECTANGLE RECT-41
  104. EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL
  105. SIZE 80 BY 2.
  106. /* Query definitions */
  107. &ANALYZE-SUSPEND
  108. DEFINE QUERY Br-Felder FOR
  109. TTabel
  110. FIELDS(TTabel.Bez1
  111. TTabel.Flag_1
  112. TTabel.Bez2) SCROLLING.
  113. &ANALYZE-RESUME
  114. /* Browse definitions */
  115. DEFINE BROWSE Br-Felder
  116. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS Br-Felder gExportfelder _STRUCTURED
  117. QUERY Br-Felder NO-LOCK DISPLAY
  118. TTabel.Bez1 COLUMN-LABEL "Feld" FORMAT "x(30)":U
  119. TTabel.Flag_1 COLUMN-LABEL "Ausgeben" FORMAT "Ja/Nein":U
  120. COLUMN-FONT 6
  121. TTabel.Bez2 COLUMN-LABEL "Variablenname" FORMAT "x(30)":U
  122. ENABLE
  123. TTabel.Flag_1
  124. /* _UIB-CODE-BLOCK-END */
  125. &ANALYZE-RESUME
  126. WITH NO-ROW-MARKERS SEPARATORS SIZE 76 BY 10
  127. BGCOLOR 15 TOOLTIP "mit rechtes Maustaste zur Auswahl / RETURN -> ändern".
  128. /* ************************ Frame Definitions *********************** */
  129. DEFINE FRAME gExportfelder
  130. Br-Felder AT ROW 1.95 COL 5
  131. F_Dateiname AT ROW 13.38 COL 32.6 COLON-ALIGNED
  132. Btn_OpenFile AT ROW 13.38 COL 76 NO-TAB-STOP
  133. Btn_OK AT ROW 15.52 COL 24.6
  134. Btn_Cancel AT ROW 15.52 COL 48.8
  135. RECT-40 AT ROW 1.48 COL 3
  136. RECT-41 AT ROW 12.91 COL 3
  137. SPACE(1.99) SKIP(2.13)
  138. WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER
  139. SIDE-LABELS NO-UNDERLINE THREE-D SCROLLABLE
  140. TITLE "Exportfelder bestimmen".
  141. /* *********************** Procedure Settings ************************ */
  142. &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  143. /* Settings for THIS-PROCEDURE
  144. Type: SmartDialog
  145. Allow: Basic,Browse,DB-Fields,Query,Smart
  146. Container Links: Data-Target,Data-Source,Page-Target,Update-Source,Update-Target
  147. Design Page: 1
  148. Other Settings: COMPILE
  149. Temp-Tables and Buffers:
  150. TABLE: TTabel T "?" NO-UNDO AnaDat Tabel
  151. END-TABLES.
  152. */
  153. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  154. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB gExportfelder
  155. /* ************************* Included-Libraries *********************** */
  156. {src/adm2/containr.i}
  157. /* _UIB-CODE-BLOCK-END */
  158. &ANALYZE-RESUME
  159. /* *********** Runtime Attributes and AppBuilder Settings *********** */
  160. &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
  161. /* SETTINGS FOR DIALOG-BOX gExportfelder
  162. FRAME-NAME */
  163. /* BROWSE-TAB Br-Felder RECT-41 gExportfelder */
  164. ASSIGN
  165. FRAME gExportfelder:SCROLLABLE = FALSE
  166. FRAME gExportfelder:HIDDEN = TRUE.
  167. ASSIGN
  168. Br-Felder:POPUP-MENU IN FRAME gExportfelder = MENU POPUP-MENU-Br-Felder:HANDLE.
  169. /* _RUN-TIME-ATTRIBUTES-END */
  170. &ANALYZE-RESUME
  171. /* Setting information for Queries and Browse Widgets fields */
  172. &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE Br-Felder
  173. /* Query rebuild information for BROWSE Br-Felder
  174. _TblList = "Temp-Tables.TTabel"
  175. _Options = "NO-LOCK INDEXED-REPOSITION"
  176. _TblOptList = "USED"
  177. _OrdList = "Temp-Tables.TTabel.Bez1|yes"
  178. _FldNameList[1] > Temp-Tables.TTabel.Bez1
  179. "Bez1" "Feld" ? "character" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  180. _FldNameList[2] > Temp-Tables.TTabel.Flag_1
  181. "Flag_1" "Ausgeben" "Ja/Nein" "logical" ? ? 6 ? ? ? yes ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  182. _FldNameList[3] > Temp-Tables.TTabel.Bez2
  183. "Bez2" "Variablenname" ? "character" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  184. _Query is OPENED
  185. */ /* BROWSE Br-Felder */
  186. &ANALYZE-RESUME
  187. &ANALYZE-SUSPEND _QUERY-BLOCK DIALOG-BOX gExportfelder
  188. /* Query rebuild information for DIALOG-BOX gExportfelder
  189. _Options = "SHARE-LOCK"
  190. _Query is NOT OPENED
  191. */ /* DIALOG-BOX gExportfelder */
  192. &ANALYZE-RESUME
  193. /* ************************ Control Triggers ************************ */
  194. &Scoped-define SELF-NAME gExportfelder
  195. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL gExportfelder gExportfelder
  196. ON END-ERROR OF FRAME gExportfelder /* Exportfelder bestimmen */
  197. DO:
  198. RUN ENDE.
  199. RETURN NO-APPLY.
  200. END.
  201. /* _UIB-CODE-BLOCK-END */
  202. &ANALYZE-RESUME
  203. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL gExportfelder gExportfelder
  204. ON GO OF FRAME gExportfelder /* Exportfelder bestimmen */
  205. DO:
  206. /*
  207. RUN ENDE_PROGRAMM ( INPUT Progname ) NO-ERROR.
  208. */
  209. END.
  210. /* _UIB-CODE-BLOCK-END */
  211. &ANALYZE-RESUME
  212. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL gExportfelder gExportfelder
  213. ON WINDOW-CLOSE OF FRAME gExportfelder /* Exportfelder bestimmen */
  214. DO:
  215. RUN ENDE.
  216. RETURN NO-APPLY.
  217. END.
  218. /* _UIB-CODE-BLOCK-END */
  219. &ANALYZE-RESUME
  220. &Scoped-define BROWSE-NAME Br-Felder
  221. &Scoped-define SELF-NAME Br-Felder
  222. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br-Felder gExportfelder
  223. ON LEFT-MOUSE-DBLCLICK OF Br-Felder IN FRAME gExportfelder
  224. DO:
  225. DO WITH FRAME {&FRAME-NAME}:
  226. FEntry = FALSE.
  227. APPLY 'ENTRY' TO Btn_OK.
  228. {&BROWSE-NAME}:READ-ONLY = FALSE.
  229. APPLY 'ENTRY' TO TTabel.Flag_1 IN BROWSE {&BROWSE-NAME}.
  230. FEntry = TRUE.
  231. END.
  232. END.
  233. /* _UIB-CODE-BLOCK-END */
  234. &ANALYZE-RESUME
  235. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br-Felder gExportfelder
  236. ON RETURN OF Br-Felder IN FRAME gExportfelder
  237. DO:
  238. DO WITH FRAME {&FRAME-NAME}:
  239. FEntry = FALSE.
  240. APPLY 'ENTRY' TO Btn_OK.
  241. {&BROWSE-NAME}:READ-ONLY = FALSE.
  242. APPLY 'ENTRY' TO TTabel.Flag_1 IN BROWSE {&BROWSE-NAME}.
  243. FEntry = TRUE.
  244. END.
  245. END.
  246. /* _UIB-CODE-BLOCK-END */
  247. &ANALYZE-RESUME
  248. &Scoped-define SELF-NAME TTabel.Flag_1
  249. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL TTabel.Flag_1 Br-Felder _BROWSE-COLUMN gExportfelder
  250. ON END-ERROR OF TTabel.Flag_1 IN BROWSE Br-Felder /* Ausgeben */
  251. DO:
  252. DO WITH FRAME {&FRAME-NAME}:
  253. APPLY 'ENTRY' TO Btn_OpenFile.
  254. {&BROWSE-NAME}:READ-ONLY = TRUE.
  255. APPLY 'ENTRY' TO BROWSE {&BROWSE-NAME}.
  256. RETURN NO-APPLY.
  257. END.
  258. END.
  259. /* _UIB-CODE-BLOCK-END */
  260. &ANALYZE-RESUME
  261. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL TTabel.Flag_1 Br-Felder _BROWSE-COLUMN gExportfelder
  262. ON RETURN OF TTabel.Flag_1 IN BROWSE Br-Felder /* Ausgeben */
  263. DO:
  264. APPLY 'TAB' TO SELF.
  265. RETURN NO-APPLY.
  266. END.
  267. /* _UIB-CODE-BLOCK-END */
  268. &ANALYZE-RESUME
  269. &Scoped-define SELF-NAME TTabel.Bez2
  270. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL TTabel.Bez2 Br-Felder _BROWSE-COLUMN gExportfelder
  271. ON END-ERROR OF TTabel.Bez2 IN BROWSE Br-Felder /* Variablenname */
  272. DO:
  273. DO WITH FRAME {&FRAME-NAME}:
  274. APPLY 'ENTRY' TO Btn_OpenFile.
  275. {&BROWSE-NAME}:READ-ONLY = TRUE.
  276. APPLY 'ENTRY' TO BROWSE {&BROWSE-NAME}.
  277. RETURN NO-APPLY.
  278. END.
  279. END.
  280. /* _UIB-CODE-BLOCK-END */
  281. &ANALYZE-RESUME
  282. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL TTabel.Bez2 Br-Felder _BROWSE-COLUMN gExportfelder
  283. ON RETURN OF TTabel.Bez2 IN BROWSE Br-Felder /* Variablenname */
  284. DO:
  285. APPLY 'TAB' TO SELF.
  286. RETURN NO-APPLY.
  287. END.
  288. /* _UIB-CODE-BLOCK-END */
  289. &ANALYZE-RESUME
  290. &Scoped-define SELF-NAME Btn_Cancel
  291. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Cancel gExportfelder
  292. ON CHOOSE OF Btn_Cancel IN FRAME gExportfelder /* Abbrechen */
  293. DO:
  294. RUN ENDE.
  295. RETURN NO-APPLY.
  296. END.
  297. /* _UIB-CODE-BLOCK-END */
  298. &ANALYZE-RESUME
  299. &Scoped-define SELF-NAME Btn_OK
  300. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_OK gExportfelder
  301. ON CHOOSE OF Btn_OK IN FRAME gExportfelder /* Start */
  302. DO:
  303. APPLY 'ENTRY' TO Btn_OpenFile.
  304. RUN SCHREIBEN_FELDER.
  305. IF RETURN-VALUE <> '' THEN RETURN NO-APPLY.
  306. opExport = TRUE.
  307. RUN ENDE.
  308. RETURN NO-APPLY.
  309. END.
  310. /* _UIB-CODE-BLOCK-END */
  311. &ANALYZE-RESUME
  312. &Scoped-define SELF-NAME Btn_OpenFile
  313. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_OpenFile gExportfelder
  314. ON CHOOSE OF Btn_OpenFile IN FRAME gExportfelder /* suchen in */
  315. DO:
  316. RUN OPEN_DATEI.
  317. END.
  318. /* _UIB-CODE-BLOCK-END */
  319. &ANALYZE-RESUME
  320. &Scoped-define SELF-NAME m_alle_ausgeben
  321. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_alle_ausgeben gExportfelder
  322. ON CHOOSE OF MENU-ITEM m_alle_ausgeben /* alle ausgeben */
  323. DO:
  324. DO WITH FRAME {&FRAME-NAME}:
  325. APPLY 'ENTRY' TO Btn_OpenFile.
  326. REPEAT TRANSACTION:
  327. FOR EACH BTabel:
  328. BTabel.Flag_1 = TRUE.
  329. BROWSE {&BROWSE-NAME}:REFRESH().
  330. END.
  331. LEAVE.
  332. END.
  333. APPLY 'ENTRY' TO BROWSE {&BROWSE-NAME}.
  334. END.
  335. END.
  336. /* _UIB-CODE-BLOCK-END */
  337. &ANALYZE-RESUME
  338. &Scoped-define SELF-NAME m_keine_ausgeben
  339. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_keine_ausgeben gExportfelder
  340. ON CHOOSE OF MENU-ITEM m_keine_ausgeben /* keine ausgeben */
  341. DO:
  342. DO WITH FRAME {&FRAME-NAME}:
  343. APPLY 'ENTRY' TO Btn_OpenFile.
  344. REPEAT TRANSACTION:
  345. FOR EACH BTabel:
  346. BTabel.Flag_1 = FALSE.
  347. BROWSE {&BROWSE-NAME}:REFRESH().
  348. END.
  349. LEAVE.
  350. END.
  351. APPLY 'ENTRY' TO BROWSE {&BROWSE-NAME}.
  352. END.
  353. END.
  354. /* _UIB-CODE-BLOCK-END */
  355. &ANALYZE-RESUME
  356. &UNDEFINE SELF-NAME
  357. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK gExportfelder
  358. /* *************************** Main Block *************************** */
  359. MaxPage = 1.
  360. AktSeite = 1.
  361. opExport = FALSE.
  362. FEntry = TRUE.
  363. sAktiv = DYNAMIC-FUNCTION('getSuperAktiv':U) NO-ERROR.
  364. IF sAktiv THEN DO:
  365. Firma = DYNAMIC-FUNCTION('GETMANDANT':U ) NO-ERROR.
  366. AdFirma = DYNAMIC-FUNCTION('GETADMANDANT':U ) NO-ERROR.
  367. ProgName = DYNAMIC-FUNCTION('MAKEPROGNAME':U, INPUT THIS-PROCEDURE ) NO-ERROR.
  368. END.
  369. RUN EINLESEN_FELDER.
  370. SESSION:DATA-ENTRY-RETURN = TRUE.
  371. /* TRIGGERS ------------------------------------------------------ */
  372. ON 'ENTRY':U OF FRAME {&FRAME-NAME} ANYWHERE
  373. DO:
  374. IF NOT FEntry THEN RETURN.
  375. RUN ENTRY_FELD_TEST ( INPUT SELF:HANDLE ).
  376. IF RETURN-VALUE = 'ERROR' THEN DO:
  377. APPLY 'ENTRY' TO SELF.
  378. RETURN NO-APPLY.
  379. END.
  380. IF RETURN-VALUE = 'APPLY' THEN DO:
  381. RETURN NO-APPLY.
  382. END.
  383. END.
  384. ON 'END-ERROR':U OF FRAME {&FRAME-NAME} ANYWHERE
  385. DO:
  386. RUN ENDE.
  387. RETURN NO-APPLY.
  388. END.
  389. /* ------------------------------------------------------------------ */
  390. {src/adm2/dialogmn.i}
  391. /* _UIB-CODE-BLOCK-END */
  392. &ANALYZE-RESUME
  393. /* ********************** Internal Procedures *********************** */
  394. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects gExportfelder _ADM-CREATE-OBJECTS
  395. PROCEDURE adm-create-objects :
  396. /*------------------------------------------------------------------------------
  397. Purpose: Create handles for all SmartObjects used in this procedure.
  398. After SmartObjects are initialized, then SmartLinks are added.
  399. Parameters: <none>
  400. ------------------------------------------------------------------------------*/
  401. END PROCEDURE.
  402. /* _UIB-CODE-BLOCK-END */
  403. &ANALYZE-RESUME
  404. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE changePage gExportfelder
  405. PROCEDURE changePage :
  406. /*------------------------------------------------------------------------------
  407. Purpose: Super Override
  408. Parameters:
  409. Notes:
  410. ------------------------------------------------------------------------------*/
  411. /* Code placed here will execute PRIOR to standard behavior. */
  412. RUN SUPER.
  413. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U).
  414. CASE AktSeite:
  415. WHEN 1 THEN DO:
  416. /* RUN addLink ( h_dyntoolbar , 'TableIO':U , h_v-auftr ). */
  417. /* RUN addLink ( h_dyntoolbar , 'Navigation':U , h_d-auftr ). */
  418. /* RUN ToolbarInit ( INPUT h_d-auftr ). */
  419. RUN ENTRY_CURSOR.
  420. END.
  421. WHEN 2 THEN DO:
  422. RUN ENTRY_CURSOR.
  423. END.
  424. END CASE.
  425. END PROCEDURE.
  426. /* _UIB-CODE-BLOCK-END */
  427. &ANALYZE-RESUME
  428. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI gExportfelder _DEFAULT-DISABLE
  429. PROCEDURE disable_UI :
  430. /*------------------------------------------------------------------------------
  431. Purpose: DISABLE the User Interface
  432. Parameters: <none>
  433. Notes: Here we clean-up the user-interface by deleting
  434. dynamic widgets we have created and/or hide
  435. frames. This procedure is usually called when
  436. we are ready to "clean-up" after running.
  437. ------------------------------------------------------------------------------*/
  438. /* Hide all frames. */
  439. HIDE FRAME gExportfelder.
  440. END PROCEDURE.
  441. /* _UIB-CODE-BLOCK-END */
  442. &ANALYZE-RESUME
  443. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE EINLESEN_FELDER gExportfelder
  444. PROCEDURE EINLESEN_FELDER :
  445. /*------------------------------------------------------------------------------
  446. Purpose:
  447. Parameters: <none>
  448. Notes:
  449. ------------------------------------------------------------------------------*/
  450. DEF VAR cFelder AS CHAR NO-UNDO.
  451. DEF VAR cInhalt AS CHAR NO-UNDO.
  452. DEF VAR cSection AS CHAR NO-UNDO.
  453. DEF VAR cKey AS CHAR NO-UNDO.
  454. DEF VAR cValue AS CHAR NO-UNDO.
  455. DEF VAR i1 AS INT NO-UNDO.
  456. DEF VAR ja AS LOG NO-UNDO.
  457. EMPTY TEMP-TABLE TTabel.
  458. cSection = 'Adressexport'.
  459. GET-KEY-VALUE SECTION cSection KEY ? VALUE cFelder.
  460. IF cFelder = ? THEN cFelder = ''.
  461. IF cFelder = '?' THEN cFelder = ''.
  462. IF cFelder = '' THEN RUN SCHREIBEN_ADRESSFELDER.
  463. DO i1 = 1 TO NUM-ENTRIES(cFelder, ','):
  464. cKey = ENTRY(i1, cFelder, ',').
  465. GET-KEY-VALUE SECTION cSection KEY cKey VALUE cValue.
  466. IF ENTRY(1, cValue, ';') = '0' THEN ja = FALSE.
  467. ELSE ja = TRUE.
  468. CREATE TTabel.
  469. ASSIGN TTabel.CodeI = i1
  470. TTabel.Bez1 = cKey
  471. TTabel.Flag_1 = ja
  472. TTabel.Bez2 = ENTRY(2, cValue, ';').
  473. END.
  474. GET-KEY-VALUE SECTION 'Dateinamen' KEY 'Adressexport' VALUE F_Dateiname.
  475. END PROCEDURE.
  476. /* _UIB-CODE-BLOCK-END */
  477. &ANALYZE-RESUME
  478. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableObject gExportfelder
  479. PROCEDURE enableObject :
  480. /*------------------------------------------------------------------------------
  481. Purpose: Super Override
  482. Parameters:
  483. Notes:
  484. ------------------------------------------------------------------------------*/
  485. DEF VAR wx AS INT NO-UNDO.
  486. DEF VAR wy AS INT NO-UNDO.
  487. DEF VAR MaxX AS INT NO-UNDO.
  488. DEF VAR MaxY AS INT NO-UNDO.
  489. DEF VAR xString AS CHAR NO-UNDO.
  490. MaxX = SESSION:WIDTH-PIXELS.
  491. MaxY = SESSION:HEIGHT-PIXELS.
  492. GET-KEY-VALUE SECTION 'FensterPositionen'
  493. KEY ProgName
  494. VALUE xString.
  495. IF xString = ? THEN xString = '30;30'.
  496. IF xString = '' THEN xString = '30;30'.
  497. wx = INTEGER(ENTRY(1, xString, ';')).
  498. wy = INTEGER(ENTRY(2, xString, ';')).
  499. IF wx < 0 THEN wx = 30.
  500. IF wy < 0 THEN wy = 30.
  501. IF wx > (MaxX - 20) THEN wx = 30.
  502. IF wy > (MaxY - 20) THEN wy = 30.
  503. FRAME {&FRAME-NAME}:X = wx.
  504. FRAME {&FRAME-NAME}:Y = wy.
  505. RUN SUPER.
  506. IF sAktiv THEN RUN FENSTER_TITEL ( INPUT FRAME {&FRAME-NAME}:HANDLE ) NO-ERROR.
  507. END PROCEDURE.
  508. /* _UIB-CODE-BLOCK-END */
  509. &ANALYZE-RESUME
  510. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI gExportfelder _DEFAULT-ENABLE
  511. PROCEDURE enable_UI :
  512. /*------------------------------------------------------------------------------
  513. Purpose: ENABLE the User Interface
  514. Parameters: <none>
  515. Notes: Here we display/view/enable the widgets in the
  516. user-interface. In addition, OPEN all queries
  517. associated with each FRAME and BROWSE.
  518. These statements here are based on the "Other
  519. Settings" section of the widget Property Sheets.
  520. ------------------------------------------------------------------------------*/
  521. DISPLAY F_Dateiname
  522. WITH FRAME gExportfelder.
  523. ENABLE RECT-40 RECT-41 Br-Felder F_Dateiname Btn_OpenFile Btn_OK Btn_Cancel
  524. WITH FRAME gExportfelder.
  525. VIEW FRAME gExportfelder.
  526. {&OPEN-BROWSERS-IN-QUERY-gExportfelder}
  527. END PROCEDURE.
  528. /* _UIB-CODE-BLOCK-END */
  529. &ANALYZE-RESUME
  530. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ENDE gExportfelder
  531. PROCEDURE ENDE :
  532. /*------------------------------------------------------------------------------
  533. Purpose:
  534. Parameters: <none>
  535. Notes:
  536. ------------------------------------------------------------------------------*/
  537. DEF VAR wx AS INT NO-UNDO.
  538. DEF VAR wy AS INT NO-UNDO.
  539. DEF VAR xString AS CHAR NO-UNDO.
  540. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U) NO-ERROR.
  541. IF AktSeite > 1 THEN DO:
  542. RUN selectPage ( INPUT 1 ).
  543. RETURN NO-APPLY.
  544. END.
  545. IF sAktiv THEN RUN ENDE_PROGRAMM ( INPUT Progname ).
  546. wx = FRAME {&FRAME-NAME}:X NO-ERROR.
  547. wy = FRAME {&FRAME-NAME}:Y NO-ERROR.
  548. xString = STRING(wx) + ';' + STRING(wy).
  549. PUT-KEY-VALUE SECTION 'FensterPositionen'
  550. KEY ProgName
  551. VALUE xString.
  552. APPLY 'CLOSE':U TO THIS-PROCEDURE.
  553. APPLY 'GO' TO FRAME {&FRAME-NAME}.
  554. RETURN NO-APPLY.
  555. END PROCEDURE.
  556. /* _UIB-CODE-BLOCK-END */
  557. &ANALYZE-RESUME
  558. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ENTRY_FELD_TEST gExportfelder
  559. PROCEDURE ENTRY_FELD_TEST :
  560. /*------------------------------------------------------------------------------
  561. Purpose:
  562. Parameters: <none>
  563. Notes:
  564. ------------------------------------------------------------------------------*/
  565. DEF INPUT PARAMETER ipHandle AS HANDLE NO-UNDO.
  566. DEF VAR FeldName AS CHAR NO-UNDO.
  567. DEF VAR FeldInhalt AS CHAR NO-UNDO.
  568. FeldName = ''.
  569. FeldInhalt = ''.
  570. IF NOT VALID-HANDLE(ipHandle) THEN RETURN ''.
  571. IF ipHandle:TYPE = 'FRAME' THEN RETURN ''.
  572. IF ipHandle:TYPE = 'WINDOW' THEN RETURN ''.
  573. FeldName = ipHandle:NAME.
  574. DO WITH FRAME {&FRAME-NAME}:
  575. CASE FeldName:
  576. WHEN 'Flag_1' THEN RETURN ''.
  577. WHEN 'Bez2' THEN RETURN ''.
  578. OTHERWISE DO:
  579. FEntry = FALSE.
  580. APPLY 'ENTRY' TO Btn_OpenFile.
  581. {&BROWSE-NAME}:READ-ONLY = TRUE.
  582. APPLY 'ENTRY' TO ipHandle.
  583. FEntry = TRUE.
  584. END.
  585. END CASE.
  586. END.
  587. RETURN ''.
  588. END PROCEDURE.
  589. /* _UIB-CODE-BLOCK-END */
  590. &ANALYZE-RESUME
  591. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE exitObject gExportfelder
  592. PROCEDURE exitObject :
  593. /*------------------------------------------------------------------------------
  594. Purpose: Super Override
  595. Parameters:
  596. Notes:
  597. ------------------------------------------------------------------------------*/
  598. RUN ENDE.
  599. RETURN NO-APPLY.
  600. END PROCEDURE.
  601. /* _UIB-CODE-BLOCK-END */
  602. &ANALYZE-RESUME
  603. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initializeObject gExportfelder
  604. PROCEDURE initializeObject :
  605. /*------------------------------------------------------------------------------
  606. Purpose: Super Override
  607. Parameters:
  608. Notes:
  609. ------------------------------------------------------------------------------*/
  610. RUN SUPER.
  611. DO WITH FRAME {&FRAME-NAME}:
  612. APPLY 'ENTRY' TO Btn_OK.
  613. {&BROWSE-NAME}:READ-ONLY = TRUE.
  614. APPLY 'ENTRY' TO BROWSE {&BROWSE-NAME}.
  615. END.
  616. END PROCEDURE.
  617. /* _UIB-CODE-BLOCK-END */
  618. &ANALYZE-RESUME
  619. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE OPEN_DATEI gExportfelder
  620. PROCEDURE OPEN_DATEI :
  621. /*------------------------------------------------------------------------------
  622. Purpose:
  623. Parameters: <none>
  624. Notes:
  625. ------------------------------------------------------------------------------*/
  626. DEF VAR ja AS LOG NO-UNDO.
  627. DO WITH FRAME {&FRAME-NAME}:
  628. F_Dateiname = F_Dateiname:SCREEN-VALUE.
  629. SYSTEM-DIALOG GET-FILE F_Dateiname
  630. FILTERS 'Textdatei' '*.txt',
  631. 'csv - Datei' '*.csv',
  632. 'Exceldatei' '*.xls',
  633. 'alle Dateien' '*.*'
  634. INITIAL-FILTER 1
  635. CREATE-TEST-FILE
  636. DEFAULT-EXTENSION '.txt'
  637. TITLE 'Export der Daten in ....'
  638. USE-FILENAME
  639. UPDATE ja.
  640. IF Ja THEN DO:
  641. F_DateiName:SCREEN-VALUE = F_Dateiname.
  642. END.
  643. END.
  644. END PROCEDURE.
  645. /* _UIB-CODE-BLOCK-END */
  646. &ANALYZE-RESUME
  647. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SCHREIBEN_ADRESSFELDER gExportfelder
  648. PROCEDURE SCHREIBEN_ADRESSFELDER :
  649. /*------------------------------------------------------------------------------
  650. Purpose:
  651. Parameters: <none>
  652. Notes:
  653. ------------------------------------------------------------------------------*/
  654. DEF VAR hBuf AS WIDGET-HANDLE NO-UNDO.
  655. DEF VAR hFeld AS WIDGET-HANDLE NO-UNDO.
  656. DEF VAR cInhalt AS CHAR NO-UNDO.
  657. DEF VAR cKey AS CHAR NO-UNDO.
  658. DEF VAR cValue AS CHAR NO-UNDO.
  659. DEF VAR i1 AS INT NO-UNDO.
  660. DEF VAR i2 AS INT NO-UNDO.
  661. GET-KEY-VALUE SECTION 'Adressexport' KEY ? VALUE cInhalt.
  662. IF cInhalt <> '?' AND
  663. cInhalt <> ? AND
  664. cInhalt <> '' THEN RETURN.
  665. hBuf = BUFFER Adresse:HANDLE.
  666. i2 = hBuf:NUM-FIELDS.
  667. DO i1 = 1 TO i2:
  668. hFeld = hBuf:BUFFER-FIELD(i1) NO-ERROR.
  669. cInhalt = '1;'.
  670. IF hFeld:LABEL = ? THEN cInhalt = cInhalt + hFeld:NAME.
  671. ELSE cInhalt = cInhalt + hFeld:LABEL.
  672. PUT-KEY-VALUE SECTION 'Adressexport' KEY hFeld:NAME VALUE cInhalt.
  673. END.
  674. END PROCEDURE.
  675. /* _UIB-CODE-BLOCK-END */
  676. &ANALYZE-RESUME
  677. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SCHREIBEN_FELDER gExportfelder
  678. PROCEDURE SCHREIBEN_FELDER :
  679. /*------------------------------------------------------------------------------
  680. Purpose:
  681. Parameters: <none>
  682. Notes:
  683. ------------------------------------------------------------------------------*/
  684. DEF VAR cSection AS CHAR NO-UNDO.
  685. DEF VAR cKey AS CHAR NO-UNDO.
  686. DEF VAR cValue AS CHAR NO-UNDO.
  687. cSection = 'Adressexport'.
  688. FOR EACH BTabel BY BTabel.Bez1:
  689. cKey = BTabel.Bez1.
  690. IF BTabel.Flag_1 THEN cValue = '1;' + BTabel.Bez2.
  691. ELSE cValue = '0;' + BTabel.Bez2.
  692. PUT-KEY-VALUE SECTION cSection KEY cKey VALUE cValue.
  693. END.
  694. F_Dateiname = F_Dateiname:SCREEN-VALUE IN FRAME {&FRAME-NAME}.
  695. REPEAT ON ERROR UNDO, RETRY:
  696. IF F_Dateiname = ? THEN F_Dateiname = ''.
  697. IF F_Dateiname = '?' THEN F_Dateiname = ''.
  698. IF F_Dateiname = '' THEN LEAVE.
  699. IF RETRY THEN DO WITH FRAME {&FRAME-NAME}:
  700. APPLY 'ENTRY' TO F_Dateiname.
  701. RETURN 'ERROR'.
  702. END.
  703. OUTPUT TO VALUE(F_Dateiname).
  704. LEAVE.
  705. END.
  706. OUTPUT CLOSE.
  707. PUT-KEY-VALUE SECTION 'Dateinamen' KEY 'Adressexport' VALUE F_Dateiname.
  708. END PROCEDURE.
  709. /* _UIB-CODE-BLOCK-END */
  710. &ANALYZE-RESUME
  711. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE selectPage gExportfelder
  712. PROCEDURE selectPage :
  713. /*------------------------------------------------------------------------------
  714. Purpose: Super Override
  715. Parameters:
  716. Notes:
  717. ------------------------------------------------------------------------------*/
  718. DEF INPUT PARAMETER piPageNum AS INT NO-UNDO.
  719. DEF VAR FMutFlag AS LOG NO-UNDO.
  720. DEF VAR MutProg AS CHAR NO-UNDO.
  721. FMutFlag = DYNAMIC-FUNCTION ('GETMUTFLAG':U, INPUT Progname) NO-ERROR.
  722. IF FMutFlag THEN RETURN NO-APPLY.
  723. CASE piPageNum:
  724. END CASE.
  725. AktSeite = DYNAMIC-FUNCTION('getCurrentPage':U) NO-ERROR.
  726. CASE AktSeite:
  727. WHEN 1 THEN DO:
  728. /* RUN removeLink ( h_dyntoolbar , 'TableIO':U , h_v-auftr ). */
  729. /* RUN removeLink ( h_dyntoolbar , 'Navigation':U , h_d-auftr ). */
  730. END.
  731. END CASE.
  732. RUN SUPER( INPUT piPageNum).
  733. END PROCEDURE.
  734. /* _UIB-CODE-BLOCK-END */
  735. &ANALYZE-RESUME