home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d9xx / d996 / startup-menu.lha / Startup-Menu / Source / SMPrefs / List.PAS next >
Pascal/Delphi Source File  |  1994-04-05  |  4KB  |  158 lines
  1. (* ===================================================================== *)
  2. Function Add_Name(name : string) : pMyNode;
  3. VAR
  4.     namenode : pMyNode;
  5.     strn     : STRPTR;
  6.     
  7. begin
  8.     namenode := AllocRemember(@RememberKey, sizeof(tMyNode), MEMF_CLEAR OR MEMF_PUBLIC);
  9.     namenode^.LSK_Name := name;
  10.     namenode^.LSK_Node.ln_Name := @namenode^.LSK_Name[1];
  11.     namenode^.LSK_Node.ln_Type := NT_USER;
  12.     namenode^.LSK_Node.ln_Pri  := 0;
  13.     namenode^.LSK_Cmd := 'None'#0;
  14.     AddHead(CurrentList, pNode(namenode));
  15.     add_name := namenode;
  16. end;
  17.  
  18. (* ===================================================================== *)
  19.  
  20. Procedure DetachObjectList;
  21.  
  22. VAR 
  23.     Tag_Array : array[0..1] of tTagItem;
  24.  
  25. begin
  26.     Tag_Array[0].ti_Tag  := GTLV_Labels;
  27.     Tag_Array[0].ti_Data := $FFFFFFFF;
  28.     Tag_Array[1].ti_Tag  := TAG_END;
  29.     GT_SetGadgetAttrsA(gads[G_LV], Thewindow, NIL, @Tag_Array);
  30. end;
  31.  
  32. (* ===================================================================== *)
  33.  
  34. Procedure DisableObjectGadgets(Disable : byte);
  35.  
  36. begin
  37.     DisableGadget(gads[G_B_TOP], TheWindow, Disable);
  38.     DisableGadget(gads[G_B_UP], TheWindow, Disable);
  39.     DisableGadget(gads[G_B_DOWN], TheWindow, Disable);
  40.     DisableGadget(gads[G_B_BOTTOM], TheWindow, Disable);
  41.     DisableGadget(gads[G_B_REMOVE], TheWindow, Disable);
  42.     DisableGadget(gads[G_B_COPY], TheWindow, Disable);
  43.     DisableGadget(gads[G_S_CMD], TheWindow, Disable);
  44.     DisableGadget(gads[G_B_CMDREQ], TheWindow, Disable);
  45.     DisableGadget(gads[G_S_KEY], TheWindow, Disable);
  46. end;
  47.  
  48. (* ===================================================================== *)
  49.  
  50. Procedure AttachObjectList;
  51.  
  52. VAR 
  53.     Tag_Array : array[0..3] of tTagItem;
  54.  
  55. begin
  56.     Tag_Array[0].ti_Tag  := GTLV_Labels;
  57.     Tag_Array[0].ti_Data := LONG(CurrentList);
  58.     Tag_Array[1].ti_Tag  := GTLV_Top;      
  59.     Tag_Array[1].ti_Data := CurrentTop;
  60.     Tag_Array[2].ti_Tag  := GTLV_Selected; 
  61.     Tag_Array[2].ti_Data := CurrentOrd;
  62.     Tag_Array[3].ti_Tag  := TAG_END;
  63.     GT_SetGadgetAttrsA(gads[G_LV], TheWindow, NIL, @Tag_Array);
  64. end;
  65.  
  66. (* ===================================================================== *)
  67.  
  68. Procedure SortGadgetFunc;
  69.  
  70. VAR
  71.     notfinished : Boolean;
  72.     first, second, tmpnode : pNode;
  73.     n,i :integer;
  74.  
  75. begin
  76.     IF CurrentList^.lh_Head^.ln_Succ <> NIL then begin
  77.         wl := rtLockWindow(TheWindow);
  78.         notfinished := true;
  79.          (* Detach object list *)
  80.          DetachObjectList;
  81.         tmpnode := currentlist^.lh_Head;
  82.         i := 0;
  83.         while tmpnode <> NIL do begin
  84.              tmpnode := tmpnode^.ln_Succ;
  85.              i := i + 1;
  86.         end;
  87.         i := i-2;
  88.     
  89.          (* Sort list (quick & dirty bubble sort) *)
  90.          while (notfinished) do begin
  91.  
  92.           (* Reset not finished flag *)
  93.           notfinished := FALSE;
  94.  
  95.           (* Get first node *)
  96.           first := currentlist^.lh_Head;
  97.           if first <> NIL then begin
  98.             n := 0;
  99.            (* One bubble sort round *)
  100.            second := first^.ln_Succ;
  101.            while n <> i do begin
  102.  
  103.                 (* Compare *)
  104.                 n := n + 1;
  105.                 if (stricmp(first^.ln_Name,second^.ln_Name)>0) then begin
  106.                      (* Swap *)
  107.                      Remove(first);
  108.                      Insert_(CurrentList,first,second);
  109.                      notfinished := TRUE;
  110.                 end else
  111.                      (* Next *)
  112.                      first := second;
  113.                  second := first^.ln_Succ;
  114.               end;
  115.          end;
  116.     end;
  117.  (* Reset pointers *)
  118.  CurrentNode := NIL;
  119.  CurrentOrd := -1;
  120.  CurrentTop := 0;
  121.  
  122.  (* Deactivate object gadgets *)
  123.  DisableObjectGadgets(TRUE_);
  124.  
  125.  (* Attach object list *)
  126.  AttachObjectList;
  127.  tl := rtUnLockWindow(TheWindow, pointer(wl));
  128.  end;
  129. end;
  130.  
  131. { ===================================================================== }
  132.  
  133. Function CalcDown(across : integer) : Longint;
  134. VAR
  135.     tmpnode : pNode;
  136.     o : integer;
  137.     down : integer;
  138.     tags : array[0..1] of tTagItem;
  139. begin
  140.     DetachObjectList;
  141.     tmpnode := currentlist^.lh_Head;
  142.     o := -1;
  143.     while tmpnode <> NIL do begin
  144.         tmpnode := tmpnode^.ln_Succ;
  145.         o := o + 1;
  146.     end;
  147.     down := o div across;
  148.     while (down * across) < o do begin
  149.         down := down + 1;
  150.     end;
  151.     tags[0].ti_Tag  := GTNM_Number;
  152.     tags[0].ti_Data := down;
  153.     tags[1].ti_Tag  := TAG_DONE;
  154.     GT_SetGadgetAttrsA(gads[G_ND_DOWN], TheWindow, NIL, @tags);
  155.     AttachObjectList;
  156.     calcdown := down; 
  157. end;
  158. (* ===================================================================== *)