Last updated: 18. 1.1998, 13:13
<* +M2EXTENSIONS *>
MODULE DigClock;
(*-----------------------------------------
DIGCLOCK.C --- Digital Clock Program
(c) Charles Petzold, 1996
DigClock.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1997
-----------------------------------------*)
IMPORT Windows;
IMPORT SYSTEM;
IMPORT SysClock;
IMPORT Str;
CONST ID_TIMER = 1;
VAR
sDate : ARRAY[0..1] OF CHAR;
sTime : ARRAY[0..1] OF CHAR;
sAMPM : ARRAY[0..1],[0..4] OF CHAR;
iTime : INTEGER;
iDate : INTEGER;
CONST szAppName = "DigClock";
CONST cName = "intl";
TYPE szDay = ARRAY[0..2] OF CHAR;
TYPE szWeek = ARRAY[0..6] OF szDay;
CONST szWday = szWeek
{"Sun",
"Mon",
"Tue",
"Wed",
"Thu",
"Fri",
"Sat"};
VAR
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
xStart : INTEGER;
yStart : INTEGER;
xClient : INTEGER;
yClient : INTEGER;
(*++++*****************************************************************)
PROCEDURE SizeTheWindow (VAR xStart : INTEGER;
VAR yStart : INTEGER;
VAR xClient: INTEGER;
VAR yClient: INTEGER);
(**********************************************************************)
VAR
hdc : Windows.HDC;
tm : Windows.TEXTMETRIC;
ch2 : ARRAY[0..1] OF Windows.WCHAR;
BEGIN
hdc := Windows.CreateIC ("DISPLAY", ch2, NIL, NIL);
Windows.GetTextMetrics (hdc, tm);
Windows.DeleteDC (hdc);
xClient := 2 * Windows.GetSystemMetrics (Windows.SM_CXDLGFRAME) + 16*tm.tmAveCharWidth;
xStart := Windows.GetSystemMetrics (Windows.SM_CXSCREEN) - xClient;
yClient := 2 * Windows.GetSystemMetrics (Windows.SM_CYDLGFRAME) + 2*tm.tmHeight;
yStart := 0;
END SizeTheWindow;
(*++++*****************************************************************)
PROCEDURE SetInternational();
(**********************************************************************)
BEGIN
iDate := Windows.GetProfileInt (cName, "iDate", 0);
iTime := Windows.GetProfileInt (cName, "iTime", 0);
Windows.GetProfileString (cName, "sDate", "\", sDate, 2);
Windows.GetProfileString (cName, "sTime", ":", sTime, 2);
Windows.GetProfileString (cName, "s1159", "AM", sAMPM[0], 5);
Windows.GetProfileString (cName, "s2359", "PM", sAMPM[1], 5);
END SetInternational;
(*++++*****************************************************************)
PROCEDURE WndPaint(hwnd : Windows.HWND;
(**********************************************************************)
hdc : Windows.HDC);
VAR
cBuffer1 : ARRAY[0..25] OF CHAR;
cBuffer2 : ARRAY[0..25] OF CHAR;
cBuffer : ARRAY[0..50] OF CHAR;
iLength : INTEGER;
rect : Windows.RECT;
dateTime: Windows.SYSTEMTIME;
datetime:SysClock.DateTime;
weekDay : ARRAY[0..5] OF CHAR;
ch2 : ARRAY[0..1] OF CHAR;
BEGIN
Windows.GetSystemTime(dateTime);
SysClock.GetClock(datetime);
Str.Copy(weekDay,szWday[dateTime.wDayOfWeek]);
IF(iDate=1) THEN
iLength := Windows.wsprintf (cBuffer1, " %s %d%s%02d%s%02d",
weekDay,
datetime.day, sDate,
datetime.month, sDate,
datetime.year REM 100);
ELSIF(iDate=2) THEN
iLength := Windows.wsprintf (cBuffer1, " %s %d%s%02d%s%02d",
szWday[dateTime.wDayOfWeek],
datetime.year REM 100, sDate,
datetime.month, sDate,
datetime.day);
ELSE
iLength := Windows.wsprintf (cBuffer1, " %s %d%s%02d%s%02d",
szWday[dateTime.wDayOfWeek],
datetime.month, sDate,
datetime.day, sDate,
datetime.year REM 100);
END;
IF (iTime = 1) THEN
iLength := Windows.wsprintf (cBuffer2, " %02d%s%02d%s%02d ",
datetime.hour,
sTime,
datetime.minute,
sTime,
datetime.second);
ELSE
IF(datetime.hour REM 12#0) THEN
iLength := Windows.wsprintf (cBuffer2, " %d%s%02d%s%02d %s ",
datetime.hour REM 12,
sTime,
datetime.minute,
sTime,
datetime.second,
sAMPM[datetime.hour DIV 12]);
ELSE
iLength := Windows.wsprintf (cBuffer2, " %d%s%02d%s%02d %s ",
12,
sTime,
datetime.minute,
sTime,
datetime.second,
sAMPM[datetime.hour DIV 12]);
END;
END;
Windows.GetClientRect (hwnd, rect);
ch2[0] := CHR(13);
ch2[1] := CHR(10);
Str.Append(cBuffer1,ch2);
Str.Concat(cBuffer,cBuffer1,cBuffer2);
Windows.DrawText (hdc, cBuffer, -1, rect, Windows.DT_CENTER + Windows.DT_NOCLIP);
END WndPaint;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc (hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
VAR
hdc : Windows.HDC;
ps : Windows.PAINTSTRUCT;
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
SetInternational ();
RETURN 0;
| Windows.WM_TIMER :
Windows.InvalidateRect (hwnd, NIL, FALSE);
RETURN 0;
| Windows.WM_PAINT :
hdc := Windows.BeginPaint (hwnd, ps);
WndPaint (hwnd, hdc);
Windows.EndPaint (hwnd, ps);
RETURN 0;
| Windows.WM_WININICHANGE :
SetInternational ();
Windows.InvalidateRect (hwnd, NIL, TRUE);
RETURN 0;
| Windows.WM_DESTROY :
Windows.KillTimer (hwnd, ID_TIMER);
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
BEGIN
wc.cbSize := SIZE(wc);
wc.style := Windows.CS_HREDRAW + Windows.CS_VREDRAW;
wc.lpfnWndProc := WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := Windows.MyInstance();
wc.hIcon := NIL;
wc.hCursor := Windows.LoadCursor (NIL, Windows.IDC_ARROW);
wc.hbrBackground := SYSTEM.CAST(Windows.HBRUSH, Windows.GetStockObject (Windows.WHITE_BRUSH));
wc.lpszMenuName := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := NIL;
RETURN Windows.RegisterClassEx(wc)#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
SizeTheWindow (xStart, yStart, xClient, yClient);
hwnd := Windows.CreateWindow (szAppName,
"DigClock Demo: Translation to XDS Modula-2",
Windows.WS_POPUP + Windows.WS_DLGFRAME + Windows.WS_SYSMENU,
xStart, yStart,
xClient, yClient,
NIL,
NIL,
Windows.MyInstance(),
NIL);
WHILE(Windows.SetTimer (hwnd, ID_TIMER, 1000, NIL)=0) DO
Windows.MessageBox (hwnd,
"Too many clocks or timers!",
szAppName,
Windows.MB_ICONEXCLAMATION + Windows.MB_OK);
RETURN FALSE;
END;
Windows.ShowWindow (hwnd, Windows.SW_SHOWNOACTIVATE);
Windows.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END DigClock.