Last updated: 18. 1.1998, 13:16
<* +M2EXTENSIONS *>
MODULE Head;
(*---------------------------------------------
HEAD.C --- Displays beginning (head) of file
(c) Charles Petzold, 1996
Head.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1998
---------------------------------------------*)
IMPORT Windows;
IMPORT SYSTEM;
IMPORT FIO;
IMPORT Str;
CONST
MAXPATH = 256;
MAXREAD = 8192;
CONST
szAppName = "Head";
VAR
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
bValidFile : BOOLEAN;
sReadBuffer : ARRAY[0..MAXREAD-1] OF CHAR;
szFile : ARRAY[0..MAXPATH-1] OF CHAR;
hwndList : Windows.HWND;
hwndText : Windows.HWND;
ofs : Windows.OFSTRUCT;
rect : Windows.RECT;
fnOldList : Windows.WNDPROC;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc (hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
VAR
i : INTEGER;
iHandle : INTEGER;
tm : Windows.TEXTMETRIC;
hdc : Windows.HDC;
ps : Windows.PAINTSTRUCT;
szBuffer: ARRAY[0..MAXPATH] OF CHAR;
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
hdc := Windows.GetDC (hwnd);
Windows.SelectObject (hdc, Windows.GetStockObject (Windows.SYSTEM_FIXED_FONT));
Windows.GetTextMetrics (hdc, tm);
Windows.ReleaseDC (hwnd, hdc);
rect.left := 20 * tm.tmAveCharWidth;
rect.top := 3 * tm.tmHeight;
hwndList := Windows.CreateWindow ("listbox", "",
Windows.WS_CHILDWINDOW + Windows.WS_VISIBLE + Windows.LBS_STANDARD,
tm.tmAveCharWidth, tm.tmHeight * 3,
tm.tmAveCharWidth * 13 +
Windows.GetSystemMetrics (Windows.SM_CXVSCROLL),
tm.tmHeight * 10,
hwnd, SYSTEM.CAST(Windows.HMENU,1),
SYSTEM.CAST(Windows.HINSTANCE, Windows.GetWindowLong (hwnd, Windows.GWL_HINSTANCE)),
NIL);
FIO.GetDir(1,szBuffer);
hwndText := Windows.CreateWindow ("static",szBuffer ,
Windows.WS_CHILDWINDOW + Windows.WS_VISIBLE + Windows.SS_LEFT,
tm.tmAveCharWidth, tm.tmHeight,
tm.tmAveCharWidth * MAXPATH, tm.tmHeight,
hwnd, SYSTEM.CAST(Windows.HMENU,2),
SYSTEM.CAST(Windows.HINSTANCE,Windows.GetWindowLong (hwnd, Windows.GWL_HINSTANCE)),
NIL);
fnOldList := SYSTEM.CAST(Windows.WNDPROC,Windows.SetWindowLong (hwndList, Windows.GWL_WNDPROC,
SYSTEM.CAST(Windows.LPARAM,ListProc)));
Windows.SendMessage (hwndList, Windows.LB_DIR, 37h, SYSTEM.CAST(Windows.LPARAM,SYSTEM.ADR("*.*")));
RETURN 0;
| Windows.WM_SIZE :
rect.right := Windows.LOWORD (lParam);
rect.bottom := Windows.HIWORD (lParam);
RETURN 0;
| Windows.WM_SETFOCUS :
Windows.SetFocus (hwndList);
RETURN 0;
| Windows.WM_COMMAND :
IF (Windows.LOWORD (wParam) = 1) AND (Windows.HIWORD (wParam) = Windows.LBN_DBLCLK) THEN
i := Windows.SendMessage (hwndList,Windows.LB_GETCURSEL, 0, 0h);
IF (Windows.LB_ERR = i) THEN
(* break;*)
END;
Windows.SendMessage (hwndList, Windows.LB_GETTEXT, i, SYSTEM.CAST(Windows.LPARAM,szBuffer));
IF (0 # FIO.Open(szBuffer)) THEN
bValidFile := TRUE;
Str.Copy(szFile,szBuffer);
FIO.GetDir(1,szBuffer);
(*
IF (szBuffer [LENGTH (szBuffer) - 1] # '( *') THEN
Str.Append(szBuffer, "( *");
END;
*)
Str.Append(szBuffer,szFile);
Windows.SetWindowText (hwndText, szBuffer);
ELSE
bValidFile := FALSE;
szBuffer [LENGTH(szBuffer) - 1] := '';
FIO.ChDir(szBuffer (* + 1*));
FIO.GetDir(1,szBuffer);
Windows.SetWindowText (hwndText, szBuffer);
Windows.SendMessage (hwndList, Windows.LB_RESETCONTENT, 0, 0h);
Windows.SendMessage (hwndList, Windows.LB_DIR, 37h, SYSTEM.CAST(Windows.LONG, SYSTEM.ADR("*.*")));
END;
Windows.InvalidateRect (hwnd, NIL, TRUE);
END;
RETURN 0;
| Windows.WM_PAINT :
hdc := Windows.BeginPaint (hwnd, ps);
Windows.SelectObject (hdc, Windows.GetStockObject (Windows.SYSTEM_FIXED_FONT));
Windows.SetTextColor (hdc, Windows.GetSysColor (Windows.COLOR_BTNTEXT));
Windows.SetBkColor (hdc, Windows.GetSysColor (Windows.COLOR_BTNFACE));
iHandle := FIO.Open(szFile);
IF (bValidFile) AND (0#iHandle ) THEN
i := FIO.RdBin(iHandle, sReadBuffer, MAXREAD);
FIO.Close (iHandle);
Windows.DrawText (hdc, sReadBuffer, i, rect, Windows.DT_WORDBREAK +
Windows.DT_EXPANDTABS + Windows.DT_NOCLIP + Windows.DT_NOPREFIX);
ELSE
bValidFile := FALSE;
END;
Windows.EndPaint (hwnd, ps);
RETURN 0;
| Windows.WM_DESTROY :
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] ListProc (hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
BEGIN
IF (iMsg = Windows.WM_KEYDOWN) AND (wParam = Windows.VK_RETURN) THEN
Windows.SendMessage (Windows.GetParent (hwnd), Windows.WM_COMMAND, 1,
Windows.MAKELONG (SYSTEM.CAST(Windows.WORD,hwnd), Windows.LBN_DBLCLK));
END;
RETURN Windows.CallWindowProc (fnOldList, hwnd, iMsg, wParam, lParam);
END ListProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
rc : CARDINAL;
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 := Windows.LoadIcon (NIL, Windows.IDI_APPLICATION);
wc.hCursor := Windows.LoadCursor (NIL, Windows.IDC_ARROW);
wc.hbrBackground := SYSTEM.CAST(Windows.HBRUSH,Windows.COLOR_BTNFACE+1);
wc.lpszMenuName := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := Windows.LoadIcon (NIL,Windows.IDI_APPLICATION);
rc := Windows.RegisterClassEx(wc);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := Windows.CreateWindow (
szAppName, (* window class name *)
"File Head: Translation to XDS Modula-2",
(* window caption *)
Windows.WS_OVERLAPPEDWINDOW, (* window style *)
Windows.CW_USEDEFAULT, (* initial x position *)
Windows.CW_USEDEFAULT, (* initial y position *)
Windows.CW_USEDEFAULT, (* initial x size *)
Windows.CW_USEDEFAULT, (* initial y size *)
NIL, (* parent window handle *)
NIL, (* window menu handle *)
wc.hInstance, (* program instance handle *)
NIL); (* creation parameters *)
IF hwnd = NIL THEN
RETURN FALSE;
END;
Windows.ShowWindow (hwnd, Windows.SW_SHOWDEFAULT);
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 Head.