editpal.pas

还是一个词法分析程序

    Insert(NewStr('Apple'));
    Insert(NewStr('Orange'));
    Insert(NewStr('Banana'));
    Insert(NewStr('Grape'));
    Insert(NewStr('Peach'));
    Insert(NewStr('Mango'));
    Insert(NewStr('Lemon'));
    Insert(NewStr('Lime'));
    Insert(NewStr('Raisin'));
  end;
  NewListBoxList := C;
end;

function NewListBoxDialog: PDialog;
var
  D: PDialog;
  R: TRect;
  P: PView;
  SB: PScrollBar;
  C: PTextCollection;
begin
  R.Assign(0,0,30,15);
  D := New(PDialog, Init(R, 'ListBox'));
  with D^ do
  begin
    NoBuf(Options);
    R.Assign(27,2,28,8);
    SB := New(PScrollBar, Init(R));
    Insert(SB);
    R.Assign(2,2,27,8);
    P := New(PListBox, Init(R, 2, SB));
    PListBox(P)^.NewList(NewListBoxList);
    Insert(P);
    R.Assign(1,1,15,2);
    Insert(New(PLabel, Init(R, '~L~ist Box', P)));
    R.Assign(2,9,14,11);
    Insert(New(PButton, Init(R, '~D~efault', cmNothing, bfDefault)));
  end;
  NewListBoxDialog := D;
end;

procedure TWorkDesktop.HandleEvent(var Event: TEvent);
var
  D: PFileDialog;
begin
  inherited HandleEvent(Event);
  if Event.What = evCommand then
  begin
    case Event.Command of
      cmCWindow: Insert(NewWindow(wcCyan, 'Cyan Window'));
      cmBWindow: Insert(NewWindow(wcBlue, 'Blue Window'));
      cmGWindow: Insert(NewWindow(wcGray, 'Gray Window'));
      cmDClusters: Insert(NewClusterDialog);
      cmDInputs: Insert(NewInputDialog);
      cmDListBox: Insert(NewListBoxDialog);
      else Exit;
    end;
    ClearEvent(Event);
  end;
end;

procedure TTextCollection.FreeItem(Item: pointer);
begin
  if Item <> nil then DisposeStr(Item);
end;

function TPalApp.GetPalette: PPalette;
begin
  GetPalette := @AppPal;
end;

function TWorkWindow.GetPalette: PPalette;
begin
  GetPalette := @WinPal;
end;

function TWorkGroup.GetPalette: PPalette;
begin
  GetPalette := @GrpPal;
end;

procedure TWorkGroup.HandleEvent(var Event: TEvent);
begin
  inherited HandleEvent(Event);
  if (Event.What = evBroadcast) and (Event.Command = cmRefresh) then
  begin
    DT^.ReDraw;
    MB^.DrawView;
    SL^.DrawView;
  end;
end;


function PaletteNames: PTextCollection;
var
  C: PTextCollection;
begin
  C := New(PTextCollection, Init(64,0));
  with C^ do
  begin
    Insert(NewStr('Background'));
    Insert(NewStr('Normal text'));
    Insert(NewStr('Disabled text'));
    Insert(NewStr('Shortcut text'));
    Insert(NewStr('Normal selection'));
    Insert(NewStr('Disabled selection'));
    Insert(NewStr('Shortcut selection'));

    Insert(NewStr('Frame Passive (Blue)'));
    Insert(NewStr('Frame Active (Blue)'));
    Insert(NewStr('Frame Icon (Blue)'));
    Insert(NewStr('Scrollbar Page (Blue)'));
    Insert(NewStr('Scrollbar Reserved (Blue)'));
    Insert(NewStr('Scroller Normal Text (Blue)'));
    Insert(NewStr('Scroller Selected Text (Blue)'));
    Insert(NewStr('Reserved (Blue)'));

    Insert(NewStr('Frame Passive (Cyan)'));
    Insert(NewStr('Frame Active (Cyan)'));
    Insert(NewStr('Frame Icon (Cyan)'));
    Insert(NewStr('Scrollbar Page (Cyan)'));
    Insert(NewStr('Scrollbar Reserved (Cyan)'));
    Insert(NewStr('Scroller Normal Text (Cyan)'));
    Insert(NewStr('Scroller Selected Text (Cyan)'));
    Insert(NewStr('Reserved (Cyan)'));

    Insert(NewStr('Frame Passive (Gray)'));
    Insert(NewStr('Frame Active (Gray)'));
    Insert(NewStr('Frame Icon (Gray)'));
    Insert(NewStr('Scrollbar Page (Gray)'));
    Insert(NewStr('Scrollbar Reserved (Gray)'));
    Insert(NewStr('Scroller Normal Text (Gray)'));
    Insert(NewStr('Scroller Selected Text (Gray)'));
    Insert(NewStr('Reserved (Gray)'));

    Insert(NewStr('Frame Passive (Dlg)'));
    Insert(NewStr('Frame Active (Dlg)'));
    Insert(NewStr('Frame Icon (Dlg)'));
    Insert(NewStr('Scrollbar Page (Dlg)'));
    Insert(NewStr('Scrollbar Controls (Dlg)'));
    Insert(NewStr('Static Text'));
    Insert(NewStr('Label Normal'));
    Insert(NewStr('Label Highlight'));
    Insert(NewStr('Label Shortcut'));

    Insert(NewStr('Button Normal'));
    Insert(NewStr('Button Default'));
    Insert(NewStr('Button Selected'));
    Insert(NewStr('Button Disabled'));
    Insert(NewStr('Button Shortcut'));
    Insert(NewStr('Button Shadow'));
    Insert(NewStr('Cluster Normal'));
    Insert(NewStr('Cluster Selected'));
    Insert(NewStr('Cluster Shortcut'));

    Insert(NewStr('Inputline Normal'));
    Insert(NewStr('Inputline Selected'));
    Insert(NewStr('Inputline Arrows'));
    Insert(NewStr('History Arrow'));
    Insert(NewStr('History Sides'));
    Insert(NewStr('Scrollbar page (Hist)'));
    Insert(NewStr('Scrollbar controls (Hist)'));

    Insert(NewStr('Listviewer Normal'));
    Insert(NewStr('Listviewer Focused'));
    Insert(NewStr('Listviewer Selected'));
    Insert(NewStr('Listviewer Divider'));
    Insert(NewStr('InfoPane'));
    Insert(NewStr('Reserved'));
    Insert(NewStr('Reserved'));

  end;
  PaletteNames := C;
end;

procedure TPaletteList.FocusItem(Item: Integer);
var
  B: Byte;
begin
  inherited FocusItem(Item);
  B := Byte( AppPal[64 + Item] );
  Message(Owner, evBroadcast, cmNewColor, Pointer(B));
  Message(Owner, evBroadcast, cmColorSet, Pointer(B));
end;


procedure TWorkWindow.HandleEvent(var Event: TEvent);
var
  B, B2: Byte;
begin
  inherited HandleEvent(Event);

  if Event.What = evBroadcast then
  begin
    case Event.Command of
      cmColorBackgroundChanged:
        begin
          B := Byte( AppPal[ListBox^.Focused + 64] );
          B := (B and $0F) or (Event.InfoByte shl 4 and $F0);
        end;
      cmColorForegroundChanged:
        begin
          B := Byte( AppPal[ListBox^.Focused + 64] );
          B := (B and $F0) or (Event.InfoByte and $0F);
        end;
      else Exit;
    end;
    AppPal[ListBox^.Focused + 64] := Char(B);
    Message(Desktop, evBroadcast, cmRefresh, Pointer(B));
    Message(@Self, evBroadcast, cmNewColor, Pointer(B));
    ClearEvent(Event);
  end;
end;


procedure ShowDialog;
var
  R: TRect;
  W: PWorkWindow;
  G: PWorkGroup;
  P: PView;
  SB: PScrollBar;
begin
  Desktop^.GetExtent(R);
  R.A.X := R.B.X - 75;
  Dec(R.B.Y,2);
  W := New(PWorkWindow, Init(R, 'Color Selection'));
  with W^ do
  begin
    Options := Options or ofCentered;
    EventMask := EventMask or evBroadcast;

    R.Assign(35,2,36,12);
    SB := New(PScrollBar, Init(R));
    Insert(SB);
    R.Assign(1,2,35,12);
    ListBox := New(PPaletteList, Init(R, 1, SB));
    Insert(ListBox);
    ListBox^.NewList(PaletteNames);
    Dec(R.A.Y); R.B.Y := R.A.Y+1;
    Insert(New(PLabel, Init(R, '~I~tems', ListBox)));

    R.Assign(3, 13, 15, 17);
    ForSel := New(PColorSelector, Init(R, csForeground));
    Insert(ForSel);
    Dec(R.A.Y); R.B.Y := R.A.Y+1;
    Insert(New(PLabel, Init(R, '~F~oreground', ForSel)));

    R.Assign(18, 13, 30, 15);
    BackSel := New(PColorSelector, Init(R, csBackground));
    Insert(BackSel);
    Dec(R.A.Y); R.B.Y := R.A.Y+1;
    Insert(New(PLabel, Init(R, '~B~ackground', BackSel)));

    R.Assign(1,18,13,20);
    Insert(New(PButton, Init(R, '~O~K', cmOK, bfNormal)));

    GetExtent(R);
    R.Grow(-1,-1);
    R.A.X := R.B.X - 36;
    G := New(PWorkGroup, Init(R));
    Insert(G);

    with G^ do
    begin
      GrowMode := gfGrowHiX + gfGrowHiY;
      Options := Options or ofFramed;
      GetExtent(R); R.Grow(0,-1);
      DT := New(PWorkDesktop, Init(R));
      DT^.Options := DT^.Options and (not ofBuffered);
      Insert(DT);

      GetExtent(R);
      R.A.Y := R.B.Y - 1;
      SL := New(PStatusLine, Init(R,
        NewStatusDef(0, 0,
          NewStatusKey('~F1~ Active', 0, cmNothing,
          NewStatusKey('~F2~ Inactive', 0, cmInactive,
          nil)),
        nil)));
      Insert(SL);

      GetExtent(R); R.B.Y := R.A.Y + 1;
      MB := New(PMenuBar, Init(R, NewMenu(
             NewSubMenu('Fi~l~e', 0, NewMenu(
               NewItem('~A~ctive', 'F1', 0, cmNothing, 0,
               NewItem('~I~nactive', 'F2', 0, cmInactive, 0,
               nil))),
             NewSubMenu('~V~iews', 0, NewMenu(
               NewSubMenu('~W~indows...', 0, NewMenu(
                 NewItem('~B~lue Window', '', 0, cmBWindow, 0,
                 NewItem('~C~yan Window', '', 0, cmCWindow, 0,
                 NewItem('~G~ray Window', '', 0, cmGWindow, 0,
                 nil)))),
               NewSubMenu('~D~ialogs', 0, NewMenu(
                 NewItem('Dialog with TClusters','', 0, cmDClusters, 0,
                 NewItem('Dialog with TInputLine','', 0, cmDInputs, 0,
                 NewItem('Dialog with TListBox','', 0, cmDListBox, 0,
                 nil)))),
             nil))),
           nil)))));

      Insert(MB);
    end;
    ListBox^.FocusItem(ListBox^.Focused);
    SelectNext(False);

  end;
  Desktop^.ExecView(W);
  Dispose(W, Done);
end;

procedure TPalApp.InitStatusLine;
var R: TRect;
begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine := New(PStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
      NewStatusKey('~F2~ Save', kbF2, cmSavePalette,
      NewStatusKey('~F3~ Open', kbF3, cmOpenPalette,
      NewStatusKey('~F9~ Edit', kbF9, cmShowDialog,
      NewStatusKey('', kbF6, cmNext,
      nil))))),
    nil)
  ));
end;

procedure TPalApp.HandleEvent(var Event: TEvent);
begin
  inherited HandleEvent(Event);
  if (Event.What = evCommand) and (Event.Command = cmSavePalette) then
    SavePalette;
  if (Event.What = evCommand) and (Event.Command = cmOpenPalette) then
    OpenPalette;
  if (Event.What = evCommand) and (Event.Command = cmShowDialog) then
    ShowDialog;
end;


var
  A: TPalApp;

begin
  A.Init;
  A.DisableCommands([cmInactive]);
  A.Run;
  A.Done;
end.