{ Programm: Menu ~~~~~~~~~ Sprache: MaxonPASCAL 3 / KickPascal 2.12 & OS 2.0-Includes ~~~~~~~~ ©: FREEWARE, wenn Autor in Infofenster des jeweiligen Programmes ~~ erwähnt und selbiges ihm zugesendet wird. Vertrieb nur auf PURITY zulässig. Sinn: Gadtoolsmenu umgesetzt (siehe Kommentar) ~~~~~ Stringgadget mit "StringA_exitHelp"-Tag .exe von Shell starten oder aus Editor. Autor: PackMAN ~~~~~~ c/o Falk Zühlsdorff Lindenberg 66 D-98693 Ilmenau/Thüringen Kommentar: Version für MAXON ~~~~~~~~~~ ab OS 2.0 } Program menutest; USES INTUITION,GRAPHICS,GADTOOLS; {$INCL 'intuition/intuition_functions.h'} {{from MP3}} TYPE MenuType = array[0..15] OF NewMenu; VAR PScr : p_screen; drawinfo : p_drawinfo; txattr : TextAttr;STATIC; font : p_textfont; ysize,ScrTextFont, Winbreite : word;STATIC; baseline : word;STATIC; Wbr : integer;STATIC; ourfont : long;STATIC; ex,help : boolean;STATIC; Win : ^Window; {fs. Win} RP : ^RastPort; msg : ^IntuiMessage; akt : ^Gadget; NWTags : array[1..13] OF tagitem;STATIC; titel : string;STATIC; pgad,glist : p_Gadget; vi : PTR; fontname : string;STATIC; {**************} ng : NewGadget;STATIC; g : p_Gadget;STATIC; STx : string;STATIC; {STR-Gad} STags : array[0..4] OF TagItem;STATIC; StrAkt : boolean;STATIC; sig : ^stringinfo; {++++++++++++++} MTags : array[0..1] of TagItem;STATIC; {Menu} menue : MenuType;STATIC; menustrip : p_menu; formenu,Done : boolean;STATIC; menuNumber, menuenum,itemnumb, subnumb : word; item : p_MenuItem; {-------------------------------------------------------------------------} BEGIN PScr:=NIL; PScr:=lockpubscreen(NIL); IF PScr<>NIL THEN BEGIN drawinfo:=getscreendrawinfo(PScr); IF drawinfo<>NIL THEN BEGIN font:=drawinfo^.dri_font; ysize:=font^.tf_ysize; ScrTextFont:=ysize; baseline:=font^.tf_baseline; Wbr:=textlength(^PScr^.rastport,'W',1); Winbreite:=textlength(^PScr^.rastport,'W',1)*50; vi:=GetVisualinfoA(PScr,nil); freescreendrawinfo(PScr,drawinfo); UnlockPubScreen(NIL,PScr); Pgad:=NIL; Pgad:=CreateContext(^Glist); IF pgad<>nil THEN BEGIN fontname:=drawinfo^.dri_font^.tf_Message.mn_Node.ln_Name; txattr:=TextAttr(fontname,ysize,0,0); END; STx:=''; STags[0]:=TagItem(GT_Underscore,ord('_')); STags[1]:=TagItem(GTST_MaxChars,20); STags[2]:=TagItem(STRINGA_ExitHelp,ord(true)); STags[3]:=TagItem(GTST_String,long(^STx)); STags[4].ti_tag:=Tag_Done; ng:=NewGadget(13*Wbr,ScrTextFont+ysize,23*Wbr,ysize+6,'An_wahl:', ^txattr,0,PLACETEXT_LEFT,vi,nil); pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^STags[0]); g:=pgad; {*** Menu: entries using from RKRM_Libs***} MTags[0]:=TagItem(GTMN_textAttr,long(^txattr)); MTags[1].ti_tag:=Tag_END; Menue:=MenuType( NewMenu(NM_TITLE,0,'Project', NIL,0,0,NIL), NewMenu(NM_ITEM, 0,'Open...', 'O', 0,0,NIL), NewMenu(NM_ITEM, 0,'Save', 'S', 0,0,NIL), NewMenu(NM_ITEM, 0,STR(NM_BARLABEL),NIL,0,0,NIL), NewMenu(NM_ITEM, 0,'Print', NIL,0,0,NIL), NewMenu(NM_SUB, 0,'Draft', NIL,0,0,NIL), NewMenu(NM_SUB, 0,'NLQ', NIL,0,0,NIL), NewMenu(NM_ITEM, 0,STR(NM_BARLABEL),NIL,0,0,NIL), NewMenu(NM_ITEM, 0,'Quit...', 'Q', 0,0,NIL), NewMenu(NM_TITLE,0,'Edit', NIL,0,0,NIL), NewMenu(NM_ITEM, 0,'Cut', 'X', 0,0,NIL), NewMenu(NM_ITEM, 0,'Copy', 'C', 0,0,NIL), NewMenu(NM_ITEM, 0,'Paste', 'V', 0,0,NIL), NewMenu(NM_ITEM, 0,STR(NM_BARLABEL),NIL,0,0,NIL), NewMenu(NM_ITEM, 0,'Undo', 'Z', 0,0,NIL), NewMenu(NM_END, 0,NIL, NIL,0,0,NIL)); {15} titel:='Menütest 0.10 by PackMAN'; NWTags[1] :=Tagitem(wa_left,0); NWTags[2] :=Tagitem(wa_top,0); NWTags[3] :=Tagitem(wa_width,Winbreite); NWTags[4] :=Tagitem(wa_height,ScrTextFont+8*ysize); NWTags[5] :=Tagitem(wa_activate,ord(true)); NWTags[6] :=Tagitem(wa_smartrefresh,ord(true)); NWTags[7] :=Tagitem(wa_title,long(^titel)); NWTags[8] :=Tagitem(wa_Flags,WFLG_CLOSEGADGET+WFLG_DRAGBAR+ WFLG_DEPTHGADGET); NWTags[9] :=Tagitem(wa_idcmp,IDCMP_GADGETUP+IDCMP_RAWKEY+ IDCMP_MENUPICK+IDCMP_CLOSEWINDOW); NWTags[10] :=Tagitem(wa_Gadgets,long(glist)); NWTags[11]:=Tagitem(tag_done,0); Win:=openwindowtaglist(nil,^NWTags[1]); IF Win<>NIL THEN BEGIN RP:=Win^.RPort; ourfont:=setfont(RP,font); menustrip:=CreateMenusA(^menue[0],^MTags[1]); formenu:=LayoutMenusA(menustrip,vi,^MTags[0]); formenu:=SetMenuStrip(win,menustrip); ex:=false; REPEAT Msg:=Wait_Port(Win^.UserPort); Msg:=GT_GetIMsg(Win^.UserPort); IF Msg<>NIL THEN BEGIN GT_ReplyIMsg(Msg); CASE Msg^.Class OF IDCMP_MENUPICK: BEGIN menuNumber:=Msg^.code; { Etwas anders als in RKRM_Libs } done:=false; { da sonst mit Gadgets Probleme } { oder sogar Programmabstürze } IF menuNumber<>MENUNULL { möglich sind, PackMAN } THEN REPEAT item:=ItemAddress(menustrip,menuNumber); menueNum:=MENUNUM(MenuNumber); itemNumb:=ITEMNUM(MenuNumber); subNumb :=SUBNUM(MenuNumber); CASE menueNum OF 0: CASE ITEMNUMB OF 0: BEGIN writeln('Open'); Done:=true;END; 1: BEGIN writeln('Save'); Done:=true;END; 3: IF subNumb=0 THEN BEGIN writeln('Draft'); Done:=true;END ELSE BEGIN writeln('NLQ'); Done:=true;END; 5: BEGIN writeln('Quit'); ex:=true; Done:=true;END; ELSE;END; 1: CASE ITEMNUMB OF 0: BEGIN writeln('Cut'); Done:=true;END; 1: BEGIN writeln('Copy'); Done:=true;END; 2: BEGIN writeln('Paste'); Done:=true;END; 4: BEGIN writeln('Undo'); Done:=true;END; ELSE;END; ELSE;END; IF NOT Done THEN menuNumber:=item^.nextselect; UNTIL Done; END; IDCMP_CLOSEWINDOW: ex:=true; IDCMP_GADGETUP: BEGIN Akt:=Msg^.IAddress; case AKT^.GADGETID of 0 : BEGIN IF Msg^.code= $5F THEN writeln('Help') ELSE writeln('RETURN');END; else;end; END; IDCMP_RAWKEY: IF Msg^.code= $11 THEN strakt:=ACTIVATEGADGET(g,Win,NIL); {W} ELSE;END; END; UNTIL ex; ClearMenuStrip(Win); FreeMenus(menustrip); CloseWindow(Win); END; FreeGadgets(glist); FreeVisualInfo(vi); closelib(gadtoolsbase); closelib(gfxbase); closelib(Intuitionbase); END; END; END.