home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 1: Amiga
/
FrozenFish-Apr94.iso
/
bbs
/
mar94
/
util
/
misc
/
kalender.lha
/
Kalender
/
txt
/
window2.mod
< prev
next >
Wrap
Text File
|
1993-12-18
|
7KB
|
248 lines
IMPLEMENTATION MODULE Window2;
(*$ StackChk := FALSE *)
(*$ RangeChk := FALSE *)
(*$ OverflowChk := FALSE *)
(*$ NilChk := FALSE *)
(*$ CaseChk := FALSE *)
(*$ ReturnChk := FALSE *)
(*$ LargeVars := FALSE *)
(*$ EntryClear := TRUE *)
(*$ Volatile := TRUE *)
(*$ StackParms := TRUE *)
(*$ CStrings := TRUE *)
FROM Arts IMPORT Assert;
FROM SYSTEM IMPORT TAG,ADR,ADDRESS,LONGSET;
FROM String IMPORT Concat,Copy;
FROM ExecL IMPORT GetMsg,ReplyMsg;
FROM GraphicsD IMPORT Rectangle,invalidID,
TextAttr,TextAttrPtr,
FontStyleSet,FontStyles,
FontFlagSet,FontFlags,
DrawModeSet,DrawModes,
GfxBasePtr,GfxBase;
FROM GraphicsL IMPORT GetVPModeID,
RectFill,
SetAPen,SetDrMd,
graphicsBase;
FROM IntuitionD IMPORT Window,WindowPtr,
WaTags,
IDCMPFlagSet,IDCMPFlags,
IntuiMessage,IntuiMessagePtr,
IntuiText,IntuiTextPtr,
Screen,ScreenPtr,
oScanText;
FROM IntuitionL IMPORT intuitionVersion,
OpenWindowTagList,CloseWindow,
LockPubScreen,UnlockPubScreen,
QueryOverscan,
ZipWindow,ChangeWindowBox,
ModifyIDCMP,
PrintIText,IntuiTextLength,
BeginRefresh,EndRefresh;
FROM UtilityD IMPORT tagDone;
FROM Datum IMPORT wtstring,GetDate,FormatDate,datestr;
TYPE
tstring = ARRAY [1..80] OF CHAR;
wtxttyp = RECORD
txt : tstring;
col : SHORTCARD;
rev : BOOLEAN;
END;
VAR
window : WindowPtr;
left,top,width,height : INTEGER;
pos : INTEGER;
woche,wt,tag,monat : SHORTCARD;
jahr : CARDINAL;
ActionMem : action2mem;
wtstr : wtstring;
datumstr : datestr;
ypos : SHORTCARD;
wtxt : ARRAY [0..35] OF wtxttyp;
wpos : SHORTCARD;
scrFontYSize,scrFontXSize : CARDINAL;
winFontYSize,winFontXSize : CARDINAL;
font := TextAttr{name:ADR("topaz.font"),ySize:8,style:FontStyleSet{},flags:FontFlagSet{romFont}};
txt := IntuiText{frontPen:1,backPen:0,drawMode:DrawModeSet{dm0},leftEdge:5,topEdge:12,iTextFont:NIL(*ADR(font)*),iText:NIL};
titletxt := IntuiText{frontPen:1,backPen:0,drawMode:DrawModeSet{dm0},leftEdge:0,topEdge:0,iTextFont:NIL,iText:NIL};
titlewidth : LONGINT;
PROCEDURE OpenWin2(zeilen,spalten : SHORTCARD; wintitle : ADDRESS) : SHORTCARD;
VAR screen : ScreenPtr;
scrrec : Rectangle;
scrmodeid : LONGCARD;
tagbuffer : ARRAY [1..16*2] OF LONGCARD;
zoombuffer : RECORD
LeftEdge : INTEGER;
TopEdge : INTEGER;
Width : INTEGER;
Height : INTEGER;
END;
BEGIN
screen := LockPubScreen(NIL);
IF screen # NIL THEN
scrmodeid := GetVPModeID(ADR(screen^.viewPort));
IF scrmodeid # invalidID THEN
IF QueryOverscan(scrmodeid,ADR(scrrec),oScanText) THEN
scrFontYSize := screen^.font^.ySize;
scrFontXSize := screen^.rastPort.font^.xSize;
winFontYSize := graphicsBase^.defaultFont^.ySize;
winFontXSize := graphicsBase^.defaultFont^.xSize;
width := INTEGER(spalten)*INTEGER(winFontXSize)+9;
height := INTEGER(zeilen)*INTEGER(winFontYSize)+INTEGER(scrFontYSize)+6;
IF height > scrrec.maxY - scrrec.minY +1 THEN
height := scrrec.maxY - scrrec.minY +1;
END;
titletxt.iTextFont := screen^.font;
titletxt.iText := wintitle;
titlewidth := IntuiTextLength(ADR(titletxt));
IF titlewidth + 90 > width THEN
width := INTEGER(titlewidth)+90;
END;
IF width > scrrec.maxX - scrrec.minX +1 THEN
width := scrrec.maxX - scrrec.minX +1;
END;
IF screen^.topEdge >= 0 THEN
top := 0;
ELSE
top := -screen^.topEdge;
END;
IF screen^.leftEdge >= 0 THEN
left := 0;
ELSE
left := -screen^.leftEdge +1;
END;
zoombuffer.Width := width;
zoombuffer.Height := scrFontYSize+3;
zoombuffer.LeftEdge := left;
zoombuffer.TopEdge := top;
window := OpenWindowTagList(NIL,TAG(tagbuffer,
waLeft, left,
waTop, top,
waWidth, width,
waHeight, height,
waTitle, wintitle,
waScreenTitle, ADR("Kalender V2.1 (C) 1991-1993 by Kai Hofmann"),
waPubScreen, screen,
waDragBar, TRUE,
waDepthGadget, TRUE,
waCloseGadget, TRUE,
waZoom, ADR(zoombuffer),
waActivate, TRUE,
waIDCMP, IDCMPFlagSet{closeWindow,gadgetDown,gadgetUp,refreshWindow},
waSmartRefresh, TRUE,
tagDone));
UnlockPubScreen(NIL,screen);
IF window # NIL THEN
;
txt.leftEdge := window^.borderLeft+1;
txt.topEdge := window^.borderTop+1;
RETURN(window^.userPort^.sigBit);
END;
END;
END;
END;
RETURN(0);
END OpenWin2;
PROCEDURE CloseWin2;
VAR intuimsg : IntuiMessagePtr;
BEGIN
LOOP
intuimsg := GetMsg(window^.userPort);
IF intuimsg = NIL THEN
EXIT;
END;
ReplyMsg(intuimsg);
END;
CloseWindow(window);
END CloseWin2;
PROCEDURE OutputWin2(text : ARRAY OF CHAR; col : SHORTCARD; rev : BOOLEAN);
BEGIN
IF rev THEN
txt.frontPen := 0;
txt.backPen := col;
ELSE
txt.frontPen := col;
txt.backPen := 0;
END;
txt.iText := ADR(text);
IF INTEGER(ypos) < ((height-(INTEGER(scrFontYSize)+6)) DIV INTEGER(winFontXSize)) THEN
PrintIText(window^.rPort,ADR(txt),0,winFontYSize*ypos);
wtxt[ypos].col := col;
wtxt[ypos].rev := rev;
Copy(wtxt[ypos].txt,text);
INC(ypos);
END;
END OutputWin2;
PROCEDURE HandleAction2() : action2ptr;
VAR intuimsg : IntuiMessagePtr;
code : CARDINAL;
tagbuffer : ARRAY [1..2*2] OF LONGCARD;
BEGIN
intuimsg := GetMsg(window^.userPort);
WHILE intuimsg # NIL DO
IF intuimsg^.class = IDCMPFlagSet{closeWindow} THEN
ReplyMsg(intuimsg);
ActionMem.Action := close;
RETURN(ADR(ActionMem));
ELSIF intuimsg^.class = IDCMPFlagSet{refreshWindow} THEN
ReplyMsg(intuimsg);
wpos := ypos;
ypos := 0;
BeginRefresh(window);
REPEAT
OutputWin2(wtxt[ypos].txt,wtxt[ypos].col,wtxt[ypos].rev);
UNTIL ypos = wpos;
EndRefresh(window,TRUE);
ActionMem.Action := nothing;
RETURN(ADR(ActionMem));
(* ELSIF intuimsg^.class = IDCMPFlagSet{} THEN *)
ELSE
END;
ReplyMsg(intuimsg);
intuimsg := GetMsg(window^.userPort);
END;
ActionMem.Action := nothing;
RETURN(ADR(ActionMem));
END HandleAction2;
PROCEDURE ClearWin2;
BEGIN
SetAPen(window^.rPort,0);
SetDrMd(window^.rPort,DrawModeSet{});
RectFill(window^.rPort,left+4,top+INTEGER(scrFontYSize)+3,left+width-5,top+height-3);
SetAPen(window^.rPort,1);
ypos := 0;
END ClearWin2;
BEGIN
Assert(intuitionVersion >= 37,ADR("Es wird mindestens OS2.04 gebraucht!"));
GetDate(wt,tag,monat,jahr);
END Window2.