tcolors.pas

Turbo Pascal 6.0编译器源码

unit TColors;

{$O+,F+,S-,X+}

interface

uses Objects, Drivers, Views, Dialogs, ColorSel;

type

  PMonoSelector = ^TMonoSelector;
  TMonoSelector = object(TCluster)
    constructor Init(var Bounds: TRect);
    procedure Draw; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function  Mark(Item: Integer): Boolean; virtual;
    procedure NewColor;
    procedure Press(Item: Integer); virtual;
    procedure MovedTo(Item: Integer); virtual;
  end;

  PColorDialog = ^TColorDialog;
  TColorDialog = object(TDialog)
    Dislpay: PColorDisplay;
    Groups: PColorGroupList;
    Pal: TPalette;
    ForLabel: PLabel;
    ForSel: PColorSelector;
    BakLabel: PLabel;
    BakSel: PColorSelector;
    MonoLabel: PLabel;
    MonoSel: PMonoSelector;
    constructor Init(APalette: TPalette; AGroups: PColorGroup);
    constructor Load(var S: TStream);
    function  DataSize: Word; virtual;
    procedure GetData(var Rec); virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure SetData(var Rec); virtual;
    procedure Store(var S: TStream);
  end;

const

  RColorDialog: TStreamRec = (
    ObjType: 20005;
    VmtLink: Ofs(TypeOf(TColorDialog)^);
    Load:    @TColorDialog.Load;
    Store:   @TColorDialog.Store
  );
  RMonoSelector: TStreamRec = (
    ObjType: 20006;
    VmtLink: Ofs(TypeOf(TMonoSelector)^);
    Load:    @TMonoSelector.Load;
    Store:   @TMonoSelector.Store
  );

function ColorDialog: PColorDialog;

implementation

uses Controls, Context;

const
  MonoColors: array[0..4] of Byte = ($7, $F, $1, $70, $9);

constructor TMonoSelector.Init(var Bounds: TRect);
begin
  TCluster.Init(Bounds,
    NewSItem('Normal',
    NewSItem('Highlight',
    NewSItem('Underline',
    NewSItem('Inverse', nil)))));
  EventMask := EventMask or evBroadcast;
end;

procedure TMonoSelector.Draw;
begin
  DrawBox(' ( ) ', #7);
end;

procedure TMonoSelector.HandleEvent(var Event: TEvent);
var
  I: Integer;
begin
  TCluster.HandleEvent(Event);
  if (Event.What = evBroadcast) and (Event.Command = cmColorSet) then
  begin
    Value := Event.InfoByte;
    for I := 0 to 4 do
      if Value = MonoColors[I] then
        Sel := I;
    DrawView;
  end;
end;

function TMonoSelector.Mark(Item: Integer): Boolean;
begin
  Mark := Value = MonoColors[Item];
end;

procedure TMonoSelector.NewColor;
begin
  Message(Owner, evBroadcast, cmColorForegroundChanged,
    Pointer(Value and $F));
  Message(Owner, evBroadcast, cmColorBackgroundChanged,
    Pointer((Value shr 4) and $F));
end;

procedure TMonoSelector.Press(Item: Integer);
begin
  Value := MonoColors[Item];
  NewColor;
end;

procedure TMonoSelector.MovedTo(Item: Integer);
begin
  Value := MonoColors[Item];
  NewColor;
end;

constructor TColorDialog.Init(APalette: TPalette; AGroups: PColorGroup);
var
  R: TRect;
  P: PView;
begin
  R.Assign(0, 0, 61, 18);
  TDialog.Init(R, 'Colors');
  Options := Options or ofCentered;
  Pal := APalette;
  R.Assign(18, 3, 19, 14);
  P := New(PScrollBar, Init(R));
  Insert(P);
  R.Assign(3, 3, 18, 14);
  Groups := PColorGroupList(SetHelp(New(PColorGroupList,
    Init(R, PScrollBar(P), AGroups)), hcColorGroupList));
  Insert(Groups);
  Insert(StandardLabel('~G~roup', Groups, lfTop));
  R.Assign(41, 3, 42, 14);
  P := New(PScrollBar, Init(R));
  Insert(P);
  R.Assign(21, 3, 41, 14);
  P := SetHelp(New(PColorItemList,
    Init(R, PScrollBar(P), AGroups^.Items)), hcColorItemList);
  Insert(P);
  Insert(StandardLabel('~I~tem', P, lfTop));
  R.Assign(45, 3, 57, 7);
  ForSel := PColorSelector(SetHelp(New(PColorSelector,
  Init(R, csForeground)), hcForegroundSelector));
  Insert(ForSel);
  Dec(R.A.Y);
  R.B.Y := R.A.Y + 1;
  ForLabel := New(PLabel, Init(R, '~F~oreground', ForSel));
  Insert(ForLabel);
  Inc(R.A.Y, 7);
  Inc(R.B.Y, 8);
  BakSel := PColorSelector(SetHelp(New(PColorSelector,
    Init(R, csBackground)), hcBackgroundSelector));
  Insert(BakSel);
  Dec(R.A.Y);
  R.B.Y := R.A.Y + 1;
  BakLabel := New(PLabel, Init(R, '~B~ackground', BakSel));
  Insert(BakLabel);
  Dec(R.A.X);
  Inc(R.B.X);
  Inc(R.A.Y, 4);
  Inc(R.B.Y, 5);
  Dislpay := New(PColorDisplay, Init(R, NewStr('Text ')));
  Insert(Dislpay);
  R.Assign(44, 3, 59, 7);
  MonoSel := PMonoSelector(SetHelp(New(PMonoSelector,
    Init(R)), hcMonoSelector));
  MonoSel^.Hide;
  Insert(MonoSel);
  R.Assign(43, 2, 49, 3);
  MonoLabel := New(PLabel, Init(R, '~C~olor', MonoSel));
  MonoLabel^.Hide;
  Insert(MonoLabel);
  Insert(OkButton(24, 15));
  Insert(CnlButton(36,15));
  Insert(HelpButton(48, 15, hcColorsDialog));
  SelectNext(False);
end;

constructor TColorDialog.Load(var S: TStream);
var
  Len:Byte;
begin
  TDialog.Load(S);
  GetSubViewPtr(S, Dislpay);
  GetSubViewPtr(S, Groups);
  GetSubViewPtr(S, ForLabel);
  GetSubViewPtr(S, ForSel);
  GetSubViewPtr(S, BakLabel);
  GetSubViewPtr(S, BakSel);
  GetSubViewPtr(S, MonoLabel);
  GetSubViewPtr(S, MonoSel);
  S.Read(Len, SizeOf(Len));
  S.Read(Pal[1], Len);
  Pal[0] := Chr(Len);
end;

procedure TColorDialog.HandleEvent(var Event: TEvent);
var
  C: Byte;
begin
  TDialog.HandleEvent(Event);
  if (Event.What = evBroadcast) and (Event.Command = cmNewColorIndex) then
    Dislpay^.SetColor(Byte(Pal[Event.InfoByte]));
end;

procedure TColorDialog.Store(var S: TStream);
begin
  TDialog.Store(S);
  PutSubViewPtr(S, Dislpay);
  PutSubViewPtr(S, Groups);
  PutSubViewPtr(S, ForLabel);
  PutSubViewPtr(S, ForSel);
  PutSubViewPtr(S, BakLabel);
  PutSubViewPtr(S, BakSel);
  PutSubViewPtr(S, MonoLabel);
  PutSubViewPtr(S, MonoSel);
  S.Write(Pal, Length(Pal) + 1);
end;

function TColorDialog.DataSize: Word;
begin
  DataSize := SizeOf(Pal);
end;

procedure TColorDialog.GetData(var Rec);
begin
  TPalette(Rec) := Pal;
end;

procedure TColorDialog.SetData(var Rec);
begin
  Pal := TPalette(Rec);
  Dislpay^.SetColor(Byte(Pal[1]));
  Groups^.FocusItem(0);
  if ShowMarkers then
  begin
    ForLabel^.Hide;
    ForSel^.Hide;
    BakLabel^.Hide;
    BakSel^.Hide;
    MonoLabel^.Show;
    MonoSel^.Show;
  end;
  Groups^.Select;
end;

function ColorDialog: PColorDialog;
begin
  ColorDialog := New(PColorDialog, Init('',
    ColorGroup('Desktop',
      ColorItem('Color', 1, nil),
    ColorGroup('Menus',
      ColorItem('Normal', 2,
      ColorItem('Disabled', 3,
      ColorItem('Shortcut', 4,
      ColorItem('Selected', 5,
      ColorItem('Selected disabled', 6,
      ColorItem('Shortcut selected', 7, nil)))))),
    ColorGroup('Dialogs',
      ColorItem('Frame/background', 33,
      ColorItem('Frame icons', 34,
      ColorItem('Scroll bar page', 35,
      ColorItem('Scroll bar icons', 36,
      ColorItem('Static text', 37,
      ColorItem('Label normal', 38,
      ColorItem('Label selected', 39,
      ColorItem('Label shortcut', 40,
      ColorItem('Button normal', 41,
      ColorItem('Button default', 42,
      ColorItem('Button selected', 43,
      ColorItem('Button disabled', 44,
      ColorItem('Button shortcut', 45,
      ColorItem('Button shadow', 46,
      ColorItem('Cluster normal', 47,
      ColorItem('Cluster selected', 48,
      ColorItem('Cluster shortcut', 49,
      ColorItem('Input normal', 50,
      ColorItem('Input selected', 51,
      ColorItem('Input arrow', 52,
      ColorItem('History button', 53,
      ColorItem('History sides', 54,
      ColorItem('History bar page', 55,
      ColorItem('History bar icons', 56,
      ColorItem('List normal', 57,
      ColorItem('List focused', 58,
      ColorItem('List selected', 59,
      ColorItem('List divider', 60,
      ColorItem('Information pane', 61, nil))))))))))))))))))))))))))))),
    ColorGroup('Editor',
      ColorItem('Frame passive', 64,
      ColorItem('Frame active', 65,
      ColorItem('Frame icons', 66,
      ColorItem('Scroll bar page', 67,
      ColorItem('Scroll bar icons', 68,
      ColorItem('Normal text', 69,
      ColorItem('Selected text', 70,
      ColorItem('Error message', 71,
      ColorItem('Breakpoint', 72,
      ColorItem('Source position', 73, nil)))))))))),
    ColorGroup('Help',
      ColorItem('Frame passive', 80,
      ColorItem('Frame active', 81,
      ColorItem('Frame icons', 82,
      ColorItem('Scroll bar page', 83,
      ColorItem('Scroll bar icons', 84,
      ColorItem('Normal text', 85,
      ColorItem('Normal example', 86,
      ColorItem('Normal keyword', 87,
      ColorItem('Highlight keyword', 88,
      ColorItem('Selected text', 89,
      ColorItem('Selected example', 90,
      ColorItem('Selected keyword', 91,
      ColorItem('Sel/high keyword', 92, nil))))))))))))),
    ColorGroup('Watches',
      ColorItem('Frame passive', 96,
      ColorItem('Frame active', 97,
      ColorItem('Frame icons', 98,
      ColorItem('Scroll bar page', 99,
      ColorItem('Scroll bar icons', 100,
      ColorItem('Normal text', 101,
      ColorItem('Selected text', 102, nil))))))),
    ColorGroup('Call stack',
      ColorItem('Frame passive', 104,
      ColorItem('Frame active', 105,
      ColorItem('Frame icons', 106,
      ColorItem('Scroll bar page', 107,
      ColorItem('Scroll bar icons', 108,
      ColorItem('Normal text', 109,
      ColorItem('Selected text', 110, nil))))))),
    ColorGroup('Register',
      ColorItem('Frame passive', 112,
      ColorItem('Frame active', 113,
      ColorItem('Frame icons', 114,
      ColorItem('Normal text', 117, nil)))),
    ColorGroup('Output',
      ColorItem('Frame passive', 120,
      ColorItem('Frame active', 121,
      ColorItem('Frame icons', 122,
      ColorItem('Scroll bar page', 123,
      ColorItem('Scroll bar icons', 124, nil))))),
    ColorGroup('Compiler',
      ColorItem('Frame passive', 128,
      ColorItem('Frame active', 129,
      ColorItem('Frame icons', 130,
      ColorItem('Normal text', 133,
      ColorItem('Status line', 134, nil))))), nil))))))))))));
end;

end.