PC-X 1998 March/pcx19_9803.iso/PC-XUSER/PC-XUSER.14/OOP/PCX_DLG.PAS

Pascal/Delphi Source File | 1998-02-09 | 13.5 KB | 449 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}

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;


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

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;


END.