{$if not def AP_ALLGEMEIN_H} CONST AP_ALLGEMEIN_H = 0; { -- Zeigt eine UserMeldung per EasyRequester -- -- an. -- } PROCEDURE UMeld(txt:String200); VAR es : EasyStruct; l : LONG; BEGIN es := EasyStruct(SizeOF(EasyStruct),0,"AddiPro",^txt,"OK"); l := EasyRequestArgs(NIL,^es,NIL,NIL); END; FUNCTION MeldReq(tit,txt,gad:String200) : LONG; VAR es : EasyStruct; BEGIN es := EasyStruct(SizeOf(EasyStruct),0,^tit,^txt,^gad); MeldReq := EasyRequestArgs(NIL,^es,NIL,NIL); END; FUNCTION FileReqpattern(tit:STRING; VAR Filename,Dirname:String200;pattern:String200) : BOOLEAN; {erzeugt einen Filerequester mit der Möglichkeit des Musters } VAR Req : p_Filerequester; t : ARRAY[0..9] OF TagItem; bool: BOOLEAN; Dir1: String200; BEGIN t[0].ti_Tag := ASL_Hail; t[0].ti_Data := tit; t[1].ti_Tag := ASL_File; t[1].ti_Data := ^Filename; t[2].ti_Tag := ASL_Dir; t[2].ti_Data := ^Dirname; t[3] := TagItem(ASL_Width,aslf_width); t[4] := TagItem(ASL_Height,aslf_height); t[5] := TagItem(ASL_TopEdge,aslf_topedge); t[6] := TagItem(ASL_Leftedge,aslf_Leftedge); t[7].ti_Tag:=ASLFR_InitialPattern; t[7].ti_data:=^pattern; t[8] := TagItem(ASLFR_DOPATTERNS,ord(TRUE)); t[9].ti_Tag := TAG_DONE; Req := AllocAslRequest(ASL_Filerequest, ^t); IF Req <> NIL THEN BEGIN IF AslRequest(Req,^t) THEN BEGIN FileReqpattern := TRUE; Filename:=req^.rf_File; Dirname:=req^.rf_Dir; IF (dirname<>'') AND (Dirname[length(dirname)]<>':') AND (Dirname[length(dirname)]<>'/') THEN Dirname:=Dirname+'/'; END ELSE FileReqpattern := FALSE; aslf_width:=req^.rf_width; aslf_height:=req^.rf_height; aslf_topedge:=req^.rf_topedge; aslf_LeftEdge:=req^.rf_leftedge; FreeAslRequest(Req); END ELSE BEGIN DisplayBeep(NIL); UMeld("ASLRequest-Struktur konnte nicht"+CHR(10)+"angelegt werden !!"); END; END; { -- Universalprozedur für das Abfragen von IDCMP-Messages. Sollten später auch -- -- Menüfunktionen hinzukommen, so muß diese Prozedur noch erweitert werden ... -- } PROCEDURE GetMessage(VAR wo:p_Window; VAR class,code,qual:LONG; VAR GadNum:CARDINAL); VAR msg : p_IntuiMessage; BEGIN msg := p_IntuiMessage(WaitPort(wo^.UserPort)); msg := GT_GetIMsg(wo^.UserPort); class := msg^.Class; code := msg^.Code; qual := msg^.Qualifier; IF class IN [IDCMP_GADGETUP,IDCMP_GADGETDOWN] THEN BEGIN KlickG := msg^.IAddress; GadNum := KlickG^.GadgetID; END; GT_ReplyIMsg(msg); END; { -- IDCMP-Blocker -- } PROCEDURE SetBusyWindow(VAR wp:p_Window; VAR req:Requester); VAR dum : BOOLEAN; BEGIN InitRequester(^req); dum := Request(^req,wp); IF dum THEN BEGIN IF OS39 THEN BEGIN t[1] := TagItem(WA_BusyPointer, 1); t[2].ti_Tag := TAG_DONE; SetWindowPointerA(wp,^t); END ELSE SetPointer(wp,WaitPointer,16,16,-8,0); END; END; { -- IDCMP-Blocker aufheben -- } PROCEDURE UnBusyWindow(VAR wp:p_Window; VAR req:Requester); BEGIN EndRequest(^req,wp); ClearPointer(wp); END; { -- Sicheres Schliessen eines Fensters -- } PROCEDURE Fenster_Zu(VAR wp:p_Window); VAR msg,nextmsg : p_IntuiMessage; l : BOOLEAN; BEGIN { Forbid; msg:=p_IntuiMessage(wp^.UserPort^.mp_MsgList.lh_head); WHILE msg <> NIL DO BEGIN IF msg^.IDCMPWindow = wp THEN BEGIN nextmsg := p_IntuiMessage(msg^.ExecMessage.mn_Node.ln_succ); Remove(p_Node(msg)); ReplyMsg(p_Message(msg)); msg := nextmsg; END ELSE msg := p_IntuiMessage(msg^.ExecMessage.mn_Node.ln_succ); END; wp^.UserPort := NIL; l := ModifyIDCMP(wp,0); Permit;} CloseWindow(wp); END; { -- Selektiert ein Button-Gadget oder deselektiert es. -- } { -- Macht also Tastendruck "sichtbar". -- } PROCEDURE ButSelecter(VAR wp:p_Window; VAR gad:p_Gadget); VAR n : p_Gadget; old : LONG; dummy : BOOLEAN; BEGIN old := wp^.IDCMPFlags; dummy:=ModifyIDCMP(wp,IDCMP_RAWKEY); n := gad^.NextGadget; gad^.NextGadget := NIL; gad^.Flags := gad^.Flags + SELECTED; RefreshGadgets(gad,wp,NIL); REPEAT GetMessage(wp,class,code,qual,GadNum); UNTIL (class = IDCMP_RAWKEY) AND ( (code AND IECODE_UP_PREFIX)=IECODE_UP_PREFIX); dummy:=ModifyIDCMP(wp,old); gad^.Flags := gad^.Flags - SELECTED; RefreshGadgets(gad,wp,NIL); gad^.NextGadget := n; END; PROCEDURE checkit(wo:p_window,welches:p_gadget); { zum toggeln eines Checkbox_kind-Gadgtoolsgadget} BEGIN t[1] := TagItem(GT_UNDERSCORE,LONG('_')); t[2] := TagItem(GTCB_SCALED,1); t[3] := TagItem(GTCB_CHECKED,1); t[4].ti_Tag := TAG_DONE; IF (welches^.flags AND SELECTED) = SELECTED THEN t[3].ti_data:=0; GT_SetGadgetAttrsA(welches,wo,NIL,^t); END; PROCEDURE changecycler (wind:p_window;gad:p_gadget;labels:PTR;max:INTEGER;VAR akt:INTEGER); { ändert den Zustand von Cyclegadgets. In max muß die Anzahl der Möglichkeiten angegeben werden in akt der aktuelle Zustand (nur bei 0) AND (height>0) THEN BEGIN IF ( (ComputeX(width)+xoff+WBR)>psw) THEN GOTO UseTopaz; IF ( (ComputeY(height)+yoff+WBB)>psh) THEN GOTO UseTopaz; END; EXIT; UseTopaz: MyTattr^.ta_Name := "topaz.font"; FontX := 8; FontY := 8; MyTattr^.ta_Flags := FPF_ROMFONT; MyTattr^.ta_YSize := 8; END; PROCEDURE SetAfPt(w:p_RastPort;p:Ptr;n:Integer); BEGIN w^.AreaPtrn:=p; w^.AreaPtSz:=n; END; FUNCTION OpenProzentWin(titel:STRING) : BOOLEAN; { Öffnet Prozentanzeige-Fenster } BEGIN OpenProzentWin := TRUE; ComputeFont(300,20); ww := ComputeX(300); wh := ComputeY(20); t[1].ti_Tag := WA_Title; t[1].ti_Data := ^titel; t[2] := TagItem(WA_Flags, WFLG_DRAGBAR+ WFLG_SMART_REFRESH+ WFLG_NOCAREREFRESH+ WFLG_DEPTHGADGET+ WFLG_ACTIVATE+ WFLG_RMBTRAP); t[3] := TagItem(WA_InnerWidth, ww); t[4] := TagItem(WA_InnerHeight, wh); t[5].ti_Tag := TAG_DONE; IF pubname <> "" THEN BEGIN t[5] := TagItem(WA_PubScreenFallBack, 1); t[6] := TagItem(WA_PubScreenName, LONG(pubname)); t[7].ti_Tag := TAG_DONE; END; prozentwin := OpenWindowTagList(NIL, ^t); IF prozentwin = NIL THEN OpenProzentWin := FALSE ELSE BEGIN t[1] := TagItem(GT_VisualInfo, LONG(vi)); t[2] := TagItem(GTBB_Recessed, 1); t[3].ti_Tag := TAG_DONE; DrawBevelBoxA(prozentwin^.RPort,xoff+ComputeX(2), yoff+ComputeY(2),ComputeX(296), ComputeY(16),^t); END; END; PROCEDURE ShowProzent(VAR max,akt : LONG); { Zeigt einen Prozentbalken an } VAR pix,proz : LONG; pattern : ARRAY[0..1] OF WORD; BEGIN pattern[0] := $AAAA; pattern[1] := $5555; SetAfPt(prozentwin^.rport,^pattern,1); proz := Round( (akt * 100) / max); pix := Round( (292 * proz) / 100); IF prozentwin <> NIL THEN BEGIN SetDrMd(prozentwin^.rport,JAM1); SetAPen(prozentwin^.RPort, 2); SetBPen(prozentwin^.RPort, 0); RectFill(prozentwin^.RPort, xoff+ComputeX(4), yoff+ComputeY(3), xoff+ComputeX(pix+3), yoff+ComputeY(17)); {Yep, jetzt auch XHelvetika 11 - kompatibel} SetAfPt(prozentwin^.rport,NIL,0); {Pattern zurücksetzen nicht vergessen !} END; END; {$endif}