home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d9xx / d996 / startup-menu.lha / Startup-Menu / Source / SM / Window.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-05  |  7KB  |  212 lines
  1. (* ===================================================================== *) 
  2.  
  3. Procedure RefreshWin;
  4. begin
  5.     GT_BeginRefresh(TheWindow);
  6.     GT_EndRefresh(TheWindow, True);
  7. end;
  8.  
  9. (* ===================================================================== *)
  10.  
  11. Procedure ErrExit(Errortxt : string; ExitCode : integer);
  12.  
  13. VAR OK : Boolean;
  14.  
  15. Begin
  16.     ErrorExit('** Startup-Menu Error **'#0, Errortxt);
  17.     CloseLibrary(pLibrary(IntuitionBase));
  18.     If GadToolsBase <> NIL then CloseLibrary(pLibrary(GadtoolsBase));
  19.     If GfxBase <> NIL then CloseLibrary(pLibrary(GfxBase));
  20.     If DiskFontBase <> NIL then CloseLibrary(pLibrary(DiskFontBase));
  21.     If TheWindow <> NIL then CloseWindow(TheWindow);
  22.     If TheScreen <> NIL then OK := CloseScreen(TheScreen);
  23.     If vi <> NIL then FreeVisualInfo(vi);
  24.     FreeRemember(@RememberKey, True);
  25.     Halt(exitcode);
  26. end;
  27.  
  28. (* ===================================================================== *)
  29.  
  30. Procedure open_window;
  31.  
  32. Var 
  33.     DTags   : Array[0..17] Of tTagItem;
  34.     tags    : Array[0..3] of tTagItem;
  35.     node    : pMyNode;
  36.     SampTxt : tIntuiText;
  37.     n,i     : integer;
  38.     err     : long;
  39.    
  40. Begin
  41.     WindowIDCMP := IDCMP_REFRESHWINDOW | BUTTONIDCMP | 
  42.                         IDCMP_MOUSEBUTTONS | IDCMP_VANILLAKEY;
  43.    pgad  := NIL;
  44.  
  45.     (* Make sure w've got an openable TextAttr *)
  46.     GetMem(MyTextFont, sizeof(tTextFont));
  47.     MyTextFont := OpenDiskFont(@CD.cd_Font);
  48.     If MyTextFont = NIL then begin  { default to topaz 8 if unsuccesful }
  49.         With CD.cd_Font do begin
  50.             ta_Name := CStrConstPtr('topaz.font');
  51.             ta_YSize := 8;
  52.             ta_Style := 0;
  53.             ta_Flags := FPF_ROMFONT;
  54.         end;
  55.         MyTextFont^.tf_XSize := 6;
  56.     end;
  57.     
  58.     DTags[0].ti_Tag  := SA_Type;
  59.    DTags[0].ti_Data := CUSTOMSCREEN;
  60.    DTags[1].ti_Tag  := SA_Title;
  61.    DTags[1].ti_Data := LONG(@CD.cd_ScrTit[1]);
  62.    DTags[2].ti_Tag  := SA_OverScan;
  63.    DTags[2].ti_Data := OSCAN_TEXT;
  64.    DTags[3].ti_Tag  := SA_Depth;
  65.    DTags[3].ti_Data := 2;
  66.    DTags[4].ti_Tag  := SA_Font;
  67.    DTags[4].ti_Data := LONG(@CD.cd_Font);
  68.    DTags[5].ti_Tag  := SA_DisplayID;
  69.    DTags[5].ti_Data := CD.cd_ModeID; 
  70.    DTags[6].ti_Tag  := SA_Width;
  71.    DTags[6].ti_Data := STDSCREENWIDTH;
  72.    DTags[7].ti_Tag  := SA_Height;
  73.    DTags[7].ti_Data := STDSCREENHEIGHT;
  74.    DTags[8].ti_Tag  := SA_Pens;
  75.    DTags[8].ti_Data := LONG(@MyPens);
  76.    DTags[9].ti_Tag  := SA_ErrorCode;
  77.    DTags[9].ti_Data := LONG(@Err);
  78.    DTags[10].ti_Tag  := TAG_END;
  79.    
  80.    TheScreen := OpenScreenTagList(NIL, @DTags);
  81.    IF TheScreen = NIL then begin
  82.        Case Err of
  83.         OSERR_NOMONITOR : ErrExit('Can''t open screen, monitor required not available (Monitor not installed?)'#0, 10);
  84.         OSERR_NOCHIPS : ErrExit('Can''t open screen, Newer custom chips required'#0, 10);
  85.         OSERR_UNKNOWNMODE : ErrExit('Can''t open screen, Unknown ModeID (Monitor no installed?)'#0, 10);
  86.         ELSE ErrExit('Can''t open screen'#0, 10);
  87.        end;
  88.    end;
  89.    LoadRGB4(@TheScreen^.ViewPort, @CD.cd_Pal[0], 4);
  90.  
  91. (* Get visual info and create context *)
  92.        vi := GetVisualInfoA(TheScreen, NIL);
  93.    If vi = NIL Then
  94.       ErrExit('Failed to get visual info'#0, 10);
  95.       
  96.    pGad := CreateContext(@glist);
  97.    if pgad = NIL then
  98.        ErrExit('Failed to create Context'#0, 10);
  99.    
  100. (* Get some data from the screen *)
  101.  
  102.     node := pMyNode(CurrentList^.lh_Head);
  103.     tmpstr := node^.LSK_Name;
  104.     While pMyNode(node^.LSK_Node.ln_Succ) <> NIL do begin
  105.         If length(tmpstr) < length(node^.LSK_Name) then
  106.             tmpstr := node^.LSK_Name;
  107.         node := pMyNode(node^.LSK_Node.ln_Succ);
  108.     end;
  109.  
  110.     SampTxt.ITextFont := @CD.cd_Font;
  111.     SampTxt.IText := @TmpStr[1];
  112.     Sizes[GAD_W] := IntuiTextLength(@SampTxt) + 30 ;
  113.     
  114.     FreeMem(MyTextFont, sizeof(tTextFont));
  115.     
  116.    Sizes[TBS]   := TheScreen^.WBorTop + (TheScreen^.Font^.ta_YSize + 1);
  117.    Sizes[Gad_H] := sizes[TBS];
  118.    sizes[S_WB_T]    := TheScreen^.WBorTop;
  119.    sizes[S_WB_L]    := TheScreen^.WBorLeft;
  120.    sizes[S_WB_R]    := TheScreen^.WBorRight;
  121.    sizes[S_WB_B]    := TheScreen^.WBorBottom;
  122.    
  123.    Tags[0].ti_Tag  := GTTX_Text;
  124.    Tags[0].ti_Data := LONG(NIL);
  125.    Tags[1].ti_Tag  := GTTX_Border;
  126.    Tags[1].ti_Data := True_;
  127.    Tags[2].ti_Tag  := GTTX_CopyText;
  128.    Tags[2].ti_Data := True_;
  129.    Tags[3].ti_Tag  := TAG_END;
  130.    
  131.    With GadgetFlags Do Begin
  132.       ng_TextAttr   := @CD.cd_Font;
  133.       ng_LeftEdge   := sizes[S_WB_L]+2;
  134.       ng_Width      := Sizes[GAD_W];
  135.       ng_Height     := Sizes[GAD_H];
  136.       ng_VisualInfo := vi;
  137.    End;
  138.    
  139.    node := pMyNode(CurrentList^.lh_Head);
  140.    For n := 1 to CD.cd_Down do begin  { traverse down list creating gadgets } 
  141.        GadgetFlags.ng_TopEdge    := Sizes[TBS] + 1 + (n-1)*(Sizes[GAD_H]+1);
  142.        For i := 1 to CD.cd_Across do begin
  143.            With GadgetFlags Do Begin
  144.               ng_LeftEdge   := sizes[S_WB_L] + (i-1)*(ng_Width+4);
  145.               If pMyNode(node^.LSK_Node.ln_Succ) <> NIL then begin
  146.                   IF node^.LSK_Cmd = 'None'#0 then begin
  147.                       Tags[0].ti_Data := LONG(@node^.LSK_Name[1]);
  148.                       ng_GadgetText := NIL;
  149.                         pGad := CreateGadgetA(TEXT_KIND, pGad, @Gadgetflags, @Tags);
  150.                     end else begin
  151.                       ng_GadgetText := CstrConstPtr(node^.LSK_Name);
  152.                       ng_UserData   := CStrConstPtr(node^.LSK_Cmd);
  153.                       pGad := CreateGadgetA(BUTTON_KIND, pGad, @Gadgetflags, NIL);
  154.                   end;
  155.               end else begin  (* We dont want to traverse out of the list *)
  156.                   Tags[0].ti_Data := LONG(NIL);
  157.                   ng_GadgetText := NIL;
  158.                     pGad := CreateGadgetA(TEXT_KIND, pGad, @Gadgetflags, @tags);
  159.               End;
  160.            End;
  161.            pGad := CreateGadgetA(BUTTON_KIND, pGad, @Gadgetflags, NIL);
  162.            If pMyNode(node^.LSK_Node.ln_Succ) <> NIL then
  163.                node := pMyNode(node^.LSK_Node.ln_Succ);
  164.        end;
  165.    end;
  166.     
  167.    If pGad = NIL Then
  168.       ErrExit('Failed to create gadgets'#0, 10);
  169.       
  170. (* window structure *)
  171.     
  172.    DTags[0].ti_Tag  := WA_Width;
  173.    DTags[0].ti_Data := GadgetFlags.ng_LeftEdge+GadgetFlags.ng_Width+4;
  174.    DTags[1].ti_Tag  := WA_Height;
  175.    DTags[1].ti_Data := GadgetFlags.ng_TopEdge+GadgetFlags.ng_Height+3;
  176.    DTags[2].ti_Tag  := WA_Left;
  177.    DTags[2].ti_Data := (TheScreen^.Width div 2) - (DTags[0].ti_Data div 2);
  178.    DTags[3].ti_Tag  := WA_Top;
  179.    DTags[3].ti_Data := (TheScreen^.Height div 2) - (DTags[1].ti_Data div 2);
  180.    DTags[4].ti_Tag  := WA_Title;
  181.    DTags[4].ti_Data := LONG(@CD.cd_WinTit[1]); 
  182.    DTags[5].ti_Tag  := WA_IDCMP;
  183.    DTags[5].ti_Data := WindowIDCMP;
  184.    DTags[6].ti_Tag  := WA_CloseGadget;
  185.    DTags[6].ti_Data := False_;
  186.    DTags[7].ti_Tag  := WA_DragBar;
  187.    DTags[7].ti_Data := True_;
  188.    DTags[8].ti_Tag  := WA_DepthGadget;
  189.    DTags[8].ti_Data := False_;
  190.    DTags[9].ti_Tag  := WA_AutoAdjust;
  191.    DTags[9].ti_Data := True_;
  192.    DTags[10].ti_Tag := WA_Activate;
  193.    DTags[10].ti_Data:= True_;
  194.    DTags[11].ti_Tag := WA_Gadgets;
  195.    DTags[11].ti_Data:= LONG(glist);
  196.    DTags[12].ti_Tag := WA_SimpleRefresh;
  197.    DTags[12].ti_Data:= True_;
  198.    DTags[13].ti_Tag := WA_RMBTrap;
  199.    DTags[13].ti_Data:= True_;
  200.    DTags[14].ti_Tag := WA_CustomScreen;
  201.    DTags[14].ti_Data:= LONG(TheScreen);
  202.    DTags[15].ti_Tag := TAG_DONE;
  203.   
  204.    TheWindow := OpenWindowTaglist(NIL,@DTags);
  205.    If TheWindow = NIL Then 
  206.        ErrExit('Failed to create window'#0, 206);
  207.  
  208.     GT_RefreshWindow(TheWindow, NIL);
  209. End;
  210.  
  211.  
  212.