editpal.pas

还是一个词法分析程序

{************************************************}
{                                                }
{   Turbo Vision File Manager Demo               }
{   Copyright (c) 1992 by Borland International  }
{                                                }
{************************************************}

{$X+}
{$V-}

uses Drivers, Objects, App, Views, Dialogs, Menus, StdDlg, MsgBox,
     HistList, ColorSel;

const

  AddToWin =
    #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79 +
    #80#81#82#83#84#85#86#87#88#89#90#91#92#93#94#95 +
    #96#97#98#99#100#101#102#103#104#105#106#107#108#109#110#111 +
    #112#113#114#115#116#117#118#119#120#121#122#123#124#125#126#127;

  AppPal : String[Length(CColor) * 2] =
    CColor + CColor;

  WinPal : String[Length(CDialog) + 64] =
    CDialog + AddToWin;

  GrpPal : String[64] =
    #33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48 +
    #49#50#51#52#53#54#55#56#57#58#59#60#61#62#63#64 +
    #65#66#67#68#69#70#71#72#73#74#75#76#77#78#79#80 +
    #81#82#83#84#85#86#87#88#89#90#91#92#93#94#95#96;

  cmNothing = 100;
  cmInActive = 101;

  { Change the current palette entry }
  cmBack = 110;
  cmFore = 111;

  { Commands to insert new windows and controls }

  cmBWindow     = 200;
  cmCWindow     = 201;
  cmGWindow     = 202;
  cmDListBox    = 204;  { Dialog with TListBox }
  cmDClusters   = 205;
  cmDInputs     = 206;

  cmRefresh     = 120;
  cmNewColor    = 121;

  cmSavePalette = 130;
  cmOpenPalette = 131;
  cmShowDialog  = 132;

type

  PPalApp = ^TPalApp;
  TPalApp = object(TApplication)
    function GetPalette: PPalette; virtual;
    procedure InitStatusLine; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  PWorkWindow = ^TWorkWindow;
  TWorkWindow = object(TDialog)
    ListBox: PListBox;
    ForSel: PColorSelector;
    BackSel: PColorSelector;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  ColorWindowType = (wcBlue, wcCyan, wcGray);

  PColorWindow = ^TColorWindow;
  TColorWindow = object(TWindow)
    ThePalette: PPalette;
    constructor Init(var Bounds: TRect; ATitle: TTitleStr;
      APalette: PPalette);
    function GetPalette: PPalette; virtual;
  end;

  PWorkDesktop = ^TWorkDesktop;
  TWorkDesktop = object(TDesktop)
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  PWorkGroup = ^TWorkGroup;
  TWorkGroup = object(TGroup)
    DT: PWorkDeskTop;
    MB: PMenuBar;
    SL: PStatusLine;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  PTextCollection = ^TTextCollection;
  TTextCollection = object(TCollection)
    procedure FreeItem(Item: Pointer); virtual;
  end;

  PPaletteList = ^TPaletteList;
  TPaletteList = object(TListBox)
    procedure FocusItem(Item: Integer); virtual;
  end;

  PWinInterior = ^TWinInterior;
  TWinInterior = object(TScroller)
    Lines: PCollection;
    procedure Draw; virtual;
    destructor Done; virtual;
  end;

const
  CurrentPalette : FNameStr = '';
  isDirty: Boolean = False;

  WindowPalettes: array[ColorWindowType] of TPalette =
    (CBlueWindow, CCyanWindow, CGrayWindow);


{ TColorWindow }
constructor TColorWindow.Init(var Bounds: TRect; ATitle: TTitleStr;
  APalette: PPalette);
begin
  inherited Init(Bounds, ATitle, wnNoNumber);
  ThePalette := APalette;
end;

function TColorWindow.GetPalette: PPalette;
begin
  GetPalette := ThePalette;
end;


{ TWinInterior }
procedure TWinInterior.Draw;
var
  B: TDrawBuffer;
  C: Byte;
  I: Integer;
  S: String;
  P: PString;
begin
  for I := 0 to Size.Y - 1 do
  begin
    if (Delta.Y + I) = 1 then C := GetColor(2)
    else C := GetColor(1);
    MoveChar(B, ' ', C, Size.X);
    if Delta.Y + I < Lines^.Count then
    begin
      P := Lines^.At(Delta.Y + I);
      if P <> nil then S := Copy(P^, Delta.X + 1, Size.X)
      else S := '';
      MoveStr(B, S, C);
    end;
    WriteLine(0, I, Size.X, 1, B);
  end;
end;

destructor TWinInterior.Done;
begin
  if Lines <> nil then Dispose(Lines, Done);
  inherited Done;
end;

procedure SavePalette;
var
  S: TBufStream;
  Desc: String;
  D: PFileDialog;
  C: Word;
begin
  if CurrentPalette = '' then
  begin
    D := New(PFileDialog, Init('*.PAL', 'Save As', CurrentPalette,
           fdOKButton, 100));
    if Desktop^.ExecView(D) <> cmCancel then
      D^.GetFileName(CurrentPalette);
    Dispose(D, Done);
  end;
  if CurrentPalette = '' then Exit;

  S.Init(CurrentPalette, stCreate, 1024);
  if S.Status <> stOK then Exit;
  S.Write(AppPal[64], 64);
  S.Done;
end;

procedure OpenPalette;
var
  S: TBufStream;
  Desc: String;
  D: PFileDialog;
  C: Word;
begin
  D := New(PFileDialog, Init('*.PAL', 'Open Palette', '~N~ame',
    fdOKButton, 100));
  if Desktop^.ExecView(D) <> cmCancel then
    D^.GetFileName(CurrentPalette);
  Dispose(D, Done);
  if CurrentPalette = '' then Exit;

  S.Init(CurrentPalette, stOpenRead, 1024);
  if S.Status <> stOK then Exit;
  S.Read(AppPal[64], 64);
  S.Done;
  Message(Desktop, evBroadcast, cmRefresh, nil);
end;

procedure NoBuf(var Options: Word);
begin
  Options := Options and (not ofBuffered);
end;

function NewTextCollection: PTextCollection;
var
  C: PTextCollection;
begin
  C := New(PTextCollection, Init(10,0));
  with C^ do
  begin
    Insert(NewStr('This is line 1 of 10'));
    Insert(NewStr('This line is selected'));
    Insert(NewStr('This line is normal'));
    Insert(NewStr('This is line 4 of 10'));
    Insert(NewStr('This is line 5 of 10'));
    Insert(NewStr('This is line 6 of 10'));
    Insert(NewStr('This is line 7 of 10'));
    Insert(NewStr('This is line 8 of 10'));
    Insert(NewStr('This is line 9 of 10'));
    Insert(NewStr('This is line 10 of 10'));
  end;
  NewTextCollection := C;
end;

function NewWinInterior(var R: TRect; SB: PScrollBar): PWinInterior;
var
  Interior: PWinInterior;
begin
  Interior := New(PWinInterior, Init(R, nil, SB));
  Interior^.Lines := NewTextCollection;
  Interior^.SetLimit(0,10);
  Interior^.GrowMode := gfGrowHiX + gfGrowHiY;
  NewWinInterior := Interior;
end;

function NewWindow(wType: ColorWindowType; ATitle: TTitleStr): PWindow;
var
  W: PWindow;
  R: TRect;
  SB: PScrollBar;
begin
  R.Assign(0,0,23,7);
  W := New(PColorWindow, Init(R, ATitle, @WindowPalettes[wType]));
  with W^ do
  begin
    NoBuf(Options);
    SB := StandardScrollBar(sbVertical);
    Insert(SB);
    GetExtent(R);
    R.Grow(-1,-1);
    Insert(NewWinInterior(R,SB));
  end;
  NewWindow := W;
end;


function NewClusterDialog: PDialog;
var
  D: PDialog;
  R: TRect;
  P: PView;
begin
  R.Assign(0,0,30,14);
  D := New(PDialog, Init(R, 'Clusters'));
  with D^ do
  begin
    Options := Options or ofCentered;
    NoBuf(Options);
    R.Assign(2,2,15,5);
    P := New(PCheckBoxes, Init(R, NewSItem('Check ~1~',
                                  NewSItem('Check ~2~',
                                  NewSItem('Check ~3~',
                                  nil)))));
    Insert(P);
    R.Assign(1,1,15,2);
    Insert(New(PLabel, Init(R, '~C~heck Boxes', P)));

    R.Assign(2,7,15,10);
    P := New(PRadioButtons, Init(R, NewSItem('Radio ~X~',
                                    NewSItem('Radio ~Y~',
                                    NewSItem('Radio ~Z~',
                                    nil)))));
    Insert(P);
    R.Assign(1,6,15,7);
    Insert(New(PLabel, Init(R, '~R~adio Buttons', P)));

    R.Assign(16,2,28,4);
    Insert(New(PButton, Init(R, '~D~efault', cmNothing, bfDefault)));
    R.Move(0,2);
    Insert(New(PButton, Init(R, '~N~ormal', cmNothing, bfNormal)));
    R.Move(0,2);
    Insert(New(PButton, Init(R, 'D~i~sabled', cmInactive, bfNormal)));

    R.Assign(2,11,28,12);
    Insert(New(PStaticText, Init(R, 'This is static text')));
  end;
  NewClusterDialog := D;
end;

function NewInputDialog: PDialog;
var
  D: PDialog;
  R: TRect;
  P: PView;
  H: PHistory;
begin
  R.Assign(0,0,39,8);
  D := New(PDialog, Init(R, 'InputLine'));
  with D^ do
  begin
    NoBuf(Options);
    R.Assign(2,3,25,4);
    P := New(PInputLine, Init(R, 80));
    Insert(P);
    R.Assign(1,2,28,3);
    Insert(New(PLabel, Init(R, '~I~nput Line', P)));
    R.Assign(25,3,28,4);
    H := New(PHistory, Init(R, PInputLine(P), 100));
    NoBuf(H^.Options);
    Insert(H);
    R.Assign(1,5,11,7);
    Insert(New(PButton, Init(R, '~D~efault', cmNothing, bfDefault)));
    R.Move(11,0);
    Insert(New(PButton, Init(R, '~N~ormal', cmNothing, bfNormal)));
    R.Move(11,0);
    Insert(New(PButton, Init(R, 'D~i~sabled', cmInactive, bfNormal)));
    SelectNext(False);
  end;
  NewInputDialog := D;
end;

function NewListBoxList: PTextCollection;
var
  C: PTextCollection;
begin
  C := New(PTextCollection, Init(10,0));
  with C^ do
  begin