(*------------------------------------------------------------------- :Program. kzb.mod :Author. Jürgen Schmidt :Address. Zweigstr.27, D-8045 Ismaning :Copyright. Freeware :Language. Oberon :Translator. Amiga Oberon Compiler V2.14 :History. V1.0 [J.Schmidt] 01-Sep-92 : initial release :Contents. Hilfsprogramm für Aktionäre,um den Kurs zu berechnen, :Contents. den eine Aktie haben muss,um nach Abzug der Unkosten :Contents. einen bestimmten Erlös zu bringen. :Support. Thanks for following helpful Source-Codes : :Support. GadToolsDemo.mod [fbs] on AMOK #56 :Support. Source-Codes for KwikBackup2.0 [acs] on AMOK #70 :Remark. Requires Kick 2.04 -------------------------------------------------------------------*) MODULE KZB; IMPORT ASL, d : Dos, e : Exec, fs : FileSystem, g : Graphics, gt : GadTools, I : Intuition, lrc : LongRealConversions, r : Requests, str : Strings, sys : SYSTEM, u : Utility; CONST expenseGad = 1; piecesGad = 2; aimGad = 3; calcGad = 4; printGad = 5; endGad = 6; modeGad = 7; resGad = 8; rasterGad = 9; wWidth = 400; wHeight = 164; modeTotal = 0; modePerc = 1; modeGain = 2; appWindowConst = I.NewWindow( 120,36, (* Left Edge, Top Edge *) wWidth,wHeight, (* Width,Height *) -1,-1, (* DetailPen,BlockPen *) LONGSET{I.gadgetUp,I.gadgetDown,I.vanillaKey,I.menuPick,I.closeWindow}, (* IDCMP *) LONGSET{I.activate,I.windowDrag,I.windowDepth,I.windowClose}, (* Flags *) NIL, (* FirstGadget *) NIL, (* CheckMark *) sys.ADR("Kurszielbestimmung"), (* Title *) NIL, (* Screen *) NIL, (* BitMap *) wWidth,wHeight, (* MinWidth,MinHeight *) wWidth,wHeight, (* MaxWidth,MaxHeight *) {I.wbenchScreen}); (* Type *) Topaz80Const = g.TextAttr( sys.ADR("topaz.font"), (* Name *) 8, (* YSize *) SHORTSET{}, (* Style *) SHORTSET{}); (* Flags *) TYPE GridArray = ARRAY 4 OF e.STRPTR; ModeArray = ARRAY 4 OF e.STRPTR; LRealArray = ARRAY 3 OF LONGREAL; String = ARRAY 80 OF CHAR; GrStrArray = ARRAY 3 OF String; menuType = ARRAY 8 OF gt.NewMenu; CONST gridLabels = GridArray(sys.ADR("0.01"),sys.ADR("0.1"),sys.ADR("1.0"),NIL); modeLabels = ModeArray(sys.ADR("Endbetrag"),sys.ADR("Prozentsatz"), sys.ADR("Gewinn"),NIL); gridStrings = GrStrArray("0.01","0.1","1.0"); gridVals = LRealArray(0.01,0.1,1.0); mymenu = menuType( gt.title,sys.ADR("Project") , NIL,{},LONGSET{},NIL, gt.item ,sys.ADR("Unkostendatei laden..."),sys.ADR("L"),{},LONGSET{},NIL, gt.item ,sys.ADR("Zoom") ,sys.ADR("Z"),{},LONGSET{},NIL, gt.item ,sys.VAL(e.STRPTR,gt.barLabel) , NIL,{},LONGSET{},NIL, gt.item ,sys.ADR("Information...") ,sys.ADR("I"),{},LONGSET{},NIL, gt.item ,sys.VAL(e.STRPTR,gt.barLabel) , NIL,{},LONGSET{},NIL, gt.item ,sys.ADR("Ende") ,sys.ADR("Q"),{},LONGSET{},NIL, gt.end ,NIL ,NIL ,{},LONGSET{},NIL); stdDrawer = "S:"; stdFeefile = "default.unk"; stdFeepath = "S:default.unk"; title = "Kurszielbestimmung V1.0 © 1992 Jürgen Schmidt"; UnderOn = "\e[4m"; UnderOff = "\e[24m"; NLQOn = "\e[2\"z"; NLQOff = "\e[1\"z"; VAR sc : I.ScreenPtr; vi : e.APTR; topaz80 : g.TextAttr; font : g.TextFontPtr; topborder,leftborder : INTEGER; mywin : I.WindowPtr; glist,mygad : I.GadgetPtr; gadEXPENSE,gadCALC,gadPRINT,gadMODE,gadRESULT,gadPIECES : I.GadgetPtr; gadAIM,gadRASTER : I.GadgetPtr; terminated,changed : BOOLEAN; imsg : I.IntuiMessagePtr; imsgClass : LONGSET; imsgCode,actMode : INTEGER; FeeA,FeeP,actExpense,actPieces,actAim,actGrid : LONGREAL; FinalAim,Zielkurs,Zielwert : LONGREAL; eValid,pValid,aValid,firstTime,resultValid : BOOLEAN; Buffer,feefile : String; fh : d.FileHandlePtr; gridCode : INTEGER; zoom : ARRAY 4 OF INTEGER; menu : I.MenuPtr; selectedMenu,selectedItem : INTEGER; PROCEDURE MessExit(error : ARRAY OF CHAR); BEGIN r.Assert(FALSE,error); END MessExit; PROCEDURE ScanFee; VAR FeeId : fs.File; Buffer : String; BEGIN IF ~fs.Open(FeeId,feefile,FALSE) THEN MessExit("Kann Unkostendatei nicht öffnen !"); END; IF ~fs.ReadString(FeeId,Buffer) THEN MessExit("Kann Unkostendatei nicht lesen !"); END; IF ~lrc.StringToReal(Buffer,FeeP) THEN MessExit("Falscher Wert in Unkostendatei !"); END; IF ~fs.ReadString(FeeId,Buffer) THEN MessExit("Kann Unkostendatei nicht lesen !"); END; IF ~lrc.StringToReal(Buffer,FeeA) THEN MessExit("Falscher Wert in Unkostendatei !"); END; IF ~fs.Close(FeeId) THEN MessExit("Kann Unkostendatei nicht schliessen !"); END; END ScanFee; PROCEDURE CreateAllGadgets():BOOLEAN; VAR ng : gt.NewGadget; gad : I.GadgetPtr; BEGIN gad := gt.CreateContext(glist); ng.leftEdge := leftborder+10; ng.topEdge := 8+sc.font.ySize+topborder; ng.width := 200; ng.height := 14; ng.gadgetText := sys.ADR("_Aufgewendetes Kapital:"); ng.textAttr := sys.ADR(topaz80); ng.gadgetID := expenseGad; ng.flags := LONGSET{gt.placeTextAbove}; ng.visualInfo := vi; gad := gt.CreateGadget(gt.integerKind,gad,ng, gt.inNumber,0, gt.inMaxChars,10, gt.underscore,ORD("_"), I.tabCycle,I.LTRUE, I.gaDisabled,I.LTRUE, u.done); gadEXPENSE := gad; ng.leftEdge := leftborder+200; ng.topEdge := sc.font.ySize+topborder+4; ng.gadgetText := sys.ADR("_Modus:"); ng.flags := LONGSET{gt.placeTextIn}; gad := gt.CreateGadget(gt.textKind,gad,ng, gt.txText,NIL, gt.underscore,ORD("_"), u.done); IF gad # NIL THEN INC(ng.leftEdge,48); INC(ng.topEdge,20); END; ng.flags := LONGSET{gt.placeTextRight}; ng.gadgetID := modeGad; gad := gt.CreateGadget(gt.mxKind,gad,ng, gt.mxLabels,sys.ADR(modeLabels), gt.mxActive,0, gt.mxSpacing,4, u.done); IF gad # NIL THEN INC(ng.leftEdge,20); INC(ng.topEdge,60); gadMODE := gad; END; ng.flags := LONGSET{gt.placeTextAbove}; ng.gadgetID := rasterGad; ng.gadgetText := sys.ADR("_Raster:"); ng.width := 64; gad := gt.CreateGadget(gt.cycleKind,gad,ng, gt.cyLabels,sys.ADR(gridLabels), gt.cyActive,0, gt.underscore,ORD("_"), u.done); IF gad # NIL THEN gadRASTER := gad; END; ng.width := 200; ng.leftEdge := leftborder+10; ng.topEdge := sc.font.ySize+topborder+38; ng.gadgetText := sys.ADR("_Stückzahl:"); ng.gadgetID := piecesGad; gad := gt.CreateGadget(gt.integerKind,gad,ng, gt.inNumber,0, gt.inMaxChars,10, gt.underscore,ORD("_"), I.tabCycle,I.LTRUE, u.done); IF gad # NIL THEN INC(ng.topEdge,30); gadPIECES := gad; END; ng.gadgetText := sys.ADR("_Zielwert:"); ng.gadgetID := aimGad; gad := gt.CreateGadget(gt.integerKind,gad,ng, gt.inNumber,0, gt.inMaxChars,10, gt.underscore,ORD("_"), I.tabCycle,I.LTRUE, u.done); IF gad # NIL THEN INC(ng.topEdge,30); gadAIM := gad; END; ng.gadgetText := sys.ADR("Ergebnis:"); ng.gadgetID := resGad; gad := gt.CreateGadget(gt.textKind,gad,ng, gt.txText,NIL, gt.txBorder,I.LTRUE, u.done); IF gad # NIL THEN INC(ng.topEdge,30); gadRESULT := gad; END; ng.gadgetText := sys.ADR("_Berechnen"); ng.width := 80; ng.height := 14; ng.gadgetID := calcGad; ng.flags := LONGSET{gt.placeTextIn}; gad := gt.CreateGadget(gt.buttonKind,gad,ng, gt.underscore,ORD("_"), I.gaDisabled,I.LTRUE, u.done); IF gad # NIL THEN INC(ng.leftEdge,140); gadCALC := gad; END; ng.gadgetText := sys.ADR("_Drucken"); ng.width := 64; ng.gadgetID := printGad; gad := gt.CreateGadget(gt.buttonKind,gad,ng, gt.underscore,ORD("_"), I.gaDisabled,I.LTRUE, u.done); IF gad # NIL THEN INC(ng.leftEdge,140); gadPRINT := gad; END; ng.gadgetText := sys.ADR("_Ende"); ng.width := 40; ng.gadgetID := endGad; gad := gt.CreateGadget(gt.buttonKind,gad,ng, gt.underscore,ORD("_"), u.done); RETURN (gad # NIL); END CreateAllGadgets; PROCEDURE RemoveSpaces(VAR z : ARRAY OF CHAR); VAR pos : INTEGER; BEGIN pos := str.Occurs(z," "); WHILE pos # -1 DO str.Delete(z,pos,1); pos := str.Occurs(z," "); END; END RemoveSpaces; PROCEDURE NewLines(z:SHORTINT); VAR ret : LONGINT; count : LONGINT; BEGIN count := 0; WHILE count < z DO ret := d.FPutC(fh,CHR(10)); INC(count,1); END; END NewLines; PROCEDURE Round(z:LONGREAL):LONGREAL; BEGIN RETURN ENTIER((z*100.0)+0.5)/100.0; END Round; PROCEDURE PrintResult; CONST part1 = "Bei einer Stückzahl von "; part2 = " wird ein Kurs von "; part3 = " DM benötigt,"; part4 = "um eine Summe von "; part5 = " DM zu erzielen (Raster = "; part6 = " DM)."; part7 = "Der Erlös beträgt dann "; part8 = " DM."; VAR dummy : LONGINT; BufPrint : String; BufPiece,BufAim,BufVal,BufCtrl,BufExp : ARRAY 20 OF CHAR; dum2 : BOOLEAN; BEGIN fh := NIL; BufPrint[0] := CHR(0); dum2 := lrc.RealToString(actExpense,BufExp,10,0,FALSE); RemoveSpaces(BufExp); dum2 := lrc.RealToString(Zielkurs,Buffer,9,2,FALSE); RemoveSpaces(Buffer); dum2 := lrc.RealToString(Zielwert,BufVal,9,2,FALSE); RemoveSpaces(BufVal); dum2 := lrc.RealToString(actPieces,BufPiece,9,0,FALSE); RemoveSpaces(BufPiece); dum2 := lrc.RealToString(actAim,BufAim,10,0,FALSE); RemoveSpaces(BufAim); fh := d.Open("PRT:",d.oldFile); IF fh = NIL THEN MessExit("Kann Drucker nicht ansprechen !") END; dummy := d.FPuts(fh,UnderOn); dummy := d.FPuts(fh,NLQOn); dummy := d.FPuts(fh,"Auswertung der Kurszielbestimmung"); dummy := d.FPuts(fh,UnderOff); NewLines(2); CASE actMode OF modeTotal: str.Append(BufPrint,part1); str.Append(BufPrint,BufPiece); str.Append(BufPrint,part2); str.Append(BufPrint,Buffer); str.Append(BufPrint,part3); dummy := d.FPuts(fh,BufPrint); NewLines(1); BufPrint[0] := CHR(0); str.Append(BufPrint,part4); str.Append(BufPrint,BufAim); str.Append(BufPrint,part5); str.Append(BufPrint,gridStrings[gridCode]); str.Append(BufPrint,part6); dummy := d.FPuts(fh,BufPrint); NewLines(1); BufPrint[0] := CHR(0)| modePerc: str.Append(BufPrint,"Bei einem Kapitalaufwand von "); str.Append(BufPrint,BufExp); str.Append(BufPrint," DM"); dummy := d.FPuts(fh,BufPrint); NewLines(1); BufPrint[0] := CHR(0); str.Append(BufPrint,"und einer Stückzahl von "); str.Append(BufPrint,BufPiece); dummy := d.FPuts(fh,BufPrint); NewLines(1); BufPrint[0] := CHR(0); str.Append(BufPrint,"wird ein Kurs von "); str.Append(BufPrint,Buffer); str.Append(BufPrint," DM benötigt,um"); dummy := d.FPuts(fh,BufPrint); NewLines(1); BufPrint[0] := CHR(0); IF actAim < 0 THEN dum2 := lrc.RealToString(ABS(actAim),BufAim,10,0,FALSE); RemoveSpaces(BufAim); str.Append(BufPrint,"den Verlust auf "); str.Append(BufPrint,BufAim); str.Append(BufPrint," Prozent zu begrenzen"); ELSE str.Append(BufPrint,"einen Gewinn von "); str.Append(BufPrint,BufAim); str.Append(BufPrint," Prozent zu erreichen"); END; str.Append(BufPrint," (Raster = "); str.Append(BufPrint,gridStrings[gridCode]); str.Append(BufPrint," DM)."); dummy := d.FPuts(fh,BufPrint); NewLines(1); BufPrint[0] := CHR(0)| modeGain: str.Append(BufPrint,"Bei einem Kapitalaufwand von "); str.Append(BufPrint,BufExp); str.Append(BufPrint," DM"); dummy := d.FPuts(fh,BufPrint); NewLines(1); BufPrint[0] := CHR(0); str.Append(BufPrint,"und einer Stückzahl von "); str.Append(BufPrint,BufPiece); dummy := d.FPuts(fh,BufPrint); NewLines(1); BufPrint[0] := CHR(0); str.Append(BufPrint,"wird ein Kurs von "); str.Append(BufPrint,Buffer); str.Append(BufPrint," DM benötigt,um"); dummy := d.FPuts(fh,BufPrint); NewLines(1); BufPrint[0] := CHR(0); IF actAim < 0 THEN dum2 := lrc.RealToString(ABS(actAim),BufAim,10,0,FALSE); RemoveSpaces(BufAim); str.Append(BufPrint,"den Verlust auf "); str.Append(BufPrint,BufAim); str.Append(BufPrint," DM zu begrenzen"); ELSE str.Append(BufPrint,"einen Gewinn von "); str.Append(BufPrint,BufAim); str.Append(BufPrint," DM zu erreichen"); END; str.Append(BufPrint," (Raster = "); str.Append(BufPrint,gridStrings[gridCode]); str.Append(BufPrint," DM)."); dummy := d.FPuts(fh,BufPrint); NewLines(1); BufPrint[0] := CHR(0)| ELSE END; str.Append(BufPrint,part7); str.Append(BufPrint,BufVal); str.Append(BufPrint,part8); dummy := d.FPuts(fh,BufPrint); NewLines(2); dummy := d.FPuts(fh,NLQOff); dum2 := d.Close(fh); END PrintResult; PROCEDURE CalcFinal; VAR psum : LONGREAL; BEGIN CASE actMode OF modeTotal : FinalAim := actAim| modePerc : psum := (actAim/100.0)*actExpense; FinalAim := actExpense+psum| modeGain : FinalAim := actExpense+actAim| ELSE END; END CalcFinal; PROCEDURE CalcResult; VAR ak,nk,nw,aw : LONGREAL; BEGIN nk := ENTIER(FinalAim/actPieces); REPEAT ak := nk; nk := ak+actGrid; nw := nk*actPieces; nw := nw-(nw*FeeP)-FeeA; aw := (ak*actPieces); aw := aw-(aw*FeeP)-FeeA; UNTIL (aw < FinalAim) AND (nw >= FinalAim); Zielkurs := Round(nk); Zielwert := Round(nw); END CalcResult; PROCEDURE ReadyToRun():BOOLEAN; BEGIN IF (actMode = modeTotal) THEN IF pValid AND aValid THEN RETURN TRUE; END; ELSE IF pValid AND aValid AND eValid THEN RETURN TRUE; END; END; RETURN FALSE; END ReadyToRun; PROCEDURE Adjust(VAR t : ARRAY OF CHAR); (* Assure that gridCode = 1 when calling this function *) VAR z,code : INTEGER; dummy : BOOLEAN; BEGIN z := str.Occurs(t,"."); IF t[z+2] = '9' THEN Zielkurs := Zielkurs+0.01; dummy := lrc.RealToString(Zielkurs,t,9,2,FALSE); RemoveSpaces(t); END; END Adjust; PROCEDURE HandleKeyPress(code:INTEGER):BOOLEAN; VAR terminated,dummy : BOOLEAN; oldMode : INTEGER; Buffer : String; OKey,UKey : CHAR; BEGIN terminated := FALSE; OKey := CHR(code); UKey := CAP(OKey); CASE UKey OF 'A' : IF ~(I.gadgDisabled IN gadEXPENSE.flags) THEN IF I.ActivateGadget(gadEXPENSE^,mywin,NIL) THEN END; END| 'S' : IF I.ActivateGadget(gadPIECES^,mywin,NIL) THEN END| 'Z' : IF I.ActivateGadget(gadAIM^,mywin,NIL) THEN END| 'M' : oldMode := actMode; IF OKey = 'm' THEN actMode := (actMode+1) MOD 3; ELSE actMode := actMode-1; IF actMode < 0 THEN actMode := 2 END; END; IF firstTime OR ~changed THEN IF actMode = 0 THEN gt.SetGadgetAttrs(gadEXPENSE^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); ELSE gt.SetGadgetAttrs(gadEXPENSE^,mywin,NIL,I.gaDisabled,I.LFALSE,u.done); END; gt.SetGadgetAttrs(gadMODE^,mywin,NIL,gt.mxActive,actMode,u.done); gt.SetGadgetAttrs(gadPRINT^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); gt.SetGadgetAttrs(gadRESULT^,mywin,NIL,gt.txText,NIL,u.done); changed := FALSE; ELSE IF r.Request("Achtung!","Modus ändern ? (Werte gehen verloren)","Ja","Nein") THEN eValid := FALSE; pValid := FALSE; aValid := FALSE; gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); IF actMode = 0 THEN gt.SetGadgetAttrs(gadEXPENSE^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); ELSE gt.SetGadgetAttrs(gadEXPENSE^,mywin,NIL,I.gaDisabled,I.LFALSE,u.done); END; gt.SetGadgetAttrs(gadMODE^,mywin,NIL,gt.mxActive,actMode,u.done); gt.SetGadgetAttrs(gadPRINT^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); gt.SetGadgetAttrs(gadRESULT^,mywin,NIL,gt.txText,NIL,u.done); changed := FALSE; ELSE actMode := oldMode; END; END| 'R': IF OKey = 'r' THEN gridCode := (gridCode+1) MOD 3; ELSE gridCode := gridCode-1; IF gridCode < 0 THEN gridCode := 2 END; END; actGrid := gridVals[gridCode]; gt.SetGadgetAttrs(gadRASTER^,mywin,NIL,gt.cyActive,gridCode,u.done); gt.SetGadgetAttrs(gadPRINT^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); gt.SetGadgetAttrs(gadRESULT^,mywin,NIL,gt.txText,NIL,u.done)| 'B': gt.DrawBevelBox(mywin^.rPort,leftborder+10,sc.font.ySize+topborder+128, 80,14,gt.visualInfo,vi,gt.bbRecessed,I.LTRUE,u.done); d.Delay(5); gt.DrawBevelBox(mywin^.rPort,leftborder+10,sc.font.ySize+topborder+128, 80,14,gt.visualInfo,vi,u.done); IF (actMode = modeGain) AND (actExpense+actAim <= 0) THEN dummy := r.Request("Achtung !","Verlust grösser als eingesetzter Betrag !","","Ok"); gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); END; CalcFinal; CalcResult; dummy := lrc.RealToString(Zielkurs,Buffer,9,2,FALSE); RemoveSpaces(Buffer); IF gridCode = 1 THEN Adjust(Buffer) END; gt.SetGadgetAttrs(gadRESULT^,mywin,NIL,gt.txText,sys.ADR(Buffer),u.done); resultValid := TRUE; gt.SetGadgetAttrs(gadPRINT^,mywin,NIL,I.gaDisabled,I.LFALSE,u.done)| 'D': gt.DrawBevelBox(mywin^.rPort,leftborder+150,sc.font.ySize+topborder+128, 64,14,gt.visualInfo,vi,gt.bbRecessed,I.LTRUE,u.done); d.Delay(5); gt.DrawBevelBox(mywin^.rPort,leftborder+150,sc.font.ySize+topborder+128, 64,14,gt.visualInfo,vi,u.done); PrintResult| 'E': gt.DrawBevelBox(mywin^.rPort,leftborder+290,sc.font.ySize+topborder+128, 40,14,gt.visualInfo,vi,gt.bbRecessed,I.LTRUE,u.done); d.Delay(5); gt.DrawBevelBox(mywin^.rPort,leftborder+290,sc.font.ySize+topborder+128, 40,14,gt.visualInfo,vi,u.done); IF r.Request("Achtung!","Programm wirklich beenden ?","Ja","Nein") THEN terminated := TRUE; END| ELSE END; RETURN terminated; END HandleKeyPress; PROCEDURE HandleGadgetEvent(gad:I.GadgetPtr;code:INTEGER):BOOLEAN; VAR terminated : BOOLEAN; strinfo : I.StringInfoPtr; dummy : BOOLEAN; Buffer : String; oldMode : INTEGER; BEGIN terminated := FALSE; CASE gad.gadgetID OF endGad: IF r.Request("Achtung!","Programm wirklich beenden ?","Ja","Nein") THEN terminated := TRUE; END| modeGad: oldMode := actMode; actMode := code; IF firstTime OR ~changed THEN IF actMode = 0 THEN gt.SetGadgetAttrs(gadEXPENSE^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); ELSE gt.SetGadgetAttrs(gadEXPENSE^,mywin,NIL,I.gaDisabled,I.LFALSE,u.done); END; gt.SetGadgetAttrs(gadPRINT^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); gt.SetGadgetAttrs(gadRESULT^,mywin,NIL,gt.txText,NIL,u.done); changed := FALSE; ELSE IF r.Request("Achtung!","Modus ändern ? (Werte gehen verloren)","Ja","Nein") THEN eValid := FALSE; pValid := FALSE; aValid := FALSE; gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); actMode := code; IF actMode = 0 THEN gt.SetGadgetAttrs(gadEXPENSE^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); ELSE gt.SetGadgetAttrs(gadEXPENSE^,mywin,NIL,I.gaDisabled,I.LFALSE,u.done); END; gt.SetGadgetAttrs(gadPRINT^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); gt.SetGadgetAttrs(gadRESULT^,mywin,NIL,gt.txText,NIL,u.done); changed := FALSE; ELSE actMode := oldMode; gt.SetGadgetAttrs(gadMODE^,mywin,NIL,gt.mxActive,actMode,u.done); END; END| rasterGad: gt.SetGadgetAttrs(gadPRINT^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); gt.SetGadgetAttrs(gadRESULT^,mywin,NIL,gt.txText,NIL,u.done); actGrid := gridVals[code]; gridCode := code| expenseGad: strinfo := gad.specialInfo; actExpense := strinfo.longInt; IF actExpense <=0.0 THEN dummy := r.Request("Achtung!","Unzulässiger Wert bei aufgewendetes Kapital !","","Ok"); eValid := FALSE; gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); ELSE eValid := TRUE; END; IF ReadyToRun() THEN gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LFALSE,u.done); END; changed := TRUE; resultValid := FALSE; IF firstTime THEN firstTime := FALSE; END| piecesGad: strinfo := gad.specialInfo; actPieces := strinfo.longInt; IF actPieces <= 0.0 THEN dummy := r.Request("Achtung !","Unzulässiger Wert bei Stückzahl !","","Ok"); pValid := FALSE; gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); ELSE pValid := TRUE; END; IF ReadyToRun() THEN gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LFALSE,u.done); END; resultValid := FALSE; changed := TRUE; IF firstTime THEN firstTime := FALSE; END| aimGad: strinfo := gad.specialInfo; actAim := strinfo.longInt; IF (actAim <= -100.0) AND (actMode = modePerc) THEN dummy := r.Request("Achtung !","Prozent muß grösser als -100 sein","","Ok"); aValid := FALSE; gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); ELSIF (actAim <=0.0) AND (actMode = modeTotal) THEN dummy := r.Request("Achtung !","Endbetrag muß positiv sein","","Ok"); aValid := FALSE; gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); ELSE aValid := TRUE; END; IF ReadyToRun() THEN gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LFALSE,u.done); END; resultValid := FALSE; changed := TRUE; IF firstTime THEN firstTime := FALSE; END| calcGad: IF (actMode = modeGain) AND (actExpense+actAim <= 0) THEN dummy := r.Request("Achtung !","Verlust grösser als eingesetzter Betrag !","","Ok"); gt.SetGadgetAttrs(gadCALC^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); END; CalcFinal; CalcResult; dummy := lrc.RealToString(Zielkurs,Buffer,9,2,FALSE); RemoveSpaces(Buffer); IF gridCode = 1 THEN Adjust(Buffer) END; gt.SetGadgetAttrs(gadRESULT^,mywin,NIL,gt.txText,sys.ADR(Buffer),u.done); resultValid := TRUE; gt.SetGadgetAttrs(gadPRINT^,mywin,NIL,I.gaDisabled,I.LFALSE,u.done)| printGad: PrintResult| ELSE END; IF ~resultValid THEN gt.SetGadgetAttrs(gadRESULT^,mywin,NIL,gt.txText,NIL,u.done); gt.SetGadgetAttrs(gadPRINT^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); END; RETURN terminated; END HandleGadgetEvent; PROCEDURE GetFeeFile; VAR ret : e.APTR; fr : ASL.FileRequesterPtr; dummy : BOOLEAN; flags : LONGSET; BEGIN ret := NIL; flags := LONGSET{ASL.patGad}; IF ASL.asl # NIL THEN IF I.RemoveGList(mywin,glist,-1)#0 THEN END; fr := ASL.AllocAslRequestTags(ASL.fileRequest, ASL.hail,sys.ADR("Bitte Unkostendatei wählen"), ASL.window,mywin, ASL.leftEdge,150, ASL.topEdge,35, ASL.height,180, ASL.okText,sys.ADR("Load"), ASL.file,sys.ADR(stdFeefile), ASL.dir,sys.ADR(stdDrawer), ASL.pattern,sys.ADR("(#?.unk)"), ASL.funcFlags,sys.VAL(e.ADDRESS,flags), u.done); IF fr = NIL THEN MessExit("Konnte Speicher für Filerequester nicht allozieren !") END; ret := ASL.AslRequestTags(fr,u.done); IF I.AddGList(mywin,glist,-1,-1,NIL)#0 THEN END; I.RefreshGList(glist,mywin,NIL,-1); IF ret # NIL THEN COPY(fr.dir^,feefile); dummy := d.AddPart(feefile,fr.file^,80); IF fs.Exists(feefile) THEN ScanFee; gt.SetGadgetAttrs(gadPRINT^,mywin,NIL,I.gaDisabled,I.LTRUE,u.done); gt.SetGadgetAttrs(gadRESULT^,mywin,NIL,gt.txText,NIL,u.done); ELSE IF r.Request("Achtung!","Unkostendatei existiert nicht !","","OK") THEN END; COPY(stdFeepath,feefile); END; END; ASL.FreeAslRequest(fr); ELSE IF r.Request("Achtung!","Konnte asl.library nicht öffnen !","","OK") THEN END; END; END GetFeeFile; PROCEDURE HandleMenuEvent():BOOLEAN; VAR terminated : BOOLEAN; item : I.MenuItemPtr; BEGIN terminated := FALSE; WHILE imsgCode # I.menuNull DO selectedMenu := I.MenuNum(imsgCode); selectedItem := I.ItemNum(imsgCode); IF selectedMenu = 0 THEN CASE selectedItem OF 0 : GetFeeFile| 1 : I.ZipWindow(mywin)| 3 : IF r.Request("Kurszielbestimmung V1.0","© 1992 by Jürgen Schmidt","","Ok") THEN END| 5 : IF r.Request("Achtung!","Programm wirklich beenden ?","Ja","Nein") THEN terminated := TRUE; END| ELSE END; ELSE END; item := I.ItemAddress(mywin^.menuStrip^,imsgCode); imsgCode := item^.nextSelect; END; RETURN terminated; END HandleMenuEvent; PROCEDURE InitValues; BEGIN topborder := sc.wBorTop + sc.font.ySize + 1; leftborder := sc.wBorLeft; topaz80 := Topaz80Const; terminated := FALSE; resultValid := TRUE; firstTime := TRUE; changed := FALSE; eValid := FALSE; pValid := FALSE; aValid := FALSE; actMode := 0; actGrid := 0.01; gridCode := 0; zoom[0] := 0; zoom[1] := 0; zoom[2] := wWidth+6; zoom[3] := topborder; feefile[0] := CHR(0); str.Append(feefile,stdFeepath); END InitValues; BEGIN IF(I.int.libNode.version<37) THEN MessExit("Kickstart 2.04 wird benötigt !") END; sc := I.LockPubScreen(NIL); IF sc = NIL THEN MessExit("Konnte Public Screen nicht finden !") END; InitValues; ScanFee; font := g.OpenFont(topaz80); IF font = NIL THEN MessExit("Kann Font Topaz80 nicht finden !"); END; vi := gt.GetVisualInfo(sc,u.done); IF vi = NIL THEN MessExit("GetVisualInfo() ist fehlgeschlagen !") END; menu := gt.CreateMenus(mymenu,gt.fullMenu,I.LTRUE,u.done); IF menu = NIL THEN MessExit("Konnte Menü nicht erstellen !") END; IF ~gt.LayoutMenus(menu,vi,u.done) THEN MessExit("LayoutMenus() ist fehlgeschlagen !"); END; mywin := I.OpenWindowTags(appWindowConst, I.waInnerHeight,wHeight, I.waInnerWidth,wWidth, I.waPubScreen, sc, I.waScreenTitle,sys.ADR(title), I.waZoom,sys.ADR(zoom), u.done); IF mywin = NIL THEN MessExit("Konnte Fenster nicht öffnen !") END; I.UnlockPubScreen("",sc); IF ~CreateAllGadgets() THEN MessExit("CreateAllGadgets() ist fehlgeschlagen !"); END; IF I.AddGList(mywin,glist,-1,-1,NIL)=0 THEN END; I.RefreshGList(glist,mywin,NIL,-1); gt.RefreshWindow(mywin,NIL); IF ~I.SetMenuStrip(mywin,menu^) THEN MessExit("Konnte Menü nicht installieren !"); END; WHILE ~terminated DO REPEAT UNTIL e.Wait(LONGSET{mywin.userPort.sigBit}) # LONGSET{}; terminated := FALSE; LOOP IF terminated THEN EXIT END; imsg := gt.GetIMsg(mywin.userPort); IF imsg=NIL THEN EXIT END; imsgClass := imsg.class; imsgCode := imsg.code; mygad := imsg.iAddress; gt.ReplyIMsg(imsg); IF I.gadgetUp IN imsgClass THEN terminated := HandleGadgetEvent(mygad,imsgCode); END; IF I.gadgetDown IN imsgClass THEN terminated := HandleGadgetEvent(mygad,imsgCode); END; IF I.vanillaKey IN imsgClass THEN terminated := HandleKeyPress(imsgCode); END; IF I.menuPick IN imsgClass THEN terminated := HandleMenuEvent(); END; IF I.closeWindow IN imsgClass THEN IF r.Request("Achtung!","Programm wirklich beenden ?","Ja","Nein") THEN terminated := TRUE; END; END; END; END; CLOSE IF mywin # NIL THEN I.ClearMenuStrip(mywin); I.CloseWindow(mywin); END; gt.FreeMenus(menu); gt.FreeGadgets(glist); gt.FreeVisualInfo(vi); END KZB.