559 lines
14 KiB
Plaintext
559 lines
14 KiB
Plaintext
|
|
{*******************************************************}
|
|
{ }
|
|
{ Turbo Pascal Version 6.0 }
|
|
{ Turbo Vision Unit }
|
|
{ }
|
|
{ Copyright (c) 1990 Borland International }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
unit Views;
|
|
|
|
{$F+,O+,S-,X+}
|
|
|
|
interface
|
|
|
|
uses Objects, Drivers, Memory;
|
|
|
|
const
|
|
|
|
{ TView State masks }
|
|
|
|
sfVisible = $0001;
|
|
sfCursorVis = $0002;
|
|
sfCursorIns = $0004;
|
|
sfShadow = $0008;
|
|
sfActive = $0010;
|
|
sfSelected = $0020;
|
|
sfFocused = $0040;
|
|
sfDragging = $0080;
|
|
sfDisabled = $0100;
|
|
sfModal = $0200;
|
|
sfDefault = $0400;
|
|
sfExposed = $0800;
|
|
|
|
{ TView Option masks }
|
|
|
|
ofSelectable = $0001;
|
|
ofTopSelect = $0002;
|
|
ofFirstClick = $0004;
|
|
ofFramed = $0008;
|
|
ofPreProcess = $0010;
|
|
ofPostProcess = $0020;
|
|
ofBuffered = $0040;
|
|
ofTileable = $0080;
|
|
ofCenterX = $0100;
|
|
ofCenterY = $0200;
|
|
ofCentered = $0300;
|
|
|
|
{ TView GrowMode masks }
|
|
|
|
gfGrowLoX = $01;
|
|
gfGrowLoY = $02;
|
|
gfGrowHiX = $04;
|
|
gfGrowHiY = $08;
|
|
gfGrowAll = $0F;
|
|
gfGrowRel = $10;
|
|
|
|
{ TView DragMode masks }
|
|
|
|
dmDragMove = $01;
|
|
dmDragGrow = $02;
|
|
dmLimitLoX = $10;
|
|
dmLimitLoY = $20;
|
|
dmLimitHiX = $40;
|
|
dmLimitHiY = $80;
|
|
dmLimitAll = $F0;
|
|
|
|
{ TView Help context codes }
|
|
|
|
hcNoContext = 0;
|
|
hcDragging = 1;
|
|
|
|
{ TScrollBar part codes }
|
|
|
|
sbLeftArrow = 0;
|
|
sbRightArrow = 1;
|
|
sbPageLeft = 2;
|
|
sbPageRight = 3;
|
|
sbUpArrow = 4;
|
|
sbDownArrow = 5;
|
|
sbPageUp = 6;
|
|
sbPageDown = 7;
|
|
sbIndicator = 8;
|
|
|
|
{ TScrollBar options for TWindow.StandardScrollBar }
|
|
|
|
sbHorizontal = $0000;
|
|
sbVertical = $0001;
|
|
sbHandleKeyboard = $0002;
|
|
|
|
{ TWindow Flags masks }
|
|
|
|
wfMove = $01;
|
|
wfGrow = $02;
|
|
wfClose = $04;
|
|
wfZoom = $08;
|
|
|
|
{ TWindow number constants }
|
|
|
|
wnNoNumber = 0;
|
|
|
|
{ TWindow palette entries }
|
|
|
|
wpBlueWindow = 0;
|
|
wpCyanWindow = 1;
|
|
wpGrayWindow = 2;
|
|
|
|
{ Standard command codes }
|
|
|
|
cmValid = 0;
|
|
cmQuit = 1;
|
|
cmError = 2;
|
|
cmMenu = 3;
|
|
cmClose = 4;
|
|
cmZoom = 5;
|
|
cmResize = 6;
|
|
cmNext = 7;
|
|
cmPrev = 8;
|
|
cmHelp = 9;
|
|
|
|
{ Application command codes }
|
|
|
|
cmCut = 20;
|
|
cmCopy = 21;
|
|
cmPaste = 22;
|
|
cmUndo = 23;
|
|
cmClear = 24;
|
|
cmTile = 25;
|
|
cmCascade = 26;
|
|
|
|
{ TDialog standard commands }
|
|
|
|
cmOK = 10;
|
|
cmCancel = 11;
|
|
cmYes = 12;
|
|
cmNo = 13;
|
|
cmDefault = 14;
|
|
|
|
{ Standard messages }
|
|
|
|
cmReceivedFocus = 50;
|
|
cmReleasedFocus = 51;
|
|
cmCommandSetChanged = 52;
|
|
|
|
{ TScrollBar messages }
|
|
|
|
cmScrollBarChanged = 53;
|
|
cmScrollBarClicked = 54;
|
|
|
|
{ TWindow select messages }
|
|
|
|
cmSelectWindowNum = 55;
|
|
|
|
{ TListViewer messages }
|
|
|
|
cmListItemSelected = 56;
|
|
|
|
{ Color palettes }
|
|
|
|
CFrame = #1#1#2#2#3;
|
|
CScrollBar = #4#5#5;
|
|
CScroller = #6#7;
|
|
CListViewer = #26#26#27#28#29;
|
|
CBlueWindow = #8#9#10#11#12#13#14#15;
|
|
CCyanWindow = #16#17#18#19#20#21#22#23;
|
|
CGrayWindow = #24#25#26#27#28#29#30#31;
|
|
|
|
{ TDrawBuffer maximum view width }
|
|
|
|
MaxViewWidth = 132;
|
|
|
|
type
|
|
|
|
{ Command sets }
|
|
|
|
PCommandSet = ^TCommandSet;
|
|
TCommandSet = set of Byte;
|
|
|
|
{ Color palette type }
|
|
|
|
PPalette = ^TPalette;
|
|
TPalette = String;
|
|
|
|
{ TDrawBuffer, buffer used by draw methods }
|
|
|
|
TDrawBuffer = array[0..MaxViewWidth - 1] of Word;
|
|
|
|
{ TView object Pointer }
|
|
|
|
PView = ^TView;
|
|
|
|
{ TGroup object Pointer }
|
|
|
|
PGroup = ^TGroup;
|
|
|
|
{ TView object }
|
|
|
|
TView = object(TObject)
|
|
Owner: PGroup;
|
|
Next: PView;
|
|
Origin: TPoint;
|
|
Size: TPoint;
|
|
Cursor: TPoint;
|
|
GrowMode: Byte;
|
|
DragMode: Byte;
|
|
HelpCtx: Word;
|
|
State: Word;
|
|
Options: Word;
|
|
EventMask: Word;
|
|
constructor Init(var Bounds: TRect);
|
|
constructor Load(var S: TStream);
|
|
destructor Done; virtual;
|
|
procedure BlockCursor;
|
|
procedure CalcBounds(var Bounds: TRect; Delta: TPoint); virtual;
|
|
procedure ChangeBounds(var Bounds: TRect); virtual;
|
|
procedure ClearEvent(var Event: TEvent);
|
|
function CommandEnabled(Command: Word): Boolean;
|
|
function DataSize: Word; virtual;
|
|
procedure DisableCommands(Commands: TCommandSet);
|
|
procedure DragView(Event: TEvent; Mode: Byte;
|
|
var Limits: TRect; MinSize, MaxSize: TPoint);
|
|
procedure Draw; virtual;
|
|
procedure DrawView;
|
|
procedure EnableCommands(Commands: TCommandSet);
|
|
procedure EndModal(Command: Word); virtual;
|
|
function EventAvail: Boolean;
|
|
function Execute: Word; virtual;
|
|
function Exposed: Boolean;
|
|
procedure GetBounds(var Bounds: TRect);
|
|
procedure GetClipRect(var Clip: TRect);
|
|
function GetColor(Color: Word): Word;
|
|
procedure GetCommands(var Commands: TCommandSet);
|
|
procedure GetData(var Rec); virtual;
|
|
procedure GetEvent(var Event: TEvent); virtual;
|
|
procedure GetExtent(var Extent: TRect);
|
|
function GetHelpCtx: Word; virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
procedure GetPeerViewPtr(var S: TStream; var P);
|
|
function GetState(AState: Word): Boolean;
|
|
procedure GrowTo(X, Y: Integer);
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
procedure Hide;
|
|
procedure HideCursor;
|
|
procedure KeyEvent(var Event: TEvent);
|
|
procedure Locate(var Bounds: TRect);
|
|
procedure MakeFirst;
|
|
procedure MakeGlobal(Source: TPoint; var Dest: TPoint);
|
|
procedure MakeLocal(Source: TPoint; var Dest: TPoint);
|
|
function MouseEvent(var Event: TEvent; Mask: Word): Boolean;
|
|
function MouseInView(Mouse: TPoint): Boolean;
|
|
procedure MoveTo(X, Y: Integer);
|
|
function NextView: PView;
|
|
procedure NormalCursor;
|
|
function Prev: PView;
|
|
function PrevView: PView;
|
|
procedure PutEvent(var Event: TEvent); virtual;
|
|
procedure PutInFrontOf(Target: PView);
|
|
procedure PutPeerViewPtr(var S: TStream; P: PView);
|
|
procedure Select;
|
|
procedure SetBounds(var Bounds: TRect);
|
|
procedure SetCommands(Commands: TCommandSet);
|
|
procedure SetCursor(X, Y: Integer);
|
|
procedure SetData(var Rec); virtual;
|
|
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
|
procedure Show;
|
|
procedure ShowCursor;
|
|
procedure SizeLimits(var Min, Max: TPoint); virtual;
|
|
procedure Store(var S: TStream);
|
|
function TopView: PView;
|
|
function Valid(Command: Word): Boolean; virtual;
|
|
procedure WriteBuf(X, Y, W, H: Integer; var Buf);
|
|
procedure WriteChar(X, Y: Integer; C: Char; Color: Byte;
|
|
Count: Integer);
|
|
procedure WriteLine(X, Y, W, H: Integer; var Buf);
|
|
procedure WriteStr(X, Y: Integer; Str: String; Color: Byte);
|
|
end;
|
|
|
|
{ TFrame types }
|
|
|
|
TTitleStr = string[80];
|
|
|
|
{ TFrame object }
|
|
|
|
{ Palette layout }
|
|
{ 1 = Passive frame }
|
|
{ 2 = Passive title }
|
|
{ 3 = Active frame }
|
|
{ 4 = Active title }
|
|
{ 5 = Icons }
|
|
|
|
PFrame = ^TFrame;
|
|
TFrame = object(TView)
|
|
constructor Init(var Bounds: TRect);
|
|
procedure Draw; virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
|
end;
|
|
|
|
{ ScrollBar characters }
|
|
|
|
TScrollChars = array[0..4] of Char;
|
|
|
|
{ TScrollBar object }
|
|
|
|
{ Palette layout }
|
|
{ 1 = Page areas }
|
|
{ 2 = Arrows }
|
|
{ 3 = Indicator }
|
|
|
|
PScrollBar = ^TScrollBar;
|
|
TScrollBar = object(TView)
|
|
Value: Integer;
|
|
Min: Integer;
|
|
Max: Integer;
|
|
PgStep: Integer;
|
|
ArStep: Integer;
|
|
constructor Init(var Bounds: TRect);
|
|
constructor Load(var S: TStream);
|
|
procedure Draw; virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
procedure ScrollDraw; virtual;
|
|
function ScrollStep(Part: Integer): Integer; virtual;
|
|
procedure SetParams(AValue, AMin, AMax, APgStep, AArStep: Integer);
|
|
procedure SetRange(AMin, AMax: Integer);
|
|
procedure SetStep(APgStep, AArStep: Integer);
|
|
procedure SetValue(AValue: Integer);
|
|
procedure Store(var S: TStream);
|
|
end;
|
|
|
|
{ TScroller object }
|
|
|
|
{ Palette layout }
|
|
{ 1 = Normal text }
|
|
{ 2 = Selected text }
|
|
|
|
PScroller = ^TScroller;
|
|
TScroller = object(TView)
|
|
HScrollBar: PScrollBar;
|
|
VScrollBar: PScrollBar;
|
|
Delta: TPoint;
|
|
Limit: TPoint;
|
|
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
|
constructor Load(var S: TStream);
|
|
procedure ChangeBounds(var Bounds: TRect); virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
procedure ScrollDraw; virtual;
|
|
procedure ScrollTo(X, Y: Integer);
|
|
procedure SetLimit(X, Y: Integer);
|
|
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
|
procedure Store(var S: TStream);
|
|
end;
|
|
|
|
{ TListViewer }
|
|
|
|
{ Palette layout }
|
|
{ 1 = Active }
|
|
{ 2 = Inactive }
|
|
{ 3 = Focused }
|
|
{ 4 = Selected }
|
|
{ 5 = Divider }
|
|
|
|
PListViewer = ^TListViewer;
|
|
|
|
TListViewer = object(TView)
|
|
HScrollBar: PScrollBar;
|
|
VScrollBar: PScrollBar;
|
|
NumCols: Integer;
|
|
TopItem: Integer;
|
|
Focused: Integer;
|
|
Range: Integer;
|
|
constructor Init(var Bounds: TRect; ANumCols: Word;
|
|
AHScrollBar, AVScrollBar: PScrollBar);
|
|
constructor Load(var S: TStream);
|
|
procedure ChangeBounds(var Bounds: TRect); virtual;
|
|
procedure Draw; virtual;
|
|
procedure FocusItem(Item: Integer); virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
function GetText(Item: Integer; MaxLen: Integer): String; virtual;
|
|
function IsSelected(Item: Integer): Boolean; virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
procedure SelectItem(Item: Integer); virtual;
|
|
procedure SetRange(ARange: Integer);
|
|
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
|
procedure Store(var S: TStream);
|
|
end;
|
|
|
|
{ Video buffer }
|
|
|
|
PVideoBuf = ^TVideoBuf;
|
|
TVideoBuf = array[0..3999] of Word;
|
|
|
|
{ Selection modes }
|
|
|
|
SelectMode = (NormalSelect, EnterSelect, LeaveSelect);
|
|
|
|
{ TGroup object }
|
|
|
|
TGroup = object(TView)
|
|
Last: PView;
|
|
Current: PView;
|
|
Phase: (phFocused, phPreProcess, phPostProcess);
|
|
Buffer: PVideoBuf;
|
|
constructor Init(var Bounds: TRect);
|
|
constructor Load(var S: TStream);
|
|
destructor Done; virtual;
|
|
procedure ChangeBounds(var Bounds: TRect); virtual;
|
|
function DataSize: Word; virtual;
|
|
procedure Delete(P: PView);
|
|
procedure Draw; virtual;
|
|
procedure EndModal(Command: Word); virtual;
|
|
procedure EventError(var Event: TEvent); virtual;
|
|
function ExecView(P: PView): Word;
|
|
function Execute: Word; virtual;
|
|
function First: PView;
|
|
function FirstThat(P: Pointer): PView;
|
|
procedure ForEach(P: Pointer);
|
|
procedure GetData(var Rec); virtual;
|
|
function GetHelpCtx: Word; virtual;
|
|
procedure GetSubViewPtr(var S: TStream; var P);
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
procedure Insert(P: PView);
|
|
procedure InsertBefore(P, Target: PView);
|
|
procedure Lock;
|
|
procedure PutSubViewPtr(var S: TStream; P: PView);
|
|
procedure Redraw;
|
|
procedure SelectNext(Forwards: Boolean);
|
|
procedure SetData(var Rec); virtual;
|
|
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
|
procedure Store(var S: TStream);
|
|
procedure Unlock;
|
|
function Valid(Command: Word): Boolean; virtual;
|
|
end;
|
|
|
|
{ TWindow object }
|
|
|
|
{ Palette layout }
|
|
{ 1 = Frame passive }
|
|
{ 2 = Frame active }
|
|
{ 3 = Frame icon }
|
|
{ 4 = ScrollBar page area }
|
|
{ 5 = ScrollBar controls }
|
|
{ 6 = Scroller normal text }
|
|
{ 7 = Scroller selected text }
|
|
{ 8 = Reserved }
|
|
|
|
PWindow = ^TWindow;
|
|
TWindow = object(TGroup)
|
|
Flags: Byte;
|
|
ZoomRect: TRect;
|
|
Number: Integer;
|
|
Palette: Integer;
|
|
Frame: PFrame;
|
|
Title: PString;
|
|
constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
|
|
constructor Load(var S: TStream);
|
|
destructor Done; virtual;
|
|
procedure Close; virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
function GetTitle(MaxSize: Integer): TTitleStr; virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
procedure InitFrame; virtual;
|
|
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
|
procedure SizeLimits(var Min, Max: TPoint); virtual;
|
|
function StandardScrollBar(AOptions: Word): PScrollBar;
|
|
procedure Store(var S: TStream);
|
|
procedure Zoom; virtual;
|
|
end;
|
|
|
|
{ Message dispatch function }
|
|
|
|
function Message(Receiver: PView; What, Command: Word;
|
|
InfoPtr: Pointer): Pointer;
|
|
|
|
{ Views registration procedure }
|
|
|
|
procedure RegisterViews;
|
|
|
|
const
|
|
|
|
{ Event masks }
|
|
|
|
PositionalEvents: Word = evMouse;
|
|
FocusedEvents: Word = evKeyboard + evCommand;
|
|
|
|
{ Minimum window size }
|
|
|
|
MinWinSize: TPoint = (X: 16; Y: 6);
|
|
|
|
{ Shadow definitions }
|
|
|
|
ShadowSize: TPoint = (X: 2; Y: 1);
|
|
ShadowAttr: Byte = $08;
|
|
|
|
{ Markers control }
|
|
|
|
ShowMarkers: Boolean = False;
|
|
|
|
{ MapColor error return value }
|
|
|
|
ErrorAttr: Byte = $CF;
|
|
|
|
{ Stream Registration Records }
|
|
|
|
RView: TStreamRec = (
|
|
ObjType: 1;
|
|
VmtLink: Ofs(TypeOf(TView)^);
|
|
Load: @TView.Load;
|
|
Store: @TView.Store
|
|
);
|
|
RFrame: TStreamRec = (
|
|
ObjType: 2;
|
|
VmtLink: Ofs(TypeOf(TFrame)^);
|
|
Load: @TFrame.Load;
|
|
Store: @TFrame.Store
|
|
);
|
|
RScrollBar: TStreamRec = (
|
|
ObjType: 3;
|
|
VmtLink: Ofs(TypeOf(TScrollBar)^);
|
|
Load: @TScrollBar.Load;
|
|
Store: @TScrollBar.Store
|
|
);
|
|
RScroller: TStreamRec = (
|
|
ObjType: 4;
|
|
VmtLink: Ofs(TypeOf(TScroller)^);
|
|
Load: @TScroller.Load;
|
|
Store: @TScroller.Store
|
|
);
|
|
RListViewer: TStreamRec = (
|
|
ObjType: 5;
|
|
VmtLink: Ofs(TypeOf(TListViewer)^);
|
|
Load: @TListViewer.Load;
|
|
Store: @TLIstViewer.Store
|
|
);
|
|
RGroup: TStreamRec = (
|
|
ObjType: 6;
|
|
VmtLink: Ofs(TypeOf(TGroup)^);
|
|
Load: @TGroup.Load;
|
|
Store: @TGroup.Store
|
|
);
|
|
RWindow: TStreamRec = (
|
|
ObjType: 7;
|
|
VmtLink: Ofs(TypeOf(TWindow)^);
|
|
Load: @TWindow.Load;
|
|
Store: @TWindow.Store
|
|
);
|
|
|
|
{ Characters used for drawing selected and default items in }
|
|
{ monochrome color sets }
|
|
|
|
SpecialChars: array[0..5] of Char = (#175, #174, #26, #27, ' ', ' ');
|
|
|
|
{ True if the command set has changed since being set to false }
|
|
|
|
CommandSetChanged: Boolean = False;
|