MODULE mac; IMPORT FindMeta; IMPORT GrConst; IMPORT GrProcs1; IMPORT GrProcs2; IMPORT GrPorts; IMPORT GrFonts; FROM GrProcs1 IMPORT AddPt,AlignPattern,BackColor,BackPattern,BorderColor,CenterRect,CharWidth,ClearText,ClipRect, ClrInt,CopyBits,CursorBitmap,CursorMap,CursorStyle,DefineCursor,DefineDash,DefinePattern,DrawChar, DrawString,DrawText,DupPt,DupRect,EqualPt,EqualRect,EraseArc,EraseOval,ErasePoly,EraseRect, EraseRoundRect,EventQueue,FillArc,FillOval,FillPoly,FillRect,FillRoundRect,FrameArc,FrameOval, FramePoly,FrameRect,FrameRoundRect,Gbl2LclPt,Gbl2LclRect,Gbl2VirPt,Gbl2VirRect,GetBMapField, GetCmdLine,GetFontField,GetLPixel,GetPenState,GetPixel,GetPort,GetPortField,HardCopy, HideCursor,HidePen,ImagePara,ImageSize,InceptRect,InitBitmap,InitGrafix,InitMouse,InitPort, InitRowTable,InsetRect,InvertArc,InvertOval,InvertPoly,InvertRect,InvertRoundRect,KeyEvent, Lcl2GblPt,Lcl2GblRect,Lcl2VirPt,Lcl2VirRect,LimitMouse,LineRel,LineTo,LoadFont,LoadPalette, MapPoly,MapPt,MapRect,MarkerAngle,MarkerSize,MarkerType,MetaInstalled,MiterLimit,MoveCursor, MovePortTo,MoveTo,OffsetPoly,OffsetRect,OvalPt; FROM GrProcs2 IMPORT PaintArc,PaintOval,PaintPoly,PaintRect,PaintRoundRect,PeekEvent,PenCap,PenColor,PenDash,PenJoin, PenMode,PenNormal,PenOffset,PenPattern,PenSize,PolyLine,PolyMarker,PopGrafix,PortBitmap,PortOrigin, PortSize,ProtectOff,ProtectPort,ProtectRect,Pt2Rect,PtInArc,PtInRect,PtInRoundRect,PtOnArc, PtOnLine,PtOnOval,PtOnPoly,PtOnRect,PtOnRoundRect,PtToAngle,PushGrafix,QueryColors,QueryComm, QueryCursor,QueryError,QueryGrafix,QueryPosn,QueryRes,QueryX,QueryY,RasterOp,ReadImage, ReadMouse,ScaleMouse,ScalePt,ScreenRect,ScreenSize,ScrollRect,SetBitmap,SetDisplay,SetFont, SetInt,SetLocal,SetOrigin,SetPalette,SetPenState,SetPixel,SetPort,SetPt,SetRect,SetVirtual, ShiftRect,ShowCursor,ShowPen,StopEvent,StopMouse,StoreEvent,StringWidth,SubPt,SystemFont, TextAlign,TextAngle,TextExtra,TextFace,TextMode,TextPath,TextScore,TextSize,TextSlant,TextSpace, TextUnder,TextWidth,TrackCursor,UnionRect,Vir2GblPt,Vir2GblRect,Vir2LclPt,Vir2LclRect,VirtualRect, WriteImage,XlateImage,XYInRect,XYOnLine,ZoomBits; FROM GrConst IMPORT Replace, Ovrlay, Invert, Erase, zREPz, zORz, zXORz, zNANDz, zNREPz, zNORz, zNXORz, zANDz, ATT , (* AT&T Std. Color & DEB Adaptors *) ATT640x400 , (* 640x400 monochrome *) DEB640x200 , (* 640x200 16-color *) DEB640x400 , (* 640x400 16-color *) CGA , (* IBM Color Graphics Adaptor (CGA) *) CGA320x200 , (* 320x200 4-color *) CGA640x200 , (* 640x200 2-color *) COR , (* Cornerstone *) COR1600x1280V , (* Vista 1600 1600x1280 mono *) COR1600x1280VA , (*Vista 1600 1600x1280 no em, 2 mon *) COR1600x1280DP , (* DualPage 1600x1280 mono *) COR1600x1280DPA , (* DualPage 1600x1280, no JP1 *) EGA , (* IBM Enhanced Graphics Adaptor *) EGAMono , (* 640x350 monochrome *) EGA320x200 , (* 320x200 16-color *) EGA640x200 , (* 640x200 16-color *) EGA640x350 , (* 640x350 16-color (128k EGA) *) MGA640x350 , (* 640x350 2-color *) EGA640x480 , (* 640x480 16-color (VGA) *) MGA640x480 , (* 640x480 2-color (MCGA) *) VGA320x200 , (* 320x200 256-color (PS2 VGA) *) EGA640x350S , (* 640x350 16-color (no bios-EGA) *) VGA640x350S , (* 640x350 16-color (no bios-VGA) *) VGA640x480S , (* 640x480 16-color (no bios-VGA) *) JRT320x200 , (*320x200 16-color IBM PCjr & Tandy 1000 EX *) EVA , (* Tseng Labs EVA/480 *) EVA640x480 , (* 640x480 16-color *) EVR , (* Everex Graphics Edge Adaptor *) EVR640x200 , (* 640x200 16-color *) EVR640x400 , (* 640x400 4-color *) GEN , (* Genoa SuperEGA HiRes *) GEN800x600 , (* 800x600 16-color *) GEN1024x768 , (* Genoa SuperVGA HiRes-10 16-color *) GEN640x350X , (* 640x350 256-color *) GEN640x480X , (* 640x480 256-color *) HER , (* Hercules/AST Monochrome Adaptor *) HER720x348 , (* 720x348 monochrome *) MDS , (* MDS Genius Graphics Display *) MDS736x1008 , (* 736x1008 monochrome *) NNR512x512 , (* Number Nine 512x485 256-color *) NNR1024x768 , (* 2048x4 @ 1024x768x16 *) NSI , (* NSI Logic Smart EGA/Plus *) NSI800x600 , (* 800x600 16-color *) OCD800x600 , (* Orchid Designer VGA 800x600x16 *) OCD1024x768 , (* 1024x768 16 color *) OCD640x350X , (* 640x480 256 color *) OCD640x480X , (* 640x480 256 color *) PAR , (* Paradise AutoSwitch EGA/480 *) PAR640x480 , (* 640x480 16-color *) PAR800x600 , (* 800x600 16-color *) SIG , (* Sigma Design *) SIG640x400 , (* 640x400 16-color, Color-400 *) SIG1664x1200 , (* Sigma LaserView 1664x1200 mono *) STB , (* STB GraphicsPlus-II Adaptor *) STB640x352 , (* 640x352 monochrome *) STB320x200 , (* 320x200 16-color *) STB640x200 , (* 640x200 4-color *) STB640x400 , (* 640x400 monochrome *) STB800x600 , (* STB VGA Extra/EM 800x600x16 *) STB1024x768 , (* 1024x768 16 color *) STB640x350X , (* 640x350 256 color *) STB640x480X , (* 640x480 256 color *) TEC , (* Tecmar Graphics-Master Adaptor *) TEC720x352 , (* 720x352 monochrome *) TEC720x704 , (* 720x704 monochrome *) TEC320x200 , (* 320x200 16-color *) TEC640x200 , (* 640x200 16-color *) TEC640x400 , (* 640x400 16-color *) TOS , (* Toshiba 3100 *) TOS640x400 , (* 640x400 monochrome *) TTS , (* IBM 3270 PC *) TTS720x350 , (* 720x350 monochrome *) TTS360x350 , (* 360x350 4-color *) VGA , (* Video-7 VEGA Deluxe *) VGA640x480 , (* 640x480 16-color *) VGA752x410 , (* 752x410 16-color *) VGA720x540 , (* V7 VGA 720x540 16-color *) VGA800x600 , (* 800x600 16-color (VGA) *) VGA640x350X , (* V7 VRAM 640x350 256-color *) VGA640x480X , (* 640x480 256-color *) VGA1024x768x2 , (* 1024x768 2-color *) WYS , (* Wyse WY-700 Graphics Display *) WYS1280x800 , (* 1280x800 monochrome *) WYS1280x400 , (* 1280x400 monochrome *) WYS640x400 , (* 640x400 monochrome *) MEC1120x750 , (* NEC PC 98XA monochrome *) MEC640x400 , (* NEC PC 98VM monochrome *) NEC1120x750 , (* NEC PC 98XA 16-color *) NEC640x400 , (* NEC PC 98VM 16-color *) (* Defines for National Design Genesis-1024/1280 *) NDI640x480x4D , (* 640x480 16-color, digitl *) NDI640x480x4A , (* 640x480 16-color, analog *) NDI1024x768x4J , (* 1024x768 16-color, JVC *) NDI1024x768x4M , (* 1024x768 16-color, Mitsu. *) NDI1280x1024x4J , (* 1280x1024 16-color, JVC *) NDI960x720x4N , (* 960x720 16-color, NEC XL *) (* Defines for Hewlett-Packard HP82328 IGC *) HP1024x768x4 , (* 1024x768 16-color *) CUSTLIN , (* User defined linear memory *) CUSTBS , (* User defined Bank select *) CUSTEGA , (* User defined EGA Superset *) (* Mouse Definitions *) com1 , (* Mouse Systems mouse, COM1 *) com2 , (* Mouse Systems mouse, COM2 *) msMouse , (* Microsoft Bus Mouse *) msCOM1 , (* Microsoft Serial Mouse, COM1 *) msCOM2 , (* Microsoft Serial Mouse, COM2 *) MsDriver , (* Microsoft Mouse driver *) swRight , swMiddle , (* (not on 2 button mice) *) swLeft , swAll , black , (* all bits OFF *) white , (* all bits ON *) TextPg0 , GrafPg0 , GrafPg1 , ScrnXmin , ScrnYmin , cNormal , (* TEXTFACE *) cBold , cItalic , cUnderline , cStrikeout , cMirrorX , cMirrorY , cProportional , alignLeft , (* TEXTALIGN - Horizontal *) alignCenter , alignRight , alignBaseline , (* TEXTALIGN - Vertical *) alignBottom , alignMiddle , alignTop , pathRight , (* TEXTPATH definitions *) pathUp , pathLeft , pathDown , capFlat , (* PENCAP definitions *) capRound , capSquare , joinRound , (* PENJOIN definitions *) joinBevel , joinMiter , POINT , (* "Point" structure type RECORD X: INTEGER; (* X coordinate *) Y: INTEGER; (* Y coordinate *) END; *) COLRTABLE, (*= ARRAY[0..15] OF LONGINT; *) RECT , (* "Rectangle" structure type RECORD xMin: INTEGER; (* minimum X *) yMin: INTEGER; (* minimum Y *) xMax: INTEGER; (* maximum X *) yMax: INTEGER; (* maximum Y *) END; *) POLYHEAD , (* Polygon "header" structure RECORD polyBgn: CARDINAL; (* beginning index *) polyEnd: CARDINAL; (* ending index *) polyRect: RECT; (* boundry limits *) END; *) EVENT , (* Event record structure RECORD ASCII: CHAR; (* ASCII character code *) ScanCode: SYSTEM.BYTE; (* Keyboard scan code *) State: CARDINAL; (* Keyboard & mouse switches *) CursorX: INTEGER; (* Cursor X position *) CursorY: INTEGER; (* Cursor Y position *) Time: INTEGER; (* System time of event *) END; *) CURRCD , (* Cursor Image definition RECORD curWidth: CARDINAL; (* must be 16 *) curHeight: CARDINAL; (* must be 16 *) curAlign: CARDINAL; (* must be 0 *) curRowBytes: CARDINAL; (* must be 2 *) curBits: CHAR; (* must be 1 *) curPlanes: CHAR; (* must be 1 *) curData: ARRAY [1..32] OF SYSTEM.BYTE;(* cursor data bytes *) END; *) PATRCD , (* Pattern Image definition RECORD patWidth: CARDINAL; (* must be 8 *) patHeight: CARDINAL; (* must be 8 *) patAlign: CARDINAL; (* must be zero *) patRowBytes: CARDINAL; (* must be equal to patBits *) patBits: SYSTEM.BYTE; (* value of 1,2,4 or 8 *) patPlanes: SYSTEM.BYTE; (* value of 1 thru 32 *) patData: ARRAY [1..32] OF SYSTEM.BYTE; (* pattern data bytes *) END; *) PENSTATE , (* Pen State record structure RECORD psBkColor: LONGINT; (* Background color *) psPnColor: LONGINT; (* Pen color *) psPnLoc: POINT; (* Pen location *) psPnSize: POINT; (* Pen size *) psPnMode: CARDINAL; (* Pen mode (rasterOp) *) psPnPat: CARDINAL; (* Pen pattern index *) psPnCap: CARDINAL; (* Pen end-cap style *) psPnJoin: CARDINAL; (* Line join style *) psPnDash: CARDINAL; (* Line dash style *) psPnOffset: CARDINAL;(* Dash starting offset *) psPnLevel: CARDINAL; (* Pen visibility level *) END; *) DIRREC , (* FILEQUERY - directory record RECORD reserved: ARRAY [1..21] OF CHAR; (* (DOS reserved) *) fileAttr: SYSTEM.BYTE; (* File attribute *) fileTime: CARDINAL; (* File create time *) fileDate: CARDINAL; (* File create date *) fileSize: LONGINT; (* File size (bytes) *) fileName: ARRAY [1..14] OF CHAR; (* "FILENAME.EXT\0" *) END; *) IMAGEHEADER , (* Image Header record structure RECORD imWidth: CARDINAL; (* Pixel width (X) *) imHeight: CARDINAL; (* Pixel height (Y) *) imAlign: CARDINAL; (* Image alignment *) imRowBytes: CARDINAL; (* Bytes per row *) imBits: SYSTEM.BYTE; (* Bits per pixel *) imPlanes: SYSTEM.BYTE;(* Planes per pixel *) (* imData: array [1..?] of byte; image data, variable length *) END; *) DASHRCD , (* DEFINEDASH data record RECORD nCnts: CARDINAL; (* number of active entries, 1-8*) cnt1: CARDINAL; (* distance ON, 1 *) cnt2: CARDINAL; (* distance OFF, 2 *) cnt3: CARDINAL; (* distance ON, 3 *) cnt4: CARDINAL; (* distance OFF, 4 *) cnt5: CARDINAL; (* distance ON, 5 *) cnt6: CARDINAL; (* distance OFF, 6 *) cnt7: CARDINAL; (* distance ON, 7 *) cnt8: CARDINAL; (* distance OFF, 8 *) END; *) MAPARRAY , (*ARRAY [0..7] OF CARDINAL;(* CursorMap data record *) *) (* Sample User Definable Types: *) CCBtype , (* RECORD (*User Definable Clock_Communication_Block*) Timer: CARDINAL; tX: INTEGER; tY: INTEGER; tSw: INTEGER; END; *) MCBtype , (* RECORD (*User Definable Mouse_Communication_Block*) mX: INTEGER; mY: INTEGER; mSw: INTEGER; END; *) IMAGE , (* SYSTEM.BYTE; (* "image" type equivalence *) *) IMAGEPTR ; (* POINTER TO IMAGE;*) FROM GrPorts IMPORT adsMem , (* POINTER TO SYSTEM.BYTE; *) MAP , (* RECORD (* "rowTable" Raster Line Pointers *) rowTable: ARRAY [0..1280] OF adsMem; (* Table of row pointers *) END; *) rowtblPtr , (* POINTER TO MAP;*) BITMAP , (* "bitmap" Data Structure RECORD devClass: INTEGER; (* Device class *) devType: INTEGER; (* Device type *) devProcs: adsMem; (* Ptr to device procedure list *) rowBytes: INTEGER; (* Bytes per scan line *) pixWidth: INTEGER; (* Pixels horizontal *) pixHeight: INTEGER; (* Pixels vertical *) pixResX: INTEGER; (* Pixels per inch horzontally *) pixResY: INTEGER; (* Pixels per inch vertically *) pixBits: INTEGER; (* Color bits per pixel *) pixPlanes: INTEGER; (* Color planes per pixel *) mapTable: ARRAY [0..23] OF rowtblPtr; (* Pointers to rowTable(s) *) mapActive: INTEGER; (* Active logical page *) mapPages: INTEGER; (* Number of mapList entries,1-4 *) mapList: ARRAY [0..3] OF INTEGER; (* List of logical pages loaded *) mapRsvd: ARRAY [0..5] OF INTEGER; (* (reserved for future use) *) mapSegment: CARDINAL;(* Map segment *) mapHandle: CARDINAL; (* Map handle *) mapManager: adsMem; (* Pointer to paging manager *) END; *) BITMAPPTR , (* POINTER TO BITMAP;*) (* Bitmap Device Type (devType) Definitions *) devSTD , (* Standard memory mapped bitmap *) devEGA , (* IBM EGA/VGA display bitmap *) devND1 , (* NDI Genesis-1024 bitmap *) devND2 , (* NDI Genesis-1280 bitmap *) devHP1 , (* Hewlett Packard1 *) devEMS , (* EMS expanded memory bitmap *) devWYS , (* Wyse 1280x800 display bitmap *) devSIG , (* Sigma Design Color-400 bitmap *) devLASVU , (* Sigma Design LaserView/plus *) devVISTA , (* Cornerstone VISTA 1600 *) devREV512 , (* Number Nine Revolution 512x484 *) devDUALPG , (* Cornerstone DualPage System *) devTSENG , (* Tseng labs Bank Select - STB/GENOA/ORCHID *) devREV2048 , (* #9 2048x4 Bank manager *) cDevClass , (* "GetBMapField" index definitions *) cDevType , cRowBytes , cPixWidth , cPixHeight , cPixRsX , cPixRsY , cPixBits , cPixPlanes , cMapTable , METAPORT , (* "metaPort" Data Structure RECORD portBMap: BITMAPPTR; (* Pointer to "bitmap" record *) portRect: GrConst.RECT; (* 'Local' coordinate port bounds *) portOrgn: GrConst.POINT; (* 'Global' origin of portRect *) portVirt: GrConst.RECT; (* 'Virtual' port bounds *) portFlgs: INTEGER; (* Port Flags *) portClip: GrConst.RECT; (* 'Local' clipping rectangle *) portRgn: adsMem; (* (reserved) *) bkPat: INTEGER; (* Background pattern index *) bkColor: LONGINT; (* Background color *) pnColor: LONGINT; (* Pen color *) pnLoc: GrConst.POINT; (* Pen location *) pnSize: GrConst.POINT; (* Pen size *) pnMode: INTEGER; (* Pen mode (rasterOp) *) pnPat: INTEGER; (* Pen pattern index *) pnCap: INTEGER; (* Pen end-cap style *) pnJoin: INTEGER; (* Line join style *) pnDash: INTEGER; (* Line dash style *) pnOffset: INTEGER; (* Dash sequence offset *) pnLevel: INTEGER; (* Pen visibility level *) txFont: adsMem; (* Pointer to current font record *) txFace: INTEGER; (* Text facing flags *) txMode: INTEGER; (* Text mode (rasterOp) *) txUnder: INTEGER; (* Text underline position *) txScore: INTEGER; (* Text underline scoring *) txPath: INTEGER; (* Text path *) txAlign: GrConst.POINT; (* Text alignment *) txAngle: INTEGER; (* Text angle (stroked) *) txSize: GrConst.POINT; (* Text size (stroked) *) txSlant: INTEGER; (* Text slant (stroked) *) txExtra: INTEGER; (* Text justify bits *) txSpace: INTEGER; (* Space justify bits *) mkType: INTEGER; (* Marker type index *) mkSize: GrConst.POINT; (* Marker size *) mkAngle: INTEGER; (* Marker angle *) spare: ARRAY [1..10] OF INTEGER; (* (spares) *) END; *) METAPORTPTR , (* POINTER TO METAPORT;*) PUSHAREA , (* PUSHGRAFIX/POPGRAFIX savearea RECORD saveArea: ARRAY [1..64] OF CARDINAL; END; *) cportBMap , (* "GetPortField" Index Definitions *) cportRect , cportOrgn , cportVirt , cportFlgs , cportClip , cportRgn , cbkPat , cbkColor , cpnColor , cpnLoc , cpnSize , cpnMode , cpnPat , cpnCap , cpnJoin , cpnDash , cpnOffset , cpnLevel , ctxFont , ctxFace , ctxMode , ctxUnder , ctxScore , ctxPath , ctxAlign , ctxAngle , ctxSize , ctxSlant , ctxExtra , ctxSpace , cmkType , cmkSize , cmkAngle , cspare , cxmin , cymin , cxmax , cymax , cX , cY , cseg , coff ; IMPORT IO,SYSTEM,Lib,Str,FIO; FROM Storage IMPORT ALLOCATE,DEALLOCATE; VAR ecran : RECT; car : CHAR; aire : PUSHAREA; i : INTEGER; carre : RECT; bouton : RECT; PROCEDURE GetTime ( VAR Hrs,Mins,Secs,Hsecs : CARDINAL ) ; VAR R : SYSTEM.Registers ; BEGIN WITH R DO AH := 2CH ; Lib.Dos(R) ; Hrs := CARDINAL(CH) ; Mins := CARDINAL(CL) ; Secs := CARDINAL(DH) ; Hsecs := CARDINAL(DL) ; END ; END GetTime ; PROCEDURE GetDate ( VAR Year,Month,Day : CARDINAL ; VAR DayOfWeek : BYTE ) ; VAR R : SYSTEM.Registers ; BEGIN WITH R DO AH := 2AH ; Lib.Dos(R) ; Year := CX ; Month := CARDINAL(DH) ; Day := CARDINAL(DL) ; DayOfWeek := AL ; END ; END GetDate ; TYPE t_bouton = RECORD rectangle : RECT; posh,posb : POINT; contenu : CHAR; END; VAR tableau_boutons : ARRAY[1..8] OF t_bouton; PROCEDURE init_boutons; VAR i : CARDINAL; BEGIN tableau_boutons[1].posh.X := 10; tableau_boutons[1].posh.Y := 10; tableau_boutons[1].posb.X := 60; tableau_boutons[1].posb.Y := 60; Pt2Rect(tableau_boutons[1].posh, tableau_boutons[1].posb,tableau_boutons[1].rectangle); (**********************************) FOR i := 2 TO 8 DO tableau_boutons[i].posh.X := tableau_boutons[i-1].posh.X ; tableau_boutons[i].posh.Y := tableau_boutons[i-1].posh.Y + 53; tableau_boutons[i].posb.X := tableau_boutons[i-1].posb.X; tableau_boutons[i].posb.Y := tableau_boutons[i-1].posb.Y + 53; Pt2Rect(tableau_boutons[i].posh, tableau_boutons[i].posb,tableau_boutons[i].rectangle); END; END init_boutons; PROCEDURE dessine_boutons; VAR i : CARDINAL; aire : PUSHAREA; fichier,cal : FIO.File; tampon : ADDRESS; ptr_port: METAPORTPTR; adr_fonte : ADDRESS; BEGIN PushGrafix(aire); GetPort(ptr_port); adr_fonte := ptr_port^.txFont; ALLOCATE(tampon,15000); fichier := FIO.Open("c:\mII\fonte\CAIRO24.fnt"); i := FIO.RdBin(fichier,tampon^,15000); SetFont(tampon^); BackColor(3); BackPattern(0); FOR i := 1 TO 8 DO EraseRect(tableau_boutons[i].rectangle) ; PenColor(0); PenSize(3,3); FrameRect(tableau_boutons[i].rectangle); PenNormal; PenColor(15); MoveTo(tableau_boutons[i].posh.X,tableau_boutons[i].posb.Y); LineTo(tableau_boutons[i].posb.X,tableau_boutons[i].posb.Y); MoveTo(tableau_boutons[i].posh.X+1,tableau_boutons[i].posb.Y-1); LineTo(tableau_boutons[i].posb.X,tableau_boutons[i].posb.Y-1); MoveTo(tableau_boutons[i].posh.X+2,tableau_boutons[i].posb.Y-2); LineTo(tableau_boutons[i].posb.X,tableau_boutons[i].posb.Y-2); PenColor(15); MoveTo(tableau_boutons[i].posb.X-2,tableau_boutons[i].posh.Y+2); LineTo(tableau_boutons[i].posb.X-2,tableau_boutons[i].posb.Y); MoveTo(tableau_boutons[i].posb.X-1,tableau_boutons[i].posh.Y+1); LineTo(tableau_boutons[i].posb.X-1,tableau_boutons[i].posb.Y); MoveTo(tableau_boutons[i].posb.X,tableau_boutons[i].posh.Y); LineTo(tableau_boutons[i].posb.X,tableau_boutons[i].posb.Y); MoveTo(tableau_boutons[i].posh.X+3,tableau_boutons[i].posh.Y + 25 ); DrawChar(CHR(83H)); END; PopGrafix(aire); SetFont(adr_fonte^); END dessine_boutons; VAR curseur,inter: INTEGER; pointeur : POINT; im_calc : RECT; PROCEDURE horloge; VAR hor : RECT; aire: PUSHAREA; BEGIN PushGrafix(aire); SetRect(hor,580,25,620,70); BackColor(0); BackPattern(0); EraseRect(hor); FrameRect(hor); ShowCursor; Lib.Delay(500); LOOP QueryCursor(pointeur.X,pointeur.Y,inter,curseur); IF PtInRect(pointeur,tableau_boutons[2].rectangle) AND (curseur = swLeft) THEN EXIT END; END; Lib.Delay(100); HideCursor; InvertRect(tableau_boutons[2].rectangle); ShowCursor; Lib.Delay(50); HideCursor; InvertRect(tableau_boutons[2].rectangle); PopGrafix(aire); BackPattern(4); EraseRect(hor); PenNormal; END horloge; PROCEDURE calculatrice; VAR image_calc : RECT; aire : PUSHAREA; tab_boutons: ARRAY[1..22] OF t_bouton; PROCEDURE dessine_bout; VAR i : CARDINAL; BEGIN FOR i := 1 TO 22 DO EraseRoundRect(tab_boutons[i].rectangle,3,3); END; END dessine_bout; PROCEDURE dessine; BEGIN SetRect(image_calc,100,100,600,400); BackColor(3); BackPattern(0); PenColor(15); EraseRect(image_calc); FrameRect(image_calc); MoveTo(110,402); PenSize(4,4); LineTo(602,402); MoveTo(602,107); LineTo(602,402); MoveTo(100,125); PenNormal; LineTo(600,125); MoveTo(300,120); DrawString("CALCULATRICE"); MoveTo(100,150); LineTo(600,150); MoveTo(110,145); TextMode(1); TextFace(cBold ); DrawString("Editions Options "); PenPattern(0); TextFace(0); END dessine; VAR quantite : CARDINAL; ptr : IMAGEPTR; cal : FIO.File; j : CARDINAL; petitrect, onoff : RECT; BEGIN PushGrafix(aire); SetRect(im_calc,100,100,610,410); (* SetRect(petitrect,100,100,200,200); IF NOT FIO.Exists("c:\m2\call.pic") THEN dessine; cal := FIO.Create("c:\m2\call.pic"); quantite := ImagePara(petitrect); quantite := quantite * 16; ALLOCATE(ptr,quantite); ReadImage(petitrect,ptr); FIO.WrBin(cal,ptr^,quantite); DEALLOCATE(ptr,quantite); FIO.Close(cal); ELSE cal := FIO.Open("c:\m2\call.pic"); ALLOCATE(ptr,VAL(CARDINAL,FIO.Size(cal))); j := FIO.RdBin(cal,ptr^,VAL(CARDINAL,FIO.Size(cal))); WriteImage(petitrect,ptr); DEALLOCATE(ptr,VAL(CARDINAL,FIO.Size(cal))); FIO.Close(cal); END; *) dessine; SetRect(onoff,550,104,578,120); BackColor(5); EraseRoundRect(onoff,3,3); FrameRoundRect(onoff,3,3); MoveTo(552,115); i:=SystemFont(16); DrawString("OFF"); BackColor(0); ShowCursor; LOOP QueryCursor(pointeur.X,pointeur.Y,inter,curseur); IF PtInRect(pointeur,(*onoff*)tableau_boutons[1].rectangle) AND (curseur = swLeft) THEN EXIT END; END; HideCursor; InvertRoundRect(onoff,3,3); ShowCursor; Lib.Delay(50); HideCursor; InvertRoundRect(onoff,3,3); PopGrafix(aire); BackPattern(4); EraseRect(im_calc); PenNormal; END calculatrice; VAR vois_curseur : MAPARRAY; BEGIN (* principal *) InitGrafix(-562); SetDisplay(GrafPg0); InitMouse(msCOM1); ScreenRect(ecran); LimitMouse(ecran.xMin,ecran.yMin,ecran.xMax,ecran.yMax); BackPattern(4); EraseRoundRect(ecran,ecran.xMax DIV 32,ecran.yMax DIV 32); PenSize(10,8); FrameRoundRect(ecran,ecran.xMax DIV 32,ecran.yMax DIV 32); MoveCursor(ecran.xMax DIV 2,ecran.yMax DIV 2); PenNormal; CursorMap(vois_curseur); init_boutons; dessine_boutons; ShowCursor; TrackCursor(TRUE); LOOP QueryCursor(pointeur.X,pointeur.Y,inter,curseur); IF PtInRect(pointeur,tableau_boutons[1].rectangle) AND (curseur = swLeft) THEN HideCursor; InvertRect(tableau_boutons[1].rectangle); ShowCursor; Lib.Delay(50); HideCursor; InvertRect(tableau_boutons[1].rectangle); calculatrice; ShowCursor; END; IF PtInRect(pointeur,tableau_boutons[2].rectangle) AND (curseur = swLeft) THEN HideCursor; InvertRect(tableau_boutons[2].rectangle); ShowCursor; Lib.Delay(50); HideCursor; InvertRect(tableau_boutons[2].rectangle); horloge; ShowCursor; END; IF PtInRect(pointeur,tableau_boutons[3].rectangle) AND (curseur = swLeft) THEN HideCursor; InvertRect(tableau_boutons[3].rectangle); ShowCursor; Lib.Delay(50); HideCursor; InvertRect(tableau_boutons[3].rectangle); 2 calculatrice; ShowCursor; END; IF PtInRect(pointeur,tableau_boutons[4].rectangle) AND (curseur = swLeft) THEN HideCursor; InvertRect(tableau_boutons[4].rectangle); ShowCursor; Lib.Delay(50); HideCursor; InvertRect(tableau_boutons[4].rectangle); calculatrice; ShowCursor; END; IF PtInRect(pointeur,tableau_boutons[5].rectangle) AND (curseur = swLeft) THEN HideCursor; InvertRect(tableau_boutons[5].rectangle); ShowCursor; Lib.Delay(50); HideCursor; InvertRect(tableau_boutons[5].rectangle); calculatrice; ShowCursor; END; IF PtInRect(pointeur,tableau_boutons[6].rectangle) AND (curseur = swLeft) THEN HideCursor; InvertRect(tableau_boutons[6].rectangle); ShowCursor; Lib.Delay(50); HideCursor; InvertRect(tableau_boutons[6].rectangle); calculatrice; ShowCursor; END; IF PtInRect(pointeur,tableau_boutons[7].rectangle) AND (curseur = swLeft) THEN HideCursor; InvertRect(tableau_boutons[7].rectangle); ShowCursor; Lib.Delay(50); HideCursor; InvertRect(tableau_boutons[7].rectangle); ShowCursor; calculatrice; END; IF PtInRect(pointeur,tableau_boutons[8].rectangle) AND (curseur = swLeft) THEN HideCursor; InvertRect(tableau_boutons[8].rectangle); ShowCursor; Lib.Delay(50); HideCursor; InvertRect(tableau_boutons[8].rectangle); calculatrice; ShowCursor; END; IF curseur = swRight THEN EXIT END; END; TrackCursor(FALSE); StopMouse; SetDisplay(TextPg0); ClearText; END mac.