{************************************************
 **             L I S T I N G  2               **
 **                                            **
 **     OBJECT-Darstellung unter CCD-Pascal    **
 **                                            **
 **     written by M.Baldauf 3/87              **
 **                                            **
 ************************************************}

              {  DATENSTRUKTUREN }

TYPE ted1 = PACKED RECORD   { TEDINFO-Struktur }
                   te_ptext:long_integer;  { Zeiger auf auszugebenden Text }
                   te_ptmplt:long_integer; { Zeiger auf Eingabe-Schablone }
                   te_pvalid:long_integer; { Zeiger auf zugelassene Eingabeart }
                   te_font:integer;        { Normaler oder kleiner Zeichensatz }
                   te_junk1:integer;       { Reserviert }
                   te_just:integer;        { Textformatierung - links,rechts...}
                   te_color:integer;       { Bestimmung der Farbe }
                   te_junk2:integer;       { Reserviert }
                   te_thickness:integer;   { Dicke der Rechteckumrandung }
                   te_txtlen:integer;      { L„nge des Strings ^te_ptext }
                   te_tmplen:integer       { L„nge des Strings ^te_ptmplt }
                  END;

     tedinfo = RECORD
               CASE boolean OF
                 FALSE: (ted_tree:long_integer);
                 TRUE : (p_ted:^ted1)
               END;

     ob1 = PACKED RECORD    { OBJECT-Struktur }
                   ob_next:integer;        { n„chstes Object }
                   ob_head:integer;        { Anfangsobject }
                   ob_tail:integer;        { Endobject }
                   ob_type:integer;        { Art des Objects }
                   ob_flags:integer;       { W„hlbarkeit von Objecten }
                   ob_state:integer;       { Zustand des Objects }
                   ob_spec:long_integer;   { Objectspezifikation }
                   ob_x:integer;           { Object X-Koordinate }
                   ob_y:integer;           { Object Y-Koordinate }
                   ob_width:integer;       { Objectbreite }
                   ob_height:integer       { Objecth”he }
                  END;

     object_typ = RECORD
              CASE boolean OF
                FALSE: (object_tree:long_integer);
                TRUE : (p_obj:^ob1)
              END;

        { ---------------------------------------------- }

{ NOTWENDIGE PROZEDUREN }

{*********************
 **  Peek und Poke  **
 *********************}
function peek(adr:long_integer):byte;
type word = packed record
                    w:byte
                   end;
var ptr:record
         case boolean of
          false:(i:long_integer);
          true :(p:^word)
         end;
begin
  ptr.i := adr;
  peek := ptr.p^.w
end;

procedure poke(adr:long_integer;val:byte);
type word = packed record
                    w:byte
                   end;
var ptr:record
         case boolean of
          false:(i:long_integer);
          true :(p:^word)
         end;
begin
  ptr.i := adr;
  ptr.p^.w := val
end;

{****************************************
 **         Objecttext holen           **
 ****************************************}
PROCEDURE get_text(baum,index:integer;VAR text:string);
VAR adress,text_tree:long_integer;
    object:object_typ;
    ted_info:tedinfo;
    text_len,i:integer;
    i1:integer;
BEGIN
 dummy:=rsrc_gaddr(0,baum,adress);
 object.object_tree:=adress+index*24;
 ted_info.ted_tree:=object.p_obj^.ob_spec;
 text_tree:=ted_info.p_ted^.te_ptext;
 text_len:=ted_info.p_ted^.te_tmplen-2;
 text:='';
 for i:=0 TO text_len DO text:=concat(text,chr(peek(text_tree+i)));
 if text[1] = '@' then text:=''
   else begin
     i1:=1;
     text:='';
     loop
        exit if (text[i1]=chr(0)) or ((i1>=text_len-2) and (text[i1]=' '));
        text:=concat(text,text[i1]);
        i1:=i1+1;
     end;
   end;
END;

{****************************************
 **         Objecttext setzen          **
 ****************************************}
PROCEDURE set_text(baum,index:integer;text:string);
VAR adress,text_tree:long_integer;
    object:object_typ;
    ted_info:tedinfo;
    text_len,i:integer;
BEGIN
 dummy:=rsrc_gaddr(0,baum,adress);
 object.object_tree:=adress+index*24;
 ted_info.ted_tree:=object.p_obj^.ob_spec;
 text_tree:=ted_info.p_ted^.te_ptext;
 text_len:=ted_info.p_ted^.te_txtlen-2;
 text:='';
 FOR i:=0 TO text_len DO poke(text_tree+i,ord(text[i+1]));
END;

{****************************************
 **         Objectstatus holen         **
 ****************************************}
FUNCTION get_state(baum,index:integer):integer;
var  object:object_typ;
     error:integer;
     address:long_integer;
begin
  error := rsrc_gaddr(0,baum,address);
  object.object_tree := address + index*24;
  get_state := object.p_obj^.ob_state;
end;

{*******************************
 **  Object nicht angew„hlen  **
 *******************************}
procedure desel_obj(tree:long_integer; which:integer);
BEGIN
  objc_change(tree,which,0,xdesk,ydesk,wdesk,hdesk,0,1);
END;

{***********************
 **  Object anw„hlen  **
 ***********************}
procedure sel_obj(tree:long_integer; which:integer);
BEGIN
  objc_change(tree,which,0,xdesk,ydesk,wdesk,hdesk,1,1);
END;

{**********************************************
 **  Diese Function stellt Dialog-Boxen dar  **
 **********************************************}
function hndl_dial(tree:long_integer; def, x,y,w,h:integer):integer;
VAR obj,xdial,ydial,wdial,hdial:integer;
BEGIN
  form_center(tree, xdial,ydial,wdial,hdial);   { Es werden die Koordinaten des}
                                                { angegebenen Objectbaumes be- }
                                                { rechnet, so daž dieser in der}
                                                { Mitte des Bildschirms er- }
                                                { scheint. }
  form_dial(0,x,y,w,h,xdial,ydial,wdial,hdial); { Reservierung des Bildschirm- }
                                                { speicherbereichs }
  form_dial(1,x,y,w,h,xdial,ydial,wdial,hdial); { Zeichnen eines sich aus- }
                                                { dehnenden Kastens }
  objc_draw(tree,0,30,xdial,ydial,wdial,hdial); { Zeichnen des Objectbaums }
  obj := form_do(tree,def);                     { Formularberwachung durch das}
                                                { AES. }
  hndl_dial := obj;
  form_dial(2,x,y,w,h,xdial,ydial,wdial,hdial); { Zeichnen eines schrumpfenden }
                                                { Kastens }
  form_dial(3,x,y,w,h,xdial,ydial,wdial,hdial); { Freigeben des reservierten }
                                                { Bildschirmspeichers }
END;

        { ---------------------------------------------- }

{ EIN BEISPIEL - AUFRUF }

{ Die Grožgeschriebenen Worte sind Konstanten aus dem vom RCS erzeugten }
{ Pascal - Include File zu dem jeweiligen Resource-File. Dieses Include }
{ File muž im CONST - Vereinbarungsteil des Pascal-Programms mittels }
{ Include {$I name.I } hinzugefgt werden. }

procedure about_prg;
var tree:long_integer;
    dummy,obj,status:integer;
begin
  set_text(UEBER, DRUCKRND,'Matthias'); { Setzt Text 'Matthias' in TEDINFO - }
                                        { Struktur DRUCKRND in dem Object - }
                                        { Baum UEBER }
  set_text(UEBER, SEITE,'Baldauf');     { Setzt Text 'Baldauf' in TEDINFO - }
                                        { Struktur SEITE in dem Object-Baum }
                                        { UEBER }

  dummy := rsrc_gaddr(0, UEBER, tree);  { Hier wird die Adresse der OBJECT - }
                                        { Struktur UEBER geholt und an 'tree' }
                                        { zugewiesen. }

  obj := hndl_dial(tree,0,320,200,1,1); { Die Prozedur 'hndl_dial' wird auf- }
                                        { gerufen. Sie bernimmt die Programm-}
                                        { Kontrolle bis der Benutzer einen }
                                        { Exit-Knopf bet„tigt. }
                                        { Zurck kommt der Index des Exit- }
                                        { Buttons }

  desel_obj(tree,obj);                  { Der angeklickte EXIT-Button wird }
                                        { 'abgew„hlt' . }

  get_text(UEBER, DRUCKRND,str_1);      { Holt Text aus TEDINFO-Struktur }
                                        { DRUCKRND aus der OBJECT-Struktur }
                                        { UEBER und weist ihn dem String str_1 }
                                        { zu. }

  status := get_state(UEBER, OK_BUTTON);{ Holt den Object-Status des OK_BUTTON }
                                        { aus der OBJECT-Struktur UEBER }
end;

{ ENDE DES BEISPIEL-AUFRUFS }
