home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
vp21beta.zip
/
ATVSRC.RAR
/
VIEWS.PAS
< prev
Wrap
Pascal/Delphi Source File
|
2000-08-15
|
105KB
|
3,931 lines
{*******************************************************}
{ }
{ Turbo Pascal Version 7.0 }
{ Turbo Vision Unit }
{ }
{ Copyright (c) 1992 Borland International }
{ }
{ Virtual Pascal v2.1 }
{ Copyright (C) 1996-2000 vpascal.com }
{ }
{*******************************************************}
unit Views;
{$X+,I-,S-,Cdecl-,Delphi-,Use32+}
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;
ofValidate = $0400;
ofVersion = $3000;
ofVersion10 = $0000;
ofVersion20 = $1000;
{ 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 = 255;
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 SmallWord;
{ 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 Awaken; 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;
function Focus: 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 SetCmdState(Commands: TCommandSet; Enable: Boolean);
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);
private
procedure DrawCursor;
procedure DrawHide(LastView: PView);
procedure DrawShow(LastView: PView);
procedure DrawUnderRect(var R: TRect; LastView: PView);
procedure DrawUnderView(DoShadow: Boolean; LastView: PView);
procedure ResetCursor; virtual;
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;
private
FrameMode: Word;
procedure FrameLine(var FrameBuf; Y, N: Integer; Color: Byte);
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);
private
Chars: TScrollChars;
procedure DrawPos(Pos: Integer);
function GetPos: Integer;
function GetSize: Integer;
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);
private
DrawLock: Byte;
DrawFlag: Boolean;
procedure CheckDraw;
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);
private
procedure FocusItemNum(Item: Integer); virtual;
end;
{ Video buffer }
PVideoBuf = ^TVideoBuf;
TVideoBuf = array[0..3999] of SmallWord;
{ Selection modes }
SelectMode = (NormalSelect, EnterSelect, LeaveSelect);
{ TGroup object }
TGroup = object(TView)
Last: PView;
Current: PView;
Phase: (phFocused, phPreProcess, phPostProcess);
Buffer: PVideoBuf;
EndState: Word;
constructor Init(var Bounds: TRect);
constructor Load(var S: TStream);
destructor Done; virtual;
procedure Awaken; 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;
function FocusNext(Forwards: Boolean): Boolean;
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;
private
Clip: TRect;
LockFlag: Byte;
function At(Index: Integer): PView;
procedure DrawSubViews(P, Bottom: PView);
function FirstMatch(AState: Word; AOptions: Word): PView;
function FindNext(Forwards: Boolean): PView;
procedure FreeBuffer;
procedure GetBuffer;
function IndexOf(P: PView): Integer;
procedure InsertView(P, Target: PView);
procedure RemoveView(P: PView);
procedure ResetCurrent;
procedure ResetCursor; virtual;
procedure SetCurrent(P: PView; Mode: SelectMode);
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 }
const
RView: TStreamRec = (
ObjType: 1;
VmtLink: Ofs(TypeOf(TView)^);
Load: @TView.Load;
Store: @TView.Store
);
const
RFrame: TStreamRec = (
ObjType: 2;
VmtLink: Ofs(TypeOf(TFrame)^);
Load: @TFrame.Load;
Store: @TFrame.Store
);
const
RScrollBar: TStreamRec = (
ObjType: 3;
VmtLink: Ofs(TypeOf(TScrollBar)^);
Load: @TScrollBar.Load;
Store: @TScrollBar.Store
);
const
RScroller: TStreamRec = (
ObjType: 4;
VmtLink: Ofs(TypeOf(TScroller)^);
Load: @TScroller.Load;
Store: @TScroller.Store
);
const
RListViewer: TStreamRec = (
ObjType: 5;
VmtLink: Ofs(TypeOf(TListViewer)^);
Load: @TListViewer.Load;
Store: @TLIstViewer.Store
);
const
RGroup: TStreamRec = (
ObjType: 6;
VmtLink: Ofs(TypeOf(TGroup)^);
Load: @TGroup.Load;
Store: @TGroup.Store
);
const
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;
{ True if the cursor is currently hidden }
CursorHidden: Boolean = True;
{ Line drawing characters }
ldFrameChars : array[0..31] of Char = ' └ │┌├ ┘─┴┐┤┬┼ ╚ ║╔║ ╝══╗║═ ';
{ Codepage = 437 : ' └ │┌├ ┘─┴┐┤┬┼ ╚ ║╔╟ ╝═╧╗╢╤ '; }
ldMenuFrameChars : array[0..19] of Char = ' ┌─┐ └─┘ │ │ ├─┤ ';
ldCloseWindow : array[0..4] of char = '[~■~]';
ldCloseClicked : array[0..4] of char = '[~'#15'~]';
ldMaximize : array[0..4] of char = '[~'#24'~]';
ldBottomRight : array[0..3] of char = '~─┘~';
ldVerticalScroll : TScrollChars = #30#31#177#254#178;
ldHorizontalScroll : TScrollChars = #17#16#177#254#178;
ldHistoryDropDown : array[0..4] of char = #222'~'#25'~'#221;
ldPathDir : array[0..2] of char = '└─┬';
ldFirstDir : array[0..2] of char = '└┬─';
ldMiddleDir : array[0..2] of char = ' ├─';
ldLastDir : array[0..2] of char = ' └─';
ldIndentSize : String[10] = ' ';
ldDesktopBackground : char = #176; // ░
ldSubMenuArrow : char = #16; //
ldVerticalBar : char = #179; // │
ldHorizontalBar : char = #196; // ─
ldDblHorizontalBar : char = #205; // ═
ldBlockFull : char = #219; // █
ldBlockBottom : char = #220; // ▄
ldBlockTop : char = #223; // ▀
ldRadioSelect : char = #7; //
implementation
uses VpSysLow;
type
PFixupList = ^TFixupList;
TFixupList = array[1..4096] of Pointer;
const
OwnerGroup: PGroup = nil;
FixupList: PFixupList = nil;
TheTopView: PView = nil;
const
{ Bit flags to determine how to draw the frame icons }
fmCloseClicked = $0001;
fmZoomClicked = $0002;
{ Current command set. All but window commands are active by default }
CurCommandSet: TCommandSet =
[0..255] - [cmZoom, cmClose, cmResize, cmNext, cmPrev];
procedure ShowBuffer(BufOfs,Len: Word);
begin
asm
push esi
push edi
mov esi,ScreenBuffer
add esi,BufOfs // Pointer to screen
mov edx,esi
mov edi,OFFSET ScreenMirror
add edi,BufOfs // Pointer to mirror
mov ecx,Len // Length of required update
mov eax,ecx
shr ecx,2
and eax,3
test eax,eax // divisible by 4?
je @@Byte4
inc ecx
@@Byte4:
cld
repe cmpsd // Compare mirror and buffer
jne @@Update // Buffers ne; search from other end
xor eax,eax // Do not update screen
jmp @@Equal
@@Update:
inc ecx
sub edi,4 // Adjust pointers
sub esi,4
sub edx,esi // Subtract new from old
sub BufOfs,edx // Set new offset to start from
push esi // Store place to update from
push edi
lea esi,[esi+ecx*4-4]
lea edi,[edi+ecx*4-4]
std
repe cmpsd
pop edi
pop esi
inc ecx // Increase counter
mov eax,ecx // Store new length
shl eax,2 // New length times dword size
cld
rep movsd // Update
@@Equal:
mov Len,eax
pop edi
pop esi
end;
If Len <> 0 then
SysTVShowBuf(BufOfs, Len);
end;
{ Convert color into attribute }
{ In AL = Color }
{ Out AL = Attribute }
procedure MapColor; assembler; {&USES ebx} {&FRAME-}
const
Self = 8;
TView_GetPalette = vmtHeaderSize + $2C;
asm
test al,al
jz @@3
mov ecx,[ebp].Self
@@1:
push ecx
push eax
push ecx { [1]:Pointer = Self }
mov ecx,[ecx]
Call DWord Ptr [ecx].TView_GetPalette
mov ebx,eax
pop eax
pop ecx
test ebx,ebx
jz @@2
cmp al,[ebx]
ja @@3
xlat
test al,al
jz @@3
@@2:
mov ecx,[ecx].TView.Owner
jecxz @@4
jmp @@1
@@3:
mov al,ErrorAttr
@@4:
end;
{ Convert color pair into attribute pair }
{ In AX = Color pair }
{ Out AX = Attribute pair }
procedure MapCPair; {&USES None} {&FRAME-}
asm
test ah,ah
jz @@1
xchg al,ah
Call MapColor
xchg al,ah
@@1:
Call MapColor
end;
{ Write to view }
{ In eax = Y coordinate }
{ ebx = X coordinate }
{ ecx = Count }
{ edi = Buffer Pointer }
procedure WriteView; assembler; {&USES None} {&FRAME-}
const
Self = 8;
Target = -4;
Buffer = -8;
BufOfs = -12;
asm
mov [ebp].BufOfs,ebx
mov [ebp].Buffer[0],edi
add ecx,ebx
xor edx,edx { edx = Flag (0:Char&Attr,1:Char only) }
mov edi,[ebp].Self
test eax,eax
jl @@3
cmp eax,[edi].TView.Size.Y
jge @@3
test ebx,ebx
jge @@1
xor ebx,ebx
@@1:
cmp ecx,[edi].TView.Size.X
jle @@2
mov ecx,[edi].TView.Size.X
@@2:
cmp ebx,ecx
jl @@10
@@3:
ret
@@10:
test [edi].TView.State,sfVisible
jz @@3
cmp [edi].TView.Owner,0
jz @@3
mov [ebp].Target,edi
add eax,[edi].TView.Origin.Y
mov esi,[edi].TView.Origin.X
add ebx,esi
add ecx,esi
add [ebp].BufOfs,esi
mov edi,[edi].TView.Owner
cmp eax,[edi].TGroup.Clip.A.Y
jl @@3
cmp eax,[edi].TGroup.Clip.B.Y
jge @@3
cmp ebx,[edi].TGroup.Clip.A.X
jge @@11
mov ebx,[edi].TGroup.Clip.A.X
@@11:
cmp ecx,[edi].TGroup.Clip.B.X
jle @@12
mov ecx,[edi].TGroup.Clip.B.X
@@12:
cmp ebx,ecx
jge @@3
mov edi,[edi].TGroup.Last
@@20:
mov edi,[edi].TView.Next
cmp edi,[ebp].Target
je @@40
test [edi].TView.State,sfVisible
jz @@20
mov esi,[edi].TView.Origin.Y
cmp eax,esi
jl @@20
add esi,[edi].TView.Size.Y
cmp eax,esi
jl @@23
test [edi].TView.State,sfShadow
jz @@20
add esi,ShadowSize.Y
cmp eax,esi
jge @@20
mov esi,[edi].TView.Origin.X
add esi,ShadowSize.X
cmp ebx,esi
jge @@22
cmp ecx,esi
jle @@20
Call @@30
@@22:
add esi,[edi].TView.Size.X
jmp @@26
@@23:
mov esi,[edi].TView.Origin.X
cmp ebx,esi
jge @@24
cmp ecx,esi
jle @@20
Call @@30
@@24:
add esi,[edi].TView.Size.X
cmp ebx,esi
jge @@25
cmp ecx,esi
jle @@31
mov ebx,esi
@@25:
test [edi].TView.State,sfShadow
je @@20
push esi
mov esi,[edi].TView.Origin.Y
add esi,ShadowSize.Y
cmp eax,esi
pop esi
jl @@27
add esi,ShadowSize.X
@@26:
cmp ebx,esi
jge @@27
inc edx
cmp ecx,esi
jle @@27
Call @@30
dec edx
@@27:
jmp @@20
@@30:
push DWord Ptr [ebp].Target
push DWord Ptr [ebp].BufOfs
push edi
push esi
push edx
push ecx
push eax
mov ecx,esi
Call @@20
pop eax
pop ecx
pop edx
pop esi
pop edi
pop DWord Ptr [ebp].BufOfs
pop DWord Ptr [ebp].Target
mov ebx,esi
@@31:
ret
@@40:
mov edi,[edi].TView.Owner
mov esi,[edi].TGroup.Buffer
test esi,esi
jz @@44
cmp esi,ScreenBuffer
jne @@43
push eax
push ecx
push edx
Call UpdateMouseWhere
pop edx
pop ecx
pop eax
cmp eax,MouseWhere.Y
jne @@43
cmp ebx,MouseWhere.X
ja @@43
cmp ecx,MouseWhere.X
jbe @@43
push eax
push ecx
push edx
Call HideMouse
pop edx
pop ecx
pop eax
Call @@50
push eax
push ecx
push edx
Call ShowMouse
pop edx
pop ecx
pop eax
jmp @@44
@@43:
Call @@50
@@44:
cmp [edi].TGroup.LockFlag,0
jne @@31
jmp @@10
{ Copy to Buffer }
@@50:
push edi
push ecx
push ebx
push eax
mul [edi].TView.Size.X.Byte[0]
add eax,ebx
lea edi,[esi+eax*2]
xor al,al
mov ah,ShadowAttr
sub ecx,ebx
xchg esi,ebx
sub esi,[ebp].BufOfs
shl esi,1
add esi,[ebp].Buffer
push edi
push ecx
cld
test edx,edx
jnz @@52
shr ecx,1
rep movsd
adc ecx,ecx
rep movsw
jmp @@53
@@52:
lodsb
inc esi
stosw
loop @@52
@@53:
pop ecx
pop edi
mov eax,ScreenBuffer
cmp ebx,eax
jne @@54
shl ecx,1
sub edi,eax
push edi { [1]:DWord = Offset }
push ecx { [2]:DWord = Length }
Call ShowBuffer
@@54:
pop eax
pop ebx
pop ecx
pop edi
ret
end;
{ TView }
constructor TView.Init(var Bounds: TRect);
begin
TObject.Init;
Owner := nil;
State := sfVisible;
SetBounds(Bounds);
DragMode := dmLimitLoY;
HelpCtx := hcNoContext;
EventMask := evMouseDown + evKeyDown + evCommand;
end;
constructor TView.Load(var S: TStream);
begin
TObject.Init;
S.Read(Origin,
SizeOf(TPoint) * 3 +
SizeOf(Byte) * 2 +
SizeOf(Word) * 4);
end;
destructor TView.Done;
begin
Hide;
if Owner <> nil then Owner^.Delete(@Self);
end;
procedure TView.Awaken;
begin
end;
procedure TView.BlockCursor;
begin
SetState(sfCursorIns, True);
end;
procedure TView.CalcBounds(var Bounds: TRect; Delta: TPoint);
var
S, D: Integer;
Min, Max: TPoint;
procedure Grow(var I: Integer);
begin
if GrowMode and gfGrowRel = 0 then Inc(I, D) else
I := (I * S + (S - D) shr 1) div (S - D);
end;
function Range(Val, Min, Max: Integer): Integer;
begin
if Val < Min then Range := Min else
if Val > Max then Range := Max else
Range := Val;
end;
begin
GetBounds(Bounds);
S := Owner^.Size.X;
D := Delta.X;
if GrowMode and gfGrowLoX <> 0 then Grow(Bounds.A.X);
if GrowMode and gfGrowHiX <> 0 then Grow(Bounds.B.X);
if Bounds.B.X - Bounds.A.X > MaxViewWidth then
Bounds.B.X := Bounds.A.X + MaxViewWidth;
S := Owner^.Size.Y;
D := Delta.Y;
if GrowMode and gfGrowLoY <> 0 then Grow(Bounds.A.Y);
if GrowMode and gfGrowHiY <> 0 then Grow(Bounds.B.Y);
SizeLimits(Min, Max);
Bounds.B.X := Bounds.A.X + Range(Bounds.B.X - Bounds.A.X, Min.X, Max.X);
Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y - Bounds.A.Y, Min.Y, Max.Y);
end;
procedure TView.ChangeBounds(var Bounds: TRect);
begin
SetBounds(Bounds);
DrawView;
end;
procedure TView.ClearEvent(var Event: TEvent);
begin
Event.What := evNothing;
Event.InfoPtr := @Self;
end;
function TView.CommandEnabled(Command: Word): Boolean;
begin
CommandEnabled := (Command > 255) or (Command in CurCommandSet);
end;
function TView.DataSize: Word;
begin
DataSize := 0;
end;
procedure TView.DisableCommands(Commands: TCommandSet);
begin
CommandSetChanged := CommandSetChanged or (CurCommandSet * Commands <> []);
CurCommandSet := CurCommandSet - Commands;
end;
procedure TView.DragView(Event: TEvent; Mode: Byte;
var Limits: TRect; MinSize, MaxSize: TPoint);
var
P, S: TPoint;
SaveBounds: TRect;
function Min(I, J: Integer): Integer;
begin
if I < J then Min := I else Min := J;
end;
function Max(I, J: Integer): Integer;
begin
if I > J then Max := I else Max := J;
end;
procedure MoveGrow(P, S: TPoint);
var
R: TRect;
begin
S.X := Min(Max(S.X, MinSize.X), MaxSize.X);
S.Y := Min(Max(S.Y, MinSize.Y), MaxSize.Y);
P.X := Min(Max(P.X, Limits.A.X - S.X + 1), Limits.B.X - 1);
P.Y := Min(Max(P.Y, Limits.A.Y - S.Y + 1), Limits.B.Y - 1);
if Mode and dmLimitLoX <> 0 then P.X := Max(P.X, Limits.A.X);
if Mode and dmLimitLoY <> 0 then P.Y := Max(P.Y, Limits.A.Y);
if Mode and dmLimitHiX <> 0 then P.X := Min(P.X, Limits.B.X - S.X);
if Mode and dmLimitHiY <> 0 then P.Y := Min(P.Y, Limits.B.Y - S.Y);
R.Assign(P.X, P.Y, P.X + S.X, P.Y + S.Y);
Locate(R);
end;
procedure Change(DX, DY: Integer);
begin
if (Mode and dmDragMove <> 0) and (GetShiftState and $03 = 0) then
begin
Inc(P.X, DX);
Inc(P.Y, DY);
end else
if (Mode and dmDragGrow <> 0) and (GetShiftState and $03 <> 0) then
begin
Inc(S.X, DX);
Inc(S.Y, DY);
end;
end;
procedure Update(X, Y: Integer);
begin
if Mode and dmDragMove <> 0 then
begin
P.X := X;
P.Y := Y;
end;
end;
begin
SetState(sfDragging, True);
if Event.What = evMouseDown then
begin
if Mode and dmDragMove <> 0 then
begin
P.X := Origin.X - Event.Where.X;
P.Y := Origin.Y - Event.Where.Y;
repeat
Inc(Event.Where.X, P.X);
Inc(Event.Where.Y, P.Y);
MoveGrow(Event.Where, Size);
until not MouseEvent(Event, evMouseMove);
end else
begin
P.X := Size.X - Event.Where.X;
P.Y := Size.Y - Event.Where.Y;
repeat
Inc(Event.Where.X, P.X);
Inc(Event.Where.Y, P.Y);
MoveGrow(Origin, Event.Where);
until not MouseEvent(Event, evMouseMove);
end;
end else
begin
GetBounds(SaveBounds);
repeat
P := Origin;
S := Size;
KeyEvent(Event);
case Event.KeyCode and $FF00 of
kbLeft: Change(-1, 0);
kbRight: Change(1, 0);
kbUp: Change(0, -1);
kbDown: Change(0, 1);
kbCtrlLeft: Change(-8, 0);
kbCtrlRight: Change(8, 0);
kbHome: Update(Limits.A.X, P.Y);
kbEnd: Update(Limits.B.X - S.X, P.Y);
kbPgUp: Update(P.X, Limits.A.Y);
kbPgDn: Update(P.X, Limits.B.Y - S.Y);
end;
MoveGrow(P, S);
until (Event.KeyCode = kbEnter) or (Event.KeyCode = kbEsc);
if Event.KeyCode = kbEsc then Locate(SaveBounds);
end;
SetState(sfDragging, False);
end;
procedure TView.Draw;
var
B: TDrawBuffer;
begin
MoveChar(B, ' ', GetColor(1), Size.X);
WriteLine(0, 0, Size.X, Size.Y, B);
end;
procedure TView.DrawCursor;
begin
if State and sfFocused <> 0 then ResetCursor;
end;
procedure TView.DrawHide(LastView: PView);
begin
DrawCursor;
DrawUnderView(State and sfShadow <> 0, LastView);
end;
procedure TView.DrawShow(LastView: PView);
begin
DrawView;
if State and sfShadow <> 0 then DrawUnderView(True, LastView);
end;
procedure TView.DrawUnderRect(var R: TRect; LastView: PView);
begin
Owner^.Clip.Intersect(R);
Owner^.DrawSubViews(NextView, LastView);
Owner^.GetExtent(Owner^.Clip);
end;
procedure TView.DrawUnderView(DoShadow: Boolean; LastView: PView);
var
R: TRect;
begin
GetBounds(R);
// AM: Always increase to include shadow rect, to make sure it is
// removed if this option is changed.
// if DoShadow then
begin
Inc(R.B.X, ShadowSize.X);
Inc(R.B.Y, ShadowSize.Y);
end;
DrawUnderRect(R, LastView);
end;
procedure TView.DrawView;
begin
if Exposed then
begin
Draw;
DrawCursor;
end;
end;
procedure TView.EnableCommands(Commands: TCommandSet);
begin
CommandSetChanged := CommandSetChanged or
(CurCommandSet * Commands <> Commands);
CurCommandSet := CurCommandSet + Commands;
end;
procedure TView.EndModal(Command: Word);
var
P: PView;
begin
P := TopView;
if TopView <> nil then TopView^.EndModal(Command);
end;
function TView.EventAvail: Boolean;
var
Event: TEvent;
begin
GetEvent(Event);
if Event.What <> evNothing then PutEvent(Event);
EventAvail := Event.What <> evNothing;
end;
procedure TView.GetBounds(var Bounds: TRect); {&USES esi,edi} {&FRAME-}
asm
mov esi,Self
add esi,OFFSET TView.Origin
mov edi,Bounds
cld
lodsd {Origin.X}
mov ecx,eax
stosd
lodsd {Origin.Y}
mov edx,eax
stosd
lodsd {Size.X}
add eax,ecx
stosd
lodsd {Size.Y}
add eax,edx
stosd
end;
function TView.Execute: Word;
begin
Execute := cmCancel;
end;
function TView.Exposed: Boolean; assembler; {&USES ebx,esi,edi} {&FRAME+}
var
Target: Pointer;
asm
mov edi,Self
test [edi].TView.State,sfExposed
je @@2
xor eax,eax
cmp eax,[edi].TView.Size.X
jge @@2
cmp eax,[edi].TView.Size.Y
jge @@2
@@1:
xor ebx,ebx
mov ecx,[edi].TView.Size.X
push eax
Call @@11
pop eax
jnc @@3
mov edi,Self
inc eax
cmp eax,[edi].TView.Size.Y
jl @@1
@@2:
mov al,0
jmp @@30
@@3:
mov al,1
jmp @@30
@@8:
stc
@@9:
ret
@@10:
mov edi,[edi].TView.Owner
cmp [edi].TGroup.Buffer,0
jne @@9
@@11:
mov Target,edi
add eax,[edi].TView.Origin.Y
mov esi,[edi].TView.Origin.X
add ebx,esi
add ecx,esi
mov edi,[edi].TView.Owner
test edi,edi
jz @@9
cmp eax,[edi].TGroup.Clip.A.Y
jl @@8
cmp eax,[edi].TGroup.Clip.B.Y
jge @@8
cmp ebx,[edi].TGroup.Clip.A.X
jge @@12
mov ebx,[edi].TGroup.Clip.A.X
@@12:
cmp ecx,[edi].TGroup.Clip.B.X
jle @@13
mov ecx,[edi].TGroup.Clip.B.X
@@13:
cmp ebx,ecx
jge @@8
mov edi,[edi].TGroup.Last
@@20:
mov edi,[edi].TView.Next
cmp edi,Target
je @@10
test [edi].TView.State,sfVisible
jz @@20
mov esi,[edi].TView.Origin.Y
cmp eax,esi
jl @@20
add esi,[edi].TView.Size.Y
cmp eax,esi
jge @@20
mov esi,[edi].TView.Origin.X
cmp ebx,esi
jl @@22
add esi,[edi].TView.Size.X
cmp ebx,esi
jge @@20
mov ebx,esi
cmp ebx,ecx
jl @@20
stc
ret
@@22:
cmp ecx,esi
jle @@20
add esi,[edi].TView.Size.X
cmp ecx,esi
jg @@23
mov ecx,[edi].TView.Origin.X
jmp @@20
@@23:
push Target
push edi
push esi
push ecx
push eax
mov ecx,[edi].TView.Origin.X
Call @@20
pop eax
pop ecx
pop ebx
pop edi
pop Target
jc @@20
retn
@@30:
end;
function TView.Focus: Boolean;
var
Result: Boolean;
begin
Result := True;
if State and (sfSelected + sfModal) = 0 then
begin
if Owner <> nil then
begin
Result := Owner^.Focus;
if Result then
if ((Owner^.Current = nil) or
(Owner^.Current^.Options and ofValidate = 0) or
(Owner^.Current^.Valid(cmReleasedFocus))) then
Select
else
Result := False;
end;
end;
Focus := Result;
end;
procedure TView.GetClipRect(var Clip: TRect);
begin
GetBounds(Clip);
if Owner <> nil then Clip.Intersect(Owner^.Clip);
Clip.Move(-Origin.X, -Origin.Y);
end;
function TView.GetColor(Color: Word): Word; {&USES None} {&FRAME+}
asm
mov eax,Color
Call MapCPair
end;
procedure TView.GetCommands(var Commands: TCommandSet);
begin
Commands := CurCommandSet;
end;
procedure TView.GetData(var Rec);
begin
end;
procedure TView.GetEvent(var Event: TEvent);
begin
if Owner <> nil then Owner^.GetEvent(Event);
end;
procedure TView.GetExtent(var Extent: TRect); {&USES esi,edi} {&FRAME-}
asm
mov esi,Self
add esi,OFFSET TView.Size
mov edi,Extent
cld
xor eax,eax
stosd
stosd
movsd
movsd
end;
function TView.GetHelpCtx: Word;
begin
if State and sfDragging <> 0 then
GetHelpCtx := hcDragging else
GetHelpCtx := HelpCtx;
end;
function TView.GetPalette: PPalette;
begin
GetPalette := nil;
end;
procedure TView.GetPeerViewPtr(var S: TStream; var P);
var
Index: Integer;
begin
S.Read(Index, SizeOf(Word));
if (Index = 0) or (OwnerGroup = nil) then Pointer(P) := nil
else
begin
Pointer(P) := FixupList^[Index];
FixupList^[Index] := @P;
end;
end;
function TView.GetState(AState: Word): Boolean;
begin
GetState := State and AState = AState;
end;
procedure TView.GrowTo(X, Y: Integer);
var
R: TRect;
begin
R.Assign(Origin.X, Origin.Y, Origin.X + X, Origin.Y + Y);
Locate(R);
end;
procedure TView.HandleEvent(var Event: TEvent);
begin
if Event.What = evMouseDown then
if (State and (sfSelected + sfDisabled) = 0) and
(Options and ofSelectable <> 0) then
if not Focus or (Options and ofFirstClick = 0) then
ClearEvent(Event);
end;
procedure TView.Hide;
begin
if State and sfVisible <> 0 then SetState(sfVisible, False);
end;
procedure TView.HideCursor;
begin
SetState(sfCursorVis, False);
end;
procedure TView.KeyEvent(var Event: TEvent);
begin
repeat GetEvent(Event) until Event.What = evKeyDown;
end;
procedure TView.Locate(var Bounds: TRect);
var
R: TRect;
Min, Max: TPoint;
function Range(Val, Min, Max: Integer): Integer;
begin
if Val < Min then Range := Min else
if Val > Max then Range := Max else
Range := Val;
end;
begin
SizeLimits(Min, Max);
Bounds.B.X := Bounds.A.X + Range(Bounds.B.X - Bounds.A.X, Min.X, Max.X);
Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y - Bounds.A.Y, Min.Y, Max.Y);
GetBounds(R);
if not Bounds.Equals(R) then
begin
ChangeBounds(Bounds);
if (Owner <> nil) and (State and sfVisible <> 0) then
begin
if State and sfShadow <> 0 then
begin
R.Union(Bounds);
Inc(R.B.X, ShadowSize.X);
Inc(R.B.Y, ShadowSize.Y);
end;
DrawUnderRect(R, nil);
end;
end;
end;
procedure TView.MakeFirst;
begin
PutInFrontOf(Owner^.First);
end;
procedure TView.MakeGlobal(Source: TPoint; var Dest: TPoint); {&USES None} {&FRAME-}
asm
mov ecx,Self
xor eax,eax
mov edx,eax
@@1:
add eax,[ecx].TView.Origin.X
add edx,[ecx].TView.Origin.Y
mov ecx,[ecx].TView.Owner
test ecx,ecx
jnz @@1
add eax,Source.X
add edx,Source.Y
mov ecx,Dest
mov [ecx].TPoint.X,eax
mov [ecx].TPoint.Y,edx
end;
procedure TView.MakeLocal(Source: TPoint; var Dest: TPoint); {&USES None} {&FRAME-}
asm
mov ecx,Self
xor eax,eax
mov edx,eax
@@1:
add eax,[ecx].TView.Origin.X
add edx,[ecx].TView.Origin.Y
mov ecx,[ecx].TView.Owner
test ecx,ecx
jnz @@1
neg eax
neg edx
add eax,Source.X
add edx,Source.Y
mov ecx,Dest
mov [ecx].TPoint.X,eax
mov [ecx].TPoint.Y,edx
end;
function TView.MouseEvent(var Event: TEvent; Mask: Word): Boolean;
begin
repeat GetEvent(Event) until Event.What and (Mask or evMouseUp) <> 0;
MouseEvent := Event.What <> evMouseUp;
end;
function TView.MouseInView(Mouse: TPoint): Boolean;
var
Extent: TRect;
begin
MakeLocal(Mouse, Mouse);
GetExtent(Extent);
MouseInView := Extent.Contains(Mouse);
end;
procedure TView.MoveTo(X, Y: Integer);
var
R: TRect;
begin
R.Assign(X, Y, X + Size.X, Y + Size.Y);
Locate(R);
end;
function TView.NextView: PView;
begin
if @Self = Owner^.Last then NextView := nil else NextView := Next;
end;
procedure TView.NormalCursor;
begin
SetState(sfCursorIns, False);
end;
function TView.Prev: PView; {&USES None} {&FRAME-}
asm
mov edx,Self
mov ecx,edx
@@1:
mov eax,edx
mov edx,[edx].TView.Next
cmp edx,ecx
jne @@1
end;
function TView.PrevView: PView;
begin
if @Self = Owner^.First then PrevView := nil else PrevView := Prev;
end;
procedure TView.PutEvent(var Event: TEvent);
begin
if Owner <> nil then Owner^.PutEvent(Event);
end;
procedure TView.PutInFrontOf(Target: PView);
var
P, LastView: PView;
procedure MoveView;
begin
Owner^.RemoveView(@Self);
Owner^.InsertView(@Self, Target);
end;
begin
if (Owner <> nil) and (Target <> @Self) and (Target <> NextView) and
((Target = nil) or (Target^.Owner = Owner)) then
if State and sfVisible = 0 then MoveView else
begin
LastView := NextView;
if LastView <> nil then
begin
P := Target;
while (P <> nil) and (P <> LastView) do P := P^.NextView;
if P = nil then LastView := Target;
end;
State := State and not sfVisible;
if LastView = Target then DrawHide(LastView);
MoveView;
State := State or sfVisible;
if LastView <> Target then DrawShow(LastView);
if Options and ofSelectable <> 0 then
begin
Owner^.ResetCurrent;
Owner^.ResetCursor;
end;
end;
end;
procedure TView.PutPeerViewPtr(var S: TStream; P: PView);
var
Index: Integer;
begin
if (P = nil) or (OwnerGroup = nil) then Index := 0
else Index := OwnerGroup^.IndexOf(P);
S.Write(Index, SizeOf(Word));
end;
procedure TView.ResetCursor; {&USES esi,edi} {&FRAME-}
asm
mov edi,Self
mov eax,[edi].TView.State
not eax
test eax,sfVisible+sfCursorVis+sfFocused
jne @@Hide
mov eax,[edi].TView.Cursor.Y
mov edx,[edi].TView.Cursor.X
@@1:
test eax,eax
jl @@Hide
cmp eax,[edi].TView.Size.Y
jge @@Hide
test edx,edx
jl @@Hide
cmp edx,[edi].TView.Size.X
jge @@Hide
add eax,[edi].TView.Origin.Y
add edx,[edi].TView.Origin.X
mov ecx,edi
mov edi,[edi].TView.Owner
test edi,edi
jz @@Show
test [edi].TView.State,sfVisible
je @@Hide
mov edi,[edi].TGroup.Last
@@2:
mov edi,[edi].TView.Next
cmp ecx,edi
jne @@3
mov edi,[edi].TView.Owner
jmp @@1
@@3:
test [edi].TView.State,sfVisible
je @@2
mov esi,[edi].TView.Origin.Y
cmp eax,esi
jl @@2
add esi,[edi].TView.Size.Y
cmp eax,esi
jge @@2
mov esi,[edi].TView.Origin.X
cmp edx,esi
jl @@2
add esi,[edi].TView.Size.X
cmp edx,esi
jge @@2
@@Hide:
mov al,0 // Show := False
xor ecx,ecx
jmp @@4
{ Set Cursor Position }
@@Show:
push edx // [1]:DWord = Column
push eax // [2]:DWord = Row
Call SysTVSetCurPos
{ Set Cursor Shape }
mov al,1 // Show := True
mov cx,CursorLines
mov edi,Self
test [edi].TView.State,sfCursorIns
jz @@4
mov ch,1
test cl,cl
jne @@4
mov cl,7
@@4:
xor al,1
mov CursorHidden,al
xor al,1
movzx edx,ch
movzx ecx,cl
push edx // [1]:Integer = Y1
push ecx // [2]:Integer = Y2
push eax // [3]:Boolean = Show
Call SysTVSetCurType
end;
procedure TView.Select;
begin
if Options and ofSelectable <> 0 then
if Options and ofTopSelect <> 0 then MakeFirst else
if Owner <> nil then Owner^.SetCurrent(@Self, NormalSelect);
end;
procedure TView.SetBounds(var Bounds: TRect); {&USES None} {&FRAME-}
asm
mov edx,Self
mov ecx,Bounds
mov eax,[ecx].TRect.A.X
mov [edx].Origin.X,eax
mov eax,[ecx].TRect.A.Y
mov [edx].Origin.Y,eax
mov eax,[ecx].TRect.B.X
sub eax,[ecx].TRect.A.X
mov [edx].Size.X,eax
mov eax,[ecx].TRect.B.Y
sub eax,[ecx].TRect.A.Y
mov [edx].Size.Y,eax
end;
procedure TView.SetCmdState(Commands: TCommandSet; Enable: Boolean);
begin
if Enable then EnableCommands(Commands)
else DisableCommands(Commands);
end;
procedure TView.SetCommands(Commands: TCommandSet);
begin
CommandSetChanged := CommandSetChanged or (CurCommandSet <> Commands);
CurCommandSet := Commands;
end;
procedure TView.SetCursor(X, Y: Integer);
begin
Cursor.X := X;
Cursor.Y := Y;
DrawCursor;
end;
procedure TView.SetData(var Rec);
begin
end;
procedure TView.SetState(AState: Word; Enable: Boolean);
var
Command: Word;
begin
if Enable then
State := State or AState else
State := State and not AState;
if Owner <> nil then
case AState of
sfVisible:
begin
if Owner^.State and sfExposed <> 0 then
SetState(sfExposed, Enable);
if Enable then DrawShow(nil) else DrawHide(nil);
if Options and ofSelectable <> 0 then Owner^.ResetCurrent;
end;
sfCursorVis, sfCursorIns:
DrawCursor;
sfShadow:
DrawUnderView(State and sfShadow <> 0, nil);
sfFocused:
begin
ResetCursor;
if Enable then
Command := cmReceivedFocus else
Command := cmReleasedFocus;
Message(Owner, evBroadcast, Command, @Self);
end;
end;
end;
procedure TView.Show;
begin
if State and sfVisible = 0 then SetState(sfVisible, True);
end;
procedure TView.ShowCursor;
begin
SetState(sfCursorVis, True);
end;
procedure TView.SizeLimits(var Min, Max: TPoint);
begin
Min.X := 0;
Min.Y := 0;
if Owner <> nil then Max := Owner^.Size
else
begin
Max.X := MaxLongint;
Max.Y := MaxLongint;
end;
end;
procedure TView.Store(var S: TStream);
var
SaveState: Word;
begin
SaveState := State;
State := State and not (sfActive + sfSelected + sfFocused + sfExposed);
S.Write(Origin,
SizeOf(TPoint) * 3 +
SizeOf(Byte) * 2 +
SizeOf(Word) * 4);
State := SaveState;
end;
function TView.TopView: PView;
var
P: PView;
begin
if TheTopView = nil then
begin
P := @Self;
while (P <> nil) and (P^.State and sfModal = 0) do P := P^.Owner;
TopView := P;
end
else TopView := TheTopView;
end;
function TView.Valid(Command: Word): Boolean;
begin
Valid := True;
end;
procedure TView.WriteBuf(X, Y, W, H: Integer; var Buf); assembler; {&USES ebx,esi,edi} {&FRAME+}
var
Target: Pointer; {Variables used by WriteView}
Buffer: Pointer;
Offset: Word;
asm
cmp H,0
jle @@2
@@1:
mov eax,Y
mov ebx,X
mov ecx,W
mov edi,Buf
Call WriteView
mov eax,W
shl eax,1
add Buf,eax
inc Y
dec H
jnz @@1
@@2:
end;
procedure TView.WriteChar(X, Y: Integer; C: Char; Color: Byte;
Count: Integer); assembler; {&USES ebx,esi,edi} {&FRAME+}
var
Target: Pointer; {Variables used by WriteView}
Buffer: Pointer;
Offset: Word;
asm
mov al,Color
Call MapColor
mov ah,al
mov al,C
mov ecx,Count
test ecx,ecx
jle @@2
cmp ecx,256
jle @@1
mov ecx,256
@@1:
lea ebx,[ecx*2+2]
and ebx,NOT 11b
sub esp,ebx
mov edi,esp
mov edx,eax
shl eax,16
mov ax,dx
mov edx,ecx
cld
shr ecx,1
rep stosd
adc ecx,ecx
rep stosw
mov ecx,edx
mov edi,esp
mov eax,Y
push ebx
mov ebx,X
Call WriteView
pop eax
add esp,eax
@@2:
end;
procedure TView.WriteLine(X, Y, W, H: Integer; var Buf); assembler; {&USES ebx,esi,edi} {&FRAME+}
var
Target: Pointer; {Variables used by WriteView}
Buffer: Pointer;
Offset: Word;
asm
cmp H,0
jle @@2
@@1:
mov eax,Y
mov ebx,X
mov ecx,W
mov edi,Buf
Call WriteView
inc Y
dec H
jne @@1
@@2:
end;
procedure TView.WriteStr(X, Y: Integer; Str: String; Color: Byte); assembler; {&USES ebx,esi,edi} {&FRAME+}
var
Target: Pointer; {Variables used by WriteView}
Buffer: Pointer;
Offset: Word;
asm
mov al,Color
Call MapColor
mov ah,al
mov esi,Str
xor ecx,ecx
cld
lodsb
mov cl,al
jecxz @@2
lea ebx,[ecx*2+2]
and ebx,NOT 11b
sub esp,ebx
mov edi,esp
mov edx,ecx
@@1:
lodsb
stosw
loop @@1
mov ecx,edx
mov edi,esp
mov eax,Y
push ebx
mov ebx,X
Call WriteView
pop eax
add esp,eax
@@2:
end;
{ TFrame }
constructor TFrame.Init(var Bounds: TRect);
begin
TView.Init(Bounds);
GrowMode := gfGrowHiX + gfGrowHiY;
EventMask := EventMask or evBroadcast;
end;
procedure TFrame.FrameLine(var FrameBuf; Y, N: Integer;
Color: Byte); assembler; {&USES ebx,esi,edi} {&FRAME-}
const
InitFrame: array[0..17] of Byte =
($06, $0A, $0C, $05, $00, $05, $03, $0A, $09,
$16, $1A, $1C, $15, $00, $15, $13, $1A, $19);
var
FrameMask: array[0..MaxViewWidth-1] of Byte;
asm
{ cmp CodePage,437
je @@0
lea ebx,ldFrameChars
mov [ebx+23].Byte,'║'
mov [ebx+27].Byte,'═'
mov [ebx+29].Byte,'║'
mov [ebx+30].Byte,'═'
@@0:
}
mov ebx,Self
mov edx,[ebx].TFrame.Size.X
lea ecx,[edx-2]
mov esi,OFFSET InitFrame
add esi,N
lea edi,FrameMask
cld
movsb
lodsb
rep stosb
movsb
mov ebx,[ebx].TFrame.Owner
mov ebx,[ebx].TGroup.Last
dec edx
@@1:
mov ebx,[ebx].TView.Next
cmp ebx,Self
je @@10
@@2:
test [ebx].TView.Options,ofFramed
je @@1
test [ebx].TView.State,sfVisible
je @@1
mov eax,Y
sub eax,[ebx].TView.Origin.Y
jl @@3
cmp eax,[ebx].TView.Size.Y
jg @@1
mov ax,0005h
jl @@4
mov ax,0A03h
jmp @@4
@@3:
inc eax
jne @@1
mov ax,0A06h
@@4:
mov esi,[ebx].TView.Origin.X
mov edi,[ebx].TView.Size.X
add edi,esi
cmp esi,1
jg @@5
xor esi,esi
inc esi
@@5:
cmp edi,edx
jl @@6
mov edi,edx
@@6:
cmp esi,edi
jge @@1
or Byte Ptr FrameMask[esi-1],AL
xor al,ah
or Byte Ptr FrameMask[edi],AL
test ah,ah
jz @@1
mov ecx,edi
sub ecx,esi
@@8:
or Byte Ptr FrameMask[esi],ah
inc esi
loop @@8
jmp @@1
@@10:
inc edx
mov ah,Color
mov ebx,OFFSET ldFrameChars
mov ecx,edx
lea esi,FrameMask
mov edi,FrameBuf
@@11:
lodsb
xlat
stosw
loop @@11
end;
procedure TFrame.Draw;
var
CFrame, CTitle: Word;
F, I, L, Width: Integer;
B: TDrawBuffer;
Title: TTitleStr;
Min, Max: TPoint;
begin
if State and sfDragging <> 0 then
begin
CFrame := $0505;
CTitle := $0005;
F := 0;
end else if State and sfActive = 0 then
begin
CFrame := $0101;
CTitle := $0002;
F := 0;
end else
begin
CFrame := $0503;
CTitle := $0004;
F := 9;
end;
CFrame := GetColor(CFrame);
CTitle := GetColor(CTitle);
Width := Size.X;
L := Width - 10;
if PWindow(Owner)^.Flags and (wfClose+wfZoom) <> 0 then Dec(L,6);
FrameLine(B, 0, F, Byte(CFrame));
if (PWindow(Owner)^.Number <> wnNoNumber) and
(PWindow(Owner)^.Number < 10) then
begin
Dec(L,4);
if PWindow(Owner)^.Flags and wfZoom <> 0 then I := 7
else I := 3;
WordRec(B[Width - I]).Lo := PWindow(Owner)^.Number + $30;
end;
if Owner <> nil then Title := PWindow(Owner)^.GetTitle(L)
else Title := '';
if Title <> '' then
begin
L := Length(Title);
if L > Width - 10 then L := Width - 10;
if L < 0 then L := 0;
I := (Width - L) shr 1;
MoveChar(B[I - 1], ' ', CTitle, 1);
MoveBuf(B[I], Title[1], CTitle, L);
MoveChar(B[I + L], ' ', CTitle, 1);
end;
if State and sfActive <> 0 then
begin
if PWindow(Owner)^.Flags and wfClose <> 0 then
if FrameMode and fmCloseClicked = 0 then
MoveCStr(B[2], ldCloseWindow, CFrame)
else MoveCStr(B[2], ldCloseClicked, CFrame);
if PWindow(Owner)^.Flags and wfZoom <> 0 then
begin
MoveCStr(B[Width - 5], ldMaximize, CFrame);
Owner^.SizeLimits(Min, Max);
if FrameMode and fmZoomClicked <> 0 then
WordRec(B[Width - 4]).Lo := 15
else if (Owner^.Size.X = Max.X) and (Owner^.Size.Y = Max.Y) then
WordRec(B[Width - 4]).Lo := 18;
end;
end;
WriteLine(0, 0, Size.X, 1, B);
for I := 1 to Size.Y - 2 do
begin
FrameLine(B, I, F + 3, Byte(CFrame));
WriteLine(0, I, Size.X, 1, B);
end;
FrameLine(B, Size.Y - 1, F + 6, Byte(CFrame));
if State and sfActive <> 0 then
if PWindow(Owner)^.Flags and wfGrow <> 0 then
MoveCStr(B[Width - 2], ldBottomRight, CFrame);
WriteLine(0, Size.Y - 1, Size.X, 1, B);
end;
function TFrame.GetPalette: PPalette;
const
P: String[Length(CFrame)] = CFrame;
begin
GetPalette := @P;
end;
procedure TFrame.HandleEvent(var Event: TEvent);
var
Mouse: TPoint;
procedure DragWindow(Mode: Byte);
var
Limits: TRect;
Min, Max: TPoint;
begin
Owner^.Owner^.GetExtent(Limits);
Owner^.SizeLimits(Min, Max);
Owner^.DragView(Event, Owner^.DragMode or Mode, Limits, Min, Max);
ClearEvent(Event);
end;
begin
TView.HandleEvent(Event);
if Event.What = evMouseDown then
begin
MakeLocal(Event.Where, Mouse);
if Mouse.Y = 0 then
begin
if (PWindow(Owner)^.Flags and wfClose <> 0) and
(State and sfActive <> 0) and (Mouse.X >= 2) and (Mouse.X <= 4) then
begin
repeat
MakeLocal(Event.Where, Mouse);
if (Mouse.X >= 2) and (Mouse.X <= 4) and (Mouse.Y = 0) then
FrameMode := fmCloseClicked
else FrameMode := 0;
DrawView;
until not MouseEvent(Event, evMouseMove + evMouseAuto);
FrameMode := 0;
if (Mouse.X >= 2) and (Mouse.X <= 4) and (Mouse.Y = 0) then
begin
Event.What := evCommand;
Event.Command := cmClose;
Event.InfoPtr := Owner;
PutEvent(Event);
end;
ClearEvent(Event);
DrawView;
end else
if (PWindow(Owner)^.Flags and wfZoom <> 0) and
(State and sfActive <> 0) and (Event.Double or
(Mouse.X >= Size.X - 5) and
(Mouse.X <= Size.X - 3)) then
begin
if not Event.Double then
repeat
MakeLocal(Event.Where, Mouse);
if (Mouse.X >= Size.X - 5) and (Mouse.X <= Size.X - 3) and
(Mouse.Y = 0) then
FrameMode := fmZoomClicked
else FrameMode := 0;
DrawView;
until not MouseEvent(Event, evMouseMove + evMouseAuto);
FrameMode := 0;
if ((Mouse.X >= Size.X - 5) and (Mouse.X <= Size.X - 3) and
(Mouse.Y = 0)) or Event.Double then
begin
Event.What := evCommand;
Event.Command := cmZoom;
Event.InfoPtr := Owner;
PutEvent(Event);
end;
ClearEvent(Event);
DrawView;
end else
if PWindow(Owner)^.Flags and wfMove <> 0 then
DragWindow(dmDragMove);
end else
if (State and sfActive <> 0) and (Mouse.X >= Size.X - 2) and
(Mouse.Y >= Size.Y - 1) then
if PWindow(Owner)^.Flags and wfGrow <> 0 then
DragWindow(dmDragGrow);
end;
end;
procedure TFrame.SetState(AState: Word; Enable: Boolean);
begin
TView.SetState(AState, Enable);
if AState and (sfActive + sfDragging) <> 0 then DrawView;
end;
{ TScrollBar }
constructor TScrollBar.Init(var Bounds: TRect);
begin
TView.Init(Bounds);
Value := 0;
Min := 0;
Max := 0;
PgStep := 1;
ArStep := 1;
if Size.X = 1 then
begin
GrowMode := gfGrowLoX + gfGrowHiX + gfGrowHiY;
Chars := ldVerticalScroll;
end else
begin
GrowMode := gfGrowLoY + gfGrowHiX + gfGrowHiY;
Chars := ldHorizontalScroll;
end;
end;
constructor TScrollBar.Load(var S: TStream);
begin
TView.Load(S);
S.Read(Value, SizeOf(Integer) * 5 + SizeOf(TScrollChars));
end;
procedure TScrollBar.Draw;
begin
DrawPos(GetPos);
end;
procedure TScrollBar.DrawPos(Pos: Integer);
var
S: Integer;
B: TDrawBuffer;
begin
S := GetSize - 1;
MoveChar(B[0], Chars[0], GetColor(2), 1);
if Max = Min then
MoveChar(B[1], Chars[4], GetColor(1), S - 1)
else
begin
MoveChar(B[1], Chars[2], GetColor(1), S - 1);
MoveChar(B[Pos], Chars[3], GetColor(3), 1);
end;
MoveChar(B[S], Chars[1], GetColor(2), 1);
WriteBuf(0, 0, Size.X, Size.Y, B);
end;
function TScrollBar.GetPalette: PPalette;
const
P: String[Length(CScrollBar)] = CScrollBar;
begin
GetPalette := @P;
end;
function TScrollBar.GetPos: Integer;
var
R: Integer;
begin
R := Max - Min;
if R = 0 then
GetPos := 1 else
GetPos := ((Value - Min) * (GetSize - 3) + R shr 1) div R + 1;
end;
function TScrollBar.GetSize: Integer;
var
S: Integer;
begin
if Size.X = 1 then S := Size.Y else S := Size.X;
if S < 3 then GetSize := 3 else GetSize := S;
end;
procedure TScrollBar.HandleEvent(var Event: TEvent);
var
Tracking: Boolean;
I, P, S, ClickPart: Integer;
Mouse: TPoint;
Extent: TRect;
function GetPartCode: Integer;
var
Mark, Part: Integer;
begin
Part := -1;
if Extent.Contains(Mouse) then
begin
if Size.X = 1 then Mark := Mouse.Y else Mark := Mouse.X;
if Mark = P then Part := sbIndicator else
begin
if Mark < 1 then Part := sbLeftArrow else
if Mark < P then Part := sbPageLeft else
if Mark < S then Part := sbPageRight else
Part := sbRightArrow;
if Size.X = 1 then Inc(Part, 4);
end;
end;
GetPartCode := Part;
end;
procedure Clicked;
begin
Message(Owner, evBroadcast, cmScrollBarClicked, @Self);
end;
begin
TView.HandleEvent(Event);
case Event.What of
evMouseDown:
begin
Clicked;
MakeLocal(Event.Where, Mouse);
GetExtent(Extent);
Extent.Grow(1, 1);
P := GetPos;
S := GetSize - 1;
ClickPart := GetPartCode;
if ClickPart <> sbIndicator then
begin
repeat
MakeLocal(Event.Where, Mouse);
if GetPartCode = ClickPart then
SetValue(Value + ScrollStep(ClickPart));
until not MouseEvent(Event, evMouseAuto);
end else
begin
repeat
MakeLocal(Event.Where, Mouse);
Tracking := Extent.Contains(Mouse);
if Tracking then
begin
if Size.X = 1 then I := Mouse.Y else I := Mouse.X;
if I <= 0 then I := 1;
if I >= S then I := S - 1;
end else I := GetPos;
if I <> P then
begin
DrawPos(I);
P := I;
end;
until not MouseEvent(Event, evMouseMove);
if Tracking and (S > 2) then
begin
Dec(S, 2);
SetValue(((P - 1) * (Max - Min) + S shr 1) div S + Min);
end;
end;
ClearEvent(Event);
end;
evKeyDown:
if State and sfVisible <> 0 then
begin
ClickPart := sbIndicator;
if Size.Y = 1 then
case CtrlToArrow(Event.KeyCode) of
kbLeft: ClickPart := sbLeftArrow;
kbRight: ClickPart := sbRightArrow;
kbCtrlLeft: ClickPart := sbPageLeft;
kbCtrlRight: ClickPart := sbPageRight;
kbHome: I := Min;
kbEnd: I := Max;
else
Exit;
end
else
case CtrlToArrow(Event.KeyCode) of
kbUp: ClickPart := sbUpArrow;
kbDown: ClickPart := sbDownArrow;
kbPgUp: ClickPart := sbPageUp;
kbPgDn: ClickPart := sbPageDown;
kbCtrlPgUp: I := Min;
kbCtrlPgDn: I := Max;
else
Exit;
end;
Clicked;
if ClickPart <> sbIndicator then I := Value + ScrollStep(ClickPart);
SetValue(I);
ClearEvent(Event);
end;
end;
end;
procedure TScrollBar.ScrollDraw;
begin
Message(Owner, evBroadcast, cmScrollBarChanged, @Self);
end;
function TScrollBar.ScrollStep(Part: Integer): Integer;
var
Step: Integer;
begin
if Part and 2 = 0 then Step := ArStep else Step := PgStep;
if Part and 1 = 0 then ScrollStep := -Step else ScrollStep := Step;
end;
procedure TScrollBar.SetParams(AValue, AMin, AMax, APgStep,
AArStep: Integer);
var
SValue: Integer;
begin
if AMax < AMin then AMax := AMin;
if AValue < AMin then AValue := AMin;
if AValue > AMax then AValue := AMax;
SValue := Value;
if (SValue <> AValue) or (Min <> AMin) or (Max <> AMax) then
begin
Value := AValue;
Min := AMin;
Max := AMax;
DrawView;
if SValue <> AValue then ScrollDraw;
end;
PgStep := APgStep;
ArStep := AArStep;
end;
procedure TScrollBar.SetRange(AMin, AMax: Integer);
begin
SetParams(Value, AMin, AMax, PgStep, ArStep);
end;
procedure TScrollBar.SetStep(APgStep, AArStep: Integer);
begin
SetParams(Value, Min, Max, APgStep, AArStep);
end;
procedure TScrollBar.SetValue(AValue: Integer);
begin
SetParams(AValue, Min, Max, PgStep, ArStep);
end;
procedure TScrollBar.Store(var S: TStream);
begin
TView.Store(S);
S.Write(Value, SizeOf(Integer) * 5 + SizeOf(TScrollChars));
end;
{ TScroller }
constructor TScroller.Init(var Bounds: TRect; AHScrollBar,
AVScrollBar: PScrollBar);
begin
TView.Init(Bounds);
Options := Options or ofSelectable;
EventMask := EventMask or evBroadcast;
HScrollBar := AHScrollBar;
VScrollBar := AVScrollBar;
end;
constructor TScroller.Load(var S: TStream);
begin
TView.Load(S);
GetPeerViewPtr(S, HScrollBar);
GetPeerViewPtr(S, VScrollBar);
S.Read(Delta, SizeOf(TPoint)*2);
end;
procedure TScroller.ChangeBounds(var Bounds: TRect);
begin
SetBounds(Bounds);
Inc(DrawLock);
SetLimit(Limit.X, Limit.Y);
Dec(DrawLock);
DrawFlag := False;
DrawView;
end;
procedure TScroller.CheckDraw;
begin
if (DrawLock = 0) and DrawFlag then
begin
DrawFlag := False;
DrawView;
end;
end;
function TScroller.GetPalette: PPalette;
const
P: String[Length(CScroller)] = CScroller;
begin
GetPalette := @P;
end;
procedure TScroller.HandleEvent(var Event: TEvent);
begin
TView.HandleEvent(Event);
if (Event.What = evBroadcast) and (Event.Command = cmScrollBarChanged) and
((Event.InfoPtr = HScrollBar) or (Event.InfoPtr = VScrollBar)) then
ScrollDraw;
end;
procedure TScroller.ScrollDraw;
var
D: TPoint;
begin
if HScrollBar <> nil then D.X := HScrollBar^.Value
else D.X := 0;
if VScrollBar <> nil then D.Y := VScrollBar^.Value
else D.Y := 0;
if (D.X <> Delta.X) or (D.Y <> Delta.Y) then
begin
SetCursor(Cursor.X + Delta.X - D.X, Cursor.Y + Delta.Y - D.Y);
Delta := D;
if DrawLock <> 0 then DrawFlag := True else DrawView;
end;
end;
procedure TScroller.ScrollTo(X, Y: Integer);
begin
Inc(DrawLock);
if HScrollBar <> nil then HScrollBar^.SetValue(X);
if VScrollBar <> nil then VScrollBar^.SetValue(Y);
Dec(DrawLock);
CheckDraw;
end;
procedure TScroller.SetLimit(X, Y: Integer);
begin
Limit.X := X;
Limit.Y := Y;
Inc(DrawLock);
if HScrollBar <> nil then
HScrollBar^.SetParams(HScrollBar^.Value, 0, X - Size.X, Size.X - 1,
HScrollBar^.ArStep);
if VScrollBar <> nil then
VScrollBar^.SetParams(VScrollBar^.Value, 0, Y - Size.Y, Size.Y - 1,
VScrollBar^.ArStep);
Dec(DrawLock);
CheckDraw;
end;
procedure TScroller.SetState(AState: Word; Enable: Boolean);
procedure ShowSBar(SBar: PScrollBar);
begin
if (SBar <> nil) then
if GetState(sfActive + sfSelected) then SBar^.Show
else SBar^.Hide;
end;
begin
TView.SetState(AState, Enable);
if AState and (sfActive + sfSelected) <> 0 then
begin
ShowSBar(HScrollBar);
ShowSBar(VScrollBar);
end;
end;
procedure TScroller.Store(var S: TStream);
begin
TView.Store(S);
PutPeerViewPtr(S, HScrollBar);
PutPeerViewPtr(S, VScrollBar);
S.Write(Delta, SizeOf(TPoint)*2);
end;
{ TListViewer }
constructor TListViewer.Init(var Bounds: TRect; ANumCols: Word;
AHScrollBar, AVScrollBar: PScrollBar);
var
ArStep, PgStep: Integer;
begin
TView.Init(Bounds);
Options := Options or (ofFirstClick + ofSelectable);
EventMask := EventMask or evBroadcast;
Range := 0;
NumCols := ANumCols;
Focused := 0;
if AVScrollBar <> nil then
begin
if NumCols = 1 then
begin
PgStep := Size.Y -1;
ArStep := 1;
end else
begin
PgStep := Size.Y * NumCols;
ArStep := Size.Y;
end;
AVScrollBar^.SetStep(PgStep, ArStep);
end;
if AHScrollBar <> nil then AHScrollBar^.SetStep(Size.X div NumCols, 1);
HScrollBar := AHScrollBar;
VScrollBar := AVScrollBar;
end;
constructor TListViewer.Load(var S: TStream);
begin
TView.Load(S);
GetPeerViewPtr(S, HScrollBar);
GetPeerViewPtr(S, VScrollBar);
S.Read(NumCols, SizeOf(Word) * 4);
end;
procedure TListViewer.ChangeBounds(var Bounds: TRect);
begin
TView.ChangeBounds(Bounds);
if HScrollBar <> nil then
HScrollBar^.SetStep(Size.X div NumCols, 1);
if VScrollBar <> nil then
if NumCols > 1 then
VScrollBar^.SetStep(Size.Y * NumCols, Size.Y)
else
VScrollBar^.SetStep(Size.Y - 1, 1);
end;
procedure TListViewer.Draw;
var
I, J, Item: Integer;
NormalColor, SelectedColor, FocusedColor, Color: Word;
ColWidth, CurCol, Indent: Integer;
B: TDrawBuffer;
Text: String;
SCOff: Byte;
begin
if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
begin
NormalColor := GetColor(1);
FocusedColor := GetColor(3);
SelectedColor := GetColor(4);
end else
begin
NormalColor := GetColor(2);
SelectedColor := GetColor(4);
end;
if HScrollBar <> nil then Indent := HScrollBar^.Value
else Indent := 0;
ColWidth := Size.X div NumCols + 1;
for I := 0 to Size.Y - 1 do
begin
for J := 0 to NumCols-1 do
begin
Item := J*Size.Y + I + TopItem;
CurCol := J*ColWidth;
if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
(Focused = Item) and (Range > 0) then
begin
Color := FocusedColor;
SetCursor(CurCol+1,I);
SCOff := 0;
end
else if (Item < Range) and IsSelected(Item) then
begin
Color := SelectedColor;
SCOff := 2;
end
else
begin
Color := NormalColor;
SCOff := 4;
end;
MoveChar(B[CurCol], ' ', Color, ColWidth);
if Item < Range then
begin
Text := GetText(Item, ColWidth + Indent);
Text := Copy(Text,Indent,ColWidth);
MoveStr(B[CurCol+1], Text, Color);
if ShowMarkers then
begin
WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
end;
end;
MoveChar(B[CurCol+ColWidth-1], ldVerticalBar, GetColor(5), 1);
end;
WriteLine(0, I, Size.X, 1, B);
end;
end;
procedure TListViewer.FocusItem(Item: Integer);
begin
Focused := Item;
if VScrollBar <> nil then VScrollBar^.SetValue(Item);
if Item < TopItem then
if NumCols = 1 then TopItem := Item
else TopItem := Item - Item mod Size.Y
else if Item >= TopItem + (Size.Y*NumCols) then
if NumCols = 1 then TopItem := Item - Size.Y + 1
else TopItem := Item - Item mod Size.Y - (Size.Y*(NumCols - 1));
end;
procedure TListViewer.FocusItemNum(Item: Integer);
begin
if Item < 0 then Item := 0
else if (Item >= Range) and (Range > 0) then Item := Range-1;
if Range <> 0 then FocusItem(Item);
end;
function TListViewer.GetPalette: PPalette;
const
P: String[Length(CListViewer)] = CListViewer;
begin
GetPalette := @P;
end;
function TListViewer.GetText(Item: Integer; MaxLen: Integer): String;
begin
Abstract;
end;
function TListViewer.IsSelected(Item: Integer): Boolean;
begin
IsSelected := Item = Focused;
end;
procedure TListViewer.HandleEvent(var Event: TEvent);
const
MouseAutosToSkip = 4;
var
Mouse: TPoint;
ColWidth: Word;
OldItem, NewItem: Integer;
Count: Word;
begin
TView.HandleEvent(Event);
if Event.What = evMouseDown then
begin
ColWidth := Size.X div NumCols + 1;
OldItem := Focused;
MakeLocal(Event.Where, Mouse);
if MouseInView(Event.Where) then
NewItem := Mouse.Y + (Size.Y * (Mouse.X div ColWidth)) + TopItem
else NewItem := OldItem;
Count := 0;
repeat
if NewItem <> OldItem then
begin
FocusItemNum(NewItem);
DrawView;
end;
OldItem := NewItem;
MakeLocal(Event.Where, Mouse);
if MouseInView(Event.Where) then
NewItem := Mouse.Y + (Size.Y * (Mouse.X div ColWidth)) + TopItem
else
begin
if NumCols = 1 then
begin
if Event.What = evMouseAuto then Inc(Count);
if Count = MouseAutosToSkip then
begin
Count := 0;
if Mouse.Y < 0 then NewItem := Focused-1
else if Mouse.Y >= Size.Y then NewItem := Focused+1;
end;
end
else
begin
if Event.What = evMouseAuto then Inc(Count);
if Count = MouseAutosToSkip then
begin
Count := 0;
if Mouse.X < 0 then NewItem := Focused-Size.Y
else if Mouse.X >= Size.X then NewItem := Focused+Size.Y
else if Mouse.Y < 0 then
NewItem := Focused - Focused mod Size.Y
else if Mouse.Y > Size.Y then
NewItem := Focused - Focused mod Size.Y + Size.Y - 1;
end
end;
end;
until not MouseEvent(Event, evMouseMove + evMouseAuto);
FocusItemNum(NewItem);
DrawView;
if Event.Double and (Range > Focused) then SelectItem(Focused);
ClearEvent(Event);
end
else if Event.What = evKeyDown then
begin
if (Event.CharCode = ' ') and (Focused < Range) then
begin
SelectItem(Focused);
NewItem := Focused;
end
else case CtrlToArrow(Event.KeyCode) of
kbUp: NewItem := Focused - 1;
kbDown: NewItem := Focused + 1;
kbRight: if NumCols > 1 then NewItem := Focused + Size.Y else Exit;
kbLeft: if NumCols > 1 then NewItem := Focused - Size.Y else Exit;
kbPgDn: NewItem := Focused + Size.Y * NumCols;
kbPgUp: NewItem := Focused - Size.Y * NumCols;
kbHome: NewItem := TopItem;
kbEnd: NewItem := TopItem + (Size.Y * NumCols) - 1;
kbCtrlPgDn: NewItem := Range - 1;
kbCtrlPgUp: NewItem := 0;
else
Exit;
end;
FocusItemNum(NewItem);
DrawView;
ClearEvent(Event);
end else if Event.What = evBroadcast then
if Options and ofSelectable <> 0 then
if (Event.Command = cmScrollBarClicked) and
((Event.InfoPtr = HScrollBar) or (Event.InfoPtr = VScrollBar)) then
Select
else if (Event.Command = cmScrollBarChanged) then
begin
if (VScrollBar = Event.InfoPtr) then
begin
FocusItemNum(VScrollBar^.Value);
DrawView;
end else if (HScrollBar = Event.InfoPtr) then DrawView;
end;
end;
procedure TListViewer.SelectItem(Item: Integer);
begin
Message(Owner, evBroadcast, cmListItemSelected, @Self);
end;
procedure TListViewer.SetRange(ARange: Integer);
begin
Range := ARange;
if VScrollBar <> nil then
begin
if Focused > ARange then Focused := 0;
VScrollbar^.SetParams(Focused, 0, ARange-1, VScrollBar^.PgStep,
VScrollBar^.ArStep);
end;
end;
procedure TListViewer.SetState(AState: Word; Enable: Boolean);
procedure ShowSBar(SBar: PScrollBar);
begin
if (SBar <> nil) then
if GetState(sfActive) and GetState(sfVisible) then SBar^.Show
else SBar^.Hide;
end;
begin
TView.SetState(AState, Enable);
if AState and (sfSelected + sfActive + sfVisible) <> 0 then
begin
ShowSBar(HScrollBar);
ShowSBar(VScrollBar);
DrawView;
end;
end;
procedure TListViewer.Store(var S: TStream);
begin
TView.Store(S);
PutPeerViewPtr(S, HScrollBar);
PutPeerViewPtr(S, VScrollBar);
S.Write(NumCols, SizeOf(Word) * 4);
end;
{ TGroup }
constructor TGroup.Init(var Bounds: TRect);
begin
TView.Init(Bounds);
Options := Options or (ofSelectable + ofBuffered);
GetExtent(Clip);
EventMask := $FFFFFFFF;
end;
constructor TGroup.Load(var S: TStream);
var
FixupSave: PFixupList;
Count, I: Integer;
P, Q: ^Pointer;
V: PView;
OwnerSave: PGroup;
SaveESP: Word;
begin
TView.Load(S);
GetExtent(Clip);
OwnerSave := OwnerGroup;
OwnerGroup := @Self;
FixupSave := FixupList;
S.Read(Count, SizeOf(Word));
asm {&SAVES ebx,edx,esi}
mov SaveESP,esp
mov ecx,Count
shl ecx,2
sub esp,ecx
mov FixupList,esp
mov edi,esp
xor eax,eax
shr ecx,2
cld
rep stosd
end;
for I := 1 to Count do
begin
V := PView(S.Get);
if V <> nil then InsertView(V, nil);
end;
V := Last;
for I := 1 to Count do
begin
V := V^.Next;
P := FixupList^[I];
while P <> nil do
begin
Q := P;
P := P^;
Q^ := V;
end;
end;
OwnerGroup := OwnerSave;
FixupList := FixupSave;
GetSubViewPtr(S, V);
SetCurrent(V, NormalSelect);
if OwnerGroup = nil then Awaken;
asm mov esp,SaveESP end;
end;
destructor TGroup.Done;
var
P, T: PView;
begin
Hide;
P := Last;
if P <> nil then
begin
repeat
P^.Hide;
P := P^.Prev;
until P = Last;
repeat
T := P^.Prev;
Dispose(P, Done);
P := T;
until Last = nil;
end;
FreeBuffer;
TView.Done;
end;
function TGroup.At(Index: Integer): PView; {&USES None} {&FRAME-}
asm
mov eax,Self
mov eax,[eax].TGroup.Last
mov ecx,Index
@@1:
mov eax,[eax].TView.Next
loop @@1
end;
procedure TGroup.Awaken;
procedure DoAwaken(P: PView);
begin
P^.Awaken;
end;
begin
ForEach(@DoAwaken);
end;
procedure TGroup.ChangeBounds(var Bounds: TRect);
var
D: TPoint;
procedure DoCalcChange(P: PView);
var
R: TRect;
begin
P^.CalcBounds(R, D);
P^.ChangeBounds(R);
end;
begin
D.X := Bounds.B.X - Bounds.A.X - Size.X;
D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
if (D.X or D.Y) = 0 then
begin
SetBounds(Bounds);
DrawView;
end else
begin
FreeBuffer;
SetBounds(Bounds);
GetExtent(Clip);
GetBuffer;
Lock;
ForEach(@DoCalcChange);
Unlock;
end;
end;
function TGroup.DataSize: Word;
var
T: Word;
procedure AddSubviewDataSize(P: PView);
begin
Inc(T, P^.DataSize);
end;
begin
T := 0;
ForEach(@AddSubviewDataSize);
DataSize := T;
end;
procedure TGroup.Delete(P: PView);
var
SaveState: Word;
begin
SaveState := P^.State;
P^.Hide;
RemoveView(P);
P^.Owner := nil;
P^.Next := nil;
if SaveState and sfVisible <> 0 then P^.Show;
end;
procedure TGroup.Draw;
var
R: TRect;
begin
if Buffer = nil then
begin
GetBuffer;
if Buffer <> nil then
begin
Inc(LockFlag);
Redraw;
Dec(LockFlag);
end;
end;
if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
begin
GetClipRect(Clip);
Redraw;
GetExtent(Clip);
end;
end;
procedure TGroup.DrawSubViews(P, Bottom: PView);
begin
if P <> nil then
while P <> Bottom do
begin
P^.DrawView;
P := P^.NextView;
end;
end;
procedure TGroup.EndModal(Command: Word);
begin
if State and sfModal <> 0 then EndState := Command
else TView.EndModal(Command);
end;
procedure TGroup.EventError(var Event: TEvent);
begin
if Owner <> nil then Owner^.EventError(Event);
end;
function TGroup.Execute: Word;
var
E: TEvent;
begin
repeat
EndState := 0;
repeat
GetEvent(E);
HandleEvent(E);
if E.What <> evNothing then EventError(E);
until EndState <> 0;
until Valid(EndState);
Execute := EndState;
end;
function TGroup.ExecView(P: PView): Word;
var
SaveOptions: Word;
SaveOwner: PGroup;
SaveTopView: PView;
SaveCurrent: PView;
SaveCommands: TCommandSet;
begin
if P <> nil then
begin
SaveOptions := P^.Options;
SaveOwner := P^.Owner;
SaveTopView := TheTopView;
SaveCurrent := Current;
GetCommands(SaveCommands);
TheTopView := P;
P^.Options := P^.Options and not ofSelectable;
P^.SetState(sfModal, True);
SetCurrent(P, EnterSelect);
if SaveOwner = nil then Insert(P);
ExecView := P^.Execute;
if SaveOwner = nil then Delete(P);
SetCurrent(SaveCurrent, LeaveSelect);
P^.SetState(sfModal, False);
P^.Options := SaveOptions;
TheTopView := SaveTopView;
SetCommands(SaveCommands);
end else ExecView := cmCancel;
end;
function TGroup.First: PView;
begin
if Last = nil then First := nil else First := Last^.Next;
end;
function TGroup.FirstMatch(AState: Word; AOptions: Word): PView;
function Matches(P: PView): Boolean;
begin
Matches := (P^.State and AState = AState) and
(P^.Options and AOptions = AOptions);
end;
begin
FirstMatch := FirstThat(@Matches);
end;
function TGroup.FirstThat(P: Pointer): PView; assembler; {&USES None} {&FRAME-}
var
ALast: Pointer;
asm
mov eax,Self
mov eax,[eax].TGroup.Last
test eax,eax
jz @@2
mov ALast,eax
@@1:
mov ecx,P
mov eax,[eax].TView.Next
push eax
push eax {[1]:Pointer = PView }
Call ecx
test al,al
pop eax
jnz @@2
cmp eax,ALast
jne @@1
xor eax,eax
@@2:
end;
function TGroup.FindNext(Forwards: Boolean): PView;
var
P: PView;
begin
FindNext := nil;
if Current <> nil then
begin
P := Current;
repeat
if Forwards then P := P^.Next else P := P^.Prev;
until ((P^.State and (sfVisible + sfDisabled) = sfVisible) and
(P^.Options and ofSelectable <> 0)) or (P = Current);
if P <> Current then FindNext := P;
end;
end;
function TGroup.FocusNext(Forwards: Boolean): Boolean;
var
P: PView;
begin
P := FindNext(Forwards);
FocusNext := True;
if P <> nil then FocusNext := P^.Focus;
end;
procedure TGroup.ForEach(P: Pointer); assembler; {&USES ebx} {&FRAME-}
var
ALast: Pointer;
asm
mov ecx,Self
mov ecx,[ecx].TGroup.Last
jecxz @@RET
mov ebx,P
mov ALast,ecx
mov ecx,[ecx].TView.Next
@@1:
cmp ecx,ALast
je @@2
push [ecx].TView.Next
push ecx
Call ebx
pop ecx
jmp @@1
@@2:
push ecx
Call ebx
@@RET:
end;
procedure TGroup.FreeBuffer;
begin
if (Options and ofBuffered <> 0) and (Buffer <> nil) then
DisposeCache(Pointer(Buffer));
end;
{ Allocate a group buffer if the group is exposed and buffered }
procedure TGroup.GetBuffer; {&USES None} {&FRAME-}
asm
mov ecx,Self
test [ecx].State,sfExposed
jz @@1
test [ecx].Options,ofBuffered
jz @@1
cmp [ecx].Buffer,0
jnz @@1
mov eax,[ecx].TView.Size.X
mul [ecx].TView.Size.Y
jo @@1
shl eax,1
jc @@1
js @@1
lea ecx,[ecx].TView.Buffer
push ecx { [1]:Pointer = @ of the buffer@ }
push eax { [2]:Pointer = Buffer Size }
Call NewCache
@@1:
end;
procedure TGroup.GetData(var Rec);
type
Bytes = array[0..65534] of Byte;
var
I: Word;
V: PView;
begin
I := 0;
if Last <> nil then
begin
V := Last;
repeat
V^.GetData(Bytes(Rec)[I]);
Inc(I, V^.DataSize);
V := V^.Prev;
until V = Last;
end;
end;
function TGroup.GetHelpCtx: Word;
var
H: Word;
begin
H:= hcNoContext;
if Current <> nil then H := Current^.GetHelpCtx;
if H = hcNoContext then H := TView.GetHelpCtx;
GetHelpCtx := H;
end;
procedure TGroup.GetSubViewPtr(var S: TStream; var P);
var
Index: Word;
begin
S.Read(Index, SizeOf(Word));
if Index > 0 then
Pointer(P) := At(Index)
else
Pointer(P) := nil;
end;
procedure TGroup.HandleEvent(var Event: TEvent);
procedure DoHandleEvent(P: PView);
begin
if (P = nil) or ((P^.State and sfDisabled <> 0)
and (Event.What and (PositionalEvents or FocusedEvents) <> 0)) then Exit;
case Phase of
phPreProcess: if P^.Options and ofPreProcess = 0 then Exit;
phPostProcess: if P^.Options and ofPostProcess = 0 then Exit;
end;
if Event.What and P^.EventMask <> 0 then P^.HandleEvent(Event);
end;
function ContainsMouse(P: PView): Boolean;
begin
ContainsMouse := (P^.State and sfVisible <> 0) and
P^.MouseInView(Event.Where);
end;
begin
TView.HandleEvent(Event);
if Event.What and FocusedEvents <> 0 then
begin
Phase := phPreProcess;
ForEach(@DoHandleEvent);
Phase := phFocused;
DoHandleEvent(Current);
Phase := phPostProcess;
ForEach(@DoHandleEvent);
end else
begin
Phase := phFocused;
if (Event.What and PositionalEvents <> 0) then
DoHandleEvent(FirstThat(@ContainsMouse)) else
ForEach(@DoHandleEvent);
end;
end;
function TGroup.IndexOf(P: PView): Integer; {&USES None} {&FRAME-}
asm
mov ecx,Self
mov ecx,[ecx].TGroup.Last
jecxz @@2
mov edx,ecx
xor eax,eax
@@1:
inc eax
mov ecx,[ecx].TView.Next
cmp ecx,P
je @@3
cmp ecx,edx
jne @@1
@@2:
xor eax,eax
@@3:
end;
procedure TGroup.Insert(P: PView);
begin
InsertBefore(P, First);
end;
procedure TGroup.InsertBefore(P, Target: PView);
var
SaveState: Word;
begin
if (P <> nil) and (P^.Owner = nil) and
((Target = nil) or (Target^.Owner = @Self)) then
begin
if P^.Options and ofCenterX <> 0 then
P^.Origin.X := (Size.X - P^.Size.X) div 2;
if P^.Options and ofCenterY <> 0 then
P^.Origin.Y := (Size.Y - P^.Size.Y) div 2;
SaveState := P^.State;
P^.Hide;
InsertView(P, Target);
if SaveState and sfVisible <> 0 then P^.Show;
if State and sfActive <> 0 then
P^.SetState(sfActive, True);
end;
end;
procedure TGroup.InsertView(P, Target: PView);
begin
P^.Owner := @Self;
if Target <> nil then
begin
Target := Target^.Prev;
P^.Next := Target^.Next;
Target^.Next := P;
end else
begin
if Last = nil then P^.Next := P else
begin
P^.Next := Last^.Next;
Last^.Next := P;
end;
Last := P;
end;
end;
procedure TGroup.Lock;
begin
if (Buffer <> nil) or (LockFlag <> 0) then Inc(LockFlag);
end;
procedure TGroup.PutSubViewPtr(var S: TStream; P: PView);
var
Index: Word;
begin
if P = nil then Index := 0
else Index := IndexOf(P);
S.Write(Index, SizeOf(Word));
end;
procedure TGroup.Redraw;
begin
DrawSubViews(First, nil);
end;
procedure TGroup.RemoveView(P: PView); {&USES edi} {&FRAME+}
asm
mov edx,Self
mov edi,P
mov edx,[edx].TGroup.Last
test edx,edx
jz @@4
mov eax,edx
@@1:
mov ecx,[edx].TView.Next
cmp ecx,edi
je @@2
cmp ecx,eax
je @@4
mov edx,ecx
jmp @@1
@@2:
mov ecx,[edi].TView.Next
mov [edx].TView.Next,ecx
cmp eax,edi
jne @@4
cmp ecx,edi
jne @@3
xor edx,edx
@@3:
mov edi,Self
mov [edi].TView.Last,edx
@@4:
end;
procedure TGroup.ResetCurrent;
begin
SetCurrent(FirstMatch(sfVisible, ofSelectable), NormalSelect);
end;
procedure TGroup.ResetCursor;
begin
if Current <> nil then Current^.ResetCursor;
end;
procedure TGroup.SelectNext(Forwards: Boolean);
var
P: PView;
begin
P := FindNext(Forwards);
if P <> nil then P^.Select;
end;
procedure TGroup.SetCurrent(P: PView; Mode: SelectMode);
procedure SelectView(P: PView; Enable: Boolean);
begin
if P <> nil then P^.SetState(sfSelected, Enable);
end;
procedure FocusView(P: PView; Enable: Boolean);
begin
if (State and sfFocused <> 0) and (P <> nil) then
P^.SetState(sfFocused, Enable);
end;
begin
if Current <> P then
begin
Lock;
FocusView(Current, False);
if Mode <> EnterSelect then SelectView(Current, False);
if Mode <> LeaveSelect then SelectView(P, True);
FocusView(P, True);
Current := P;
Unlock;
end;
end;
procedure TGroup.SetData(var Rec);
type
Bytes = array[0..65534] of Byte;
var
I: Word;
V: PView;
begin
I := 0;
if Last <> nil then
begin
V := Last;
repeat
V^.SetData(Bytes(Rec)[I]);
Inc(I, V^.DataSize);
V := V^.Prev;
until V = Last;
end;
end;
procedure TGroup.SetState(AState: Word; Enable: Boolean);
procedure DoSetState(P: PView);
begin
P^.SetState(AState, Enable);
end;
procedure DoExpose(P: PView);
begin
if P^.State and sfVisible <> 0 then P^.SetState(sfExposed, Enable);
end;
begin
TView.SetState(AState, Enable);
case AState of
sfActive, sfDragging:
begin
Lock;
ForEach(@DoSetState);
Unlock;
end;
sfFocused:
if Current <> nil then Current^.SetState(sfFocused, Enable);
sfExposed:
begin
ForEach(@DoExpose);
if not Enable then FreeBuffer;
end;
end;
end;
procedure TGroup.Store(var S: TStream);
var
Count: Integer;
OwnerSave: PGroup;
procedure DoPut(P: PView);
begin
S.Put(P);
end;
begin
TView.Store(S);
OwnerSave := OwnerGroup;
OwnerGroup := @Self;
Count := IndexOf(Last);
S.Write(Count, SizeOf(Word));
ForEach(@DoPut);
PutSubViewPtr(S, Current);
OwnerGroup := OwnerSave;
end;
procedure TGroup.Unlock;
begin
if LockFlag <> 0 then
begin
Dec(LockFlag);
if LockFlag = 0 then DrawView;
end;
end;
function TGroup.Valid(Command: Word): Boolean;
function IsInvalid(P: PView): Boolean;
begin
IsInvalid := not P^.Valid(Command);
end;
begin
Valid := True;
if Command = cmReleasedFocus then
begin
if (Current <> nil) and (Current^.Options and ofValidate <> 0) then
Valid := Current^.Valid(Command);
end
else
Valid := FirstThat(@IsInvalid) = nil;
end;
{ TWindow }
constructor TWindow.Init(var Bounds: TRect; ATitle: TTitleStr;
ANumber: Integer);
begin
TGroup.Init(Bounds);
State := State or sfShadow;
Options := Options or (ofSelectable + ofTopSelect);
GrowMode := gfGrowAll + gfGrowRel;
Flags := wfMove + wfGrow + wfClose + wfZoom;
Title := NewStr(ATitle);
Number := ANumber;
Palette := wpBlueWindow;
InitFrame;
if Frame <> nil then Insert(Frame);
GetBounds(ZoomRect);
end;
constructor TWindow.Load(var S: TStream);
begin
TGroup.Load(S);
S.Read(Flags, SizeOf(Byte) + SizeOf(TRect) + 2 * SizeOf(Integer));
GetSubViewPtr(S, Frame);
Title := S.ReadStr;
end;
destructor TWindow.Done;
begin
TGroup.Done;
DisposeStr(Title);
end;
procedure TWindow.Close;
begin
if Valid(cmClose) then Free;
end;
function TWindow.GetPalette: PPalette;
const
P: array[wpBlueWindow..wpGrayWindow] of string[Length(CBlueWindow)] =
(CBlueWindow, CCyanWindow, CGrayWindow);
begin
GetPalette := @P[Palette];
end;
function TWindow.GetTitle(MaxSize: Integer): TTitleStr;
begin
if Title <> nil then GetTitle := Title^
else GetTitle := '';
end;
procedure TWindow.HandleEvent(var Event: TEvent);
var
Limits: TRect;
Min, Max: TPoint;
begin
TGroup.HandleEvent(Event);
if (Event.What = evCommand) then
case Event.Command of
cmResize:
if Flags and (wfMove + wfGrow) <> 0 then
begin
Owner^.GetExtent(Limits);
SizeLimits(Min, Max);
DragView(Event, DragMode or (Flags and (wfMove + wfGrow)),
Limits, Min, Max);
ClearEvent(Event);
end;
cmClose:
if (Flags and wfClose <> 0) and
((Event.InfoPtr = nil) or (Event.InfoPtr = @Self)) then
begin
ClearEvent(Event);
if State and sfModal = 0 then Close else
begin
Event.What := evCommand;
Event.Command := cmCancel;
PutEvent(Event);
ClearEvent(Event);
end;
end;
cmZoom:
if (Flags and wfZoom <> 0) and
((Event.InfoPtr = nil) or (Event.InfoPtr = @Self)) then
begin
Zoom;
ClearEvent(Event);
end;
end
else if Event.What = evKeyDown then
case Event.KeyCode of
kbTab:
begin
FocusNext(False);
ClearEvent(Event);
end;
kbShiftTab:
begin
FocusNext(True);
ClearEvent(Event);
end;
end
else if (Event.What = evBroadcast) and (Event.Command = cmSelectWindowNum)
and (Event.InfoInt = Number) and (Options and ofSelectable <> 0) then
begin
Select;
ClearEvent(Event);
end;
end;
procedure TWindow.InitFrame;
var
R: TRect;
begin
GetExtent(R);
Frame := New(PFrame, Init(R));
end;
procedure TWindow.SetState(AState: Word; Enable: Boolean);
var
WindowCommands: TCommandSet;
begin
TGroup.SetState(AState, Enable);
if AState = sfSelected then
SetState(sfActive, Enable);
if (AState = sfSelected) or ((AState = sfExposed) and
(State and sfSelected <> 0)) then
begin
WindowCommands := [cmNext, cmPrev];
if Flags and (wfGrow + wfMove) <> 0 then
WindowCommands := WindowCommands + [cmResize];
if Flags and wfClose <> 0 then
WindowCommands := WindowCommands + [cmClose];
if Flags and wfZoom <> 0 then
WindowCommands := WindowCommands + [cmZoom];
if Enable then EnableCommands(WindowCommands)
else DisableCommands(WindowCommands);
end;
end;
function TWindow.StandardScrollBar(AOptions: Word): PScrollBar;
var
R: TRect;
S: PScrollBar;
begin
GetExtent(R);
if AOptions and sbVertical = 0 then
R.Assign(R.A.X + 2, R.B.Y-1, R.B.X-2, R.B.Y) else
R.Assign(R.B.X-1,R.A.Y+1,R.B.X,R.B.Y-1);
S := New(PScrollBar, Init(R));
Insert(S);
if AOptions and sbHandleKeyboard <> 0 then
S^.Options := S^.Options or ofPostProcess;
StandardScrollBar := S;
end;
procedure TWindow.SizeLimits(var Min, Max: TPoint);
begin
TView.SizeLimits(Min, Max);
Min.X := MinWinSize.X;
Min.Y := MinWinSize.Y;
end;
procedure TWindow.Store(var S: TStream);
begin
TGroup.Store(S);
S.Write(Flags, SizeOf(Byte) + SizeOf(TRect) + 2 * SizeOf(Integer));
PutSubViewPtr(S, Frame);
S.WriteStr(Title);
end;
procedure TWindow.Zoom;
var
R: TRect;
Max, Min: TPoint;
begin
SizeLimits(Min, Max);
if (Size.X <> Max.X) or (Size.Y <> Max.Y) then
begin
GetBounds(ZoomRect);
R.A.X := 0;
R.A.Y := 0;
R.B := Max;
Locate(R);
end else Locate(ZoomRect);
end;
{ Message dispatch function }
function Message(Receiver: PView; What, Command: Word;
InfoPtr: Pointer): Pointer;
var
Event: TEvent;
begin
Message := nil;
if Receiver <> nil then
begin
Event.What := What;
Event.Command := Command;
Event.InfoPtr := InfoPtr;
Receiver^.HandleEvent(Event);
if Event.What = evNothing then Message := Event.InfoPtr;
end;
end;
{ Views registration procedure }
procedure RegisterViews;
begin
RegisterType(RView);
RegisterType(RFrame);
RegisterType(RScrollBar);
RegisterType(RScroller);
RegisterType(RListViewer);
RegisterType(RGroup);
RegisterType(RWindow);
end;
end.