PC-X 1998 July/pcx23_9807.iso/PC-XUSER/PC-XUSER.16/OOP/PCX_DLG.PAS

Pascal/Delphi Source File | 1998-04-13 | 36.7 KB | 1,303 lines

{*******************************************************}
{                                                       }
{   PC-X User Dialogs for Turbo Vision                  }
{   Copyright (c) 1997 By PC-X User and Bérczi László   }
{                                                       }
{   Portions Copyright (c) 1990 by Borland Int.         }
{*******************************************************}
{Last Edit: 1997 II 15. 21:00}
{$X+,V-,F+,O-,S+,Q-}

{Lásd a file végét a szerzô megállapodás véget ! - Licens agreements.}

unit PCX_Dlg;

INTERFACE
uses Objects, Dialogs, Drivers, Menus, Views;

const

  GFrameCornerLU         = #193;   {┌}                     {Corner=Sarok  }
  GFrameCornerRU         = #194;   {┐}                     {L=Left;R=Right}
  GFrameCornerLD         = #195;   {└}                     {U=Up  ;D=Down }
  GFrameCornerRD         = #197;   {┘}
  GFrameSummitU          = #198;   {─}                     {Summit=Tetô   }
  GFrameSummitD          = #199;   {─}
  GFrameEdgeL            = #200;   {│}                     {Edge=Szél(e)  }
  GFrameEdgeR            = #201;   {│}

  CheckBoxCenterN  =  #203; {' '}
  CheckBoxCenterX  =  #204; {'X'}
  CheckBoxLeft     =  #202; {'['}
  CheckBoxRight    =  #181; {']'}
  RadioButtonCenterN = #207; {' '}
  RadioButtonCenterX = #206; { #7}
  RadioButtonLeft    = #205; {'('}
  RadioButtonRight   = #182; {')'}

  cmMouseChanged       = 1003;
  cmCheckBoxChanged    = 1004;
  cmRadioButtonChanged = 1005;
  cmViewChanged        = 1006;
  cmMove               = 1007;
  cmRefresh            = 1008;
  cmPCXFrameChanged    = 1009;

{ Color palettes }

  {CPCXDialogs}
  CPCXBlueDialog =
    #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79+                {  1- 16}
    #80#81#82#83#84#85#86#87#88#89#90#91#92#92#94#95+                { 17- 32}
    #96#97#98#99#100;                                                { 33- 37}
    {#64-#100}
  CPCXRedDialog  =
    #101#102#103#104#105#106#107#108#109#110#111#112#113#114#115#116+{  1- 16}
    #117#118#119#120#121#122#123#124#125#126#127#128#129#130#131#132+{ 17- 32}
    #133#134#135#136#137;                                            { 33- 37}
    {#101-#137}
  CPCXGrayDialog =
    #138#139#140#141#142#143#144#145#146#147#148#149#150#151#152#153+{  1- 16}
    #154#155#156#157#158#159#160#161#162#163#164#165#166#167#168#169+{ 17- 32}
    #170#171#172#173#174;                                            { 33- 37}
    {#138-#174}
  CPCXDialog     = CGrayDialog+#170#171#172#173#174;

  {CPCXWindows}
  CPCXWindow     = CPCXDialog;
  CPCXBlueWindow = CPCXBlueDialog;
  CPCXRedWindow  = CPCXRedDialog;
  CPCXGrayWindow = CPCXGrayDialog;

  CPCXIndicator  = #2#37#3#37;
  CPCXFileEditor = #6#4;

  CPCXTitleBar      = #175;
  CPCXControlBoxApp = #175;
  CPCXControlBoxDlg = #34;
  CPCXControlBoxWin = #34;

  CPCXFrame = #1#33#2#34#36#37#35; {CFrame + DragWindow + DragTitle}
  CPCXScrollBar = #4#5#4#5; {CSrollBar + CMyScroolBox}

type
  PString = OBJECTS.PString;

  PPCXPoint = ^TPCXPoint;
  TPCXPoint = Object(TPoint)
    procedure Assign(XA, YA: Integer);
  end;

  PPCXMenuBox = ^TPCXMenuBox;
  TPCXMenuBox = Object(TMenuBox)
    procedure Draw; virtual;
  end;

  PPCXControlBox = ^TPCXControlBox;
  TPCXControlBox = Object(TStaticText)
    constructor Init(P: TPCXPoint);
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure ExecControlMenuBox; virtual;
  private
    ControlMenuBox: PPCXMenuBox;
  end;

  PPCXControlBoxApp = ^TPCXControlBoxApp;
  TPCXControlBoxApp = Object(TPCXControlBox)
    function  GetPalette: PPalette; virtual;
    procedure ExecControlMenuBox; virtual;
  end;

  PPCXControlBoxDlg = ^TPCXControlBoxDlg;
  TPCXControlBoxDlg = Object(TPCXControlBox)
    function  GetPalette: PPalette; virtual;
    procedure ExecControlMenuBox; virtual;
  end;

  PPCXControlBoxWin = ^TPCXControlBoxWin;
  TPCXControlBoxWin = Object(TPCXControlBox)
    function  GetPalette: PPalette; virtual;
    procedure ExecControlMenuBox; virtual;
  end;

  PPCXMenuBar = ^TPCXMenuBar;
  TPCXMenuBar = Object(TMenuBar)
    function NewSubView(var Bounds: TRect; AMenu: PMenu;
      AParentMenu: PMenuView): PMenuView; virtual;
  end;

  TPCXScrollChars = Array[0..5] of Char;

  PPCXScrollBar = ^TPCXScrollBar;
  TPCXScrollBar = Object(TScrollBar)
    constructor Init(var Bounds: TRect);
    procedure Draw; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function  GetPalette: PPalette; virtual;
  private
    Chars: TPCXScrollChars;
    TempB: Byte;
    IsHorizontal: Boolean;
    procedure DrawPos(Pos: Integer);
    function GetPos: Integer;
    function GetSize: Integer;
  end;

  PPCXFrame = ^TPCXFrame;
  TPCXFrame = Object(TFrame)
    procedure Draw; virtual;
    function  GetPalette: PPalette; virtual;
  private
    FrameMode: Word;
  end;

  PPCXWindow = ^TPCXWindow;
  TPCXWindow = Object(TWindow)
    constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
    procedure InitFrame; virtual;
    procedure Draw; virtual;
    function  GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function  StandardScrollBar(AOptions: Word): PPCXScrollBar;
  private
    ControlBoxWin: PPCXControlBoxWin;
  end;

  PPCXBlueWindow = ^TPCXBlueWindow;
  TPCXBlueWindow = Object(TPCXWindow)
    function  GetPalette: PPalette; virtual;
  end;

  PPCXRedWindow = ^TPCXRedWindow;
  TPCXRedWindow = Object(TPCXWindow)
    function  GetPalette: PPalette; virtual;
  end;

  PPCXGrayWindow = ^TPCXGrayWindow;
  TPCXGrayWindow = Object(TPCXWindow)
    function  GetPalette: PPalette; virtual;
  end;

  PPCXDialog = ^TPCXDialog;
  TPCXDialog = Object(TDialog)
    constructor Init(var Bounds: TRect; ATitle: TTitleStr);
    procedure InitFrame; virtual;
    procedure Draw; virtual;
    function  GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  private
    ControlBoxDlg: PPCXControlBoxDlg;
  end;

  PPCXBlueDialog = ^TPCXBlueDialog;
  TPCXBlueDialog = Object(TPCXDialog)
    function  GetPalette: PPalette; virtual;
  end;

  PPCXRedDialog = ^TPCXRedDialog;
  TPCXRedDialog = Object(TPCXDialog)
    function  GetPalette: PPalette; virtual;
  end;

  PPCXGrayDialog = ^TPCXGrayDialog;
  TPCXGrayDialog = Object(TPCXDialog)
    function  GetPalette: PPalette; virtual;
  end;

  PPCXStaticText = ^TPCXStaticText;
  TPCXStaticText = Object(TStaticText)
     procedure SetText(AText: String); virtual;
  end;

  PPCXButton = ^TPCXButton;
  TPCXButton = Object(TButton)
    procedure Draw; virtual;
    procedure DrawView;
    procedure DrawState(Down: Boolean); virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  private
    procedure DrawCursor;
    procedure ResetCursor; virtual;
  end;


const
  IsMagyarul : Boolean = False;
  IsIntensity: Boolean = False;
  ShowMouseOn: Boolean = True;
  IsHomokOra : Boolean = False;
  On  = True;
  Off = False;
  Be  = True;
  Ki  = False;

  {Bit flags to determine how to draw the frame icons}
  fmCloseClicked = $0001;
  fmZoomClicked  = $0002;

  {PCXScrollBar}
  sbGraphLike = $0004;
  sbTextLike  = $0008;

IMPLEMENTATION
uses App, PCX_Util;

const
  FrameEmpty: String[80] =  '                                        '+
                            '                                        ';
  FrameFull : String[80] =  '████████████████████████████████████████'+
                            '████████████████████████████████████████';
  GFrameUp  : String[80] =  '╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞'+
                            '╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞╞';
  FrameUp   : String[80] =  '▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀'+
                            '▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀';
  GFrameDown: String[80] =  '╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟'+
                            '╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟╟';
  FrameDown : String[80] =  '████████████████████████████████████████'+
                            '████████████████████████████████████████';

  WindowSizer: String[2] = #210#14; {'─┘'}
  ControlBox : String[2] = #209#180;{'[■]'}
  UpWin      : String[2] = #214#11;
  RestoreWin : String[2] = #9#10;
  GFrame3DConers: Array[0..1] of Char = #221#222;
  PasswordChar  : Byte = 42; {'*' = #42}

{TPCXPoint}
procedure TPCXPoint.Assign(XA, YA: Integer);
begin
  X:=XA; Y:=YA;
end;

{TPCXMenuBox}
procedure TPCXMenuBox.Draw;
var
  CNormal, CSelect, CNormDisabled, CSelDisabled, Color: Word;
  Y: Integer;
  P: PMenuItem;
  B: TDrawBuffer;

procedure FrameLine(N: Integer);
const
     FrameChars: Array[0..19] of Char = ' ┌─┐  └─┘  │ │  ├─┤ ';
  PCXFrameChars: Array[0..19] of Char =
    GFrameCornerLU+GFrameSummitU+GFrameSummitU+GFrameSummitU+GFrameCornerRU+
    GFrameCornerLD+GFrameSummitD+GFrameSummitD+GFrameSummitD+GFrameCornerRD+
    GFrameEdgeL+#32#32#32+GFrameEdgeR+
    GFrameEdgeL+#32#196#32+GFrameEdgeR; {'┴╞╞╞┬├╟╟╟┼╚   ╔╚ ─ ╔'}
begin
  if IsPCXGraphCharsOn
  then begin
         MoveBuf(B[0], PCXFrameChars[N], Byte(CNormal), 2);
         MoveChar(B[2], PCXFrameChars[N + 2], Byte(Color), Size.X - 4);
         MoveBuf(B[Size.X - 2], PCXFrameChars[N + 3], Byte(CNormal), 2);
       end
  else begin
         MoveBuf(B[0], FrameChars[N], Byte(CNormal), 2);
         MoveChar(B[2], FrameChars[N + 2], Byte(Color), Size.X - 4);
         MoveBuf(B[Size.X - 2], FrameChars[N + 3], Byte(CNormal), 2);
       end;
end;

procedure DrawLine;
begin
  WriteBuf(0, Y, Size.X, 1, B);
  Inc(Y);
end;

begin
  CNormal := GetColor($0301);
  CSelect := GetColor($0604);
  CNormDisabled := GetColor($0202);
  CSelDisabled := GetColor($0505);
  Y := 0;
  Color := CNormal;
  FrameLine(0);
  DrawLine;
  if Menu <> nil then
  begin
    P := Menu^.Items;
    while P <> nil do
    begin
      Color := CNormal;
      if P^.Name = nil then FrameLine(15) else
      begin
        if P^.Disabled then
          if P = Current then
            Color := CSelDisabled else
            Color := CNormDisabled else
          if P = Current then Color := CSelect;
        FrameLine(10);
        MoveCStr(B[3], P^.Name^, Color);
        if P^.Command = 0 then
          MoveChar(B[Size.X - 4], #16, Byte(Color), 1) else
          if P^.Param <> nil then
            MoveStr(B[Size.X - 3 - Length(P^.Param^)],
              P^.Param^, Byte(Color));
      end;
      DrawLine;
      P := P^.Next;
    end;
  end;
  Color := CNormal;
  FrameLine(5);
  DrawLine;
  Message(Application, evCommand, cmMouseChanged, @Self);
end;

{TPCXControlBox}
constructor TPCXControlBox.Init(P: TPCXPoint);
var
  R    : TRect;
  TempS: String;
begin
  ControlMenuBox:=nil;
  R.A.X:=P.X; R.A.Y:=P.Y;
              R.B.Y:=R.A.Y+1;
  if IsPCXGraphCharsOn
  then begin
         R.B.X:=2;
         TempS:=ControlBox;
        end
  else begin
         R.B.X:=3;
         TempS:='[■]';
       end;
  Inherited Init(R, TempS);
end;

procedure TPCXControlBox.HandleEvent(var Event: TEvent);
begin
  ExecControlMenuBox;
  Inherited HandleEvent(Event);
end;

procedure TPCXControlBox.ExecControlMenuBox;
begin
  Abstract;
end;

procedure TPCXControlBoxApp.ExecControlMenuBox;
var
  R    : TRect;
  O    : TPCXPoint;
  C    : Word;
  Event: TEvent;
begin
  O.Assign(0,0);
  MakeGlobal(O, O);
  R.Assign(O.X,O.Y+1,O.X+18,O.Y+7);
  if IsMagyarul then
  begin
    Inc(R.A.X, 2);
    Inc(R.B.X, 2);
  end;
  if Not IsMagyarul then
  New(ControlMenuBox, Init(R, NewMenu(
    NewItem('~M~ove', 'Crt-F5', kbCtrlF5, cmMove, hcNoContext,
    NewItem('~Q~uit', 'Alt- X', kbAltQ, cmQuit, hcNoContext,
    NewLine(
    NewItem('~R~efresh', '', kbNoKey, cmRefresh, hcNoContext, nil))))),
    nil))           else
  New(ControlMenuBox, Init(R, NewMenu(
    NewItem('~M~ozgat', 'Crt-F5', kbCtrlF5, cmMove, hcNoContext,
    NewItem('~K~ilépés', 'Alt- X', kbAltQ, cmQuit, hcNoContext,
    NewLine(
    NewItem('~F~rissítés', '', kbNoKey, cmRefresh, hcNoContext, nil))))),
    nil));
  C:=Application^.ExecView(ControlMenuBox);
  if C<>cmCancel then
  begin
    case C of cmMove:
              begin
                {Application^.GetEvent(Event);
                Event.What:=evKeyboard;
                Application^.PutEvent(Event);}
                KeyStrokeToKeyboardBuffer(0, $62);
                Message(Application, evCommand, cmMouseChanged, @Self);
              end;
              cmRefresh: Application^.ReDraw;
              cmQuit:  {if AreYouSureToQuit then} Message(Application, evCommand, cmQuit, @Self);
    {javit!}


    end;
  end;
end;

function  TPCXControlBoxApp.GetPalette: PPalette;
const P: String[Length(CPCXControlBoxApp)] = CPCXControlBoxApp;
begin
  GetPalette:=@P;
end;

procedure TPCXControlBoxDlg.ExecControlMenuBox;
var
  R    : TRect;
  O    : TPCXPoint;
  C    : Word;
  Event: TEvent;
begin
  O.Assign(1,0);
  MakeGlobal(O, O);
  R.Assign(O.X,O.Y+1,O.X+18,O.Y+7);
  if IsMagyarul then
  begin
    Inc(R.A.X);
    Inc(R.B.X);
  end;
  if IsMagyarul then
  New(ControlMenuBox, Init(R, NewMenu(
    NewItem('~M~ozgat', 'Crt-F5', kbCtrlF5, cmMove, hcNoContext,
    NewItem('~B~ezár', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
    NewLine(
    NewItem('~F~rissít', '', kbNoKey, cmRefresh, hcNoContext, nil))))),
    nil))           else
  New(ControlMenuBox, Init(R, NewMenu(
    NewItem('~M~ove', 'Crt-F5', kbCtrlF5, cmMove, hcNoContext,
    NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
    NewLine(
    NewItem('~R~efresh', '', kbNoKey, cmRefresh, hcNoContext, nil))))),
    nil));
  C:=Application^.ExecView(ControlMenuBox);
  Owner^.EnableCommands([cmClose]);
  EnableCommands([cmClose]);
  if C<>cmCancel then
  begin
    case C of cmMove:
              begin
                {Application^.GetEvent(Event);
                Event.What:=evKeyboard;
                Application^.PutEvent(Event);}
                KeyStrokeToKeyboardBuffer(0, $62);
                Message(Application, evCommand, cmMouseChanged, @Self);
              end;
              cmRefresh: Application^.ReDraw;
              cmClose:   begin
                           KeyStrokeToKeyboardBuffer(0, $6A);
                           Message(Application, evBroadcast, cmClose, @Self);
                           Message(Application, evCommand, cmMouseChanged, @Self);
                         end;
    end;
  end;
end;

function  TPCXControlBoxDlg.GetPalette: PPalette;
const P: String[Length(CPCXControlBoxDlg)] = CPCXControlBoxDlg;
begin
  GetPalette:=@P;
end;

procedure TPCXControlBoxWin.ExecControlMenuBox;
var
  R    : TRect;
  O    : TPCXPoint;
  C    : Word;
begin
  O.Assign(1,0);
  MakeGlobal(O, O);
  R.Assign(O.X,O.Y+1,O.X+18,O.Y+7);
  Owner^.EnableCommands([cmClose]);
  EnableCommands([cmClose]);
  if IsMagyarul then
  begin
    Inc(R.A.X);
    Inc(R.B.X);
  end;
  if IsMagyarul then
  New(ControlMenuBox, Init(R, NewMenu(
    NewItem('~M~ozgat', 'Crt-F5', kbCtrlF5, cmMove, hcNoContext,
    NewItem('~B~ezár', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
    NewLine(
    NewItem('~F~rissít', '', kbNoKey, cmRefresh, hcNoContext, nil))))),
    nil))           else
  New(ControlMenuBox, Init(R, NewMenu(
    NewItem('~M~ove', 'Crt-F5', kbCtrlF5, cmMove, hcNoContext,
    NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
    NewLine(
    NewItem('~R~efresh', '', kbNoKey, cmRefresh, hcNoContext, nil))))),
    nil));
  C:=Application^.ExecView(ControlMenuBox);
  if C<>cmCancel then
  begin
    case C of cmMove:
              begin
                 KeyStrokeToKeyboardBuffer(0, $62);
                 Message(Application, evCommand, cmMouseChanged, @Self);
              end;
              cmRefresh: Application^.ReDraw;
              cmClose:
              begin
                 KeyStrokeToKeyboardBuffer(0, $6A);
                 Message(Application, evCommand, cmMouseChanged, @Self);
              end;

    end;
  end;
end;

function  TPCXControlBoxWin.GetPalette: PPalette;
const P: String[Length(CPCXControlBoxWin)] = CPCXControlBoxWin;
begin
  GetPalette:=@P;
end;

{TPCXMenuBar}
function TPCXMenuBar.NewSubView(var Bounds: TRect; AMenu: PMenu;
  AParentMenu: PMenuView): PMenuView;
begin
  NewSubView := New(PPCXMenuBox, Init(Bounds, AMenu, AParentMenu));
end;

{TPCXScrollBar}
constructor TPCXScrollBar.Init(var Bounds: TRect);
const
  {                           felb  felj   leb   lej  }
  GVChars: TPCXScrollChars = (#212, #183, #213, #184, GFrameEdgeL, GFrameEdgeR);
  GHChars: TPCXScrollChars = (#217, #21, #218, #185, #215, #215);
  VChars : TPCXScrollChars = (#30, #31, #177, #254, #178, #32); {Text, it's  }
  HChars : TPCXScrollChars = (#17, #16, #177, #254, #178, #32); {the original}
begin
  TView.Init(Bounds);
  if IsPCXGraphCharsOn then TempB:=2
                       else TempB:=1;
  Value := 0;
  Min := 0;
  Max := 0;
  PgStep := 1;
  ArStep := 1;
  if Size.X = TempB then
  begin
    GrowMode := gfGrowLoX + gfGrowHiX + gfGrowHiY;
    if IsPCXGraphCharsOn then Chars := GVChars
                         else Chars := VChars;
    IsHorizontal:=False;
  end else
  begin
    GrowMode := gfGrowLoY + gfGrowHiX + gfGrowHiY;
    if IsPCXGraphCharsOn then Chars := GHChars
                         else Chars := HChars;
    IsHorizontal:=True;
  end;
end;

procedure TPCXScrollBar.Draw;
begin
  DrawPos(GetPos);
  Message(Application, evCommand, cmMouseChanged, @Self);

  { Include it to evIdle in HandleEvent for make realtime show|hide scrollbars
  if HScrollBar <> nil then
   if HScrollBar^.Min = HScrollBar^.Max
   then HScrollBar^.Hide
   else HScrollBar^.Show;
  }
end;

procedure TPCXScrollBar.DrawPos(Pos: Integer);
var
  S: Integer;
  B: TDrawBuffer;
  i: Word;
begin
  if IsPCXGraphCharsOn then
  begin
    if Not IsHorizontal then
    begin
      S := GetSize - 1;
      MoveCStr(B[0], Chars[0], GetColor(2));
      MoveCStr(B[1], Chars[1], SwapHighAndLowAreaOfByte(GetColor(2)));
      if Max = Min then
      begin
        i:=0;
        while i<(S*2)-1 do
        begin
          Inc(I,2);
          MoveCStr(B[i], ''+Chars[4]+Chars[5]+'', GetColor(1));
        end;
      end
      else
      begin
          i:=0;
          while i<(S*2)-1 do
          begin
            Inc(i,2);
            MoveCStr(B[i], ''+Chars[4]+Chars[5]+'', GetColor(3));
            MoveCStr(B[Pos*2], ''+Chars[4]+Chars[5]+'', GetColor(4));
          end;
      end;
      MoveCStr(B[S*2], Chars[2], GetColor(2));
      MoveCStr(B[(S*2)+1], Chars[3], SwapHighAndLowAreaOfByte(GetColor(2)));
      WriteBuf(0, 0, Size.X, Size.Y, B);
    end
    else
    begin
      S := GetSize - 1;
      if Pos=1 then Inc(Pos);
      if Pos+1=S then Pos:=S-3;
      MoveCStr(B[0], Chars[0], GetColor(2));
      MoveCStr(B[1], Chars[1], SwapHighAndLowAreaOfByte(GetColor(2)));
      if Max = Min then
        MoveChar(B[2], Chars[4], GetColor(1), S - 2)
      else
      begin
        MoveChar(B[2], Chars[4], GetColor(3), S - 2);
        MoveCStr(B[Pos], Chars[5]+Chars[5], GetColor(4));
      end;
      MoveCStr(B[S-1], Chars[2], GetColor(2));
      MoveCStr(B[S], Chars[3], SwapHighAndLowAreaOfByte(GetColor(2)));
      WriteBuf(0, 0, Size.X, Size.Y, B);
    end;
  end
  else
  begin
    S := GetSize - 1;
    MoveChar(B[0], Chars[0], GetColor(2), 1);
    if Max = Min then
      MoveChar(B[1], Chars[4], GetColor(1), S - 1)
    else
    begin
      MoveChar(B[1], Chars[2], GetColor(1), S - 1);
      MoveChar(B[Pos], Chars[3], GetColor(3), 1);
    end;
    MoveChar(B[S], Chars[1], GetColor(2), 1);
    WriteBuf(0, 0, Size.X, Size.Y, B);
  end;
  Message(Application, evCommand, cmMouseChanged, @Self);
end;

procedure TPCXScrollBar.HandleEvent(var Event: TEvent);
var
  Tracking : Boolean;
  I, P,
  S,
  ClickPart: Integer;
  Mouse    : TPoint;
  Extent   : TRect;
function GetPartCode: Integer;
var
  Mark, Part: Integer;
begin
  Part := -1;
  if Extent.Contains(Mouse) then
  begin
    if Size.X = TempB then Mark := Mouse.Y else Mark := Mouse.X;
    if Mark = P then Part := sbIndicator else
    begin
      if Mark < TempB then Part := sbLeftArrow else
        if Mark < P then Part := sbPageLeft else
          if Mark < S then Part := sbPageRight else
            Part := sbRightArrow;
      if Size.X = TempB then Inc(Part, 4);
    end;
  end;
  GetPartCode := Part;
end;

procedure Clicked;
begin
  Message(Owner, evCommand, cmViewChanged, @Self);
end;

begin
  TView.HandleEvent(Event);
  case Event.What of
    evMouseDown:
      begin
        Clicked;
        MakeLocal(Event.Where, Mouse);
        GetExtent(Extent);
        Extent.Grow(1, 1);
        P := GetPos;
        S := GetSize - 1;
        ClickPart := GetPartCode;
        if ClickPart <> sbIndicator then
        begin
          repeat
            MakeLocal(Event.Where, Mouse);
            if GetPartCode = ClickPart then
              SetValue(Value + ScrollStep(ClickPart));
          until not MouseEvent(Event, evMouseAuto);
        end else
        begin
          repeat
            MakeLocal(Event.Where, Mouse);
            Tracking := Extent.Contains(Mouse);
            if Tracking then
            begin
              if Size.X = TempB then I := Mouse.Y else I := Mouse.X;
              if I <= 0 then I := 1;
              if I >= S then I := S - 1;
            end else I := GetPos;
            if I <> P then
            begin
              DrawPos(I);
              P := I;
            end;
          until not MouseEvent(Event, evMouseMove);
          if Tracking and (S > 2) then
          begin
            Dec(S, 2);
            SetValue(LongDiv(LongMul(P - 1, Max - Min) + S shr 1, S) + Min);
          end;
        end;
        ClearEvent(Event);
      end;
    evKeyDown:
      if State and sfVisible <> 0 then
      begin
        ClickPart := sbIndicator;
        if Size.Y = 1 then
          case CtrlToArrow(Event.KeyCode) of
            kbLeft: ClickPart := sbLeftArrow;
            kbRight: ClickPart := sbRightArrow;
            kbCtrlLeft: ClickPart := sbPageLeft;
            kbCtrlRight: ClickPart := sbPageRight;
            kbHome: I := Min;
            kbEnd: I := Max;
          else
            Exit;
          end
        else
          case CtrlToArrow(Event.KeyCode) of
            kbUp: ClickPart := sbUpArrow;
            kbDown: ClickPart := sbDownArrow;
            kbPgUp: ClickPart := sbPageUp;
            kbPgDn: ClickPart := sbPageDown;
            kbCtrlPgUp: I := Min;
            kbCtrlPgDn: I := Max;
          else
            Exit;
          end;
        Clicked;
        if ClickPart <> sbIndicator then I := Value + ScrollStep(ClickPart);
        SetValue(I);
        ClearEvent(Event);
      end;
  end;
end;

function TPCXScrollBar.GetPalette: PPalette;
const P: String[Length(CPCXScrollBar)] = CPCXScrollBar;
begin
  GetPalette:=@P;
end;

function TPCXScrollBar.GetPos: Integer;
var
  R: Integer;
begin
  R := Max - Min;
  if R = 0 then
    GetPos := 1 else
    GetPos := LongDiv(LongMul(Value - Min, GetSize - 3) + R shr 1, R) + 1;
end;

function TPCXScrollBar.GetSize: Integer;
var
  S: Integer;
begin
  if Size.X = TempB then S := Size.Y else S := Size.X;
  if S < 2+TempB then GetSize := 2+TempB else GetSize := S;
end;

{TPCXFrame}
procedure TPCXFrame.Draw;
var
  CFrame, CTitle: Word;
  F, I, L, Width: Integer;
  B: TDrawBuffer;
  Title: TTitleStr;
  Min, Max: TPoint;
begin
  if State and sfDragging <> 0 then
  begin
    CFrame := $0706;
    CTitle := $0007;
    F := 0;
  end else if State and sfActive = 0 then
  begin
    CFrame := $0101;
    CTitle := $0002;
    F := 0;
  end else
  begin
    CFrame := $0503;
    CTitle := $0004;
    F := 9;
  end;
  CFrame := GetColor(CFrame);
  CTitle := GetColor(CTitle);
  Width := Size.X;
  L := Width - 10;
  if PWindow(Owner)^.Flags and (wfClose+wfZoom) <> 0 then Dec(L,6);
  if IsPCXGraphCharsOn then MoveCStr(B, Copy(FrameEmpty, 1, Size.X), CTitle)
                       else MoveCStr(B, Copy(FrameEmpty, 1, Size.X), CTitle);
  if (PWindow(Owner)^.Number <> wnNoNumber) and
     (PWindow(Owner)^.Number < 10) then
  begin
    Dec(L,4);
    if PWindow(Owner)^.Flags and wfZoom <> 0 then I := 7
    else I := 3;
    WordRec(B[Width - I]).Lo := PWindow(Owner)^.Number + $30;
  end;
  if Owner <> nil then Title := PWindow(Owner)^.GetTitle(L)
  else Title := '';
  if Title <> '' then
  begin
    L := Length(Title);
    if L > Width - 10 then L := Width - 10;
    if L < 0 then L := 0;
    I := (Width - L) shr 1;
    MoveChar(B[I - 1], ' ', CTitle, 1);
    MoveBuf(B[I], Title[1], CTitle, L);
    MoveChar(B[I + L], ' ', CTitle, 1);
  end;
  if State and sfActive <> 0 then
  begin
    if PWindow(Owner)^.Flags and wfClose <> 0 then
      if FrameMode and fmCloseClicked = 0 then
        if IsPCXGraphCharsOn then MoveCStr(B[0], '~'+ControlBox+'~', CFrame) {#209#180}
                             else MoveCStr(B[1], '', CFrame) {~[■]~}
      else MoveCStr(B[2], '[~'#15'~]', CFrame);
    if PWindow(Owner)^.Flags and wfZoom <> 0 then
    begin
      if IsPCXGraphCharsOn then MoveCStr(B[Width - 4], '~'+UpWin+'~', CFrame)
                           else MoveCStr(B[Width - 4], '~['#24']~', CFrame);
      Owner^.SizeLimits(Min, Max);
      if FrameMode and fmZoomClicked <> 0 then
        WordRec(B[Width - 4]).Lo := 15
      else if Longint(Owner^.Size) = Longint(Max) then
      begin
        if IsPCXGraphCharsOn then MoveCStr(B[Width - 4], '~'+RestoreWin+'~', CFrame)
                             else MoveCStr(B[Width - 4], '~['#18']~', CFrame);
      end;
    end;
  end;
  WriteLine(0, 0, Size.X, 1, B);
  for I := 1 to Size.Y - 2 do
  begin
    if IsPCXGraphCharsOn then MoveCStr(B, GFrameEdgeL+Copy(FrameEmpty, 1, Size.X-2)+GFrameEdgeR, CFrame)
                         else MoveCStr(B, #221+Copy(FrameEmpty, 1, Size.X-2)+#222, CFrame);
    WriteLine(0, I, Size.X, 1, B);
  end;
  if IsPCXGraphCharsOn then MoveCStr(B, GFrameCornerLD+Copy(GFrameDown, 1, Size.X-2)+GFrameCornerRD, CFrame)
                       else MoveCStr(B, {#221+} Copy(FrameDown{FrameFull}, 1, Size.X) {+#222}, CFrame);
  if State and sfActive <> 0 then
    if PWindow(Owner)^.Flags and wfGrow <> 0 then
      if IsPCXGraphCharsOn then MoveCStr(B[Width - 2], WindowSizer, CFrame) {#210#211}
                           else MoveCStr(B[Width - 2], '~─┘~', CFrame);
  WriteLine(0, Size.Y - 1, Size.X, 1, B);
  Message(Application, evCommand, cmMouseChanged, @Self);
  Message(Application, evCommand, cmPCXFrameChanged, @Self);
  Message(Application, evBroadcast, cmPCXFrameChanged, @Self);
end;

function  TPCXFrame.GetPalette: PPalette;
const P: String[Length(CPCXFrame)] = CPCXFrame;
begin
  GetPalette:=@P;
end;

{TPCXWindow}
constructor TPCXWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
var P: TPCXPoint;
begin
  Inherited Init(Bounds, ATitle, ANumber);
  P.Assign(0, 0);
  New(ControlBoxWin, Init(P));
  Insert(ControlBoxWin);
end;

procedure TPCXWindow.InitFrame;
var R: TRect;
begin
  GetExtent(R);
  Frame := New(PPCXFrame, Init(R));
end;

procedure TPCXWindow.Draw;
begin
  Inherited Draw;
  Message(Application, evCommand, cmMouseChanged, @Self);
end;

function  TPCXWindow.GetPalette: PPalette;
const P: String[Length(CPCXWindow)] = CPCXWindow;
begin
  GetPalette:=@P;
end;

procedure TPCXWindow.HandleEvent(var Event: TEvent);
begin
  if Event.KeyCode=kbAltSpace then
  begin
    ControlBoxWin^.ExecControlMenuBox;
    Event.KeyCode:=Event.KeyCode and Not kbAltSpace;
  end;
  Inherited HandleEvent(Event);
end;

function TPCXWindow.StandardScrollBar(AOptions: Word): PPCXScrollBar;
var
  R: TRect;
  S: PPCXScrollBar;
begin
  GetExtent(R);
  if AOptions and sbGraphLike = 0
  then if AOptions and sbVertical = 0
       then R.Assign(R.A.X + 2, R.B.Y-1, R.B.X-2, R.B.Y)
       else R.Assign(R.B.X-1,R.A.Y+1,R.B.X,R.B.Y-1)
  else if AOptions and sbVertical = 0
       then R.Assign(R.A.X + 2, R.B.Y-1, R.B.X-2, R.B.Y)
       else R.Assign(R.B.X-2,R.A.Y+1,R.B.X,R.B.Y-1);
  S := New(PPCXScrollBar, Init(R));
  Insert(S);
  if AOptions and sbHandleKeyboard <> 0
  then S^.Options := S^.Options or ofPostProcess;
  StandardScrollBar := S;
end;

{TPCXXXXXWindows}
function  TPCXBlueWindow.GetPalette: PPalette;
const P: String[Length(CPCXBlueWindow)] = CPCXBlueWindow;
begin
  GetPalette:=@P;
end;

function  TPCXRedWindow.GetPalette: PPalette;
const P: String[Length(CPCXRedWindow)] = CPCXRedWindow;
begin
  GetPalette:=@P;
end;

function  TPCXGrayWindow.GetPalette: PPalette;
const P: String[Length(CPCXGrayWindow)] = CPCXGrayWindow;
begin
  GetPalette:=@P;
end;

{TPCXDialog}
constructor TPCXDialog.Init(var Bounds: TRect; ATitle: TTitleStr);
var P: TPCXPoint;
begin
  Inherited Init(Bounds, ATitle);
  P.Assign(0,0);
  New(ControlBoxDlg, Init(P));
  Insert(ControlBoxDlg);
end;

procedure TPCXDialog.InitFrame;
var
  R: TRect;
begin
  GetExtent(R);
  Frame := New(PPCXFrame, Init(R));
end;

procedure TPCXDialog.Draw;
begin
  Inherited Draw;
  Message(Application, evCommand, cmMouseChanged, @Self);
end;

function  TPCXDialog.GetPalette: PPalette;
const P: String[Length(CPCXDialog)] = CPCXDialog;
begin
  GetPalette:=@P;
end;

procedure TPCXDialog.HandleEvent(var Event: TEvent);
begin
  if Event.KeyCode=kbAltSpace then
  begin
    ControlBoxDlg^.ExecControlMenuBox;
    Event.KeyCode:=Event.KeyCode and Not kbAltSpace;
  end;
  Inherited HandleEvent(Event);
end;

function  TPCXBlueDialog.GetPalette: PPalette;
const P: String[Length(CPCXBlueDialog)] = CPCXBlueDialog;
begin
  GetPalette:=@P;
end;

function  TPCXRedDialog.GetPalette: PPalette;
const P: String[Length(CPCXRedDialog)] = CPCXRedDialog;
begin
  GetPalette:=@P;
end;

function  TPCXGrayDialog.GetPalette: PPalette;
const P: String[Length(CPCXGrayDialog)] = CPCXGrayDialog;
begin
  GetPalette:=@P;
end;

{TPCXStaticText}
procedure TPCXStaticText.SetText(AText: String);
begin
  if Text<>nil then DisposeStr(Text);   {Idea: By Bérczi Gábor, Power INC.}
  if AText<>'' then Text:=NewStr(AText) {      TOO . . .                  }
               else Text:=Nil;          {      TOO . . .                  }
  Draw;
  Message(Application, evCommand, cmMouseChanged, @Self);
end;

{TPCXButton}
procedure TPCXButton.Draw;
begin
  DrawState(False);
  Message(Application, evCommand, cmMouseChanged, @Self);
end;

procedure TPCXButton.DrawState(Down: Boolean);
var
  CButton, CShadow: Word;
  Ch: Char;
  I, S, Y, T: Integer;
  B: TDrawBuffer;

procedure DrawTitle;
var
  L, SCOff: Integer;
begin
  if Flags and bfLeftJust <> 0 then L := 1 else
  begin
    L := (S - CStrLen(Title^) - 1) div 2;
    if L < 1 then L := 1;
  end;
  MoveCStr(B[I + L], Title^, CButton);
  if ShowMarkers and not Down then
  begin
    if State and sfSelected <> 0 then SCOff := 0 else
      if AmDefault then SCOff := 2 else SCOff := 4;
    WordRec(B[0]).Lo := Byte(SpecialChars[SCOff]);
    WordRec(B[S]).Lo := Byte(SpecialChars[SCOff + 1]);
  end;
end;

begin
  if State and sfDisabled <> 0 then CButton := GetColor($0404) else
  begin
    CButton := GetColor($0501);
    if State and sfActive <> 0 then
      if State and sfSelected <> 0 then CButton := GetColor($0703) else
        if AmDefault then CButton := GetColor($0602);
  end;
  CShadow := GetColor(8);
  S := Size.X - 1;
  T := Size.Y div 2 - 1;
  for Y := 0 to Size.Y - 2 do
  begin
    MoveChar(B, ' ', Byte(CButton), Size.X);
    WordRec(B[0]).Hi := CShadow;
    if Down then
    begin
      WordRec(B[1]).Hi := CShadow;
      Ch := ' ';
      I := 2;
    end else
    begin
      if ShowMarkers then WordRec(B[S]).Hi := Byte(CShadow)
                     else WordRec(B[S]).Hi := SwapHighAndLowAreaOfByte(Byte(CShadow)); {from PCX_Util}
      if ShowMarkers then Ch := ' ' else
      begin
        if Y = 0 then
          WordRec(B[S]).Lo := Byte('▀') else {#223 invert = #220}
          WordRec(B[S]).Lo := Byte('█');
        Ch := '▀';
      end;
      I := 1;
    end;
    if (Y = T) and (Title <> nil) then DrawTitle;
    if ShowMarkers and not Down then
    begin
      WordRec(B[1]).Lo := Byte('[');
      WordRec(B[S - 1]).Lo := Byte(']');
    end;
    WriteLine(0, Y, Size.X, 1, B);
  end;
  MoveChar(B[0], ' ', Byte(CShadow), 2);
  MoveChar(B[2], Ch, Byte(CShadow), S - 1);
  WriteLine(0, Size.Y - 1, Size.X, 1, B);
end;

function HotKey(const S: String): Char;
var
  P: Word;
begin
  P := Pos('~',S);
  if P <> 0 then HotKey := UpCase(S[P+1])
  else HotKey := #0;
end;

const

{ TButton messages }

  cmGrabDefault    = 61;
  cmReleaseDefault = 62;

procedure TPCXButton.HandleEvent(var Event: TEvent);
var
  Down: Boolean;
  C: Char;
  Mouse: TPoint;
  ClickRect: TRect;
begin
  GetExtent(ClickRect);
  Inc(ClickRect.A.X);
  Dec(ClickRect.B.X);
  Dec(ClickRect.B.Y);
  if Event.What = evMouseDown then
  begin
    MakeLocal(Event.Where, Mouse);
    if not ClickRect.Contains(Mouse) then ClearEvent(Event);
  end;
  if Flags and bfGrabFocus <> 0 then
    TView.HandleEvent(Event);
  case Event.What of
    evMouseDown:
      begin
        if State and sfDisabled = 0 then
        begin
          Inc(ClickRect.B.X);
          Down := False;
          repeat
            MakeLocal(Event.Where, Mouse);
            if Down <> ClickRect.Contains(Mouse) then
            begin
              Down := not Down;
              DrawState(Down);
            end;
          until not MouseEvent(Event, evMouseMove);
          if Down then
          begin
            Press;
            DrawState(False);
          end;
        end;
        ClearEvent(Event);
      end;
    evKeyDown:
      begin
        C := HotKey(Title^);
        if (Event.KeyCode = GetAltCode(C)) or
          (Owner^.Phase = phPostProcess) and (C <> #0) and
            (Upcase(Event.CharCode) = C) or
          (State and sfFocused <> 0) and (Event.CharCode = ' ') then
        begin
          Press;
          ClearEvent(Event);
        end;
      end;
    evBroadcast:
      case Event.Command of
        cmDefault:
          if AmDefault then
          begin
            Press;
            ClearEvent(Event);
          end;
        cmGrabDefault, cmReleaseDefault:
          if Flags and bfDefault <> 0 then
          begin
            AmDefault := Event.Command = cmReleaseDefault;
            DrawView;
          end;
        cmCommandSetChanged:
          begin
            SetState(sfDisabled, not CommandEnabled(Command));
            DrawView;
          end;
      end;
  end;
end;

procedure TPCXButton.ResetCursor; assembler;
asm
        LES     DI,Self
        MOV     AX,ES:[DI].TPCXButton.State
        NOT     AX
        TEST    AX,sfVisible+sfCursorVis+sfFocused
        JNE     @@4
        MOV     AX,ES:[DI].TView.Cursor.Y
        MOV     DX,ES:[DI].TView.Cursor.X
@@1:    OR      AX,AX
        JL      @@4
        CMP     AX,ES:[DI].TPCXButton.Size.Y
        JGE     @@4
        OR      DX,DX
        JL      @@4
        CMP     DX,ES:[DI].TPCXButton.Size.X
        JGE     @@4
        ADD     AX,ES:[DI].TPCXButton.Origin.Y
        ADD     DX,ES:[DI].TPCXButton.Origin.X
        MOV     CX,DI
        MOV     BX,ES
        LES     DI,ES:[DI].TPCXButton.Owner
        MOV     SI,ES
        OR      SI,DI
        JE      @@5
        TEST    ES:[DI].TPCXButton.State,sfVisible
        JE      @@4
        LES     DI,ES:[DI].TGroup.Last
@@2:    LES     DI,ES:[DI].TPCXButton.Next
        CMP     CX,DI
        JNE     @@3
        MOV     SI,ES
        CMP     BX,SI
        JNE     @@3
        LES     DI,ES:[DI].TPCXButton.Owner
        JMP     @@1
@@3:    TEST    ES:[DI].TPCXButton.State,sfVisible
        JE      @@2
        MOV     SI,ES:[DI].TPCXButton.Origin.Y
        CMP     AX,SI
        JL      @@2
        ADD     SI,ES:[DI].TPCXButton.Size.Y
        CMP     AX,SI
        JGE     @@2
        MOV     SI,ES:[DI].TPCXButton.Origin.X
        CMP     DX,SI
        JL      @@2
        ADD     SI,ES:[DI].TPCXButton.Size.X
        CMP     DX,SI
        JGE     @@2
@@4:    MOV     CX,2000H
        JMP     @@6
@@5:    MOV     DH,AL
        XOR     BH,BH
        MOV     AH,2
        INT     10H
        MOV     CX,CursorLines
        LES     DI,Self
        TEST    ES:[DI].TPCXButton.State,sfCursorIns
        JE      @@6
        MOV     CH,0
        OR      CL,CL
        JNE     @@6
        MOV     CL,7
@@6:    MOV     AH,1
        INT     10H
end;

procedure TPCXButton.DrawCursor;
begin
  if State and sfFocused <> 0 then ResetCursor;
end;


procedure TPCXButton.DrawView;
begin
  if Exposed then
  begin
    Draw;
    DrawCursor;
  end;
end;


END.