Software of the Month Club 1995 December/SOFM_Dec1995.bin/pc/os2/vpascal/source/rtl/wincrt.pas

Pascal/Delphi Source File | 1995-10-31 | 23.1 KB | 836 lines

{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Runtime Library.  Version 1.0.    █}
{█      OS/2 Presentation Manager CRT interface unit     █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1995 B&M&T Corporation             █}
{█      ─────────────────────────────────────────────────█}
{█      Written by Vitaly Miryanov                       █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
{$S-,R-,Q-,I-,Cdecl-,OrgName-,AlignRec-}

unit WinCrt;

interface

uses Os2Def, Os2PmApi, Strings, WinDos, Use32;

var
  WindowTitle: array[0..79] of Char;        { CRT window title }
  InactiveTitleBuf: array[0..79] of Char;   { CRT window inactive title }

const
  cw_UseDefault = Integer($8000);

const
  WindowOrg: PointL =                       { CRT window origin }
    (X: cw_UseDefault; Y: cw_UseDefault);
  WindowSize: PointL =                      { CRT window size }
    (X: cw_UseDefault; Y: cw_UseDefault);
  ScreenSize: PointL = (X: 80; Y: 25);      { Screen buffer dimensions }
  InactiveTitle: PChar = @InactiveTitleBuf; { Inactive window title }
  Cursor: PointL = (X: 0; Y: 0);            { Cursor location }
  Origin: PointL = (X: 0; Y: 0);            { Client area origin }
  AutoTracking: Boolean = True;             { Track cursor on Write? }
  CheckEOF: Boolean = False;                { Allow Ctrl-Z for EOF? }
  CheckBreak: Boolean = True;               { Allow Ctrl-C for break? }
  FontId: ULong = 1;                        { Font Id }
  FontAttr: FAttrs = (                      { Font attributes }
    usRecordLength:  SizeOf(FAttrs);        { Size of the record }
    fsSelection:     0;                     { fattr_Sel_xxx }
    lMatch:          1;
    szFacename:      'System VIO';          { Fixed-pitch font }
    idRegistry:      0;
    usCodePage:      0;
    lMaxBaselineExt: 16;                    { Font Size: 16x8 }
    lAveCharWidth:   8;
    fsType:          0;                     { fattr_Type_xxx }
    fsFontUse:       0                      { fattr_FontUse_xxx }
  );
  CrtCreateFlags: ULong = fcf_TitleBar + fcf_SysMenu + fcf_SizeBorder +
    fcf_MinMax + fcf_TaskList + fcf_NoByteAlign + fcf_VertScroll + fcf_HorzScroll;

procedure InitWinCrt;
procedure DoneWinCrt;

procedure WriteBuf(Buffer: PChar; Count: Word);
procedure WriteChar(Ch: Char);

function KeyPressed: Boolean;
function ReadKey: Char;
function ReadBuf(Buffer: PChar; Count: Word): Word;

procedure GotoXY(X, Y: Integer);
function WhereX: Integer;
function WhereY: Integer;
procedure ClrScr;
procedure ClrEol;

procedure CursorTo(X, Y: Integer);
procedure ScrollTo(X, Y: Integer);
procedure TrackCursor;

procedure AssignCrt(var F: Text);

{ CRT window procedures }

function CrtWinProc(Window: HWnd; Message: ULong; Mp1, Mp2: MParam): MResult; cdecl; export;
function FrameWndProc(Window: HWnd; Message: ULong; Mp1, Mp2: MParam): MResult; cdecl; export;

implementation

{ Double word record }

type
  LongRec = record
    Lo, Hi: SmallInt;
  end;

{ Scroll key definition record }

type
  TScrollKey = record
    Key: Byte;
    Ctrl: Boolean;
    SBar: Byte;
    Action: Byte;
  end;

const
  CrtWindow: HWnd = 0;                  { CRT window handle }
  CrtWindowFrame: HWnd = 0;             { CRT window frame handle }
  FirstLine: Integer = 0;               { First line in circular buffer }
  KeyCount: Integer = 0;                { Count of keys in KeyBuffer }
  Created: Boolean = False;             { CRT window created? }
  Focused: Boolean = False;             { CRT window focused? }
  Reading: Boolean = False;             { Reading from CRT window? }
  Painting: Boolean = False;            { Handling wm_Paint? }

var
  SaveExit: Pointer;                    { Saved exit procedure pointer }
  ScreenBuffer: PChar;                  { Screen buffer pointer }
  ClientSize: PointL;                   { Client area dimensions }
  MaxWindowSize: PointL;                { Maximum window size }
  Range: PointL;                        { Scroll bar ranges }
  CharSize: PointL;                     { Character cell size }
  CharDescent: Integer;                 { Character descent }
  DC: HDC;                              { Global device context }
  KeyBuffer: array[0..63] of Char;      { Keyboard type-ahead buffer }
  Anchor: HAB;                          { PM anchor block }
  MsgQue: HMQ;                          { PM message queue }
  PS: HPS;                              { Presentation space handle }
  VScrollBar: HWnd;                     { Vertical scrollbar handle }
  HScrollBar: HWnd;                     { Horizontal scrollbar handle }
  PR: RectL;                            { Painting rectangle }
  cyClient: Integer;                    { Client window height }
  OldFrameWndProc: FnWp;                { Standard frame window procedure }
  DesktopSize: PointL;                  { Size of the PM Desktop }

const
  CrtClassName: PChar = 'VPWinCrt';

const
  sb_Top        = 8;    { PM does not have these ones }
  sb_Bottom     = 9;

{ Scroll keys table }

const
  ScrollKeyCount = 12;
  ScrollKeys: array[1..ScrollKeyCount] of TScrollKey = (
    (Key: vk_Left;     Ctrl: False; SBar: sbs_Horz; Action: sb_LineUp),
    (Key: vk_Right;    Ctrl: False; SBar: sbs_Horz; Action: sb_LineDown),
    (Key: vk_Left;     Ctrl: True;  SBar: sbs_Horz; Action: sb_PageUp),
    (Key: vk_Right;    Ctrl: True;  SBar: sbs_Horz; Action: sb_PageDown),
    (Key: vk_Home;     Ctrl: False; SBar: sbs_Horz; Action: sb_Top),
    (Key: vk_End;      Ctrl: False; SBar: sbs_Horz; Action: sb_Bottom),
    (Key: vk_Up;       Ctrl: False; SBar: sbs_Vert; Action: sb_LineUp),
    (Key: vk_Down;     Ctrl: False; SBar: sbs_Vert; Action: sb_LineDown),
    (Key: vk_PageUp;   Ctrl: False; SBar: sbs_Vert; Action: sb_PageUp),
    (Key: vk_PageDown; Ctrl: False; SBar: sbs_Vert; Action: sb_PageDown),
    (Key: vk_Home;     Ctrl: True;  SBar: sbs_Vert; Action: sb_Top),
    (Key: vk_End;      Ctrl: True;  SBar: sbs_Vert; Action: sb_Bottom));

{ Return the smaller of two integer values }

function Min(X, Y: Integer): Integer;
begin
  if X < Y then Min := X else Min := Y;
end;

{ Return the larger of two integer values }

function Max(X, Y: Integer): Integer;
begin
  if X > Y then Max := X else Max := Y;
end;

{ Allocate presentation space }

procedure InitPresentationSpace;
begin
  if Painting then
    PS := WinBeginPaint(CrtWindow, hNULL, @PR) else
    PS := WinGetPS(CrtWindow);
  GpiCreateLogFont(PS, nil, FontId, FontAttr);
  GpiSetCharSet(PS, FontId);
  GpiSetBackMix(PS, bm_OverPaint);
  GpiSetColor(PS, clr_Default);
  GpiSetBackColor(PS, clr_Background);
end;

{ Release presentation space }

procedure DonePresentationSpace;
begin
  GpiSetCharSet(PS, lcid_Default);
  if Painting then
    WinEndPaint(PS) else
    WinReleasePS(PS);
end;

{ Calculates window parameters: character size and descent, }
{ maximum window size                                       }

procedure GetWindowParams;
var
  Metrics: FontMetrics;
begin
  InitPresentationSpace;
  GpiQueryFontMetrics(PS, SizeOf(Metrics), Metrics);
  CharSize.X := Metrics.lAveCharWidth;
  CharSize.Y := Metrics.lMaxAscender + Metrics.lMaxDescender;
  CharDescent := Metrics.lMaxDescender;
  MaxWindowSize.X := ScreenSize.X * CharSize.X +
    WinQuerySysValue(hwnd_Desktop, sv_CxVScroll) +
    2 * WinQuerySysValue(hwnd_Desktop, sv_CxSizeBorder);
  MaxWindowSize.Y := ScreenSize.Y * CharSize.Y +
    WinQuerySysValue(hwnd_Desktop, sv_CyHScroll) +
    WinQuerySysValue(hwnd_Desktop, sv_CyTitleBar) +
    2 * WinQuerySysValue(hwnd_Desktop, sv_CySizeBorder);
  DonePresentationSpace;
end;

{ Enables/Disables specified system menu item }

procedure EnableSysMenuItem(Item: ULong; Enable: Boolean);
var
  Value: ULong;
begin
  if Enable then Value := 0 else Value := mia_Disabled;
  WinSendMsg(WinWindowFromID(CrtWindowFrame, fid_SysMenu),
    mm_SetItemAttr, Item + 1 shl 16, mia_Disabled + Value shl 16);
end;

{ Show cursor }

procedure ShowCursor;
begin
  WinCreateCursor(CrtWindow,
    (Cursor.X - Origin.X) * CharSize.X,                { X }
    cyClient - (Cursor.Y - Origin.Y + 1) * CharSize.Y, { Y }
    CharSize.X, 2, cursor_Solid + cursor_Flash, nil);
  WinShowCursor(CrtWindow, True);
end;

{ Hide cursor }

procedure HideCursor;
begin
  WinDestroyCursor(CrtWindow);
end;

{ Update scroll bars }

procedure SetScrollBars;
var
  Swap: Swp;
begin
  WinQueryWindowPos(CrtWindow, Swap);
  WinSendMsg(HScrollBar, sbm_SetScrollBar, Origin.X, 0 + Max(1, Range.X) shl 16);
  WinSendMsg(VScrollBar, sbm_SetScrollBar, Origin.Y, 0 + Max(1, Range.Y) shl 16);
  WinSendMsg(HScrollBar, sbm_SetThumbSize, Swap.cX + (ScreenSize.X * CharSize.X) shl 16, 0);
  WinSendMsg(VScrollBar, sbm_SetThumbSize, Swap.cY + (ScreenSize.Y * CharSize.Y) shl 16, 0);
end;

{ Terminate CRT window }

procedure Terminate;
begin
  if Focused and Reading then HideCursor;
  Halt(255);
end;

{ Set cursor position }

procedure CursorTo(X, Y: Integer);
begin
  Cursor.X := Max(0, Min(X, ScreenSize.X - 1));
  Cursor.Y := Max(0, Min(Y, ScreenSize.Y - 1));
end;

{ Scroll window to given origin }

procedure ScrollTo(X, Y: Integer);
begin
  if Created then
  begin
    X := Max(0, Min(X, Range.X));
    Y := Max(0, Min(Y, Range.Y));
    if (X <> Origin.X) or (Y <> Origin.Y) then
    begin
      if X <> Origin.X then WinSendMsg(HScrollBar, sbm_SetPos, X, 0);
      if Y <> Origin.Y then WinSendMsg(VScrollBar, sbm_SetPos, Y, 0);
      WinScrollWindow(CrtWindow,
        (Origin.X - X) * CharSize.X,
        (Y - Origin.Y) * CharSize.Y, nil, nil, 0, nil, sw_InvalidateRgn);
      Origin.X := X;
      Origin.Y := Y;
      WinUpdateWindow(CrtWindow);
    end;
  end;
end;

{ Scroll to make cursor visible }

procedure TrackCursor;
begin
  ScrollTo(Max(Cursor.X - ClientSize.X + 1, Min(Origin.X, Cursor.X)),
    Max(Cursor.Y - ClientSize.Y + 1, Min(Origin.Y, Cursor.Y)));
end;

{ Return pointer to location in screen buffer }

function ScreenPtr(X, Y: Integer): PChar;
begin
  Inc(Y, FirstLine);
  if Y >= ScreenSize.Y then Dec(Y, ScreenSize.Y);
  ScreenPtr := @ScreenBuffer[Y * ScreenSize.X + X];
end;

{ Update text on cursor line }

procedure ShowText(L, R: Integer);
var
  P: PointL;
begin
  if L < R then
  begin
    InitPresentationSpace;
    P.X := (L - Origin.X) * CharSize.X;
    P.Y := cyClient - (Cursor.Y - Origin.Y + 1) * CharSize.Y + CharDescent;
    GpiCharStringAt(PS, P, R - L, ScreenPtr(L, Cursor.Y));
    DonePresentationSpace;
  end;
end;

{ Write text buffer to CRT window }

procedure WriteBuf(Buffer: PChar; Count: Word);
var
  L, R: Integer;

procedure NewLine;
begin
  ShowText(L, R);
  L := 0;
  R := 0;
  Cursor.X := 0;
  Inc(Cursor.Y);
  if Cursor.Y = ScreenSize.Y then
  begin
    Dec(Cursor.Y);
    Inc(FirstLine);
    if FirstLine = ScreenSize.Y then FirstLine := 0;
    FillChar(ScreenPtr(0, Cursor.Y)^, ScreenSize.X, ' ');
    WinScrollWindow(CrtWindow, 0, CharSize.Y, nil, nil, 0, nil, sw_InvalidateRgn);
    WinUpdateWindow(CrtWindow);
  end;
end;

begin
  InitWinCrt;
  L := Cursor.X;
  R := Cursor.X;
  while Count > 0 do
  begin
    case Buffer^ of
      #32..#255:
        begin
          ScreenPtr(Cursor.X, Cursor.Y)^ := Buffer^;
          Inc(Cursor.X);
          if Cursor.X > R then R := Cursor.X;
          if Cursor.X = ScreenSize.X then NewLine;
        end;
      #13:
        NewLine;
      #8:
        if Cursor.X > 0 then
        begin
          Dec(Cursor.X);
          ScreenPtr(Cursor.X, Cursor.Y)^ := ' ';
          if Cursor.X < L then L := Cursor.X;
        end;
      #7:
        WinAlarm(hwnd_Desktop, wa_Note);
    end;
    Inc(Buffer);
    Dec(Count);
  end;
  ShowText(L, R);
  if AutoTracking then TrackCursor;
end;

{ Write character to CRT window }

procedure WriteChar(Ch: Char);
begin
  WriteBuf(@Ch, 1);
end;

{ Return keyboard status }

function KeyPressed: Boolean;
var
  M: QMsg;
begin
  InitWinCrt;
  while WinPeekMsg(Anchor, M, 0, 0, 0, pm_Remove) do
  begin
    if M.Msg = wm_Quit then Terminate;
    WinDispatchMsg(Anchor, M);
  end;
  KeyPressed := KeyCount > 0;
end;

{ Read key from CRT window }

function ReadKey: Char;
begin
  TrackCursor;
  if not KeyPressed then
  begin
    Reading := True;
    if Focused then ShowCursor;
    repeat WinWaitMsg(Anchor, 0, 0) until KeyPressed;
    if Focused then HideCursor;
    Reading := False;
  end;
  ReadKey := KeyBuffer[0];
  Dec(KeyCount);
  Move(KeyBuffer[1], KeyBuffer[0], KeyCount);
end;

{ Read text buffer from CRT window }

function ReadBuf(Buffer: PChar; Count: Word): Word;
var
  Ch: Char;
  I: Word;
begin
  I := 0;
  repeat
    Ch := ReadKey;
    case Ch of
      #8:
        if I > 0 then
        begin
          Dec(I);
          WriteChar(#8);
        end;
      #32..#255:
        if I < Count - 2 then
        begin
          Buffer[I] := Ch;
          Inc(I);
          WriteChar(Ch);
        end;
    end;
  until (Ch = #13) or (CheckEOF and (Ch = #26));
  Buffer[I] := Ch;
  Inc(I);
  if Ch = #13 then
  begin
    Buffer[I] := #10;
    Inc(I);
    WriteChar(#13);
  end;
  TrackCursor;
  ReadBuf := I;
end;

{ Set cursor position }

procedure GotoXY(X, Y: Integer);
begin
  CursorTo(X - 1, Y - 1);
end;

{ Return cursor X position }

function WhereX: Integer;
begin
  WhereX := Cursor.X + 1;
end;

{ Return cursor Y position }

function WhereY: Integer;
begin
  WhereY := Cursor.Y + 1;
end;

{ Clear screen }

procedure ClrScr;
begin
  InitWinCrt;
  FillChar(ScreenBuffer^, ScreenSize.X * ScreenSize.Y, ' ');
  Cursor.X := 0; Cursor.Y := 0;
  Origin.X := 0; Origin.Y := 0;
  SetScrollBars;
  WinInvalidateRect(CrtWindow, nil, False);
  WinUpdateWindow(CrtWindow);
end;

{ Clear to end of line }

procedure ClrEol;
begin
  InitWinCrt;
  FillChar(ScreenPtr(Cursor.X, Cursor.Y)^, ScreenSize.X - Cursor.X, ' ');
  ShowText(Cursor.X, ScreenSize.X);
end;

{ wm_Create message handler }

procedure WindowCreate;
begin
  Created := True;
  CrtWindowFrame := WinQueryWindow(CrtWindow, qw_Parent);
  GetMem(ScreenBuffer, ScreenSize.X * ScreenSize.Y);
  FillChar(ScreenBuffer^, ScreenSize.X * ScreenSize.Y, ' ');
  if not CheckBreak then EnableSysMenuItem(sc_Close, False);
  VScrollBar := WinWindowFromID(CrtWindowFrame, fid_VertScroll);
  HScrollBar := WinWindowFromID(CrtWindowFrame, fid_HorzScroll);
  GetWindowParams;
end;

{ wm_Paint message handler }

procedure WindowPaint;
var
  X1, X2, Y1, Y2: Integer;
  P: PointL;
  R: RectL;
begin
  Painting := True;
  InitPresentationSpace;
  X1 := Max(0, PR.xLeft div CharSize.X + Origin.X);
  X2 := Min(ScreenSize.X,
    (PR.xRight + CharSize.X - 1) div CharSize.X + Origin.X);
  Y1 := Max(0, (cyClient - PR.yTop) div CharSize.Y + Origin.Y);
  Y2 := Min(ScreenSize.Y,
    (cyClient - PR.yBottom + CharSize.Y - 1) div CharSize.Y + Origin.Y);
  while Y1 < Y2 do
  begin
    P.X := (X1 - Origin.X) * CharSize.X;
    P.Y := cyClient - (Y1 - Origin.Y + 1) * CharSize.Y + CharDescent;
    GpiCharStringAt(PS, P, X2 - X1, ScreenPtr(X1, Y1));
    Inc(Y1);
  end;
  R := PR;
  R.yTop := P.Y - CharDescent;
  if R.yTop > R.yBottom then WinFillRect(PS, R, clr_Background);
  R := PR;
  R.xLeft := (X2 - Origin.X) * CharSize.X;
  if R.xLeft < R.xRight then WinFillRect(PS, R, clr_Background);
  DonePresentationSpace;
  Painting := False;
end;

{ wm_VScroll and wm_HScroll message handler }

procedure WindowScroll(Which, Action, Thumb: Integer);
var
  X, Y: Integer;

function GetNewPos(Pos, Page, Range: Integer): Integer;
begin
  case Action of
    sb_LineUp: GetNewPos := Pos - 1;
    sb_LineDown: GetNewPos := Pos + 1;
    sb_PageUp: GetNewPos := Pos - Page;
    sb_PageDown: GetNewPos := Pos + Page;
    sb_SliderPosition: GetNewPos := Thumb;
    sb_Top: GetNewPos := 0;
    sb_Bottom: GetNewPos := Range;
  else
    GetNewPos := Pos;
  end;
end;

begin
  X := Origin.X;
  Y := Origin.Y;
  case Which of
    sbs_Horz: X := GetNewPos(X, ClientSize.X div 2, Range.X);
    sbs_Vert: Y := GetNewPos(Y, ClientSize.Y, Range.Y);
  end;
  ScrollTo(X, Y);
end;

{ wm_Size message handler }

procedure WindowResize(X, Y: Integer);
begin
  if Focused and Reading then HideCursor;
  cyClient := Y;
  ClientSize.X := X div CharSize.X;
  ClientSize.Y := Y div CharSize.Y;
  Range.X := Max(0, ScreenSize.X - ClientSize.X);
  Range.Y := Max(0, ScreenSize.Y - ClientSize.Y);
  Origin.X := Min(Origin.X, Range.X);
  Origin.Y := Min(Origin.Y, Range.Y);
  SetScrollBars;
  if Focused and Reading then ShowCursor;
end;

{ wm_Char message handler when characters are entered }

procedure WindowChar(Ch: Char);
begin
  if KeyCount < SizeOf(KeyBuffer) then
  begin
    KeyBuffer[KeyCount] := Ch;
    Inc(KeyCount);
  end;
end;

{ wm_Char message handler when non-character keys are pressed }

procedure WindowKeyDown(KeyDown: Word; CtrlDown: Boolean);
var
  I: Integer;
begin
  for I := 1 to ScrollKeyCount do
    with ScrollKeys[I] do
      if (Key = KeyDown) and (Ctrl = CtrlDown) then
      begin
        WindowScroll(SBar, Action, 0);
        Exit;
      end;
end;

{ wm_SetFocus message handler }

procedure WindowSetFocus(AFocused: Boolean);
begin
  Focused := AFocused;
  if Reading then
    if AFocused then ShowCursor else HideCursor;
end;

{ wm_Close message handler }

procedure WindowClose;
begin
  FreeMem(ScreenBuffer, ScreenSize.X * ScreenSize.Y);
  Cursor.X := 0; Cursor.Y := 0;
  Origin.X := 0; Origin.Y := 0;
  WinPostMsg(CrtWindow, wm_Quit, 0, 0);
  Created := False;
end;

{ CRT window procedure }

function CrtWinProc(Window: HWnd; Message: ULong; Mp1, Mp2: MParam): MResult;
begin
  CrtWinProc := 0;
  CrtWindow := Window;
  case Message of
    wm_Create: WindowCreate;
    wm_Paint: WindowPaint;
    wm_VScroll: WindowScroll(sbs_Vert, LongRec(Mp2).Hi, LongRec(Mp2).Lo);
    wm_HScroll: WindowScroll(sbs_Horz, LongRec(Mp2).Hi, LongRec(Mp2).Lo);
    wm_Size: WindowResize(LongRec(Mp2).Lo, LongRec(Mp2).Hi);
    wm_Char:
      if (CharMsgMp1(Mp1).fs and kc_KeyUp) = 0 then
      begin                                                     { Key is down }
        if CheckBreak then                                      { Break enabled }
          if (CharMsgMp2(Mp2).VKey = vk_Break) or               { Ctrl-Break }
            (((CharMsgMp1(Mp1).fs and kc_Ctrl) <> 0) and
             ((CharMsgMp2(Mp2).Chr = Ord('C')) or               { Ctrl-C }
              (CharMsgMp2(Mp2).Chr = Ord('c')))) then Terminate;{ Ctrl-c }
        if (CharMsgMp2(Mp2).Chr > 0) and (CharMsgMp2(Mp2).Chr <= 255) and
          ((CharMsgMp1(Mp1).fs and (kc_Ctrl + kc_Alt)) = 0)
          then WindowChar(Chr(CharMsgMp2(Mp2).Chr))
          else WindowKeyDown(CharMsgMp2(Mp2).VKey, (CharMsgMp1(Mp1).fs and kc_Ctrl) <> 0);
      end;
    wm_SetFocus: WindowSetFocus(LongRec(Mp2).Lo <> 0);
    wm_Close: WindowClose;
  else
    CrtWinProc := WinDefWindowProc(Window, Message, Mp1, Mp2);
  end;
end;

{ CRT window frame procedure }

function FrameWndProc(Window: HWnd; Message: ULong; Mp1, Mp2: MParam): MResult;
begin
  FrameWndProc := OldFrameWndProc(Window, Message, Mp1, Mp2);
  case Message of
    wm_AdjustWindowPos:
      with PSwp(Mp1)^ do
      if (Fl and swp_Size) <> 0 then
      begin
        cX := Min(cX, MaxWindowSize.X);
        cY := Min(cy, MaxWindowSize.Y);
        if (Fl and swp_Maximize) <> 0 then
        begin
          X := (DesktopSize.X - cX) div 2;
          Y := (DesktopSize.Y - cY) div 2;
        end;
      end;
    wm_QueryTrackInfo:
      with PTrackInfo(Mp2)^ do
      begin
        ptlMaxTrackSize.X := MaxWindowSize.X;
        ptlMaxTrackSize.Y := MaxWindowSize.Y;
      end;
  end;
end;

{ Text file device driver output function }

function CrtOutput(var F: TTextRec): Integer; far;
begin
  if F.BufPos <> 0 then
  begin
    WriteBuf(PChar(F.BufPtr), F.BufPos);
    F.BufPos := 0;
    KeyPressed;
  end;
  CrtOutput := 0;
end;

{ Text file device driver input function }

function CrtInput(var F: TTextRec): Integer; far;
begin
  F.BufEnd := ReadBuf(PChar(F.BufPtr), F.BufSize);
  F.BufPos := 0;
  CrtInput := 0;
end;

{ Text file device driver close function }

function CrtClose(var F: TTextRec): Integer; far;
begin
  CrtClose := 0;
end;

{ Text file device driver open function }

function CrtOpen(var F: TTextRec): Integer; far;
begin
  if F.Mode = fmInput then
  begin
    F.InOutFunc := @CrtInput;
    F.FlushFunc := nil;
  end else
  begin
    F.Mode := fmOutput;
    F.InOutFunc := @CrtOutput;
    F.FlushFunc := @CrtOutput;
  end;
  F.CloseFunc := @CrtClose;
  CrtOpen := 0;
end;

{ Assign text file to CRT device }

procedure AssignCrt(var F: Text);
begin
  with TTextRec(F) do
  begin
    Handle := $FFFFFFFF;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @CrtOpen;
    Name[0] := #0;
  end;
end;

{ Create CRT window if required }

procedure InitWinCrt;
var
  InitSize: PointL;
begin
  if not Created then
  begin
    DesktopSize.X := WinQuerySysValue(hwnd_Desktop, sv_CxScreen);
    DesktopSize.Y := WinQuerySysValue(hwnd_Desktop, sv_CyScreen);
    CrtWindowFrame := WinCreateStdWindow(hwnd_Desktop, 0, CrtCreateFlags,
      CrtClassName, WindowTitle, 0, 0, 0, CrtWindow);
    InitSize.X := (DesktopSize.X * 3) div 4;
    InitSize.Y := (DesktopSize.Y * 3) div 4;
    if WindowSize.X = cw_UseDefault then WindowSize := InitSize;
    WindowSize.X := Min(MaxWindowSize.X, WindowSize.X);
    WindowSize.Y := Min(MaxWindowSize.Y, WindowSize.Y);
    if WindowOrg.X = cw_UseDefault then
    begin
      WindowOrg.X := (DesktopSize.X - WindowSize.X) div 2;
      WindowOrg.Y := (DesktopSize.Y - WindowSize.Y) div 2;
    end;
    WinSetWindowPos(
      CrtWindowFrame, hNULL,
      WindowOrg.X, WindowOrg.Y,
      WindowSize.X, WindowSize.Y,
      swp_Move + swp_Size + swp_Activate + swp_Show);
    Pointer(@OldFrameWndProc) := WinSubclassWindow(CrtWindowFrame, FrameWndProc);
  end;
end;

{ Destroy CRT window if required }

procedure DoneWinCrt;
begin
  if Created then WinDestroyWindow(CrtWindow);
  Halt(0);
end;

{ WinCrt unit exit procedure }

procedure ExitWinCrt; far;
var
  Message: QMsg;
begin
  ExitProc := SaveExit;
  if Created and (ErrorAddr = nil) then
  begin
    WinSetWindowText(CrtWindowFrame, InactiveTitle);
    EnableSysMenuItem(sc_Close, True);
    CheckBreak := False;
    while WinGetMsg(Anchor, Message, 0, 0, 0) do WinDispatchMsg(Anchor, Message);
  end;
end;

begin
  Anchor := WinInitialize(0);
  MsgQue := WinCreateMsgQueue(Anchor, 0);
  if MsgQue = 0 then Halt(254);
  WinRegisterClass(Anchor, CrtClassName, CrtWinProc, cs_SizeRedraw, 0);
  AssignCrt(Input);
  Reset(Input);
  AssignCrt(Output);
  Rewrite(Output);
  GetArgStr(WindowTitle, 0, SizeOf(WindowTitle));
  StrPCopy(InactiveTitleBuf, '(Inactive ' + ParamStr(0) + ')');
  SaveExit := ExitProc;
  ExitProc := @ExitWinCrt;
end.