home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / sgem122p / sys_gem.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-30  |  38.2 KB  |  1,121 lines
  1. (* ------------------------------------------------------------------- *)
  2. (* Module Type          : *)  UNIT
  3. (* Module Name          : *)  sys_gem;
  4. (* ------------------------------------------------------------------- *
  5.  * Module Version       : 1.22                                         *
  6.  * Module Date          : 30-05-94                                     *
  7.  * Last Change          : 30-05-94                                     *
  8.  * Author               : Andrea Pietsch                               *
  9.  * Programming Language : Pure-Pascal                                  *
  10.  * Copyright            : (c) 1994, Andrea Pietsch, 56727 Mayen        *
  11.  * ------------------------------------------------------------------- *)
  12.  
  13. INTERFACE
  14.  
  15. USES    GEM;
  16.  
  17. (* -------------------------------------------------------------------
  18.  * Konstanten
  19.  * ------------------------------------------------------------------- *)
  20.  
  21. CONST   SG_START        = 0;
  22.         SG_END          = 1;
  23.         SG_QUIT         = 2;
  24.         SG_DRAW         = 3;
  25.         SG_POSX         = 4;
  26.         SG_POSY         = 5;
  27.         SG_VISIBLE      = 6;
  28.         SG_INVISIBLE    = 7;
  29.         SG_TOP          = 8;
  30.         SG_UNTOP        = 9;
  31.         SG_SIZED        = 10;
  32.         SG_LCLICK1      = 11;
  33.         SG_LCLICK2      = 12;
  34.         SG_RCLICK1      = 13;
  35.         SG_RCLICK2      = 14;
  36.         SG_BUTTON       = 15;
  37.         SG_KEY          = 16;
  38.         SG_MENU         = 17;
  39.         SG_NOWIN        = 18;
  40.         SG_DRAGDROP     = 19;
  41.         SG_MOVED        = 20;
  42.         SG_SLID_UP      = 21;
  43.         SG_SLID_DN      = 22;
  44.         SG_SLID_MV      = 23;
  45.         SG_SLID_PGUP    = 24;
  46.         SG_SLID_PGDN    = 25;
  47.         SG_TIMER        = 26;
  48.  
  49. (* -------------------------------------------------------------------
  50.  * Nachrichten von Auswertungs-Funktion an SysGem
  51.  * ------------------------------------------------------------------- *)
  52.  
  53.         SG_CLOSE        = 0;
  54.         SG_REDRAW       = 1;
  55.         SG_TERM         = 2;
  56.         SG_CONT         = 3;
  57.         SG_ABORT        = 4;
  58.         SG_KEYUSED      = 5;
  59.         SG_KEYCONT      = 6;
  60.  
  61. (* -------------------------------------------------------------------
  62.  * Spezial-Flags für die Auswertungsfunktion
  63.  * ------------------------------------------------------------------- *)
  64.  
  65.         SG_RIGHTCLICK   = 1;
  66.         SG_DOUBLECLICK  = 2;
  67.  
  68. (* -------------------------------------------------------------------
  69.  * Werte für agi aus Parameter
  70.  * ------------------------------------------------------------------- *)
  71.  
  72.         AGI_0           = 0;
  73.         AGI_3           = 1;
  74.         AGI_4           = 2;
  75.  
  76. (* -------------------------------------------------------------------
  77.  * Prioritäten für die Alert-Box
  78.  * ------------------------------------------------------------------- *)
  79.  
  80.         ALERT_NORM      = 1;
  81.         ALERT_STOP      = 3;
  82.  
  83. (* -------------------------------------------------------------------
  84.  * Flags fuer Baeume im Fenster
  85.  * ------------------------------------------------------------------- *)
  86.  
  87.         LINK_LEFT       = 0;
  88.         LINK_RIGHT      = 1;
  89.         LINK_TOP        = 2;
  90.         LINK_BOTTOM     = 3;
  91.  
  92. (* -------------------------------------------------------------------
  93.  * Button-Anordnung für Alert
  94.  * ------------------------------------------------------------------- *)
  95.  
  96.         ButtonCenter    = 0;
  97.         ButtonLeft      = 1;
  98.         ButtonRight     = 2;
  99.  
  100. (* -------------------------------------------------------------------
  101.  * Stati für RedrawObj
  102.  * ------------------------------------------------------------------- *)
  103.  
  104.         FLIP_STATE      = 0;
  105.         DEL_STATE       = 1;
  106.         SET_STATE       = 2;
  107.         UPD_STATE       = 3;
  108.  
  109. (* -------------------------------------------------------------------
  110.  * Stati für Scroll-Funktionen
  111.  * ------------------------------------------------------------------- *)
  112.  
  113.         SCROLL_UP       = 1;
  114.         SCROLL_DOWN     = 2;
  115.         SCROLL_RIGHT    = 3;
  116.         SCROLL_LEFT     = 4;
  117.         SCROLL_PG_LEFT  = 5;
  118.         SCROLL_PG_RIGHT = 6;
  119.         SCROLL_PG_UP    = 7;
  120.         SCROLL_PG_DOWN  = 8;
  121.  
  122. (* -------------------------------------------------------------------
  123.  * Stati für SetWindowParm
  124.  * ------------------------------------------------------------------- *)
  125.  
  126.         SET_X           = 1;
  127.         SET_Y           = 2;
  128.         SET_W           = 3;
  129.         SET_H           = 4;
  130.  
  131. (* -------------------------------------------------------------------
  132.  * Typen
  133.  * ------------------------------------------------------------------- *)
  134.  
  135. TYPE    RECT            = RECORD
  136.           x             : INTEGER;
  137.           y             : INTEGER;
  138.           w             : INTEGER;
  139.           h             : INTEGER;
  140.         END;
  141.  
  142.         COOKIE          = RECORD
  143.           id            : LONGINT;
  144.           value         : LONGINT;
  145.         END;
  146.  
  147.         DRAG_DROP_PTR   = ^DRAG_DROP;
  148.         DRAG_DROP       = RECORD
  149.           gemini        : integer;
  150.           data_type     : longint;
  151.           data          : pchar;
  152.           data_len      : longint;
  153.           data_id       : packed array [0..127] of char;
  154.           filename      : packed array [0..127] of char;
  155.           x, y          : integer;
  156.           state         : integer;
  157.           obj           : integer;
  158.           id            : longint;
  159.         END;
  160.  
  161.         DIALOG_INFO_PTR = ^DIALOG_INFO;
  162.         DIALOG_INFO     = RECORD
  163.           id            : longint;
  164.           user          : pointer;
  165.           special       : word;
  166.           dd            : DRAG_DROP_PTR;
  167.         END;
  168.  
  169.         WINDOW_INFO_PTR = ^WINDOW_INFO;
  170.         WINDOW_INFO     = RECORD
  171.           id            : LONGINT;
  172.           pos_x         : LONGINT;
  173.           pos_y         : LONGINT;
  174.           doc_x         : LONGINT;
  175.           doc_y         : LONGINT;
  176.           scroll        : INTEGER;
  177.           handle        : INTEGER;
  178.           key           : INTEGER;
  179.           state         : INTEGER;
  180.           mTitle        : INTEGER;
  181.           mItem         : INTEGER;
  182.           mx, my        : INTEGER;
  183.           line          : LONGINT;
  184.           column        : LONGINT;
  185.           line_ptr      : pchar;
  186.           work_area     : RECT;
  187.           draw_area     : RECT;
  188.           clip          : RECT;
  189.           user          : POINTER;
  190.           obj_id        : LONGINT;
  191.           item          : INTEGER;
  192.           dd            : DRAG_DROP_PTR;
  193.         END;
  194.  
  195.         PARAMETER       = RECORD
  196.           vdi_handle    : INTEGER;
  197.           charw         : INTEGER;
  198.           charh         : INTEGER;
  199.           boxw          : INTEGER;
  200.           boxh          : INTEGER;
  201.           appl_id       : INTEGER;
  202.           xmax          : INTEGER;
  203.           ymax          : INTEGER;
  204.           desktop       : RECT;
  205.           bitplanes     : INTEGER;
  206.           max_colors    : INTEGER;
  207.           act_colors    : INTEGER;
  208.           color_avail   : integer;
  209.           acc_entry     : INTEGER;
  210.           multitask     : integer;
  211.           aes_version   : INTEGER;
  212.           tos_version   : WORD;
  213.           magx          : INTEGER;
  214.           magx_release  : INTEGER;
  215.           mint          : INTEGER;
  216.           winx          : integer;
  217.           search        : integer;
  218.           agi           : INTEGER;
  219.           draw_3d       : integer;
  220.         END;
  221.  
  222.         AREA            = RECORD       (* Bei Benutzung _nicht_ ändern *)
  223.           init          : integer;
  224.           x, y, w, h    : INTEGER;
  225.           size          : LONGINT;
  226.           mf            : MFDB;
  227.         END;
  228.  
  229. (* ------------------------------------------------------------------- *)
  230.  
  231.         DPROC   = function ( msg, button : integer; inf : DIALOG_INFO_PTR ) : integer;
  232.         APROC   = function ( msg : integer; inf : WINDOW_INFO_PTR ) : integer;
  233.         RPROC   = procedure ( inf : WINDOW_INFO_PTR );
  234.         MPROC   = function ( msg, sub : byte; l1, l2 : longint ) : longint;
  235.         TPROC   = procedure;
  236.         EPROC   = procedure ( ed : integer; str : pchar );
  237.         FPROC   = function ( tree : AESTreePtr; ed : integer; id : longint ) : integer;
  238.         CPROC   = function ( str1, str2 : pchar ) : integer;
  239.         WPROC   = procedure ( win_id : longint; enter : integer );
  240.  
  241. (* -------------------------------------------------------------------
  242.  * Berechnet aus einem String ein Long. Wird für die (Fenster) Id's
  243.  * benötigt.
  244.  * ------------------------------------------------------------------- *)
  245.  
  246. function  MakeId        ( const id : string ) : longint;
  247.  
  248. (* -------------------------------------------------------------------
  249.  * An- und Abmelden
  250.  * ------------------------------------------------------------------- *)
  251.  
  252. function  Init_GEM      ( par : pointer; const acc_name : string; prg_id : longint; const prg_name : string; usr_id : longint; const usr_name : string; key : longint ) : integer;
  253. procedure Exit_GEM;
  254. external;
  255. procedure SetAccProc    ( a_open, a_close : TPROC );
  256. external;
  257.  
  258. (* -------------------------------------------------------------------
  259.  * Abfrageroutinen
  260.  * ------------------------------------------------------------------- *)
  261.  
  262. function  appl_geti  ( ap_gtype : integer; var ap_gout1, ap_gout2, ap_gout3, ap_gout4 : integer ) : integer;
  263. external;
  264. function  objc_sysv  ( ob_smode, ob_swhich, ob_sival1, ob_sival2 : integer; var ob_soval1, ob_soval2 : integer ) : integer;
  265. external;
  266. function  magx_avail : longint;
  267. external;
  268. function  mint_avail : word;
  269. external;
  270. function  winx_avail : integer;
  271. external;
  272. function  has_search : integer;
  273. external;
  274.  
  275. procedure CalcArea      ( tree : AESTreePtr; obj : integer; var r : rect );
  276. external;
  277. function  objc_frame    ( tree : AESTreePtr; entry : integer ) : integer;
  278. external;
  279.  
  280. (* -------------------------------------------------------------------
  281.  * Resourcen
  282.  * ------------------------------------------------------------------- *)
  283.  
  284. function  LoadResource  ( const rsc_name : string ) : word;
  285. function  RscAdr        ( tree_type, index : integer ) : AesTreePtr;
  286. external;
  287. procedure RscFree;
  288. external;
  289.  
  290. (* -------------------------------------------------------------------
  291.  * Menuezeile
  292.  * ------------------------------------------------------------------- *)
  293.  
  294. function  SetDeskTopMenu( menu : AESTreePtr; action : APROC ) : integer;
  295. external;
  296. procedure RemDeskTopMenu;
  297. external;
  298. procedure SelectMenu    ( item : integer; invert : integer );
  299. external;
  300. function  SetDeskTop    ( tree : AESTreePtr; first : integer; action : APROC ) : integer;
  301. external;
  302. procedure RemoveDeskTop;
  303. external;
  304.  
  305. (* -------------------------------------------------------------------
  306.  * Einstellungen
  307.  * ------------------------------------------------------------------- *)
  308.  
  309. procedure UseRightButton( use : integer );
  310. external;
  311. procedure TellKeyStrokes( tell : integer );
  312. external;
  313. procedure SetReturn     ( like_sysgem : integer );
  314. external;
  315. procedure UseHighButtons( use : integer );
  316. external;
  317. procedure SetButton     ( just : integer );
  318. external;
  319. procedure FrameTextColor( color : integer );
  320. external;
  321. procedure DialPosXY     ( center : integer );
  322. external;
  323. procedure SetIconColor  ( color : integer );
  324. external;
  325. procedure LinkImage     ( win_id : longint; image : bitblkptr; const text : string );
  326. procedure SetFieldProc  ( field : FPROC );
  327. external;
  328. procedure ShortCutColor ( color : integer );
  329. external;
  330. procedure SetAlertTitle ( const title : string );
  331.  
  332. (* -------------------------------------------------------------------
  333.  * Cookies
  334.  * ------------------------------------------------------------------- *)
  335.  
  336. function  RemoveCookie  ( id : longint ) : integer;
  337. external;
  338. function  SetCookie     ( id : longint ) : integer;
  339. external;
  340. function  GetCookie     ( id : longint; var value : longint ) : integer;
  341. external;
  342.  
  343. (* -------------------------------------------------------------------
  344.  * Texte im Fenster
  345.  * ------------------------------------------------------------------- *)
  346.  
  347. function  LinkList      ( win_id : longint; const text : string ) : pchar;
  348. function  AddToList     ( win_id : longint; const text : string ) : pchar;
  349. function  ChgInList     ( win_id : longint; line : word; const text : string ) : pchar;
  350. function  DelInList     ( win_id : longint; line : word ) : integer;
  351. external;
  352. function  CountLines    ( win_id : longint ) : word;
  353. external;
  354. function  Display       ( const f_name, wname, winfo : string; len : integer; win_id : longint; x, y, w, h : integer; action : APROC ) : WORD;
  355. function  cmp_strings_up( str1, str2 : pchar ) : integer;
  356. external;
  357. function  cmp_strings_dn( str1, str2 : pchar ) : integer;
  358. external;
  359. procedure do_qsort      ( win_id : longint; compare : CPROC );
  360. external;
  361.  
  362. (* -------------------------------------------------------------------
  363.  * Popup's
  364.  * ------------------------------------------------------------------- *)
  365.  
  366. function  PopUp         ( tree : AESTreePtr; x, y, start, first : integer ) : integer;
  367. external;
  368. function  xPopUp        ( tree : AESTreePtr; obj : integer; tree2 : AESTreePtr; start : integer; var first : integer ) : integer;
  369. external;
  370. function  Cycle         ( tree : AESTreePtr; obj : integer; pop_tree : AESTreePtr; first, last : integer; var ret : integer ) : integer;
  371. external;
  372. function  Listbox       ( str : pchar; count : integer; len : integer; tree : AESTreePtr; box : integer ) : integer;
  373. external;
  374.  
  375. (* -------------------------------------------------------------------
  376.  * Sliderboxen
  377.  * ------------------------------------------------------------------- *)
  378.  
  379. function  LinkSlider    ( tree : AESTreePtr; up, dn, show, hide, max, box : integer; buffer : pointer; len, format : integer ) : integer;
  380. external;
  381. procedure RedrawSliderBox(tree : AESTreePtr; box : integer );
  382. external;
  383. procedure ScrollSlider  ( tree : AESTreePtr; box, what : integer );
  384. external;
  385. function  AddSliderItem ( tree : AESTreePtr; box, anz_items : integer ) : integer;
  386. external;
  387. function  SetSliderPos  ( tree : AESTreePtr; box, pos : integer; draw : integer ) : integer;
  388. external;
  389. function  UnLinkSlider  ( tree : AESTreePtr; box : integer ) : integer;
  390. external;
  391.  
  392. (* -------------------------------------------------------------------
  393.  * Funktionen zum schreiben ins Fenster
  394.  * ------------------------------------------------------------------- *)
  395.  
  396. function  OpenLogWindow ( win_id : longint; const title, info : string; columns, rows, x, y : integer; action : aproc ) : integer;
  397. procedure wwrite        ( win_id : longint; const text : string );
  398. procedure wcls          ( win_id : longint );
  399. external;
  400. procedure wposxy        ( win_id : longint; x, y : integer );
  401. external;
  402. procedure wgetxy        ( win_id : longint; var x, y : integer );
  403. external;
  404. function  wgetchar      ( win_id : longint; x, y : integer; var effect : integer ) : char;
  405. external;
  406. procedure HideCursor    ( win_id : longint );
  407. external;
  408. procedure ShowCursor    ( win_id : longint );
  409. external;
  410.  
  411. (* -------------------------------------------------------------------
  412.  * Fenster- und Dialoge I
  413.  * ------------------------------------------------------------------- *)
  414.  
  415. function  NewDialog     ( tree : AESTreePtr ) : integer;
  416. external;
  417. procedure DelDialog     ( tree : AESTreePtr );
  418. external;
  419. function  BeginDialog   ( win_id : longint; tree : AESTreePtr; ed : INTEGER; const title : string ) : integer;
  420. function  HdlDialog     ( win_id : longint ) : integer;
  421. external;
  422. procedure FinishDialog  ( win_id : longint );
  423. external;
  424. function  Alert         ( priority, def : integer; const text : string ) : integer;
  425. function  DoDialog      ( tree : AESTreePtr; ed : integer; const text : string ) : integer;
  426. procedure RedrawObj     ( tree : AESTreePtr; obj, depth, state, flag : integer );
  427. external;
  428. procedure ShowDialog    ( tree : AESTreePtr );
  429. external;
  430. procedure EndDialog     ( tree : AESTreePtr );
  431. external;
  432. function  HandleDialog  ( tree : AESTreePtr; ed : integer ) : integer;
  433. external;
  434. procedure ChangeButton  ( tree : AESTreePtr; obj : integer; const text : string; draw : integer );
  435. procedure SetEditField  ( tree : AESTreePtr; field : integer );
  436. external;
  437. procedure GetEditFields  ( tree : AESTreePtr; callback : EPROC );
  438. external;
  439. procedure ClearEditFields ( tree : AESTreePtr );
  440. external;
  441. function  IsMenuKey     ( tree : AESTreePtr; scan, state : word ) : integer;
  442. external;
  443. procedure SetWinMinSize ( win_id : longint; w, h : integer );
  444. external;
  445. procedure SetWinMaxSize ( win_id : longint; w, h : integer );
  446. external;
  447. function  IsVisible     ( handle : integer ) : integer;
  448. external;
  449. procedure SetWatch      ( var r : rect; enter : integer; proc : wproc );
  450. external;
  451. procedure WatchWindow   ( win_id : longint; enter : integer; proc : wproc );
  452. external;
  453.  
  454. (* -------------------------------------------------------------------
  455.  * Fenster- und Dialoge II
  456.  * ------------------------------------------------------------------- *)
  457.  
  458. FUNCTION OpenWindow ( id                        : LONGINT;
  459.                       wTitle, wInfo             : STRING;
  460.                       flags                     : INTEGER;
  461.                       menu_line                 : AESTreePtr;
  462.                       align                     : INTEGER;
  463.                       part_redraw               : integer;
  464.                       scroll_x, scroll_y        : INTEGER;
  465.                       doc_x, doc_y              : LONGINT;
  466.                       x, y, w, h                : INTEGER;
  467.                       user                      : POINTER;
  468.                       redraw                    : RProc;
  469.                       action                    : AProc ) : INTEGER;
  470.  
  471. FUNCTION WindowDialog ( id              : LONGINT;
  472.                         xpos, ypos      : INTEGER;
  473.                         wtitle, winfo   : STRING;
  474.                         shut, force     : integer;
  475.                         tree, menu_line : AESTreePtr;
  476.                         first_edit      : INTEGER;
  477.                         user            : pointer;
  478.                         dfunc           : DProc ) : integer;
  479.  
  480. (* -------------------------------------------------------------------
  481.  * Fensterroutinen
  482.  * ------------------------------------------------------------------- *)
  483.  
  484. procedure CloseAllWindows;
  485. external;
  486. procedure RectIntersect ( var r1, r2 : rect );
  487. external;
  488. procedure SetWindowName ( handle : integer; const wname : string );
  489. procedure SetWindowInfo ( handle : integer; const winfo : string );
  490. function  GetWindowId   ( handle : integer ) : longint;
  491. external;
  492. function  GetTopWindow : integer;
  493. external;
  494. function  GetTopWindowId : longint;
  495. external;
  496. function  TopWindow     ( handle : integer ) : integer;
  497. external;
  498. function  GetHandle     ( id : longint ) : integer;
  499. external;
  500. function  CloseWindow   ( handle : integer ) : integer;
  501. external;
  502. procedure WhiteArea     ( var r : rect );
  503. external;
  504. function  LinkTree      ( win_id : longint; tree : AESTreePtr; id : longint; pos : integer ) : integer;
  505. external;
  506. function  SetWindowParm ( handle, what : integer; value : longint ) : longint;
  507. external;
  508. procedure ScrollWindow  ( handle, what : integer );
  509. external;
  510. procedure RedrawArea    ( handle : integer; var r : rect );
  511. external;
  512. procedure RedrawWindow  ( handle : integer );
  513. external;
  514. procedure RedrawDialog  ( tree : AESTreePtr );
  515. external;
  516.  
  517. (* -------------------------------------------------------------------
  518.  * Verwaltung
  519.  * ------------------------------------------------------------------- *)
  520.  
  521. function  HandleSysGem : integer;
  522. external;
  523. procedure DispatchEvents;
  524. external;
  525. procedure TerminateSysGem;
  526. external;
  527. function  SearchProgram ( const name : string ) : integer;
  528. procedure UseMTosIconify ( use : integer );
  529. external;
  530.  
  531. (* -------------------------------------------------------------------
  532.  * Timer-Verwaltung
  533.  * ------------------------------------------------------------------- *)
  534.  
  535. procedure SetProcTimer  ( p : TPROC );
  536. external;
  537. procedure SetTimer      ( ms_low, ms_high : integer );
  538. external;
  539. procedure SetDispatchTime ( ms_low, ms_high : integer );
  540. external;
  541. procedure SetWindowTimer ( win_id : longint; ms_low, ms_high : integer );
  542. external;
  543. procedure EnableTimer;
  544. external;
  545. procedure DisableTimer;
  546. external;
  547.  
  548. (* -------------------------------------------------------------------
  549.  * Bildschirmroutinen
  550.  * ------------------------------------------------------------------- *)
  551.  
  552. FUNCTION  NewArea        ( VAR a : AREA ) : integer;
  553. external;
  554. PROCEDURE FreeArea       ( VAR a : AREA );
  555. external;
  556. PROCEDURE ClearArea      ( VAR a : AREA );
  557. external;
  558. FUNCTION  SaveArea       ( handle : INTEGER; VAR a : AREA; VAR r : RECT ) : integer;
  559. external;
  560. PROCEDURE RestoreArea    ( handle : INTEGER; VAR a : AREA );
  561. external;
  562. PROCEDURE CopyArea       ( handle : INTEGER; VAR a : AREA; xx, yy : INTEGER );
  563. external;
  564. PROCEDURE MoveScreen     ( handle : INTEGER; VAR r : RECT; x, y : INTEGER );
  565. external;
  566.  
  567. (* -------------------------------------------------------------------
  568.  * Textfunktionen
  569.  * ------------------------------------------------------------------- *)
  570.  
  571. function  GetText       ( tree : AESTreePtr; index : integer; VAR s : String ) : pchar;
  572. procedure SetText       ( tree : AESTreePtr; index : integer; const s : String );
  573. procedure UseBlanks     ( use : integer );
  574. external;
  575.  
  576. (* ------------------------------------------------------------------- *)
  577.  
  578. PROCEDURE ShowArrow;
  579. PROCEDURE ShowBee;
  580. PROCEDURE ShowHour;
  581. PROCEDURE ShowFinger;
  582. PROCEDURE ShowHand;
  583. PROCEDURE ShowThinCross;
  584. PROCEDURE ShowThickCross;
  585. PROCEDURE ShowOutlineCross;
  586. PROCEDURE ShowMouse;
  587. PROCEDURE HideMouse;
  588.  
  589. (* ------------------------------------------------------------------- *)
  590.  
  591. PROCEDURE SetState       ( tree : AESTreePtr; obj, state : INTEGER );
  592. PROCEDURE DelState       ( tree : AESTreePtr; obj, state : INTEGER );
  593. FUNCTION  GetState       ( tree : AESTreePtr; obj, state : INTEGER ) : boolean;
  594. PROCEDURE SetGlobalState ( tree : AESTreePtr; obj, state : INTEGER );
  595.  
  596. PROCEDURE SetFlags       ( tree : AESTreePtr; obj, flag : INTEGER );
  597. PROCEDURE DelFlags       ( tree : AESTreePtr; obj, flag : INTEGER );
  598. FUNCTION  GetFlags       ( tree : AESTreePtr; obj, flag : INTEGER ) : boolean;
  599. PROCEDURE SetGlobalFlags ( tree : AESTreePtr; obj, flag : INTEGER );
  600.  
  601. (* ------------------------------------------------------------------- *)
  602.  
  603. IMPLEMENTATION
  604.  
  605. {$I-}
  606. {$Q-}
  607. {$T-}
  608. {$X+}
  609. {$Z+}
  610.  
  611. (* -------------------------------------------------------------------
  612.  * Ab hier befinden sich die spezifischen Anpassungen für die C-Lib.
  613.  *
  614.  * AUF GAR KEINEN FALL IRGENDWAS AENDERN!!!!
  615.  *
  616.  * Bei einer neuen Pascal-Version können Sie einfach durch neukompilieren
  617.  * dieser Unit eine neue Lib erstellen. Bei neuen Versionen einfach die
  618.  * SYS_PAS.LIB austauschen und neu übersetzen. Und schon haben Sie eine
  619.  * neue Lib. NIE wieder Abhängigkeiten von der Pascal-Version/Release!
  620.  * ------------------------------------------------------------------- *)
  621.  
  622. var     errno      : integer;   (* interne Error-Variable              *)
  623.         _app       : integer;   (* App oder ACC?                       *)
  624.         _atexitv   : longint;   (* Adresse                             *)
  625.         _filsysv   : longint;   (* Adresse                             *)
  626.  
  627. (* -------------------------------------------------------------------
  628.  * Berechnet aus einem String ein Long. Wird für die (Fenster) Id's
  629.  * benötigt.
  630.  * ------------------------------------------------------------------- *)
  631.  
  632. function MakeId ( const id : string ) : longint;
  633.  
  634. var     conv    : record
  635.           case integer of
  636.             0   : ( x1 : packed array [0..3] of char );
  637.             1   : ( x2 : longint );
  638.         end;
  639.  
  640. begin
  641.   conv.x1 [0] := id [1];
  642.   conv.x1 [1] := id [2];
  643.   conv.x1 [2] := id [3];
  644.   conv.x1 [3] := id [4];
  645.   MakeId := conv.x2;
  646. end;
  647.  
  648. (* -------------------------------------------------------------------
  649.  * Die Maus-Funktionen. Müssen hier als Proceduren sein, da sie in C
  650.  * als #define deklariert sind.
  651.  * ------------------------------------------------------------------- *)
  652.  
  653. function graf_mouse ( number : integer; form : pointer ) : integer;
  654. external;
  655.  
  656. (* ------------------------------------------------------------------- *)
  657.  
  658. PROCEDURE ShowArrow;        BEGIN Graf_Mouse ( 0,   NIL ); END;
  659. PROCEDURE ShowBee;          BEGIN Graf_Mouse ( 2,   NIL ); END;
  660. PROCEDURE ShowHour;         BEGIN Graf_Mouse ( 2,   NIL ); END;
  661. PROCEDURE ShowFinger;       BEGIN Graf_Mouse ( 3,   NIL ); END;
  662. PROCEDURE ShowHand;         BEGIN Graf_Mouse ( 4,   NIL ); END;
  663. PROCEDURE ShowThinCross;    BEGIN Graf_Mouse ( 5,   NIL ); END;
  664. PROCEDURE ShowThickCross;   BEGIN Graf_Mouse ( 6,   NIL ); END;
  665. PROCEDURE ShowOutlineCross; BEGIN Graf_Mouse ( 7,   NIL ); END;
  666. PROCEDURE ShowMouse;        BEGIN Graf_Mouse ( 257, NIL ); END;
  667. PROCEDURE HideMouse;        BEGIN Graf_Mouse ( 256, NIL ); END;
  668.  
  669. (* -------------------------------------------------------------------
  670.  * Die Flag-Funktionen. Müssen hier als Proceduren sein, da sie in C
  671.  * als #define deklariert sind.
  672.  * ------------------------------------------------------------------- *)
  673.  
  674. PROCEDURE SetState ( tree : AESTreePtr; obj, state : INTEGER );
  675.  
  676. begin
  677.   tree^[obj].ob_state := ( tree^[obj].ob_state OR state );
  678. end;
  679.  
  680. (* ------------------------------------------------------------------- *)
  681.  
  682. PROCEDURE SetGlobalState ( tree : AESTreePtr; obj, state : INTEGER );
  683.  
  684. begin
  685.   tree^[obj].ob_state := state;
  686. end;
  687.  
  688. (* ------------------------------------------------------------------- *)
  689.  
  690. PROCEDURE DelState ( tree : AESTreePtr; obj, state : INTEGER );
  691.  
  692. begin
  693.   tree^[obj].ob_state := ( tree^[obj].ob_state AND ( NOT state ));
  694. end;
  695.  
  696. (* ------------------------------------------------------------------- *)
  697.  
  698. PROCEDURE SetFlags ( tree : AESTreePtr; obj, flag : INTEGER );
  699.  
  700. begin
  701.   tree^[obj].ob_flags := ( tree^[obj].ob_flags OR flag );
  702. end;
  703.  
  704. (* ------------------------------------------------------------------- *)
  705.  
  706. PROCEDURE SetGlobalFlags ( tree : AESTreePtr; obj, flag : INTEGER );
  707.  
  708. begin
  709.   tree^[obj].ob_flags := flag;
  710. end;
  711.  
  712. (* ------------------------------------------------------------------- *)
  713.  
  714. PROCEDURE DelFlags ( tree : AESTreePtr; obj, flag : INTEGER );
  715.  
  716. begin
  717.   tree^[obj].ob_flags := ( tree^[obj].ob_flags AND ( NOT flag ));
  718. end;
  719.  
  720. (* ------------------------------------------------------------------- *)
  721.  
  722. FUNCTION GetState ( tree : AESTreePtr; obj, state : INTEGER ) : boolean;
  723.  
  724. begin
  725.   GetState := (( tree^[obj].ob_state AND state ) <> 0 );
  726. end;
  727.  
  728. (* ------------------------------------------------------------------- *)
  729.  
  730. FUNCTION GetFlags ( tree : AESTreePtr; obj, flag : INTEGER ) : boolean;
  731.  
  732. begin
  733.   GetFlags := (( tree^[obj].ob_flags AND flag ) <> 0 );
  734. end;
  735.  
  736. (* -------------------------------------------------------------------
  737.  * Prototypen
  738.  * ------------------------------------------------------------------- *)
  739.  
  740. function sgem_Init_GEM      ( p : pointer; acc : pchar; prg_id : Longint; prg_name : pchar; usr_id : longint; usr_name : pchar; key : longint ) : integer;
  741. external;
  742. function sgem_Alert         ( priority : integer; def : integer; txt : pchar ) : integer;
  743. external;
  744. function sgem_DoDialog      ( tree : pointer; obj : integer; txt : pchar ) : integer;
  745. external;
  746. function sgem_LinkList      ( win_id : longint; text : pchar ) : pchar;
  747. external;
  748. function sgem_AddToList     ( win_id : longint; text : pchar ) : pchar;
  749. external;
  750. function sgem_ChgInList     ( win_id : longint; line : word; text : pchar ) : pchar;
  751. external;
  752. procedure sgem_SetAlertTitle ( title : pchar );
  753. external;
  754. procedure sgem_LinkImage     ( win_id : longint; image : pointer; text : pchar );
  755. external;
  756. function sgem_LoadResource  ( rsc_name : pchar ) : word;
  757. external;
  758. function  sgem_OpenLogWindow ( win_id : longint; title, info : pchar; columns, rows, x, y : integer; action : aproc ) : integer;
  759. external;
  760. procedure sgem_ChangeButton  ( tree : AESTreePtr; obj : integer; text : pchar; draw : integer );
  761. external;
  762. procedure xwwrite ( win_id : longint; text : pchar );
  763. external;
  764. procedure sgem_SetText ( tree : AESTreePtr; index : integer; s : pchar );
  765. external;
  766. function  sgem_GetText ( tree : AESTreePtr; index : integer; s : pchar ) : pchar;
  767. external;
  768. procedure sgem_SetWindowInfo ( handle : integer; winfo : pchar );
  769. external;
  770. procedure sgem_SetWindowName ( handle : integer; wname : pchar );
  771. external;
  772. function sgem_WindowDialog ( id : LONGINT; xpos, ypos : INTEGER; wtitle, winfo : pchar; shut, force : integer; tree, menu_line : AESTreePtr; first_edit: INTEGER; user:pointer;dfunc : DProc ) : integer;
  773. external;
  774. function OpenTxtWin ( win_id : longint; wname, winfo : pchar; x, y, w, h : integer; action : aproc ) : integer;
  775. external;
  776. function sgem_BeginDialog ( win_id : longint; tree : AESTreePtr; ed : integer; title : pchar ) : integer;
  777. external;
  778. function sgem_OpenWindow ( id : LONGINT; wTitle, wInfo: pchar; flags: INTEGER;menu_line: AESTreePtr;align: INTEGER;part_redraw: integer;scroll_x, scroll_y: INTEGER;
  779.                       doc_x, doc_y: LONGINT; x, y, w, h : INTEGER; user: POINTER; redraw: RProc; action: AProc ) : INTEGER;
  780. external;
  781. function sgem_searchprogram ( pname : pchar ) : integer;
  782. external;
  783.  
  784. (* ------------------------------------------------------------------- *)
  785.  
  786. function Init_GEM ( par : pointer; const acc_name : string; prg_id : longint; const prg_name : string; usr_id : longint; const usr_name : string; key : longint ) : integer;
  787.  
  788. var     s1 : string;
  789.         s2 : string;
  790.         s3 : string;
  791.  
  792. begin
  793.   s1 := acc_name + #0;
  794.   s2 := prg_name + #0;
  795.   s3 := usr_name + #0;
  796.   Init_GEM := sgem_Init_GEM ( par, @s1[1], prg_id, @s2[1], usr_id, @s3 [1], key );
  797. end;
  798.  
  799. (* ------------------------------------------------------------------- *)
  800.  
  801. function Alert ( priority, def : integer; const text : string ) : integer;
  802.  
  803. var     s1 : string;
  804.  
  805. begin
  806.   s1 := text + #0;
  807.   Alert := sgem_Alert ( priority, def, @s1 [1] );
  808. end;
  809.  
  810. (* ------------------------------------------------------------------- *)
  811.  
  812. function DoDialog ( tree : AESTreePtr; ed : integer; const text : string ) : integer;
  813.  
  814. var     s1 : string;
  815.  
  816. begin
  817.   s1 := text + #0;
  818.   DoDialog := sgem_DoDialog ( tree, ed, @s1 [1] );
  819. end;
  820.  
  821. (* -------------------------------------------------------------------
  822.  * Da PP die File-Funktionen aus C nicht frisst, hier das Äquivalent.
  823.  * Ist (leider) etwas langsamer als in C... :-(((
  824.  * ------------------------------------------------------------------- *)
  825.  
  826. function Display ( const f_name, wname, winfo : string; len : integer; win_id : longint; x, y, w, h : integer; action : APROC ) : WORD;
  827.  
  828. var     s1, s2, s3, s4  : string;
  829.         f               : TEXT;
  830.         i               : WORD;
  831.         z               : INTEGER;
  832.  
  833. begin
  834.   s1 := f_name + #0;
  835.   s2 := wname + #0;
  836.   s3 := winfo + #0;
  837.  
  838.   assign ( f, f_name );
  839.   Reset ( f );
  840.   if ( IOResult <> 0 ) then
  841.     begin
  842.       Display := 0;
  843.       exit;
  844.     end;
  845.   z := OpenTxtWin ( win_id, @s2 [1], @s3 [1], x, y, w, h, action );
  846.   if ( z <= 0 ) then
  847.     begin
  848.       close ( f );
  849.       Display := 0;
  850.       exit;
  851.     end;
  852.   i := 0;
  853.   while ( not ( eof ( f ))) do
  854.     begin
  855.       fillchar ( s4, sizeof ( s4 ), 0 );
  856.       readln ( f, s4 );
  857.       if ( i = 0 ) then
  858.         begin
  859.           LinkList ( win_id, s4 );
  860.         end
  861.       else
  862.         begin
  863.           AddToList ( win_id, s4 );
  864.         end;
  865.       inc ( i );
  866.     end;
  867.   close ( f );
  868.   display := i;
  869. end;
  870.  
  871. (* ------------------------------------------------------------------- *)
  872.  
  873. function LinkList ( win_id : longint; const text : string ) : pchar;
  874.  
  875. var     s1 : string;
  876.  
  877. begin
  878.   s1 := text + #0;
  879.   LinkList := sgem_LinkList ( win_id, @s1 [1] );
  880. end;
  881.  
  882. (* ------------------------------------------------------------------- *)
  883.  
  884. function AddToList ( win_id : longint; const text : string ) : pchar;
  885.  
  886. var     s1 : string;
  887.  
  888. begin
  889.   s1 := text + #0;
  890.   AddToList := sgem_AddToList ( win_id, @s1 [1] );
  891. end;
  892.  
  893. (* ------------------------------------------------------------------- *)
  894.  
  895. function ChgInList ( win_id : longint; line : word; const text : string ) : pchar;
  896.  
  897. var     s1 : string;
  898.  
  899. begin
  900.   s1 := text + #0;
  901.   ChgInList := sgem_ChgInList ( win_id, line, @s1 [1] );
  902. end;
  903.  
  904. (* ------------------------------------------------------------------- *)
  905.  
  906. procedure SetAlertTitle ( const title : string );
  907.  
  908. var     s1 : string;
  909.  
  910. begin
  911.   s1 := title + #0;
  912.   sgem_SetAlertTitle ( @s1 [1] );
  913. end;
  914.  
  915. (* ------------------------------------------------------------------- *)
  916.  
  917. procedure LinkImage ( win_id : longint; image : bitblkptr; const text : string );
  918.  
  919. var     s1 : string;
  920.  
  921. begin
  922.   s1 := text + #0;
  923.   sgem_LinkImage ( win_id, image, @s1 [1] );
  924. end;
  925.  
  926. (* ------------------------------------------------------------------- *)
  927.  
  928. function LoadResource ( const rsc_name : string ) : word;
  929.  
  930. var     s1 : string;
  931.  
  932. begin
  933.   s1 := rsc_name + #0;
  934.   LoadResource := sgem_LoadResource ( @s1 [1] );
  935. end;
  936.  
  937. (* ------------------------------------------------------------------- *)
  938.  
  939. function OpenLogWindow ( win_id : longint; const title, info : string; columns, rows, x, y : integer; action : aproc ) : integer;
  940.  
  941. var     s1, s2 : string;
  942.  
  943. begin
  944.   s1 := title + #0;
  945.   s2 := info  + #0;
  946.   OpenLogWindow := sgem_OpenLogWindow ( win_id, @s1 [1], @s2 [1], columns, rows, x, y, action );
  947. end;
  948.  
  949. (* ------------------------------------------------------------------- *)
  950.  
  951. procedure ChangeButton ( tree : AESTreePtr; obj : integer; const text : string; draw : integer );
  952.  
  953. var     s1 : string;
  954.  
  955. begin
  956.   s1 := text + #0;
  957.   sgem_ChangeButton ( tree, obj, @s1 [1], draw );
  958. end;
  959.  
  960. (* ------------------------------------------------------------------- *)
  961.  
  962. procedure wwrite ( win_id : longint; const text : string );
  963.  
  964. var     s1 : string;
  965.  
  966. begin
  967.   s1 := text + #0;
  968.   xwwrite ( win_id, @s1 [1] );
  969. end;
  970.  
  971. (* ------------------------------------------------------------------- *)
  972.  
  973. procedure SetText ( tree : AESTreePtr; index : integer; const s : String );
  974.  
  975. var     s1 : string;
  976.  
  977. begin
  978.   s1 := s + #0;
  979.   sgem_SetText ( tree, index, @s1 [1] );
  980. end;
  981.  
  982. (* ------------------------------------------------------------------- *)
  983.  
  984. function GetText ( tree : AESTreePtr; index : integer; VAR s : String ) : pchar;
  985.  
  986. var     s1 : string;
  987.  
  988. begin
  989.   GetText := sgem_GetText ( tree, index, @s1 );
  990.   ctopascalstring ( s, @s1 );
  991. end;
  992.  
  993. (* ------------------------------------------------------------------- *)
  994.  
  995. procedure SetWindowInfo ( handle : integer; const winfo : string );
  996.  
  997. var     s1 : string;
  998.  
  999. begin
  1000.   s1 := winfo + #0;
  1001.   sgem_SetWindowInfo ( handle, @s1 [1] );
  1002. end;
  1003.  
  1004. (* ------------------------------------------------------------------- *)
  1005.  
  1006. procedure SetWindowName ( handle : integer; const wname : string );
  1007.  
  1008. var     s1 : string;
  1009.  
  1010. begin
  1011.   s1 := wname + #0;
  1012.   sgem_SetWindowName ( handle, @s1 [1] );
  1013. end;
  1014.  
  1015. (* ------------------------------------------------------------------- *)
  1016.  
  1017. function BeginDialog ( win_id : longint; tree : AESTreePtr; ed : INTEGER; const title : string ) : integer;
  1018.  
  1019. var     s1 : string;
  1020.  
  1021. begin
  1022.   s1 := title + #0;
  1023.   BeginDialog := sgem_BeginDialog ( win_id, tree, ed, @s1 [1] );
  1024. end;
  1025.  
  1026. (* ------------------------------------------------------------------- *)
  1027.  
  1028. function SearchProgram ( const name : string ) : integer;
  1029.  
  1030. var     s1 : string;
  1031.  
  1032. begin
  1033.   s1 := name + #0;
  1034.   SearchProgram := sgem_SearchProgram ( @s1 [1] );
  1035. end;
  1036.  
  1037. (* ------------------------------------------------------------------- *)
  1038.  
  1039. function WindowDialog ( id              : LONGINT;
  1040.                         xpos, ypos      : INTEGER;
  1041.                         wtitle, winfo   : STRING;
  1042.                         shut, force     : integer;
  1043.                         tree, menu_line : AESTreePtr;
  1044.                         first_edit      : INTEGER;
  1045.                         user            : pointer;
  1046.                         dfunc           : DProc ) : integer;
  1047.  
  1048. var     s1, s2 : string;
  1049.  
  1050. begin
  1051.   s1 := wtitle + #0;
  1052.   s2 := winfo  + #0;
  1053.   WindowDialog := sgem_WindowDialog ( id, xpos, ypos, @s1 [1], @s2 [1], shut, force, tree, menu_line, first_edit, user, dfunc );
  1054. end;
  1055.  
  1056. (* ------------------------------------------------------------------- *)
  1057.  
  1058. function OpenWindow ( id                        : LONGINT;
  1059.                       wTitle, wInfo             : STRING;
  1060.                       flags                     : INTEGER;
  1061.                       menu_line                 : AESTreePtr;
  1062.                       align                     : INTEGER;
  1063.                       part_redraw               : integer;
  1064.                       scroll_x, scroll_y        : INTEGER;
  1065.                       doc_x, doc_y              : LONGINT;
  1066.                       x, y, w, h                : INTEGER;
  1067.                       user                      : POINTER;
  1068.                       redraw                    : RProc;
  1069.                       action                    : AProc ) : INTEGER;
  1070.  
  1071. var     s1, s2 : string;
  1072.  
  1073. begin
  1074.   s1 := wtitle + #0;
  1075.   s2 := winfo  + #0;
  1076.   OpenWindow := sgem_OpenWindow ( id,@s1[1],@s2[1],flags,menu_line,align, part_redraw,scroll_x,scroll_y,doc_x, doc_y,x,y,w,h,user,redraw,action );
  1077. end;
  1078.  
  1079. (* -------------------------------------------------------------------
  1080.  * Funktionen für die Speicherverwaltung. PurePascal schmeisst Bomben
  1081.  * und scheint auszurasten, wenn die über C läuft...
  1082.  * ------------------------------------------------------------------- *)
  1083.  
  1084. procedure getmemx ( var x : pointer; s : longint );
  1085.  
  1086. begin
  1087.   getmem ( x, s );
  1088. end;
  1089.  
  1090. (* ------------------------------------------------------------------- *)
  1091.  
  1092. procedure frememx ( var x : pointer; s : longint );
  1093.  
  1094. begin
  1095.   freemem ( x, s );
  1096. end;
  1097.  
  1098. (* -------------------------------------------------------------------
  1099.  * Die Lib. Ohne die läuft nix...
  1100.  * ------------------------------------------------------------------- *)
  1101.  
  1102. (*$L sys_pas.lib *)             (* Die Lib. Pfad einfach anpassen      *)
  1103.  
  1104. (* -------------------------------------------------------------------
  1105.  * Startup-Code, damit die Lib richtig hochkommt...
  1106.  * ------------------------------------------------------------------- *)
  1107.  
  1108. begin
  1109.   _filsysv   := longint ( 0 );
  1110.   _atexitv   := longint ( 0 );
  1111.   errno      := 0;
  1112.   if (( AppFlag = TRUE ) and ( _filsysv = 0 ) and ( _atexitv = 0 )) then
  1113.     begin
  1114.       _app := 1;
  1115.     end
  1116.   else
  1117.     begin
  1118.       _app := 0;
  1119.     end;
  1120. end.
  1121.