freepascal.compiler/packages/fv/examples/testuapp.pas

program testuapp;

{$codepage UTF8}
{$h-}

uses
  Objects, UDrivers, UViews, UMenus, UDialogs, UApp, UMsgBox, UInpLong, UTabs, SysUtils;

const
  cmOrderNew    = 200;
  cmOrderWin    = 201;
  cmOrderSave   = 202;
  cmOrderCancel = 203;
  cmOrderNext   = 204;
  cmOrderPrev   = 205;
  cmClipShow    = 210;
  cmAbout       = 220;
  cmFindOrderWindow = 1002;
  cmWindow3     = 1003;
  cmOptionsVideo = 1502;
  cmOptionsSave  = 1503;
  cmOptionsLoad  = 1504;

type

  { TMyUnicodeApp }

  TMyUnicodeApp = object(TApplication)
    P3 : PGroup;
    procedure HandleEvent(var Event : TEvent);virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
    procedure Window3;
    procedure ShowAboutBox;
  end;

var
  MyUnicodeApp: TMyUnicodeApp;

{ TMyUnicodeApp }

procedure TMyUnicodeApp.HandleEvent(var Event: TEvent);
begin
  inherited HandleEvent(Event);
  if Event.What = evCommand then
  begin
    case Event.Command of
      cmWindow3:
        Window3;
      cmAbout:
        ShowAboutBox;
      else
        Exit;
    end;
  end;
  ClearEvent(Event);
end;

procedure TMyUnicodeApp.InitMenuBar;
var
  R: TRect;
begin
  GetExtent(R);
  R.B.Y := R.A.Y + 1;
  MenuBar := new (PMenuBar, Init(R, NewMenu(
                 NewSubMenu('打开', hcNoContext, NewMenu(NewItem('~Н~ов打тест по пъ́тя',  'Еф2', kbF2, cmNew, hcNew,
                      NewItem('~O~pen', '💩', kbF3, cmOpen, hcOpen,
                      NewLine(
                      NewItem('E~x~it', 'ъ́ъ́ъ́打', kbAltX, cmQuit, hcNoContext, nil))))),
                 NewSubMenu('~E~dit', hcNoContext, NewMenu(
                 NewItem('Window ~3~','',kbNoKey,cmWindow3,hcNoContext,nil)),
                 NewSubMenu('~O~rders', hcNoContext, {NewMenu(GetOrdersMenuItems(nil))}nil,
                 NewSubMenu('O~p~tions', hcNoContext, {NewMenu(GetOptionsMenuItems(nil))}nil,
                 NewSubMenu('~W~indow', hcNoContext, {NewMenu(GetWindowMenuItems(nil))}nil,
                 NewSubMenu('~H~elp', hcNoContext, NewMenu(NewItem('~A~bout...','',kbNoKey,cmAbout,hcNoContext,
                       nil)), nil)))))))));
end;

procedure TMyUnicodeApp.InitStatusLine;
var
  R: TRect;
begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  new(StatusLine, Init(R,
      NewStatusDef(0, $EFFF,
          NewStatusKey('~F1~ По пъ́тя', kbF1, cmHelp,
          NewStatusKey('~F2~ 打开', kbF2, cmOpen,
          NewStatusKey('~F3~ Отваряне', kbF3, cmOpen,
          NewStatusKey('~F4~ Νέος',  kbF4, cmNew,
          NewStatusKey('~Alt+F3~ Zavřít', kbAltF3, cmClose,
          NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
          nil)))))),
      NewStatusDef($F000, $FFFF,
          NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
          NewStatusKey('~Shift+F6~ Pref', kbShiftF6, cmOrderPrev,
          nil)),nil))));
end;

procedure TMyUnicodeApp.Window3;
VAR R: TRect; P: PGroup; B: PScrollBar;
    List: PUnicodeStringCollection; Lb: PListBox;
begin
  { Create a basic dialog box. In it are buttons,  }
  { list boxes, scrollbars, inputlines, checkboxes }
  R.Assign(32, 2, 77, 18);                           { Assign screen area }
  P := New(PDialog, Init(R, '테스트 대화 상자'));         { Create dialog }
  If (P <> Nil) Then Begin                           { Dialog valid }
    R.Assign(5, 5, 20, 7);                          { Allocate area }
    P^.Insert(New(PCheckBoxes, Init(R,
      NewSItem('Test',
      NewSITem('Item 2', Nil)))));                   { Insert check box }
    R.Assign(5, 2, 20, 3);                           { Assign area }

    B := New(PScrollBar, Init(R));                   { Insert scroll bar }
    If (B <> Nil) Then Begin                         { Scrollbar valid }
      B^.SetRange(0, 100);                           { Set scrollbar range }
      B^.SetValue(50);                               { Set position }
      P^.Insert(B);                                  { Insert scrollbar }
    End;
    R.Assign(5, 10, 20, 11);                         { Assign area }

    P^.Insert(New(PInputLine, Init(R, 60)));         { Create input line }
    R.Assign(5, 13, 20, 14);                         { Assign area }

    P^.Insert(New(PInputLine, Init(R, 60)));         { Create input line }
    R.Assign(40, 8, 41, 14);                         { Assign area }

    B := New(PScrollBar, Init(R));                   { Create scrollbar }
    P^.Insert(B);                                    { Insert scrollbar }
    R.Assign(25, 8, 40, 14);                         { Assign area }

    Lb := New(PListBox, Init(R, 1, B));              { Create listbox }
    P^.Insert(Lb);                                   { Insert listbox }
    List := New(PUnicodeStringCollection, Init(10, 5));        { Create string list }
    List^.AtInsert(0, 'Зебра');              { Insert text }
    List^.AtInsert(1, '林檎');               { Insert text }
    List^.AtInsert(2, 'Third');              { Insert text }
    List^.AtInsert(3, 'Peach');              { Insert text }
    List^.AtInsert(4, 'За́ек');               { Insert text }
    List^.AtInsert(5, 'Item six');           { Insert text }
    List^.AtInsert(6, 'Jaguar');             { Insert text }
    List^.AtInsert(7, 'Melon');              { Insert text }
    List^.AtInsert(8, 'Ninth');              { Insert text }
    List^.AtInsert(9, 'Last item');          { Insert text }
    Lb^.Newlist(List);                               { Give list to listbox }
    R.Assign(30, 2, 40, 4);                          { Assign area }

    P^.Insert(New(PButton, Init(R, '好的', 100, bfGrabFocus)));{ Create okay button }
    R.Assign(30, 15, 40, 17);                        { Assign area }

    Desktop^.Insert(P);                              { Insert dialog }
    P3:=P;
  End;
end;

procedure TMyUnicodeApp.ShowAboutBox;
begin
  MessageBox(#3'Free Vision TUI Framework'#13 +
    #3'Test/Demo Application'#13+
    #3'Мога да ям стъкло, то не ми вреди.'#13+
    #3'我能吞下玻璃而不伤身体。',
    nil, mfInformation or mfOKButton);
end;

begin
  MyUnicodeApp.Init;
  MyUnicodeApp.Run;
  MyUnicodeApp.Done;
end.