{ $Id$ } {********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********} { } { System independent GRAPHICAL clone of VIEWS.PAS } { } { Interface Copyright (c) 1992 Borland International } { } { Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer } { ldeboer@attglobal.net - primary e-mail address } { ldeboer@starwon.com.au - backup e-mail address } { } {****************[ THIS CODE IS FREEWARE ]*****************} { } { This sourcecode is released for the purpose to } { promote the pascal language on all platforms. You may } { redistribute it and/or modify with the following } { DISCLAIMER. } { } { This SOURCE CODE is distributed "AS IS" WITHOUT } { WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR } { ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. } { } {*****************[ SUPPORTED PLATFORMS ]******************} { } { Only Free Pascal Compiler supported } { } {**********************************************************} UNIT Views; {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} INTERFACE {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} {====Include file to sort compiler platform out =====================} {$I Platform.inc} {====================================================================} {==== Compiler directives ===========================================} {$X+} { Extended syntax is ok } {$R-} { Disable range checking } {$S-} { Disable Stack Checking } {$I-} { Disable IO Checking } {$Q-} { Disable Overflow Checking } {$V-} { Turn off strict VAR strings } {====================================================================} USES {$IFDEF OS_WINDOWS} { WIN/NT CODE } Windows, { Standard unit } {$ENDIF} {$IFDEF OS_OS2} { OS2 CODE } Os2Def, DosCalls, PmWin, {$ENDIF} Objects, FVCommon, Drivers, fvconsts; { GFV standard units } {***************************************************************************} { PUBLIC CONSTANTS } {***************************************************************************} {---------------------------------------------------------------------------} { TView STATE MASKS } {---------------------------------------------------------------------------} CONST sfVisible = $0001; { View visible mask } sfCursorVis = $0002; { Cursor visible } sfCursorIns = $0004; { Cursor insert mode } sfShadow = $0008; { View has shadow } sfActive = $0010; { View is active } sfSelected = $0020; { View is selected } sfFocused = $0040; { View is focused } sfDragging = $0080; { View is dragging } sfDisabled = $0100; { View is disabled } sfModal = $0200; { View is modal } sfDefault = $0400; { View is default } sfExposed = $0800; { View is exposed } sfIconised = $1000; { View is iconised } {---------------------------------------------------------------------------} { TView OPTION MASKS } {---------------------------------------------------------------------------} CONST ofSelectable = $0001; { View selectable } ofTopSelect = $0002; { Top selectable } ofFirstClick = $0004; { First click react } ofFramed = $0008; { View is framed } ofPreProcess = $0010; { Pre processes } ofPostProcess = $0020; { Post processes } ofBuffered = $0040; { View is buffered } ofTileable = $0080; { View is tileable } ofCenterX = $0100; { View centred on x } ofCenterY = $0200; { View centred on y } ofCentered = $0300; { View x,y centred } ofValidate = $0400; { View validates } ofVersion = $3000; { View TV version } ofVersion10 = $0000; { TV version 1 view } ofVersion20 = $1000; { TV version 2 view } {---------------------------------------------------------------------------} { TView GROW MODE MASKS } {---------------------------------------------------------------------------} CONST gfGrowLoX = $01; { Left side grow } gfGrowLoY = $02; { Top side grow } gfGrowHiX = $04; { Right side grow } gfGrowHiY = $08; { Bottom side grow } gfGrowAll = $0F; { Grow on all sides } gfGrowRel = $10; { Grow relative } {---------------------------------------------------------------------------} { TView DRAG MODE MASKS } {---------------------------------------------------------------------------} CONST dmDragMove = $01; { Move view } dmDragGrow = $02; { Grow view } dmLimitLoX = $10; { Limit left side } dmLimitLoY = $20; { Limit top side } dmLimitHiX = $40; { Limit right side } dmLimitHiY = $80; { Limit bottom side } dmLimitAll = $F0; { Limit all sides } {---------------------------------------------------------------------------} { >> NEW << TAB OPTION MASKS } {---------------------------------------------------------------------------} CONST tmTab = $01; { Tab move mask } tmShiftTab = $02; { Shift+tab move mask } tmEnter = $04; { Enter move mask } tmLeft = $08; { Left arrow move mask } tmRight = $10; { Right arrow move mask } tmUp = $20; { Up arrow move mask } tmDown = $40; { Down arrow move mask } {---------------------------------------------------------------------------} { >> NEW << VIEW DRAW MASKS } {---------------------------------------------------------------------------} CONST vdBackGnd = $01; { Draw backgound } vdInner = $02; { Draw inner detail } vdCursor = $04; { Draw cursor } vdBorder = $08; { Draw view border } vdFocus = $10; { Draw focus state } vdNoChild = $20; { Draw no children } vdShadow = $40; vdAll = vdBackGnd + vdInner + vdCursor + vdBorder + vdFocus + vdShadow; {---------------------------------------------------------------------------} { TView HELP CONTEXTS } {---------------------------------------------------------------------------} CONST hcNoContext = 0; { No view context } hcDragging = 1; { No drag context } {---------------------------------------------------------------------------} { TWindow FLAG MASKS } {---------------------------------------------------------------------------} CONST wfMove = $01; { Window can move } wfGrow = $02; { Window can grow } wfClose = $04; { Window can close } wfZoom = $08; { Window can zoom } {---------------------------------------------------------------------------} { TWindow PALETTES } {---------------------------------------------------------------------------} CONST wpBlueWindow = 0; { Blue palette } wpCyanWindow = 1; { Cyan palette } wpGrayWindow = 2; { Gray palette } {---------------------------------------------------------------------------} { COLOUR PALETTES } {---------------------------------------------------------------------------} CONST CFrame = #1#1#2#2#3; { Frame palette } CScrollBar = #4#5#5; { Scrollbar palette } CScroller = #6#7; { Scroller palette } CListViewer = #26#26#27#28#29; { Listviewer palette } CBlueWindow = #8#9#10#11#12#13#14#15; { Blue window palette } CCyanWindow = #16#17#18#19#20#21#22#23; { Cyan window palette } CGrayWindow = #24#25#26#27#28#29#30#31; { Grey window palette } {---------------------------------------------------------------------------} { TScrollBar PART CODES } {---------------------------------------------------------------------------} CONST sbLeftArrow = 0; { Left arrow part } sbRightArrow = 1; { Right arrow part } sbPageLeft = 2; { Page left part } sbPageRight = 3; { Page right part } sbUpArrow = 4; { Up arrow part } sbDownArrow = 5; { Down arrow part } sbPageUp = 6; { Page up part } sbPageDown = 7; { Page down part } sbIndicator = 8; { Indicator part } {---------------------------------------------------------------------------} { TScrollBar OPTIONS FOR TWindow.StandardScrollBar } {---------------------------------------------------------------------------} CONST sbHorizontal = $0000; { Horz scrollbar } sbVertical = $0001; { Vert scrollbar } sbHandleKeyboard = $0002; { Handle keyboard } {---------------------------------------------------------------------------} { STANDARD COMMAND CODES } {---------------------------------------------------------------------------} CONST cmValid = 0; { Valid command } cmQuit = 1; { Quit command } cmError = 2; { Error command } cmMenu = 3; { Menu command } cmClose = 4; { Close command } cmZoom = 5; { Zoom command } cmResize = 6; { Resize command } cmNext = 7; { Next view command } cmPrev = 8; { Prev view command } cmHelp = 9; { Help command } cmOK = 10; { Okay command } cmCancel = 11; { Cancel command } cmYes = 12; { Yes command } cmNo = 13; { No command } cmDefault = 14; { Default command } cmCut = 20; { Clipboard cut cmd } cmCopy = 21; { Clipboard copy cmd } cmPaste = 22; { Clipboard paste cmd } cmUndo = 23; { Clipboard undo cmd } cmClear = 24; { Clipboard clear cmd } cmTile = 25; { Tile subviews cmd } cmCascade = 26; { Cascade subviews cmd } cmReceivedFocus = 50; { Received focus } cmReleasedFocus = 51; { Released focus } cmCommandSetChanged = 52; { Commands changed } cmScrollBarChanged = 53; { Scrollbar changed } cmScrollBarClicked = 54; { Scrollbar clicked on } cmSelectWindowNum = 55; { Select window } cmListItemSelected = 56; { Listview item select } cmNotify = 27; cmIdCommunicate = 28; { Communicate via id } cmIdSelect = 29; { Select via id } {---------------------------------------------------------------------------} { TWindow NUMBER CONSTANTS } {---------------------------------------------------------------------------} CONST wnNoNumber = 0; { Window has no num } MaxViewWidth = 255; { Max view width } {***************************************************************************} { PUBLIC TYPE DEFINITIONS } {***************************************************************************} {---------------------------------------------------------------------------} { TWindow Title string } {---------------------------------------------------------------------------} TYPE TTitleStr = String[80]; { Window title string } {---------------------------------------------------------------------------} { COMMAND SET RECORD } {---------------------------------------------------------------------------} TYPE TCommandSet = SET OF Byte; { Command set record } PCommandSet = ^TCommandSet; { Ptr to command set } {---------------------------------------------------------------------------} { PALETTE RECORD } {---------------------------------------------------------------------------} TYPE TPalette = String; { Palette record } PPalette = ^TPalette; { Pointer to palette } {---------------------------------------------------------------------------} { TDrawBuffer RECORD } {---------------------------------------------------------------------------} TYPE TDrawBuffer = Array [0..MaxViewWidth - 1] Of Word; { Draw buffer record } PDrawBuffer = ^TDrawBuffer; { Ptr to draw buffer } {---------------------------------------------------------------------------} { TVideoBuffer RECORD } {---------------------------------------------------------------------------} TYPE TVideoBuf = ARRAY [0..3999] of Word; { Video buffer } PVideoBuf = ^TVideoBuf; { Pointer to buffer } {---------------------------------------------------------------------------} { TComplexArea RECORD } {---------------------------------------------------------------------------} TYPE PComplexArea = ^TComplexArea; { Complex area } TComplexArea = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} PACKED {$endif FPC_REQUIRES_PROPER_ALIGNMENT} RECORD X1, Y1 : Sw_Integer; { Top left corner } X2, Y2 : Sw_Integer; { Lower right corner } NextArea: PComplexArea; { Next area pointer } END; {***************************************************************************} { PUBLIC OBJECT DEFINITIONS } {***************************************************************************} TYPE PGroup = ^TGroup; { Pointer to group } {---------------------------------------------------------------------------} { TView OBJECT - ANCESTOR VIEW OBJECT } {---------------------------------------------------------------------------} PView = ^TView; TView = OBJECT (TObject) GrowMode : Byte; { View grow mode } DragMode : Byte; { View drag mode } TabMask : Byte; { Tab move masks } ColourOfs: Sw_Integer; { View palette offset } HelpCtx : Word; { View help context } State : Word; { View state masks } Options : Word; { View options masks } EventMask: Word; { View event masks } Origin : TPoint; { View origin } Size : TPoint; { View size } Cursor : TPoint; { Cursor position } Next : PView; { Next peerview } Owner : PGroup; { Owner group } HoldLimit: PComplexArea; { Hold limit values } RevCol : Boolean; BackgroundChar : Char; CONSTRUCTOR Init (Var Bounds: TRect); CONSTRUCTOR Load (Var S: TStream); DESTRUCTOR Done; Virtual; FUNCTION Prev: PView; FUNCTION Execute: Word; Virtual; FUNCTION Focus: Boolean; FUNCTION DataSize: Sw_Word; Virtual; FUNCTION TopView: PView; FUNCTION PrevView: PView; FUNCTION NextView: PView; FUNCTION GetHelpCtx: Word; Virtual; FUNCTION EventAvail: Boolean; FUNCTION GetPalette: PPalette; Virtual; function MapColor (color:byte):byte; FUNCTION GetColor (Color: Word): Word; FUNCTION Valid (Command: Word): Boolean; Virtual; FUNCTION GetState (AState: Word): Boolean; FUNCTION TextWidth (const Txt: String): Sw_Integer; FUNCTION CTextWidth (const Txt: String): Sw_Integer; FUNCTION MouseInView (Point: TPoint): Boolean; FUNCTION CommandEnabled (Command: Word): Boolean; FUNCTION OverLapsArea (X1, Y1, X2, Y2: Sw_Integer): Boolean; FUNCTION MouseEvent (Var Event: TEvent; Mask: Word): Boolean; PROCEDURE Hide; PROCEDURE Show; PROCEDURE Draw; Virtual; PROCEDURE ResetCursor; Virtual; PROCEDURE Select; PROCEDURE Awaken; Virtual; PROCEDURE DrawView; PROCEDURE MakeFirst; PROCEDURE DrawCursor; Virtual; PROCEDURE HideCursor; PROCEDURE ShowCursor; PROCEDURE BlockCursor; PROCEDURE NormalCursor; PROCEDURE FocusFromTop; Virtual; PROCEDURE MoveTo (X, Y: Sw_Integer); PROCEDURE GrowTo (X, Y: Sw_Integer); PROCEDURE EndModal (Command: Word); Virtual; PROCEDURE SetCursor (X, Y: Sw_Integer); PROCEDURE PutInFrontOf (Target: PView); PROCEDURE SetCommands (Commands: TCommandSet); PROCEDURE EnableCommands (Commands: TCommandSet); PROCEDURE DisableCommands (Commands: TCommandSet); PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual; PROCEDURE SetCmdState (Commands: TCommandSet; Enable: Boolean); PROCEDURE GetData (Var Rec); Virtual; PROCEDURE SetData (Var Rec); Virtual; PROCEDURE Store (Var S: TStream); PROCEDURE Locate (Var Bounds: TRect); PROCEDURE KeyEvent (Var Event: TEvent); PROCEDURE GetEvent (Var Event: TEvent); Virtual; PROCEDURE PutEvent (Var Event: TEvent); Virtual; PROCEDURE GetExtent (Var Extent: TRect); PROCEDURE GetBounds (Var Bounds: TRect); PROCEDURE SetBounds (Var Bounds: TRect); PROCEDURE GetClipRect (Var Clip: TRect); PROCEDURE ClearEvent (Var Event: TEvent); PROCEDURE HandleEvent (Var Event: TEvent); Virtual; PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual; PROCEDURE SizeLimits (Var Min, Max: TPoint); Virtual; PROCEDURE GetCommands (Var Commands: TCommandSet); PROCEDURE GetPeerViewPtr (Var S: TStream; Var P); PROCEDURE PutPeerViewPtr (Var S: TStream; P: PView); PROCEDURE CalcBounds (Var Bounds: TRect; Delta: TPoint); Virtual; FUNCTION Exposed: Boolean; { This needs help!!!!! } PROCEDURE WriteBuf (X, Y, W, H: Sw_Integer; Var Buf); PROCEDURE WriteLine (X, Y, W, H: Sw_Integer; Var Buf); PROCEDURE MakeLocal (Source: TPoint; Var Dest: TPoint); PROCEDURE MakeGlobal (Source: TPoint; Var Dest: TPoint); PROCEDURE WriteStr (X, Y: Sw_Integer; Str: String; Color: Byte); PROCEDURE WriteChar (X, Y: Sw_Integer; C: Char; Color: Byte; Count: Sw_Integer); PROCEDURE DragView (Event: TEvent; Mode: Byte; Var Limits: TRect; MinSize, MaxSize: TPoint); private procedure CursorChanged; procedure DrawHide(LastView: PView); procedure DrawShow(LastView: PView); procedure DrawUnderRect(var R: TRect; LastView: PView); procedure DrawUnderView(DoShadow: Boolean; LastView: PView); procedure do_WriteView(x1,x2,y:Sw_Integer; var Buf); procedure do_WriteViewRec1(x1,x2:Sw_integer; p:PView; shadowCounter:Sw_integer); procedure do_WriteViewRec2(x1,x2:Sw_integer; p:PView; shadowCounter:Sw_integer); function do_ExposedRec1(x1,x2:Sw_integer; p:PView):boolean; function do_ExposedRec2(x1,x2:Sw_integer; p:PView):boolean; END; SelectMode = (NormalSelect, EnterSelect, LeaveSelect); {---------------------------------------------------------------------------} { TGroup OBJECT - GROUP OBJECT ANCESTOR } {---------------------------------------------------------------------------} TGroup = OBJECT (TView) Phase : (phFocused, phPreProcess, phPostProcess); EndState: Word; { Modal result } Current : PView; { Selected subview } Last : PView; { 1st view inserted } Buffer : PVideoBuf; { Speed up buffer } CONSTRUCTOR Init (Var Bounds: TRect); CONSTRUCTOR Load (Var S: TStream); DESTRUCTOR Done; Virtual; FUNCTION First: PView; FUNCTION Execute: Word; Virtual; FUNCTION GetHelpCtx: Word; Virtual; FUNCTION DataSize: Sw_Word; Virtual; FUNCTION ExecView (P: PView): Word; Virtual; FUNCTION FirstThat (P: Pointer): PView; FUNCTION Valid (Command: Word): Boolean; Virtual; FUNCTION FocusNext (Forwards: Boolean): Boolean; PROCEDURE Draw; Virtual; PROCEDURE Lock; PROCEDURE UnLock; PROCEDURE ResetCursor; Virtual; PROCEDURE Awaken; Virtual; PROCEDURE ReDraw; PROCEDURE SelectDefaultView; PROCEDURE Insert (P: PView); PROCEDURE Delete (P: PView); PROCEDURE ForEach (P: Pointer); { ForEach can't be virtual because it generates SIGSEGV } PROCEDURE EndModal (Command: Word); Virtual; PROCEDURE SelectNext (Forwards: Boolean); PROCEDURE InsertBefore (P, Target: PView); PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual; PROCEDURE GetData (Var Rec); Virtual; PROCEDURE SetData (Var Rec); Virtual; PROCEDURE Store (Var S: TStream); PROCEDURE EventError (Var Event: TEvent); Virtual; PROCEDURE HandleEvent (Var Event: TEvent); Virtual; PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual; PROCEDURE GetSubViewPtr (Var S: TStream; Var P); PROCEDURE PutSubViewPtr (Var S: TStream; P: PView); function ClipChilds: boolean; virtual; procedure BeforeInsert(P: PView); virtual; procedure AfterInsert(P: PView); virtual; procedure BeforeDelete(P: PView); virtual; procedure AfterDelete(P: PView); virtual; PRIVATE LockFlag: Byte; Clip : TRect; FUNCTION IndexOf (P: PView): Sw_Integer; FUNCTION FindNext (Forwards: Boolean): PView; FUNCTION FirstMatch (AState: Word; AOptions: Word): PView; PROCEDURE ResetCurrent; PROCEDURE RemoveView (P: PView); PROCEDURE InsertView (P, Target: PView); PROCEDURE SetCurrent (P: PView; Mode: SelectMode); procedure DrawSubViews(P, Bottom: PView); END; {---------------------------------------------------------------------------} { TFrame OBJECT - FRAME VIEW OBJECT } {---------------------------------------------------------------------------} TYPE TFrame = OBJECT (TView) CONSTRUCTOR Init (Var Bounds: TRect); FUNCTION GetPalette: PPalette; Virtual; procedure Draw; virtual; procedure HandleEvent(var Event: TEvent); virtual; procedure SetState(AState: Word; Enable: Boolean); virtual; private FrameMode: Word; procedure FrameLine(var FrameBuf; Y, N: Sw_Integer; Color: Byte); END; PFrame = ^TFrame; {---------------------------------------------------------------------------} { TScrollBar OBJECT - SCROLL BAR OBJECT } {---------------------------------------------------------------------------} TYPE TScrollChars = Array [0..4] of Char; TScrollBar = OBJECT (TView) Value : Sw_Integer; { Scrollbar value } Min : Sw_Integer; { Scrollbar minimum } Max : Sw_Integer; { Scrollbar maximum } PgStep: Sw_Integer; { One page step } ArStep: Sw_Integer; { One range step } Id : Sw_Integer; { Scrollbar ID } CONSTRUCTOR Init (Var Bounds: TRect); CONSTRUCTOR Load (Var S: TStream); FUNCTION GetPalette: PPalette; Virtual; FUNCTION ScrollStep (Part: Sw_Integer): Sw_Integer; Virtual; PROCEDURE Draw; Virtual; PROCEDURE ScrollDraw; Virtual; PROCEDURE SetValue (AValue: Sw_Integer); PROCEDURE SetRange (AMin, AMax: Sw_Integer); PROCEDURE SetStep (APgStep, AArStep: Sw_Integer); PROCEDURE SetParams (AValue, AMin, AMax, APgStep, AArStep: Sw_Integer); PROCEDURE Store (Var S: TStream); PROCEDURE HandleEvent (Var Event: TEvent); Virtual; PRIVATE Chars: TScrollChars; { Scrollbar chars } FUNCTION GetPos: Sw_Integer; FUNCTION GetSize: Sw_Integer; PROCEDURE DrawPos (Pos: Sw_Integer); END; PScrollBar = ^TScrollBar; {---------------------------------------------------------------------------} { TScroller OBJECT - SCROLLING VIEW ANCESTOR } {---------------------------------------------------------------------------} TYPE TScroller = OBJECT (TView) Delta : TPoint; Limit : TPoint; HScrollBar: PScrollBar; { Horz scroll bar } VScrollBar: PScrollBar; { Vert scroll bar } CONSTRUCTOR Init (Var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar); CONSTRUCTOR Load (Var S: TStream); FUNCTION GetPalette: PPalette; Virtual; PROCEDURE ScrollDraw; Virtual; PROCEDURE SetLimit (X, Y: Sw_Integer); PROCEDURE ScrollTo (X, Y: Sw_Integer); PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual; PROCEDURE Store (Var S: TStream); PROCEDURE HandleEvent (Var Event: TEvent); Virtual; PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual; PRIVATE DrawFlag: Boolean; DrawLock: Byte; PROCEDURE CheckDraw; END; PScroller = ^TScroller; {---------------------------------------------------------------------------} { TListViewer OBJECT - LIST VIEWER OBJECT } {---------------------------------------------------------------------------} TYPE TListViewer = OBJECT (TView) NumCols : Sw_Integer; { Number of columns } TopItem : Sw_Integer; { Top most item } Focused : Sw_Integer; { Focused item } Range : Sw_Integer; { Range of listview } HScrollBar: PScrollBar; { Horz scrollbar } VScrollBar: PScrollBar; { Vert scrollbar } CONSTRUCTOR Init (Var Bounds: TRect; ANumCols: Sw_Word; AHScrollBar, AVScrollBar: PScrollBar); CONSTRUCTOR Load (Var S: TStream); FUNCTION GetPalette: PPalette; Virtual; FUNCTION IsSelected (Item: Sw_Integer): Boolean; Virtual; FUNCTION GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual; PROCEDURE Draw; Virtual; PROCEDURE FocusItem (Item: Sw_Integer); Virtual; PROCEDURE SetTopItem (Item: Sw_Integer); PROCEDURE SetRange (ARange: Sw_Integer); PROCEDURE SelectItem (Item: Sw_Integer); Virtual; PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual; PROCEDURE Store (Var S: TStream); PROCEDURE HandleEvent (Var Event: TEvent); Virtual; PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual; PROCEDURE FocusItemNum (Item: Sw_Integer); Virtual; END; PListViewer = ^TListViewer; {---------------------------------------------------------------------------} { TWindow OBJECT - WINDOW OBJECT ANCESTOR } {---------------------------------------------------------------------------} TYPE TWindow = OBJECT (TGroup) Flags : Byte; { Window flags } Number : Sw_Integer; { Window number } Palette : Sw_Integer; { Window palette } ZoomRect: TRect; { Zoom rectangle } Frame : PFrame; { Frame view object } Title : PString; { Title string } CONSTRUCTOR Init (Var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer); CONSTRUCTOR Load (Var S: TStream); DESTRUCTOR Done; Virtual; FUNCTION GetPalette: PPalette; Virtual; FUNCTION GetTitle (MaxSize: Sw_Integer): TTitleStr; Virtual; FUNCTION StandardScrollBar (AOptions: Word): PScrollBar; PROCEDURE Zoom; Virtual; PROCEDURE Close; Virtual; PROCEDURE InitFrame; Virtual; PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual; PROCEDURE Store (Var S: TStream); PROCEDURE HandleEvent (Var Event: TEvent); Virtual; PROCEDURE SizeLimits (Var Min, Max: TPoint); Virtual; END; PWindow = ^TWindow; {***************************************************************************} { INTERFACE ROUTINES } {***************************************************************************} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { WINDOW MESSAGE ROUTINES } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {-Message------------------------------------------------------------ Message sets up an event record and calls Receiver^.HandleEvent to handle the event. Message returns nil if Receiver is nil, or if the event is not handled successfully. 12Sep97 LdB ---------------------------------------------------------------------} FUNCTION Message (Receiver: PView; What, Command: Word; InfoPtr: Pointer): Pointer; {-NewMessage--------------------------------------------------------- NewMessage sets up an event record including the new fields and calls Receiver^.HandleEvent to handle the event. Message returns nil if Receiver is nil, or if the event is not handled successfully. 19Sep97 LdB ---------------------------------------------------------------------} FUNCTION NewMessage (P: PView; What, Command: Word; Id: Sw_Integer; Data: Real; InfoPtr: Pointer): Pointer; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { VIEW OBJECT REGISTRATION ROUTINES } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {-RegisterViews------------------------------------------------------ This registers all the view type objects used in this unit. 11Aug99 LdB ---------------------------------------------------------------------} PROCEDURE RegisterViews; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { NEW VIEW ROUTINES } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {-CreateIdScrollBar-------------------------------------------------- Creates and scrollbar object of the given size and direction and sets the scrollbar id number. 22Sep97 LdB ---------------------------------------------------------------------} FUNCTION CreateIdScrollBar (X, Y, Size, Id: Sw_Integer; Horz: Boolean): PScrollBar; {***************************************************************************} { INITIALIZED PUBLIC VARIABLES } {***************************************************************************} {---------------------------------------------------------------------------} { INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES } {---------------------------------------------------------------------------} CONST UseNativeClasses: Boolean = True; { Native class modes } CommandSetChanged: Boolean = False; { Command change flag } ShowMarkers: Boolean = False; { Show marker state } ErrorAttr: Byte = $CF; { Error colours } PositionalEvents: Word = evMouse; { Positional defined } FocusedEvents: Word = evKeyboard + evCommand; { Focus defined } MinWinSize: TPoint = (X: 16; Y: 6); { Minimum window size } ShadowSize: TPoint = (X: 2; Y: 1); { Shadow sizes } ShadowAttr: Byte = $08; { Shadow attribute } { Characters used for drawing selected and default items in } { monochrome color sets } SpecialChars: Array [0..5] Of Char = (#175, #174, #26, #27, ' ', ' '); {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { STREAM REGISTRATION RECORDS } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {---------------------------------------------------------------------------} { TView STREAM REGISTRATION } {---------------------------------------------------------------------------} CONST RView: TStreamRec = ( ObjType: idView; { Register id = 1 } VmtLink: TypeOf(TView); { Alt style VMT link } Load: @TView.Load; { Object load method } Store: @TView.Store { Object store method } ); {---------------------------------------------------------------------------} { TFrame STREAM REGISTRATION } {---------------------------------------------------------------------------} CONST RFrame: TStreamRec = ( ObjType: idFrame; { Register id = 2 } VmtLink: TypeOf(TFrame); { Alt style VMT link } Load: @TFrame.Load; { Frame load method } Store: @TFrame.Store { Frame store method } ); {---------------------------------------------------------------------------} { TScrollBar STREAM REGISTRATION } {---------------------------------------------------------------------------} CONST RScrollBar: TStreamRec = ( ObjType: idScrollBar; { Register id = 3 } VmtLink: TypeOf(TScrollBar); { Alt style VMT link } Load: @TScrollBar.Load; { Object load method } Store: @TScrollBar.Store { Object store method } ); {---------------------------------------------------------------------------} { TScroller STREAM REGISTRATION } {---------------------------------------------------------------------------} CONST RScroller: TStreamRec = ( ObjType: idScroller; { Register id = 4 } VmtLink: TypeOf(TScroller); { Alt style VMT link } Load: @TScroller.Load; { Object load method } Store: @TScroller.Store { Object store method } ); {---------------------------------------------------------------------------} { TListViewer STREAM REGISTRATION } {---------------------------------------------------------------------------} CONST RListViewer: TStreamRec = ( ObjType: idListViewer; { Register id = 5 } VmtLink: TypeOf(TListViewer); { Alt style VMT link } Load: @TListViewer.Load; { Object load method } Store: @TLIstViewer.Store { Object store method } ); {---------------------------------------------------------------------------} { TGroup STREAM REGISTRATION } {---------------------------------------------------------------------------} CONST RGroup: TStreamRec = ( ObjType: idGroup; { Register id = 6 } VmtLink: TypeOf(TGroup); { Alt style VMT link } Load: @TGroup.Load; { Object load method } Store: @TGroup.Store { Object store method } ); {---------------------------------------------------------------------------} { TWindow STREAM REGISTRATION } {---------------------------------------------------------------------------} CONST RWindow: TStreamRec = ( ObjType: idWindow; { Register id = 7 } VmtLink: TypeOf(TWindow); { Alt style VMT link } Load: @TWindow.Load; { Object load method } Store: @TWindow.Store { Object store method } ); {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} IMPLEMENTATION {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} USES Video; {***************************************************************************} { PRIVATE TYPE DEFINITIONS } {***************************************************************************} {---------------------------------------------------------------------------} { TFixupList DEFINITION } {---------------------------------------------------------------------------} TYPE TFixupList = ARRAY [1..4096] Of Pointer; { Fix up ptr array } PFixupList = ^TFixupList; { Ptr to fix up list } {***************************************************************************} { PRIVATE INITIALIZED VARIABLES } {***************************************************************************} {---------------------------------------------------------------------------} { INITIALIZED DOS/DPMI/WIN/NT/OS2 PRIVATE VARIABLES } {---------------------------------------------------------------------------} CONST TheTopView : PView = Nil; { Top focused view } LimitsLocked: PView = Nil; { View locking limits } OwnerGroup : PGroup = Nil; { Used for loading } FixupList : PFixupList = Nil; { Used for loading } CurCommandSet: TCommandSet = ([0..255] - [cmZoom, cmClose, cmResize, cmNext, cmPrev]); { All active but these } vdInSetCursor = $80; { AVOID RECURSION IN SetCursor } { Flags for TFrame } fmCloseClicked = $01; fmZoomClicked = $02; type TstatVar2 = record target : PView; offset,y : integer; end; var staticVar1 : PDrawBuffer; staticVar2 : TstatVar2; {***************************************************************************} { PRIVATE INTERNAL ROUTINES } {***************************************************************************} function posidx(const substr,s : string;idx:sw_integer):sw_integer; var i,j : sw_integer; e : boolean; begin i:=idx; j:=0; e:=(length(SubStr)>0); while e and (i<=Length(s)-Length(SubStr)) do begin if (SubStr[1]=s[i]) and (Substr=Copy(s,i,Length(SubStr))) then begin j:=i; e:=false; end; inc(i); end; PosIdx:=j; end; {$ifdef UNIX} const MouseUsesVideoBuf = true; {$else not UNIX} const MouseUsesVideoBuf = false; {$endif not UNIX} procedure DrawScreenBuf; begin if (GetLockScreenCount=0) then begin If MouseUsesVideoBuf then begin LockScreenUpdate; HideMouse; ShowMouse; UnlockScreenUpdate; end else HideMouse; UpdateScreen(false); If not MouseUsesVideoBuf then ShowMouse; end; end; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { VIEW PORT CONTROL ROUTINES } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} TYPE ViewPortType = RECORD X1, Y1, X2, Y2: Integer; { Corners of viewport } Clip : Boolean; { Clip status } END; var ViewPort : ViewPortType; {---------------------------------------------------------------------------} { GetViewSettings -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB } {---------------------------------------------------------------------------} PROCEDURE GetViewSettings (Var CurrentViewPort: ViewPortType); BEGIN CurrentViewPort := ViewPort; { Textmode viewport } END; {---------------------------------------------------------------------------} { SetViewPort -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB } {---------------------------------------------------------------------------} PROCEDURE SetViewPort (X1, Y1, X2, Y2: Integer; Clip: Boolean); BEGIN If (X1 < 0) Then X1 := 0; { X1 negative fix } If (X1 >ScreenWidth) Then X1 := ScreenWidth; { X1 off screen fix } If (Y1 < 0) Then Y1 := 0; { Y1 negative fix } If (Y1 > ScreenHeight) Then Y1 := ScreenHeight; { Y1 off screen fix } If (X2 < 0) Then X2 := 0; { X2 negative fix } If (X2 > ScreenWidth) Then X2 := ScreenWidth; { X2 off screen fix } If (Y2 < 0) Then Y2 := 0; { Y2 negative fix } If (Y2 > ScreenHeight) Then Y2 := ScreenHeight; { Y2 off screen fix } ViewPort.X1 := X1; { Set X1 port value } ViewPort.Y1 := Y1; { Set Y1 port value } ViewPort.X2 := X2; { Set X2 port value } ViewPort.Y2 := Y2; { Set Y2 port value } ViewPort.Clip := Clip; { Set port clip value } { $ifdef DEBUG If WriteDebugInfo then Writeln(stderr,'New ViewPort(',X1,',',Y1,',',X2,',',Y2,')'); $endif DEBUG} END; {***************************************************************************} { OBJECT METHODS } {***************************************************************************} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { TView OBJECT METHODS } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {--TView--------------------------------------------------------------------} { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20Jun96 LdB } {---------------------------------------------------------------------------} CONSTRUCTOR TView.Init (Var Bounds: TRect); BEGIN Inherited Init; { Call ancestor } DragMode := dmLimitLoY; { Default drag mode } HelpCtx := hcNoContext; { Clear help context } State := sfVisible; { Default state } EventMask := evMouseDown + evKeyDown + evCommand; { Default event masks } BackgroundChar := ' '; SetBounds(Bounds); { Set view bounds } END; {--TView--------------------------------------------------------------------} { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB } {---------------------------------------------------------------------------} { This load method will read old original TV data from a stream but the } { new options and tabmasks are not set so some NEW functionality is not } { supported but it should work as per original TV code. } {---------------------------------------------------------------------------} CONSTRUCTOR TView.Load (Var S: TStream); VAR i: Integer; BEGIN Inherited Init; { Call ancestor } S.Read(i, SizeOf(i)); Origin.X:=i; { Read origin x value } S.Read(i, SizeOf(i)); Origin.Y:=i; { Read origin y value } S.Read(i, SizeOf(i)); Size.X:=i; { Read view x size } S.Read(i, SizeOf(i)); Size.Y:=i; { Read view y size } S.Read(i, SizeOf(i)); Cursor.X:=i; { Read cursor x size } S.Read(i, SizeOf(i)); Cursor.Y:=i; { Read cursor y size } S.Read(GrowMode, SizeOf(GrowMode)); { Read growmode flags } S.Read(DragMode, SizeOf(DragMode)); { Read dragmode flags } S.Read(HelpCtx, SizeOf(HelpCtx)); { Read help context } S.Read(State, SizeOf(State)); { Read state masks } S.Read(Options, SizeOf(Options)); { Read options masks } S.Read(Eventmask, SizeOf(Eventmask)); { Read event masks } END; {--TView--------------------------------------------------------------------} { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Nov99 LdB } {---------------------------------------------------------------------------} DESTRUCTOR TView.Done; VAR P: PComplexArea; BEGIN Hide; { Hide the view } If (Owner <> Nil) Then Owner^.Delete(@Self); { Delete from owner } While (HoldLimit <> Nil) Do Begin { Free limit memory } P := HoldLimit^.NextArea; { Hold next pointer } FreeMem(HoldLimit, SizeOf(TComplexArea)); { Release memory } HoldLimit := P; { Shuffle to next } End; END; {--TView--------------------------------------------------------------------} { Prev -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.Prev: PView; VAR NP : PView; BEGIN Prev := @Self; NP := Next; While (NP <> Nil) AND (NP <> @Self) Do Begin Prev := NP; { Locate next view } NP := NP^.Next; End; END; {--TView--------------------------------------------------------------------} { Execute -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.Execute: Word; BEGIN Execute := cmCancel; { Return cancel } END; {--TView--------------------------------------------------------------------} { Focus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB } {---------------------------------------------------------------------------} FUNCTION TView.Focus: Boolean; VAR Res: Boolean; BEGIN Res := True; { Preset result } If (State AND (sfSelected + sfModal)=0) Then Begin { Not modal/selected } If (Owner <> Nil) Then Begin { View has an owner } Res := Owner^.Focus; { Return focus state } If Res Then { Owner has focus } If ((Owner^.Current = Nil) OR { No current view } (Owner^.Current^.Options AND ofValidate = 0) { Non validating view } OR (Owner^.Current^.Valid(cmReleasedFocus))) { Okay to drop focus } Then Select Else Res := False; { Then select us } End; End; Focus := Res; { Return focus result } END; {--TView--------------------------------------------------------------------} { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.DataSize: Sw_Word; BEGIN DataSize := 0; { Transfer size } END; {--TView--------------------------------------------------------------------} { TopView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.TopView: PView; VAR P: PView; BEGIN If (TheTopView = Nil) Then Begin { Check topmost view } P := @Self; { Start with us } While (P <> Nil) AND (P^.State AND sfModal = 0) { Check if modal } Do P := P^.Owner; { Search each owner } TopView := P; { Return result } End Else TopView := TheTopView; { Return topview } END; {--TView--------------------------------------------------------------------} { PrevView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.PrevView: PView; BEGIN If (@Self = Owner^.First) Then PrevView := Nil { We are first view } Else PrevView := Prev; { Return our prior } END; {--TView--------------------------------------------------------------------} { NextView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.NextView: PView; BEGIN If (@Self = Owner^.Last) Then NextView := Nil { This is last view } Else NextView := Next; { Return our next } END; {--TView--------------------------------------------------------------------} { GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.GetHelpCtx: Word; BEGIN If (State AND sfDragging <> 0) Then { Dragging state check } GetHelpCtx := hcDragging Else { Return dragging } GetHelpCtx := HelpCtx; { Return help context } END; {--TView--------------------------------------------------------------------} { EventAvail -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.EventAvail: Boolean; VAR Event: TEvent; BEGIN GetEvent(Event); { Get next event } If (Event.What <> evNothing) Then PutEvent(Event); { Put it back } EventAvail := (Event.What <> evNothing); { Return result } END; {--TView--------------------------------------------------------------------} { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.GetPalette: PPalette; BEGIN GetPalette := Nil; { Return nil ptr } END; {--TView--------------------------------------------------------------------} { MapColor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB } {---------------------------------------------------------------------------} function TView.MapColor(color:byte):byte; var cur : PView; p : PPalette; begin if color=0 then MapColor:=errorAttr else begin cur:=@Self; repeat p:=cur^.GetPalette; if (p<>Nil) then if ord(p^[0])<>0 then begin if color>ord(p^[0]) then begin MapColor:=errorAttr; Exit; end; color:=ord(p^[color]); if color=0 then begin MapColor:=errorAttr; Exit; end; end; cur:=cur^.Owner; until (cur=Nil); MapColor:=color; end; end; {--TView--------------------------------------------------------------------} { GetColor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB } {---------------------------------------------------------------------------} FUNCTION TView.GetColor (Color: Word): Word; VAR Col: Byte; W: Word; P: PPalette; Q: PView; BEGIN W := 0; { Clear colour Sw_Word } If (Hi(Color) > 0) Then Begin { High colour req } Col := Hi(Color) + ColourOfs; { Initial offset } Q := @Self; { Pointer to self } Repeat P := Q^.GetPalette; { Get our palette } If (P <> Nil) Then Begin { Palette is valid } If (Col <= Length(P^)) Then Col := Ord(P^[Col]) Else { Return colour } Col := ErrorAttr; { Error attribute } End; Q := Q^.Owner; { Move up to owner } Until (Q = Nil); { Until no owner } W := Col SHL 8; { Translate colour } End; If (Lo(Color) > 0) Then Begin Col := Lo(Color) + ColourOfs; { Initial offset } Q := @Self; { Pointer to self } Repeat P := Q^.GetPalette; { Get our palette } If (P <> Nil) Then Begin { Palette is valid } If (Col <= Length(P^)) Then Col := Ord(P^[Col]) Else { Return colour } Col := ErrorAttr; { Error attribute } End; Q := Q^.Owner; { Move up to owner } Until (Q = Nil); { Until no owner } End Else Col := ErrorAttr; { No colour found } GetColor := W OR Col; { Return color } END; {--TView--------------------------------------------------------------------} { Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.Valid (Command: Word): Boolean; BEGIN Valid := True; { Simply return true } END; {--TView--------------------------------------------------------------------} { GetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.GetState (AState: Word): Boolean; BEGIN GetState := State AND AState = AState; { Check states equal } END; {--TView--------------------------------------------------------------------} { TextWidth -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Nov99 LdB } {---------------------------------------------------------------------------} FUNCTION TView.TextWidth (const Txt: String): Sw_Integer; BEGIN TextWidth := Length(Txt); { Calc text length } END; FUNCTION TView.CTextWidth (const Txt: String): Sw_Integer; VAR I: Sw_Integer; S: String; BEGIN S := Txt; { Transfer text } Repeat I := Pos('~', S); { Check for tilde } If (I <> 0) Then System.Delete(S, I, 1); { Remove the tilde } Until (I = 0); { Remove all tildes } CTextWidth := Length(S); { Calc text length } END; {--TView--------------------------------------------------------------------} { MouseInView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.MouseInView (Point: TPoint): Boolean; BEGIN MakeLocal(Point,Point); MouseInView := (Point.X >= 0) and (Point.Y >= 0) and (Point.X < Size.X) and (Point.Y < Size.Y); END; {--TView--------------------------------------------------------------------} { CommandEnabled -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.CommandEnabled(Command: Word): Boolean; BEGIN CommandEnabled := (Command > 255) OR (Command IN CurCommandSet); { Check command } END; {--TView--------------------------------------------------------------------} { OverLapsArea -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.OverlapsArea (X1, Y1, X2, Y2: Sw_Integer): Boolean; BEGIN OverLapsArea := False; { Preset false } If (Origin.X > X2) Then Exit; { Area to the left } If ((Origin.X + Size.X) < X1) Then Exit; { Area to the right } If (Origin.Y > Y2) Then Exit; { Area is above } If ((Origin.Y + Size.Y) < Y1) Then Exit; { Area is below } OverLapsArea := True; { Return true } END; {--TView--------------------------------------------------------------------} { MouseEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TView.MouseEvent (Var Event: TEvent; Mask: Word): Boolean; BEGIN Repeat GetEvent(Event); { Get next event } Until (Event.What AND (Mask OR evMouseUp) <> 0); { Wait till valid } MouseEvent := Event.What <> evMouseUp; { Return result } END; {--TView--------------------------------------------------------------------} { Hide -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.Hide; BEGIN If (State AND sfVisible <> 0) Then { View is visible } SetState(sfVisible, False); { Hide the view } END; {--TView--------------------------------------------------------------------} { Show -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.Show; BEGIN If (State AND sfVisible = 0) Then { View not visible } SetState(sfVisible, True); { Show the view } END; {--TView--------------------------------------------------------------------} { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.Draw; VAR B : TDrawBuffer; BEGIN MoveChar(B, ' ', GetColor(1), Size.X); WriteLine(0, 0, Size.X, Size.Y, B); END; procedure TView.ResetCursor; const sfV_CV_F:word = sfVisible + sfCursorVis + sfFocused; var p,p2 : PView; G : PGroup; cur : TPoint; function Check0:boolean; var res : byte; begin res:=0; while res=0 do begin p:=p^.next; if p=p2 then begin p:=P^.owner; res:=1 end else if ((p^.state and sfVisible)<>0) and (cur.x>=p^.origin.x) and (cur.x=p^.origin.y) and (cur.y=p^.size.x) or (cur.y<0) or (cur.y>=p^.size.y) then break; inc(cur.X,p^.origin.X); inc(cur.Y,p^.origin.Y); p2:=p; G:=p^.owner; if G=Nil then { top view } begin Video.SetCursorPos(cur.x,cur.y); if (state and sfCursorIns)<>0 then Video.SetCursorType(crBlock) else Video.SetCursorType(crUnderline); exit; end; if (G^.state and sfVisible)=0 then break; p:=G^.Last; if Check0 then break; end; { while } end; { if } Video.SetCursorType(crHidden); end; {--TView--------------------------------------------------------------------} { Select -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.Select; BEGIN If (Options AND ofSelectable <> 0) Then { View is selectable } If (Options AND ofTopSelect <> 0) Then MakeFirst { Top selectable } Else If (Owner <> Nil) Then { Valid owner } Owner^.SetCurrent(@Self, NormalSelect); { Make owners current } END; {--TView--------------------------------------------------------------------} { Awaken -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.Awaken; BEGIN { Abstract method } END; {--TView--------------------------------------------------------------------} { MakeFirst -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.MakeFirst; BEGIN If (Owner <> Nil) Then Begin { Must have owner } PutInFrontOf(Owner^.First); { Float to the top } End; END; {--TView--------------------------------------------------------------------} { DrawCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.DrawCursor; BEGIN { Abstract method } if State and sfFocused <> 0 then ResetCursor; END; procedure TView.DrawHide(LastView: PView); begin TView.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); 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 LockScreenUpdate; { don't update the screen yet } Draw; UnLockScreenUpdate; DrawScreenBuf; TView.DrawCursor; end; end; {--TView--------------------------------------------------------------------} { HideCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.HideCursor; BEGIN SetState(sfCursorVis , False); { Hide the cursor } END; {--TView--------------------------------------------------------------------} { ShowCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.ShowCursor; BEGIN SetState(sfCursorVis , True); { Show the cursor } END; {--TView--------------------------------------------------------------------} { BlockCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.BlockCursor; BEGIN SetState(sfCursorIns, True); { Set insert mode } END; {--TView--------------------------------------------------------------------} { NormalCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.NormalCursor; BEGIN SetState(sfCursorIns, False); { Clear insert mode } END; {--TView--------------------------------------------------------------------} { FocusFromTop -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11Aug99 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.FocusFromTop; BEGIN If (Owner <> Nil) AND (Owner^.State AND sfSelected = 0) Then Owner^.Select; If (State AND sfFocused = 0) Then Focus; If (State AND sfSelected = 0) Then Select; END; {--TView--------------------------------------------------------------------} { MoveTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.MoveTo (X, Y: Sw_Integer); VAR R: TRect; BEGIN R.Assign(X, Y, X + Size.X, Y + Size.Y); { Assign area } Locate(R); { Locate the view } END; {--TView--------------------------------------------------------------------} { GrowTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.GrowTo (X, Y: Sw_Integer); VAR R: TRect; BEGIN R.Assign(Origin.X, Origin.Y, Origin.X + X, Origin.Y + Y); { Assign area } Locate(R); { Locate the view } END; {--TView--------------------------------------------------------------------} { EndModal -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.EndModal (Command: Word); VAR P: PView; BEGIN P := TopView; { Get top view } If (P <> Nil) Then P^.EndModal(Command); { End modal operation } END; {--TView--------------------------------------------------------------------} { SetCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.SetCursor (X, Y: Sw_Integer); BEGIN if (Cursor.X<>X) or (Cursor.Y<>Y) then begin Cursor.X := X; Cursor.Y := Y; CursorChanged; end; TView.DrawCursor; END; procedure TView.CursorChanged; begin Message(Owner,evBroadcast,cmCursorChanged,@Self); end; {--TView--------------------------------------------------------------------} { PutInFrontOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.PutInFrontOf (Target: PView); VAR P, LastView: PView; BEGIN If (Owner <> Nil) AND (Target <> @Self) AND (Target <> NextView) AND ((Target = Nil) OR (Target^.Owner = Owner)) Then { Check validity } If (State AND sfVisible = 0) Then Begin { View not visible } Owner^.RemoveView(@Self); { Remove from list } Owner^.InsertView(@Self, Target); { Insert into list } End Else Begin LastView := NextView; { Hold next view } If (LastView <> Nil) Then Begin { Lastview is valid } P := Target; { P is target } While (P <> Nil) AND (P <> LastView) Do P := P^.NextView; { Find our next view } If (P = Nil) Then LastView := Target; { Lastview is target } End; State := State AND NOT sfVisible; { Temp stop drawing } If (LastView = Target) Then DrawHide(LastView); Owner^.Lock; Owner^.RemoveView(@Self); { Remove from list } Owner^.InsertView(@Self, Target); { Insert into list } State := State OR sfVisible; { Allow drawing again } If (LastView <> Target) Then DrawShow(LastView); If (Options AND ofSelectable <> 0) Then { View is selectable } begin Owner^.ResetCurrent; { Reset current } Owner^.ResetCursor; end; Owner^.Unlock; End; END; {--TView--------------------------------------------------------------------} { SetCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.SetCommands (Commands: TCommandSet); BEGIN CommandSetChanged := CommandSetChanged OR (CurCommandSet <> Commands); { Set change flag } CurCommandSet := Commands; { Set command set } END; {--TView--------------------------------------------------------------------} { EnableCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.EnableCommands (Commands: TCommandSet); BEGIN CommandSetChanged := CommandSetChanged OR (CurCommandSet * Commands <> Commands); { Set changed flag } CurCommandSet := CurCommandSet + Commands; { Update command set } END; {--TView--------------------------------------------------------------------} { DisableCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.DisableCommands (Commands: TCommandSet); BEGIN CommandSetChanged := CommandSetChanged OR (CurCommandSet * Commands <> []); { Set changed flag } CurCommandSet := CurCommandSet - Commands; { Update command set } END; {--TView--------------------------------------------------------------------} { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.SetState (AState: Word; Enable: Boolean); var Command: Word; OState : Word; begin OState:=State; 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: TView.DrawCursor; sfShadow: DrawUnderView(True, nil); sfFocused: begin ResetCursor; if Enable then Command := cmReceivedFocus else Command := cmReleasedFocus; Message(Owner, evBroadcast, Command, @Self); end; end; if ((OState xor State) and (sfCursorVis+sfCursorIns+sfFocused))<>0 then CursorChanged; end; {--TView--------------------------------------------------------------------} { SetCmdState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.SetCmdState (Commands: TCommandSet; Enable: Boolean); BEGIN If Enable Then EnableCommands(Commands) { Enable commands } Else DisableCommands(Commands); { Disable commands } END; {--TView--------------------------------------------------------------------} { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.GetData (Var Rec); BEGIN { Abstract method } END; {--TView--------------------------------------------------------------------} { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.SetData (Var Rec); BEGIN { Abstract method } END; {--TView--------------------------------------------------------------------} { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.Store (Var S: TStream); VAR SaveState: Word; i: integer; BEGIN SaveState := State; { Hold current state } State := State AND NOT (sfActive OR sfSelected OR sfFocused OR sfExposed); { Clear flags } i:=Origin.X;S.Write(i, SizeOf(i)); { Write view x origin } i:=Origin.Y;S.Write(i, SizeOf(i)); { Write view y origin } i:=Size.X;S.Write(i, SizeOf(i)); { Write view x size } i:=Size.Y;S.Write(i, SizeOf(i)); { Write view y size } i:=Cursor.X;S.Write(i, SizeOf(i)); { Write cursor x size } i:=Cursor.Y;S.Write(i, SizeOf(i)); { Write cursor y size } S.Write(GrowMode, SizeOf(GrowMode)); { Write growmode flags } S.Write(DragMode, SizeOf(DragMode)); { Write dragmode flags } S.Write(HelpCtx, SizeOf(HelpCtx)); { Write help context } S.Write(State, SizeOf(State)); { Write state masks } S.Write(Options, SizeOf(Options)); { Write options masks } S.Write(Eventmask, SizeOf(Eventmask)); { Write event masks } State := SaveState; { Reset state masks } END; {--TView--------------------------------------------------------------------} { Locate -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Sep99 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.Locate (Var Bounds: TRect); VAR Min, Max: TPoint; R: TRect; FUNCTION Range(Val, Min, Max: Sw_Integer): Sw_Integer; BEGIN If (Val < Min) Then Range := Min Else { Value to small } If (Val > Max) Then Range := Max Else { Value to large } Range := Val; { Value is okay } END; BEGIN SizeLimits(Min, Max); { Get size limits } Bounds.B.X := Bounds.A.X + Range(Bounds.B.X - Bounds.A.X, Min.X, Max.X); { X bound limit } Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y - Bounds.A.Y, Min.Y, Max.Y); { Y bound limit } GetBounds(R); { Current bounds } If NOT Bounds.Equals(R) Then Begin { Size has changed } ChangeBounds(Bounds); { Change bounds } If (State AND sfVisible <> 0) AND { View is visible } (State AND sfExposed <> 0) AND (Owner <> Nil) { Check view exposed } 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; {--TView--------------------------------------------------------------------} { KeyEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.KeyEvent (Var Event: TEvent); BEGIN Repeat GetEvent(Event); { Get next event } Until (Event.What = evKeyDown); { Wait till keydown } END; {--TView--------------------------------------------------------------------} { GetEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.GetEvent (Var Event: TEvent); BEGIN If (Owner <> Nil) Then Owner^.GetEvent(Event); { Event from owner } END; {--TView--------------------------------------------------------------------} { PutEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.PutEvent (Var Event: TEvent); BEGIN If (Owner <> Nil) Then Owner^.PutEvent(Event); { Put in owner } END; {--TView--------------------------------------------------------------------} { GetExtent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.GetExtent (Var Extent: TRect); BEGIN Extent.A.X := 0; { Zero x field } Extent.A.Y := 0; { Zero y field } Extent.B.X := Size.X; { Return x size } Extent.B.Y := Size.Y; { Return y size } END; {--TView--------------------------------------------------------------------} { GetBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.GetBounds (Var Bounds: TRect); BEGIN Bounds.A := Origin; { Get first corner } Bounds.B.X := Origin.X + Size.X; { Calc corner x value } Bounds.B.Y := Origin.Y + Size.Y; { Calc corner y value } END; {--TView--------------------------------------------------------------------} { SetBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Sep99 LdB } {---------------------------------------------------------------------------} procedure TView.SetBounds(var Bounds: TRect); begin Origin := Bounds.A; { Get first corner } Size := Bounds.B; { Get second corner } Dec(Size.X,Origin.X); Dec(Size.Y,Origin.Y); end; {--TView--------------------------------------------------------------------} { GetClipRect -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.GetClipRect (Var Clip: TRect); BEGIN GetBounds(Clip); { Get current bounds } If (Owner <> Nil) Then Clip.Intersect(Owner^.Clip);{ Intersect with owner } Clip.Move(-Origin.X, -Origin.Y); { Sub owner origin } END; {--TView--------------------------------------------------------------------} { ClearEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.ClearEvent (Var Event: TEvent); BEGIN Event.What := evNothing; { Clear the event } Event.InfoPtr := @Self; { Set us as handler } END; {--TView--------------------------------------------------------------------} { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.HandleEvent (Var Event: TEvent); BEGIN If (Event.What = evMouseDown) Then { Mouse down event } If (State AND (sfSelected OR sfDisabled) = 0) { Not selected/disabled } AND (Options AND ofSelectable <> 0) Then { View is selectable } If (Focus = False) OR { Not view with focus } (Options AND ofFirstClick = 0) { Not 1st click select } Then ClearEvent(Event); { Handle the event } END; {--TView--------------------------------------------------------------------} { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.ChangeBounds (Var Bounds: TRect); BEGIN SetBounds(Bounds); { Set new bounds } DrawView; { Draw the view } END; {--TView--------------------------------------------------------------------} { SizeLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.SizeLimits (Var Min, Max: TPoint); BEGIN Min.X := 0; { Zero x minimum } Min.Y := 0; { Zero y minimum } If (Owner <> Nil) and(Owner^.ClipChilds) Then Max := Owner^.Size else { Max owner size } Begin Max.X := high(sw_integer); { Max possible x size } Max.Y := high(sw_integer); { Max possible y size } End; END; {--TView--------------------------------------------------------------------} { GetCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.GetCommands (Var Commands: TCommandSet); BEGIN Commands := CurCommandSet; { Return command set } END; {--TView--------------------------------------------------------------------} { GetPeerViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.GetPeerViewPtr (Var S: TStream; Var P); VAR Index: Integer; BEGIN Index := 0; { Zero index value } S.Read(Index, SizeOf(Index)); { Read view index } If (Index = 0) OR (OwnerGroup = Nil) Then { Check for peer views } Pointer(P) := Nil Else Begin { Return nil } Pointer(P) := FixupList^[Index]; { New view ptr } FixupList^[Index] := @P; { Patch this pointer } End; END; {--TView--------------------------------------------------------------------} { PutPeerViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.PutPeerViewPtr (Var S: TStream; P: PView); VAR Index: Integer; BEGIN If (P = Nil) OR (OwnerGroup = Nil) Then Index := 0 { Return zero index } Else Index := OwnerGroup^.IndexOf(P); { Return view index } S.Write(Index, SizeOf(Index)); { Write the index } END; {--TView--------------------------------------------------------------------} { CalcBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.CalcBounds (Var Bounds: Objects.TRect; Delta: TPoint); VAR S, D: Sw_Integer; Min, Max: TPoint; FUNCTION Range (Val, Min, Max: Sw_Integer): Sw_Integer; BEGIN If (Val < Min) Then Range := Min Else { Value below min } If (Val > Max) Then Range := Max Else { Value above max } Range := Val; { Accept value } END; PROCEDURE GrowI (Var I: Sw_Integer); BEGIN If (GrowMode AND gfGrowRel = 0) Then Inc(I, D) Else I := (I * S + (S - D) SHR 1) DIV (S - D); { Calc grow value } END; BEGIN GetBounds(Bounds); { Get bounds } If (GrowMode = 0) Then Exit; { No grow flags exits } S := Owner^.Size.X; { Set initial size } D := Delta.X; { Set initial delta } If (GrowMode AND gfGrowLoX <> 0) Then GrowI(Bounds.A.X); { Grow left side } If (GrowMode AND gfGrowHiX <> 0) Then GrowI(Bounds.B.X); { Grow right side } If (Bounds.B.X - Bounds.A.X > MaxViewWidth) Then Bounds.B.X := Bounds.A.X + MaxViewWidth; { Check values } S := Owner^.Size.Y; D := Delta.Y; { set initial values } If (GrowMode AND gfGrowLoY <> 0) Then GrowI(Bounds.A.Y); { Grow top side } If (GrowMode AND gfGrowHiY <> 0) Then GrowI(Bounds.B.Y); { grow lower side } SizeLimits(Min, Max); { Check sizes } Bounds.B.X := Bounds.A.X + Range(Bounds.B.X - Bounds.A.X, Min.X, Max.X); { Set right side } Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y - Bounds.A.Y, Min.Y, Max.Y); { Set lower side } END; {***************************************************************************} { TView OBJECT PRIVATE METHODS } {***************************************************************************} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { TGroup OBJECT METHODS } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {--TGroup-------------------------------------------------------------------} { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Jul99 LdB } {---------------------------------------------------------------------------} CONSTRUCTOR TGroup.Init (Var Bounds: TRect); BEGIN Inherited Init(Bounds); { Call ancestor } Options := Options OR (ofSelectable + ofBuffered); { Set options } GetExtent(Clip); { Get clip extents } EventMask := $FFFF; { See all events } END; {--TGroup-------------------------------------------------------------------} { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} CONSTRUCTOR TGroup.Load (Var S: TStream); VAR I: Sw_Word; Count: Word; P, Q: ^Pointer; V: PView; OwnerSave: PGroup; FixupSave: PFixupList; BEGIN Inherited Load(S); { Call ancestor } GetExtent(Clip); { Get view extents } OwnerSave := OwnerGroup; { Save current group } OwnerGroup := @Self; { We are current group } FixupSave := FixupList; { Save current list } Count := 0; { Zero count value } S.Read(Count, SizeOf(Count)); { Read entry count } If (MaxAvail >= Count*SizeOf(Pointer)) Then Begin { Memory available } GetMem(FixupList, Count*SizeOf(Pointer)); { List size needed } FillChar(FixUpList^, Count*SizeOf(Pointer), #0); { Zero all entries } For I := 1 To Count Do Begin V := PView(S.Get); { Get view off stream } If (V <> Nil) Then InsertView(V, Nil); { Insert valid views } End; V := Last; { Start on last view } For I := 1 To Count Do Begin V := V^.Next; { Fetch next view } P := FixupList^[I]; { Transfer pointer } While (P <> Nil) Do Begin { If valid view } Q := P; { Copy pointer } P := P^; { Fetch pointer } Q^ := V; { Transfer view ptr } End; End; FreeMem(FixupList, Count*SizeOf(Pointer)); { Release fixup list } End; OwnerGroup := OwnerSave; { Reload current group } FixupList := FixupSave; { Reload current list } GetSubViewPtr(S, V); { Load any subviews } SetCurrent(V, NormalSelect); { Select current view } If (OwnerGroup = Nil) Then Awaken; { If topview activate } END; {--TGroup-------------------------------------------------------------------} { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} DESTRUCTOR TGroup.Done; VAR P, T: PView; BEGIN Hide; { Hide the view } P := Last; { Start on last } If (P <> Nil) Then Begin { Subviews exist } Repeat P^.Hide; { Hide each view } P := P^.Prev; { Prior view } Until (P = Last); { Loop complete } Repeat T := P^.Prev; { Hold prior pointer } Dispose(P, Done); { Dispose subview } P := T; { Transfer pointer } Until (Last = Nil); { Loop complete } End; Inherited Done; { Call ancestor } END; {--TGroup-------------------------------------------------------------------} { First -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TGroup.First: PView; BEGIN If (Last = Nil) Then First := Nil { No first view } Else First := Last^.Next; { Return first view } END; {--TGroup-------------------------------------------------------------------} { Execute -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TGroup.Execute: Word; VAR Event: TEvent; BEGIN Repeat EndState := 0; { Clear end state } Repeat GetEvent(Event); { Get next event } HandleEvent(Event); { Handle the event } If (Event.What <> evNothing) Then EventError(Event); { Event not handled } Until (EndState <> 0); { Until command set } Until Valid(EndState); { Repeat until valid } Execute := EndState; { Return result } EndState := 0; { Clear end state } END; {--TGroup-------------------------------------------------------------------} { GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TGroup.GetHelpCtx: Word; VAR H: Word; BEGIN H := hcNoContext; { Preset no context } If (Current <> Nil) Then H := Current^.GetHelpCtx; { Current context } If (H=hcNoContext) Then H := Inherited GetHelpCtx; { Call ancestor } GetHelpCtx := H; { Return result } END; {--TGroup-------------------------------------------------------------------} { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Jul98 LdB } {---------------------------------------------------------------------------} FUNCTION TGroup.DataSize: Sw_Word; VAR Total: Word; P: PView; BEGIN Total := 0; { Zero totals count } P := Last; { Start on last view } If (P <> Nil) Then Begin { Subviews exist } Repeat P := P^.Next; { Move to next view } Total := Total + P^.DataSize; { Add view size } Until (P = Last); { Until last view } End; DataSize := Total; { Return data size } END; {--TGroup-------------------------------------------------------------------} { ExecView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Jul99 LdB } {---------------------------------------------------------------------------} FUNCTION TGroup.ExecView (P: PView): Word; VAR SaveOptions: Word; SaveTopView, SaveCurrent: PView; SaveOwner: PGroup; SaveCommands: TCommandSet; BEGIN If (P<>Nil) Then Begin SaveOptions := P^.Options; { Hold options } SaveOwner := P^.Owner; { Hold owner } SaveTopView := TheTopView; { Save topmost view } SaveCurrent := Current; { Save current view } GetCommands(SaveCommands); { Save commands } TheTopView := P; { Set top view } P^.Options := P^.Options AND NOT ofSelectable; { Not selectable } P^.SetState(sfModal, True); { Make modal } SetCurrent(P, EnterSelect); { Select next } If (SaveOwner = Nil) Then Insert(P); { Insert view } ExecView := P^.Execute; { Execute view } If (SaveOwner = Nil) Then Delete(P); { Remove view } SetCurrent(SaveCurrent, LeaveSelect); { Unselect current } P^.SetState(sfModal, False); { Clear modal state } P^.Options := SaveOptions; { Restore options } TheTopView := SaveTopView; { Restore topview } SetCommands(SaveCommands); { Restore commands } End Else ExecView := cmCancel; { Return cancel } END; { ********************************* REMARK ******************************** } { This call really is very COMPILER SPECIFIC and really can't be done } { effectively any other way but assembler code as SELF & FRAMES need } { to be put down in exact order and OPTIMIZERS make a mess of it. } { ******************************** END REMARK *** Leon de Boer, 17Jul99 *** } {--TGroup-------------------------------------------------------------------} { FirstThat -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB } {---------------------------------------------------------------------------} FUNCTION TGroup.FirstThat (P: Pointer): PView; VAR Tp : PView; BEGIN If (Last<>Nil) Then Begin Tp := Last; { Set temporary ptr } Repeat Tp := Tp^.Next; { Get next view } IF Byte(Longint(CallPointerMethodLocal(P,get_caller_frame(get_frame),@self,Tp)))<>0 THEN Begin { Test each view } FirstThat := Tp; { View returned true } Exit; { Now exit } End; Until (Tp=Last); { Until last } FirstThat := Nil; { None passed test } End Else FirstThat := Nil; { Return nil } END; {--TGroup-------------------------------------------------------------------} { Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TGroup.Valid (Command: Word): Boolean; FUNCTION IsInvalid (P: PView): Boolean; BEGIN IsInvalid := NOT P^.Valid(Command); { Check if valid } END; BEGIN Valid := True; { Preset valid } If (Command = cmReleasedFocus) Then Begin { Release focus cmd } If (Current <> Nil) AND { Current view exists } (Current^.Options AND ofValidate <> 0) Then { Validating view } Valid := Current^.Valid(Command); { Validate command } End Else Valid := FirstThat(@IsInvalid) = Nil; { Check first valid } END; {--TGroup-------------------------------------------------------------------} { FocusNext -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TGroup.FocusNext (Forwards: Boolean): Boolean; VAR P: PView; BEGIN P := FindNext(Forwards); { Find next view } FocusNext := True; { Preset true } If (P <> Nil) Then FocusNext := P^.Focus; { Check next focus } END; procedure TGroup.DrawSubViews(P, Bottom: PView); begin if P <> nil then while P <> Bottom do begin P^.DrawView; P := P^.NextView; end; end; {--TGroup-------------------------------------------------------------------} { ReDraw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB } {---------------------------------------------------------------------------} procedure TGroup.Redraw; begin DrawSubViews(First, nil); end; PROCEDURE TGroup.ResetCursor; BEGIN if (Current<>nil) then Current^.ResetCursor; END; {--TGroup-------------------------------------------------------------------} { Awaken -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.Awaken; PROCEDURE DoAwaken (P: PView); BEGIN If (P <> Nil) Then P^.Awaken; { Awaken view } END; BEGIN ForEach(@DoAwaken); { Awaken each view } END; {--TGroup-------------------------------------------------------------------} { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.Draw; BEGIN If Buffer=Nil then ReDraw else WriteBuf(0,0,Size.X,Size.Y,Buffer); END; {--TGroup-------------------------------------------------------------------} { SelectDefaultView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.SelectDefaultView; VAR P: PView; BEGIN P := Last; { Start at last } While (P <> Nil) Do Begin If P^.GetState(sfDefault) Then Begin { Search 1st default } P^.Select; { Select default view } P := Nil; { Force kick out } End Else P := P^.PrevView; { Prior subview } End; END; function TGroup.ClipChilds: boolean; begin ClipChilds:=true; end; procedure TGroup.BeforeInsert(P: PView); begin { abstract } end; procedure TGroup.AfterInsert(P: PView); begin { abstract } end; procedure TGroup.BeforeDelete(P: PView); begin { abstract } end; procedure TGroup.AfterDelete(P: PView); begin { abstract } end; {--TGroup-------------------------------------------------------------------} { Insert -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.Insert (P: PView); BEGIN BeforeInsert(P); InsertBefore(P, First); AfterInsert(P); END; {--TGroup-------------------------------------------------------------------} { Delete -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.Delete (P: PView); VAR SaveState: Word; BEGIN BeforeDelete(P); SaveState := P^.State; { Save state } P^.Hide; { Hide the view } RemoveView(P); { Remove the view } P^.Owner := Nil; { Clear owner ptr } P^.Next := Nil; { Clear next ptr } if SaveState and sfVisible <> 0 then P^.Show; AfterDelete(P); END; { ********************************* REMARK ******************************** } { This call really is very COMPILER SPECIFIC and really can't be done } { effectively any other way but assembler code as SELF & FRAMES need } { to be put down in exact order and OPTIMIZERS make a mess of it. } { ******************************** END REMARK *** Leon de Boer, 17Jul99 *** } {--TGroup-------------------------------------------------------------------} { ForEach -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.ForEach (P: Pointer); VAR Tp,Hp,L0 : PView; { Vars Hp and L0 are necessary to hold original pointers in case } { when some view closes himself as a result of broadcast message ! } BEGIN If (Last<>Nil) Then Begin Tp:=Last; Hp:=Tp^.Next; L0:=Last; { Set temporary ptr } Repeat Tp:=Hp; if tp=nil then exit; Hp:=Tp^.Next; { Get next view } CallPointerMethodLocal(P,get_caller_frame(get_frame),@self,Tp); Until (Tp=L0); { Until last } End; END; {--TGroup-------------------------------------------------------------------} { EndModal -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.EndModal (Command: Word); BEGIN If (State AND sfModal <> 0) Then { This view is modal } EndState := Command Else { Set endstate } Inherited EndModal(Command); { Call ancestor } END; {--TGroup-------------------------------------------------------------------} { SelectNext -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.SelectNext (Forwards: Boolean); VAR P: PView; BEGIN P := FindNext(Forwards); { Find next view } If (P <> Nil) Then P^.Select; { Select view } END; {--TGroup-------------------------------------------------------------------} { InsertBefore -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.InsertBefore (P, Target: PView); VAR SaveState : Word; BEGIN If (P <> Nil) AND (P^.Owner = Nil) AND { View valid } ((Target = Nil) OR (Target^.Owner = @Self)) { Target valid } Then Begin If (P^.Options AND ofCenterX <> 0) Then { Centre on x axis } P^.Origin.X := (Size.X - P^.Size.X) div 2; If (P^.Options AND ofCenterY <> 0) Then { Centre on y axis } P^.Origin.Y := (Size.Y - P^.Size.Y) div 2; SaveState := P^.State; { Save view state } P^.Hide; { Make sure hidden } InsertView(P, Target); { Insert into list } If (SaveState AND sfVisible <> 0) Then P^.Show; { Show the view } If (State AND sfActive <> 0) Then { Was active before } P^.SetState(sfActive , True); { Make active again } End; END; {--TGroup-------------------------------------------------------------------} { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.SetState (AState: Word; Enable: Boolean); PROCEDURE DoSetState (P: PView); BEGIN If (P <> Nil) Then P^.SetState(AState, Enable); { Set subview state } END; PROCEDURE DoExpose (P: PView); BEGIN If (P <> Nil) Then Begin If (P^.State AND sfVisible <> 0) Then { Check view visible } P^.SetState(sfExposed, Enable); { Set exposed flag } End; END; BEGIN Inherited SetState(AState, Enable); { Call ancestor } Case AState Of sfActive, sfDragging: Begin Lock; { Lock the view } ForEach(@DoSetState); { Set each subview } UnLock; { Unlock the view } End; sfFocused: Begin If (Current <> Nil) Then Current^.SetState(sfFocused, Enable); { Focus current view } End; sfExposed: Begin ForEach(@DoExpose); { Expose each subview } End; End; END; {--TGroup-------------------------------------------------------------------} { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Mar98 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.GetData (Var Rec); VAR Total: Sw_Word; P: PView; BEGIN Total := 0; { Clear total } P := Last; { Start at last } While (P <> Nil) Do Begin { Subviews exist } P^.GetData(TByteArray(Rec)[Total]); { Get data } Inc(Total, P^.DataSize); { Increase total } P := P^.PrevView; { Previous view } End; END; {--TGroup-------------------------------------------------------------------} { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Mar98 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.SetData (Var Rec); VAR Total: Sw_Word; P: PView; BEGIN Total := 0; { Clear total } P := Last; { Start at last } While (P <> Nil) Do Begin { Subviews exist } P^.SetData(TByteArray(Rec)[Total]); { Get data } Inc(Total, P^.DataSize); { Increase total } P := P^.PrevView; { Previous view } End; END; {--TGroup-------------------------------------------------------------------} { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Mar98 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.Store (Var S: TStream); VAR Count: Word; OwnerSave: PGroup; PROCEDURE DoPut (P: PView); BEGIN S.Put(P); { Put view on stream } END; BEGIN TView.Store(S); { Call view store } OwnerSave := OwnerGroup; { Save ownergroup } OwnerGroup := @Self; { Set as owner group } Count := IndexOf(Last); { Subview count } S.Write(Count, SizeOf(Count)); { Write the count } ForEach(@DoPut); { Put each in stream } PutSubViewPtr(S, Current); { Current on stream } OwnerGroup := OwnerSave; { Restore ownergroup } END; {--TGroup-------------------------------------------------------------------} { EventError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.EventError (Var Event: TEvent); BEGIN If (Owner <> Nil) Then Owner^.EventError(Event); { Event error } END; {--TGroup-------------------------------------------------------------------} { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.HandleEvent (Var Event: TEvent); FUNCTION ContainsMouse (P: PView): Boolean; BEGIN ContainsMouse := (P^.State AND sfVisible <> 0) { Is view visible } AND P^.MouseInView(Event.Where); { Is point in view } END; PROCEDURE DoHandleEvent (P: PView); BEGIN If (P = Nil) OR ((P^.State AND sfDisabled <> 0) AND (Event.What AND(PositionalEvents OR FocusedEvents) <>0 )) Then Exit; { Invalid/disabled } Case Phase Of phPreProcess: If (P^.Options AND ofPreProcess = 0) Then Exit; { Not pre processing } phPostProcess: If (P^.Options AND ofPostProcess = 0) Then Exit; { Not post processing } End; If (Event.What AND P^.EventMask <> 0) Then { View handles event } P^.HandleEvent(Event); { Pass to view } END; BEGIN Inherited HandleEvent(Event); { Call ancestor } If (Event.What = evNothing) Then Exit; { No valid event exit } If (Event.What AND FocusedEvents <> 0) Then Begin { Focused event } Phase := phPreProcess; { Set pre process } ForEach(@DoHandleEvent); { Pass to each view } Phase := phFocused; { Set focused } DoHandleEvent(Current); { Pass to current } Phase := phPostProcess; { Set post process } ForEach(@DoHandleEvent); { Pass to each } End Else Begin Phase := phFocused; { Set focused } If (Event.What AND PositionalEvents <> 0) Then { Positional event } DoHandleEvent(FirstThat(@ContainsMouse)) { Pass to first } Else ForEach(@DoHandleEvent); { Pass to all } End; END; {--TGroup-------------------------------------------------------------------} { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.ChangeBounds (Var Bounds: TRect); VAR D: TPoint; PROCEDURE DoCalcChange (P: PView); VAR R: TRect; BEGIN P^.CalcBounds(R, D); { Calc view bounds } P^.ChangeBounds(R); { Change view bounds } END; BEGIN D.X := Bounds.B.X - Bounds.A.X - Size.X; { Delta x value } D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y; { Delta y value } If ((D.X=0) AND (D.Y=0)) Then Begin SetBounds(Bounds); { Set new bounds } { Force redraw } ReDraw; { Draw the view } End Else Begin SetBounds(Bounds); { Set new bounds } GetExtent(Clip); { Get new clip extents } Lock; { Lock drawing } ForEach(@DoCalcChange); { Change each view } UnLock; { Unlock drawing } End; END; {--TGroup-------------------------------------------------------------------} { GetSubViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.GetSubViewPtr (Var S: TStream; Var P); VAR Index, I: Sw_Word; Q: PView; BEGIN Index := 0; { Zero index value } S.Read(Index, SizeOf(Index)); { Read view index } If (Index > 0) Then Begin { Valid index } Q := Last; { Start on last } For I := 1 To Index Do Q := Q^.Next; { Loop for count } Pointer(P) := Q; { Return the view } End Else Pointer(P) := Nil; { Return nil } END; {--TGroup-------------------------------------------------------------------} { PutSubViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.PutSubViewPtr (Var S: TStream; P: PView); VAR Index: Sw_Word; BEGIN If (P = Nil) Then Index := 0 Else { Nil view, Index = 0 } Index := IndexOf(P); { Calc view index } S.Write(Index, SizeOf(Index)); { Write the index } END; {***************************************************************************} { TGroup OBJECT PRIVATE METHODS } {***************************************************************************} {--TGroup-------------------------------------------------------------------} { IndexOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TGroup.IndexOf (P: PView): Sw_Integer; VAR I: Sw_Integer; Q: PView; BEGIN Q := Last; { Start on last view } If (Q <> Nil) Then Begin { Subviews exist } I := 1; { Preset value } While (Q <> P) AND (Q^.Next <> Last) Do Begin Q := Q^.Next; { Load next view } Inc(I); { Increment count } End; If (Q <> P) Then IndexOf := 0 Else IndexOf := I; { Return index } End Else IndexOf := 0; { Return zero } END; {--TGroup-------------------------------------------------------------------} { FindNext -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB } {---------------------------------------------------------------------------} FUNCTION TGroup.FindNext (Forwards: Boolean): PView; VAR P: PView; BEGIN FindNext := Nil; { Preset nil return } If (Current <> Nil) Then Begin { Has current view } P := Current; { Start on current } Repeat If Forwards Then P := P^.Next { Get next view } Else P := P^.Prev; { Get prev view } Until ((P^.State AND (sfVisible+sfDisabled) = sfVisible) AND (P^.Options AND ofSelectable <> 0)) OR { Tab selectable } (P = Current); { Not singular select } If (P <> Current) Then FindNext := P; { Return result } End; END; {--TGroup-------------------------------------------------------------------} { FirstMatch -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} 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); { Return match state } END; BEGIN FirstMatch := FirstThat(@Matches); { Return first match } END; {--TGroup-------------------------------------------------------------------} { ResetCurrent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.ResetCurrent; BEGIN SetCurrent(FirstMatch(sfVisible, ofSelectable), NormalSelect); { Reset current view } END; {--TGroup-------------------------------------------------------------------} { RemoveView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.RemoveView (P: PView); VAR Q: PView; BEGIN If (P <> Nil) AND (Last <> Nil) Then Begin { Check view is valid } Q := Last; { Start on last view } While (Q^.Next <> P) AND (Q^.Next <> Last) Do Q := Q^.Next; { Find prior view } If (Q^.Next = P) Then Begin { View found } If (Q^.Next <> Q) Then Begin { Not only view } Q^.Next := P^.Next; { Rechain views } If (P = Last) Then Last := P^.Next; { Fix if last removed } End Else Last := Nil; { Only view } End; End; END; {--TGroup-------------------------------------------------------------------} { InsertView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.InsertView (P, Target: PView); BEGIN If (P <> Nil) Then Begin { Check view is valid } P^.Owner := @Self; { Views owner is us } If (Target <> Nil) Then Begin { Valid target } Target := Target^.Prev; { 1st part of chain } P^.Next := Target^.Next; { 2nd part of chain } Target^.Next := P; { Chain completed } End Else Begin If (Last <> Nil) Then Begin { Not first view } P^.Next := Last^.Next; { 1st part of chain } Last^.Next := P; { Completed chain } End Else P^.Next := P; { 1st chain to self } Last := P; { P is now last } End; End; END; {--TGroup-------------------------------------------------------------------} { SetCurrent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.SetCurrent (P: PView; Mode: SelectMode); PROCEDURE SelectView (P: PView; Enable: Boolean); BEGIN If (P <> Nil) Then { View is valid } P^.SetState(sfSelected, Enable); { Select the view } END; PROCEDURE FocusView (P: PView; Enable: Boolean); BEGIN If (State AND sfFocused <> 0) AND (P <> Nil) { Check not focused } Then P^.SetState(sfFocused, Enable); { Focus the view } END; BEGIN If (Current<>P) Then Begin { Not already current } Lock; { Stop drawing } FocusView(Current, False); { Defocus current } If (Mode <> EnterSelect) Then SelectView(Current, False); { Deselect current } If (Mode<>LeaveSelect) Then SelectView(P, True); { Select view P } FocusView(P, True); { Focus view P } Current := P; { Set as current view } UnLock; { Redraw now } End; END; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { TFrame OBJECT METHODS } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {--TFrame-------------------------------------------------------------------} { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB } {---------------------------------------------------------------------------} CONSTRUCTOR TFrame.Init (Var Bounds: TRect); BEGIN Inherited Init(Bounds); { Call ancestor } GrowMode := gfGrowHiX + gfGrowHiY; { Set grow modes } EventMask := EventMask OR evBroadcast; { See broadcasts } END; procedure TFrame.FrameLine(var FrameBuf; Y, N: Sw_Integer; Color: Byte); 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); FrameChars: array[0..31] of Char = ' À ³Úà ÙÄÁ¿´ÂÅ È ºÉÇ ¼ÍÏ»¶Ñ '; var FrameMask : array[0..MaxViewWidth-1] of Byte; ColorMask : word; i,j,k : {Sw_ lo and hi are used !! }integer; CurrView : PView; begin FrameMask[0]:=InitFrame[n]; FillChar(FrameMask[1],Size.X-2,InitFrame[n+1]); FrameMask[Size.X-1]:=InitFrame[n+2]; CurrView:=Owner^.Last^.Next; while (CurrView<>@Self) do begin if ((CurrView^.Options and ofFramed)<>0) and ((CurrView^.State and sfVisible)<>0) then begin i:=Y-CurrView^.Origin.Y; if (i<0) then begin inc(i); if i=0 then i:=$0a06 else i:=0; end else begin if i0) then begin j:=CurrView^.Origin.X; k:=CurrView^.Size.X+j; if j<1 then j:=1; if k>Size.X then k:=Size.X; if (k>j) then begin FrameMask[j-1]:=FrameMask[j-1] or lo(i); i:=(lo(i) xor hi(i)) or (i and $ff00); FrameMask[k]:=FrameMask[k] or lo(i); if hi(i)<>0 then begin dec(k,j); repeat FrameMask[j]:=FrameMask[j] or hi(i); inc(j); dec(k); until k=0; end; end; end; end; CurrView:=CurrView^.Next; end; ColorMask:=Color shl 8; for i:=0 to Size.X-1 do TVideoBuf(FrameBuf)[i]:=ord(FrameChars[FrameMask[i]]) or ColorMask; end; procedure TFrame.Draw; const LargeC:array[boolean] of char=('^',#24); RestoreC:array[boolean] of char=('|',#18); ClickC:array[boolean] of char=('*',#15); var CFrame, CTitle: Word; F, I, L, Width: Sw_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], '[~þ~]', CFrame) else MoveCStr(B[2], '[~'+ClickC[LowAscii]+'~]', CFrame); if PWindow(Owner)^.Flags and wfZoom <> 0 then begin MoveCStr(B[Width - 5], '[~'+LargeC[LowAscii]+'~]', CFrame); Owner^.SizeLimits(Min, Max); if FrameMode and fmZoomClicked <> 0 then WordRec(B[Width - 4]).Lo := ord(ClickC[LowAscii]) else if (Owner^.Size.X=Max.X) and (Owner^.Size.Y=Max.Y) then WordRec(B[Width - 4]).Lo := ord(RestoreC[LowAscii]); 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], '~ÄÙ~', CFrame); WriteLine(0, Size.Y - 1, Size.X, 1, B); end; {--TFrame-------------------------------------------------------------------} { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB } {---------------------------------------------------------------------------} FUNCTION TFrame.GetPalette: PPalette; CONST P: String[Length(CFrame)] = CFrame; { Always normal string } BEGIN GetPalette := @P; { Return palette } 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 OBJECT METHODS } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {--TScrollBar---------------------------------------------------------------} { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB } {---------------------------------------------------------------------------} CONSTRUCTOR TScrollBar.Init (Var Bounds: TRect); const VChars: array[boolean] of TScrollChars = (('^','V', #177, #254, #178),(#30, #31, #177, #254, #178)); HChars: array[boolean] of TScrollChars = (('<','>', #177, #254, #178),(#17, #16, #177, #254, #178)); BEGIN Inherited Init(Bounds); { Call ancestor } PgStep := 1; { Page step size = 1 } ArStep := 1; { Arrow step sizes = 1 } If (Size.X = 1) Then Begin { Vertical scrollbar } GrowMode := gfGrowLoX + gfGrowHiX + gfGrowHiY; { Grow vertically } Chars := VChars[LowAscii]; { Vertical chars } End Else Begin { Horizontal scrollbar } GrowMode := gfGrowLoY + gfGrowHiX + gfGrowHiY; { Grow horizontal } Chars := HChars[LowAscii]; { Horizontal chars } End; END; {--TScrollBar---------------------------------------------------------------} { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB } {---------------------------------------------------------------------------} { This load method will read old original TV data from a stream with the } { scrollbar id set to zero. } {---------------------------------------------------------------------------} CONSTRUCTOR TScrollBar.Load (Var S: TStream); VAR i: Integer; BEGIN Inherited Load(S); { Call ancestor } S.Read(i, SizeOf(i)); Value:=i; { Read current value } S.Read(i, SizeOf(i)); Min:=i; { Read min value } S.Read(i, SizeOf(i)); Max:=i; { Read max value } S.Read(i, SizeOf(i)); PgStep:=i; { Read page step size } S.Read(i, SizeOf(i)); ArStep:=i; { Read arrow step size } S.Read(Chars, SizeOf(Chars)); { Read scroll chars } END; {--TScrollBar---------------------------------------------------------------} { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB } {---------------------------------------------------------------------------} FUNCTION TScrollBar.GetPalette: PPalette; CONST P: String[Length(CScrollBar)] = CScrollBar; { Always normal string } BEGIN GetPalette := @P; { Return palette } END; {--TScrollBar---------------------------------------------------------------} { ScrollStep -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB } {---------------------------------------------------------------------------} FUNCTION TScrollBar.ScrollStep (Part: Sw_Integer): Sw_Integer; VAR Step: Sw_Integer; BEGIN If (Part AND $0002 = 0) Then Step := ArStep { Range step size } Else Step := PgStep; { Page step size } If (Part AND $0001 = 0) Then ScrollStep := -Step { Upwards move } Else ScrollStep := Step; { Downwards move } END; {--TScrollBar---------------------------------------------------------------} { ScrollDraw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TScrollBar.ScrollDraw; VAR P: PView; BEGIN If (Id <> 0) Then Begin P := TopView; { Get topmost view } NewMessage(P, evCommand, cmIdCommunicate, Id, Value, @Self); { New Id style message } End; NewMessage(Owner, evBroadcast, cmScrollBarChanged, Id, Value, @Self); { Old TV style message } END; {--TScrollBar---------------------------------------------------------------} { SetValue -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TScrollBar.SetValue (AValue: Sw_Integer); BEGIN SetParams(AValue, Min, Max, PgStep, ArStep); { Set value } END; {--TScrollBar---------------------------------------------------------------} { SetRange -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TScrollBar.SetRange (AMin, AMax: Sw_Integer); BEGIN SetParams(Value, AMin, AMax, PgStep, ArStep); { Set range } END; {--TScrollBar---------------------------------------------------------------} { SetStep -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TScrollBar.SetStep (APgStep, AArStep: Sw_Integer); BEGIN SetParams(Value, Min, Max, APgStep, AArStep); { Set step sizes } END; {--TScrollBar---------------------------------------------------------------} { SetParams -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 21Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TScrollBar.SetParams (AValue, AMin, AMax, APgStep, AArStep: Sw_Integer); var OldValue : Sw_Integer; BEGIN If (AMax < AMin) Then AMax := AMin; { Max below min fix up } If (AValue < AMin) Then AValue := AMin; { Value below min fix } If (AValue > AMax) Then AValue := AMax; { Value above max fix } OldValue:=Value; If (Value <> AValue) OR (Min <> AMin) OR (Max <> AMax) Then Begin { Something changed } Min := AMin; { Set new minimum } Max := AMax; { Set new maximum } Value := AValue; { Set new value } DrawView; if OldValue <> AValue then ScrollDraw; End; PgStep := APgStep; { Hold page step } ArStep := AArStep; { Hold arrow step } END; {--TScrollBar---------------------------------------------------------------} { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB } {---------------------------------------------------------------------------} { You can save data to the stream compatable with the old original TV by } { temporarily turning off the ofGrafVersion making the call to this store } { routine and resetting the ofGrafVersion flag after the call. } {---------------------------------------------------------------------------} PROCEDURE TScrollBar.Store (Var S: TStream); VAR i: Integer; BEGIN TView.Store(S); { TView.Store called } i:=Value;S.Write(i, SizeOf(i)); { Write current value } i:=Min;S.Write(i, SizeOf(i)); { Write min value } i:=Max;S.Write(i, SizeOf(i)); { Write max value } i:=PgStep;S.Write(i, SizeOf(i)); { Write page step size } i:=ArStep;S.Write(i, SizeOf(i)); { Write arrow step size } S.Write(Chars, SizeOf(Chars)); { Write scroll chars } END; {--TScrollBar---------------------------------------------------------------} { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TScrollBar.HandleEvent (Var Event: TEvent); VAR Tracking: Boolean; I, P, S, ClickPart, Iv: Sw_Integer; Mouse: TPoint; Extent: TRect; FUNCTION GetPartCode: Sw_Integer; VAR Mark, Part : Sw_Integer; BEGIN Part := -1; { Preset failure } If Extent.Contains(Mouse) Then Begin { Contains mouse } If (Size.X = 1) Then Begin { Vertical scrollbar } Mark := Mouse.Y - 1; { Calc position } End Else Begin { Horizontal bar } Mark := Mouse.X - 1; { Calc position } End; If (Mark >= P) AND (Mark < P+1) Then { Within thumbnail } Part := sbIndicator; { Indicator part } If (Part <> sbIndicator) Then Begin { Not indicator part } If (Mark < 1) Then Part := sbLeftArrow Else { Left arrow part } If (Mark < P) Then Part := sbPageLeft Else { Page left part } If (Mark < S) Then Part := sbPageRight Else { Page right part } Part := sbRightArrow; { Right arrow part } If (Size.X = 1) Then Inc(Part, 4); { Correct for vertical } End; End; GetPartCode := Part; { Return part code } END; PROCEDURE Clicked; BEGIN NewMessage(Owner, evBroadcast, cmScrollBarClicked, Id, Value, @Self); { Old TV style message } END; BEGIN Inherited HandleEvent(Event); { Call ancestor } Case Event.What Of evNothing: Exit; { Speed up exit } evCommand: Begin { Command event } If (Event.Command = cmIdCommunicate) AND { Id communication } (Event.Id = Id) AND (Event.InfoPtr <> @Self) { Targeted to us } Then Begin SetValue(Round(Event.Data)); { Set scrollbar value } ClearEvent(Event); { Event was handled } End; End; evKeyDown: If (State AND sfVisible <> 0) Then Begin { Scrollbar visible } ClickPart := sbIndicator; { Preset result } If (Size.Y = 1) Then { Horizontal bar } Case CtrlToArrow(Event.KeyCode) Of kbLeft: ClickPart := sbLeftArrow; { Left one item } kbRight: ClickPart := sbRightArrow; { Right one item } kbCtrlLeft: ClickPart := sbPageLeft; { One page left } kbCtrlRight: ClickPart := sbPageRight; { One page right } kbHome: I := Min; { Move to start } kbEnd: I := Max; { Move to end } Else Exit; { Not a valid key } End Else { Vertical bar } Case CtrlToArrow(Event.KeyCode) Of kbUp: ClickPart := sbUpArrow; { One item up } kbDown: ClickPart := sbDownArrow; { On item down } kbPgUp: ClickPart := sbPageUp; { One page up } kbPgDn: ClickPart := sbPageDown; { One page down } kbCtrlPgUp: I := Min; { Move to top } kbCtrlPgDn: I := Max; { Move to bottom } Else Exit; { Not a valid key } End; Clicked; { Send out message } If (ClickPart <> sbIndicator) Then I := Value + ScrollStep(ClickPart); { Calculate position } SetValue(I); { Set new item } ClearEvent(Event); { Event now handled } End; evMouseDown: Begin { Mouse press event } Clicked; { Scrollbar clicked } Mouse.X := Event.Where.X - Origin.X; { Localize x value } Mouse.Y := Event.Where.Y - Origin.Y; { Localize y value } Extent.A.X := 0; { Zero x extent value } Extent.A.Y := 0; { Zero y extent value } Extent.B.X := Size.X; { Set extent x value } Extent.B.Y := Size.Y; { set extent y value } P := GetPos; { Current position } S := GetSize; { Initial size } ClickPart := GetPartCode; { Get part code } If (ClickPart <> sbIndicator) Then Begin { Not thumb nail } Repeat Mouse.X := Event.Where.X-Origin.X; { Localize x value } Mouse.Y := Event.Where.Y-Origin.Y; { Localize y value } If GetPartCode = ClickPart Then SetValue(Value+ScrollStep(ClickPart)); { Same part repeat } Until NOT MouseEvent(Event, evMouseAuto); { Until auto done } Clicked; { Scrollbar clicked } End Else Begin { Thumb nail move } Iv := Value; { Initial value } Repeat Mouse.X := Event.Where.X - Origin.X; { Localize x value } Mouse.Y := Event.Where.Y - Origin.Y; { Localize y value } Tracking := Extent.Contains(Mouse); { Check contains } If Tracking Then Begin { Tracking mouse } If (Size.X=1) Then I := Mouse.Y-1 Else { Calc vert position } I := Mouse.X-1; { Calc horz position } If (I < 0) Then I := 0; { Check underflow } If (I > S) Then I := S; { Check overflow } End Else I := GetPos; { Get position } If (I <> P) Then Begin SetValue(LongInt((LongInt(I)*(Max-Min)) +(S SHR 1)) DIV S + Min); { Set new value } P := I; { Hold new position } End; Until NOT MouseEvent(Event, evMouseMove); { Until not moving } If Tracking AND (S > 0) Then { Tracking mouse } SetValue(LongInt((LongInt(P)*(Max-Min))+ (S SHR 1)) DIV S + Min); { Set new value } If (Iv <> Value) Then Clicked; { Scroll has moved } End; ClearEvent(Event); { Clear the event } End; End; END; {***************************************************************************} { TScrollBar OBJECT PRIVATE METHODS } {***************************************************************************} {--TScrollBar---------------------------------------------------------------} { GetPos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23May98 LdB } {---------------------------------------------------------------------------} FUNCTION TScrollBar.GetPos: Sw_Integer; VAR R: Sw_Integer; BEGIN R := Max - Min; { Get full range } If (R = 0) Then GetPos := 1 Else { Return zero } GetPos := LongInt((LongInt(Value-Min) * (GetSize -3)) + (R SHR 1)) DIV R + 1; { Calc position } END; {--TScrollBar---------------------------------------------------------------} { GetSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23May98 LdB } {---------------------------------------------------------------------------} FUNCTION TScrollBar.GetSize: Sw_Integer; VAR S: Sw_Integer; BEGIN If Size.X = 1 Then S:= Size.Y else S:= Size.X; If (S < 3) Then S := 3; { Fix minimum size } GetSize := S; { Return size } END; {--TScrollBar---------------------------------------------------------------} { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB } {---------------------------------------------------------------------------} PROCEDURE TScrollBar.Draw; BEGIN DrawPos(GetPos); { Draw position } END; procedure TScrollBar.DrawPos(Pos: Sw_Integer); var S: Sw_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; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { TScroller OBJECT METHODS } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {--TScroller----------------------------------------------------------------} { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB } {---------------------------------------------------------------------------} CONSTRUCTOR TScroller.Init (Var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar); BEGIN Inherited Init(Bounds); { Call ancestor } Options := Options OR ofSelectable; { View is selectable } EventMask := EventMask OR evBroadcast; { See broadcasts } HScrollBar := AHScrollBar; { Hold horz scrollbar } VScrollBar := AVScrollBar; { Hold vert scrollbar } END; {--TScroller----------------------------------------------------------------} { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB } {---------------------------------------------------------------------------} { This load method will read old original TV data from a stream as well } { as the new graphical scroller views. } {---------------------------------------------------------------------------} CONSTRUCTOR TScroller.Load (Var S: TStream); VAR i: Integer; BEGIN Inherited Load(S); { Call ancestor } GetPeerViewPtr(S, HScrollBar); { Load horz scrollbar } GetPeerViewPtr(S, VScrollBar); { Load vert scrollbar } S.Read(i, SizeOf(i)); Delta.X:=i; { Read delta x value } S.Read(i, SizeOf(i)); Delta.Y:=i; { Read delta y value } S.Read(i, SizeOf(i)); Limit.X:=i; { Read limit x value } S.Read(i, SizeOf(i)); Limit.Y:=i; { Read limit y value } END; {--TScroller----------------------------------------------------------------} { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB } {---------------------------------------------------------------------------} FUNCTION TScroller.GetPalette: PPalette; CONST P: String[Length(CScroller)] = CScroller; { Always normal string } BEGIN GetPalette := @P; { Scroller palette } END; {--TScroller----------------------------------------------------------------} { ScrollTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TScroller.ScrollTo (X, Y: Sw_Integer); BEGIN Inc(DrawLock); { Set draw lock } If (HScrollBar<>Nil) Then HScrollBar^.SetValue(X); { Set horz scrollbar } If (VScrollBar<>Nil) Then VScrollBar^.SetValue(Y); { Set vert scrollbar } Dec(DrawLock); { Release draw lock } CheckDraw; { Check need to draw } END; {--TScroller----------------------------------------------------------------} { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TScroller.SetState (AState: Word; Enable: Boolean); PROCEDURE ShowSBar (SBar: PScrollBar); BEGIN If (SBar <> Nil) Then { Scroll bar valid } If GetState(sfActive + sfSelected) Then { Check state masks } SBar^.Show Else SBar^.Hide; { Draw appropriately } END; BEGIN Inherited SetState(AState, Enable); { Call ancestor } If (AState AND (sfActive + sfSelected) <> 0) { Active/select change } Then Begin ShowSBar(HScrollBar); { Redraw horz scrollbar } ShowSBar(VScrollBar); { Redraw vert scrollbar } End; END; {--TScroller----------------------------------------------------------------} { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB } {---------------------------------------------------------------------------} { The scroller is saved to the stream compatable with the old TV object. } {---------------------------------------------------------------------------} PROCEDURE TScroller.Store (Var S: TStream); VAR i: Integer; BEGIN TView.Store(S); { Call TView explicitly } PutPeerViewPtr(S, HScrollBar); { Store horz bar } PutPeerViewPtr(S, VScrollBar); { Store vert bar } i:=Delta.X;S.Write(i, SizeOf(i)); { Write delta x value } i:=Delta.Y;S.Write(i, SizeOf(i)); { Write delta y value } i:=Limit.X;S.Write(i, SizeOf(i)); { Write limit x value } i:=Limit.Y;S.Write(i, SizeOf(i)); { Write limit y value } END; {--TScroller----------------------------------------------------------------} { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TScroller.HandleEvent (Var Event: TEvent); BEGIN Inherited HandleEvent(Event); { Call ancestor } If (Event.What = evBroadcast) AND (Event.Command = cmScrollBarChanged) AND { Scroll bar change } ((Event.InfoPtr = HScrollBar) OR { Our scrollbar? } (Event.InfoPtr = VScrollBar)) Then ScrollDraw; { Redraw scroller } END; {--TScroller----------------------------------------------------------------} { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TScroller.ChangeBounds (Var Bounds: TRect); BEGIN SetBounds(Bounds); { Set new bounds } Inc(DrawLock); { Set draw lock } SetLimit(Limit.X, Limit.Y); { Adjust limits } Dec(DrawLock); { Release draw lock } DrawFlag := False; { Clear draw flag } DrawView; { Redraw now } END; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { TListViewer OBJECT METHODS } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} CONST TvListViewerName = 'LISTBOX'; { Native name } {--TListViewer--------------------------------------------------------------} { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB } {---------------------------------------------------------------------------} CONSTRUCTOR TListViewer.Init (Var Bounds: TRect; ANumCols: Sw_Word; AHScrollBar, AVScrollBar: PScrollBar); VAR ArStep, PgStep: Sw_Integer; BEGIN Inherited Init(Bounds); { Call ancestor } Options := Options OR (ofFirstClick+ofSelectable); { Set options } EventMask := EventMask OR evBroadcast; { Set event mask } NumCols := ANumCols; { Hold column number } If (AVScrollBar <> Nil) Then Begin { Chk vert scrollbar } If (NumCols = 1) Then Begin { Only one column } PgStep := Size.Y -1; { Set page size } ArStep := 1; { Set step size } End Else Begin { Multiple columns } PgStep := Size.Y * NumCols; { Set page size } ArStep := Size.Y; { Set step size } End; AVScrollBar^.SetStep(PgStep, ArStep); { Set scroll values } End; If (AHScrollBar <> Nil) Then AHScrollBar^.SetStep(Size.X DIV NumCols, 1); { Set step size } HScrollBar := AHScrollBar; { Horz scrollbar held } VScrollBar := AVScrollBar; { Vert scrollbar held } END; {--TListViewer--------------------------------------------------------------} { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB } {---------------------------------------------------------------------------} CONSTRUCTOR TListViewer.Load (Var S: TStream); VAR w: Word; BEGIN Inherited Load(S); { Call ancestor } GetPeerViewPtr(S, HScrollBar); { Get horz scrollbar } GetPeerViewPtr(S, VScrollBar); { Get vert scrollbar } S.Read(w, SizeOf(w)); NumCols:=w; { Read column number } S.Read(w, SizeOf(w)); TopItem:=w; { Read top most item } S.Read(w, SizeOf(w)); Focused:=w; { Read focused item } S.Read(w, SizeOf(w)); Range:=w; { Read listview range } END; {--TListViewer--------------------------------------------------------------} { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB } {---------------------------------------------------------------------------} FUNCTION TListViewer.GetPalette: PPalette; CONST P: String[Length(CListViewer)] = CListViewer; { Always normal string } BEGIN GetPalette := @P; { Return palette } END; {--TListViewer--------------------------------------------------------------} { IsSelected -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB } {---------------------------------------------------------------------------} FUNCTION TListViewer.IsSelected (Item: Sw_Integer): Boolean; BEGIN If (Item = Focused) Then IsSelected := True Else IsSelected := False; { Selected item } END; {--TListViewer--------------------------------------------------------------} { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB } {---------------------------------------------------------------------------} FUNCTION TListViewer.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; BEGIN { Abstract method } GetText := ''; { Return empty } END; {--TListViewer--------------------------------------------------------------} { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB } {---------------------------------------------------------------------------} PROCEDURE TListViewer.Draw; VAR I, J, ColWidth, Item, Indent, CurCol: Sw_Integer; Color: Word; SCOff: Byte; Text: String; B: TDrawBuffer; BEGIN ColWidth := Size.X DIV NumCols + 1; { Calc column width } If (HScrollBar = Nil) Then Indent := 0 Else { Set indent to zero } Indent := HScrollBar^.Value; { Fetch any indent } For I := 0 To Size.Y - 1 Do Begin { For each line } For J := 0 To NumCols-1 Do Begin { For each column } Item := J*Size.Y + I + TopItem; { Process this item } CurCol := J*ColWidth; { Current column } If (State AND (sfSelected + sfActive) = (sfSelected + sfActive)) AND (Focused = Item) { Focused item } AND (Range > 0) Then Begin Color := GetColor(3); { Focused colour } SetCursor(CurCol+1,I); { Set the cursor } SCOff := 0; { Zero colour offset } End Else If (Item < Range) AND IsSelected(Item){ Selected item } Then Begin Color := GetColor(4); { Selected color } SCOff := 2; { Colour offset=2 } End Else Begin Color := GetColor(2); { Normal Color } SCOff := 4; { Colour offset=4 } End; MoveChar(B[CurCol], ' ', Color, ColWidth); { Clear buffer } If (Item < Range) Then Begin { Within text range } Text := GetText(Item, ColWidth + Indent); { Fetch text } Text := Copy(Text, Indent, ColWidth); { Select right bit } MoveStr(B[CurCol+1], Text, Color); { Transfer to buffer } If ShowMarkers Then Begin WordRec(B[CurCol]).Lo := Byte( SpecialChars[SCOff]); { Set marker character } WordRec(B[CurCol+ColWidth-2]).Lo := Byte( SpecialChars[SCOff+1]); { Set marker character } End; End; MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1); { Put centre line marker } End; WriteLine(0, I, Size.X, 1, B); { Write line to screen } End; END; {--TListViewer--------------------------------------------------------------} { FocusItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TListViewer.FocusItem (Item: Sw_Integer); BEGIN Focused := Item; { Set focus to item } If (VScrollBar <> Nil) Then VScrollBar^.SetValue(Item); { Scrollbar to value } If (Item < TopItem) Then { Item above top item } If (NumCols = 1) Then TopItem := Item { Set top item } Else TopItem := Item - Item MOD Size.Y { Set top item } Else If (Item >= TopItem + (Size.Y*NumCols)) Then { Item below bottom } If (NumCols = 1) Then TopItem := Item-Size.Y+1 { Set new top item } Else TopItem := Item - Item MOD Size.Y - (Size.Y*(NumCols-1)); { Set new top item } END; {--TListViewer--------------------------------------------------------------} { SetTopItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Aug99 LdB } {---------------------------------------------------------------------------} PROCEDURE TListViewer.SetTopItem (Item: Sw_Integer); BEGIN TopItem := Item; { Set the top item } END; {--TListViewer--------------------------------------------------------------} { SetRange -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TListViewer.SetRange (ARange: Sw_Integer); BEGIN Range := ARange; { Set new range } If (VScrollBar <> Nil) Then Begin { Vertical scrollbar } If (Focused > ARange) Then Focused := 0; { Clear focused } VScrollBar^.SetParams(Focused, 0, ARange - 1, VScrollBar^.PgStep, VScrollBar^.ArStep); { Set parameters } End; END; {--TListViewer--------------------------------------------------------------} { SelectItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TListViewer.SelectItem (Item: Sw_Integer); BEGIN Message(Owner, evBroadcast, cmListItemSelected, @Self); { Send message } END; {--TListViewer--------------------------------------------------------------} { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB } {---------------------------------------------------------------------------} PROCEDURE TListViewer.SetState (AState: Word; Enable: Boolean); PROCEDURE ShowSBar(SBar: PScrollBar); BEGIN If (SBar <> Nil) Then { Valid scrollbar } If GetState(sfActive) AND GetState(sfVisible) { Check states } Then SBar^.Show Else SBar^.Hide; { Show or hide } END; BEGIN Inherited SetState(AState, Enable); { Call ancestor } If (AState AND (sfSelected + sfActive + sfVisible) <> 0) Then Begin { Check states } DrawView; { Draw the view } ShowSBar(HScrollBar); { Show horz scrollbar } ShowSBar(VScrollBar); { Show vert scrollbar } End; END; {--TListViewer--------------------------------------------------------------} { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TListViewer.Store (Var S: TStream); VAR w: Word; BEGIN TView.Store(S); { Call TView explicitly } PutPeerViewPtr(S, HScrollBar); { Put horz scrollbar } PutPeerViewPtr(S, VScrollBar); { Put vert scrollbar } w:=NumCols;S.Write(w, SizeOf(w)); { Write column number } w:=TopItem;S.Write(w, SizeOf(w)); { Write top most item } w:=Focused;S.Write(w, SizeOf(w)); { Write focused item } w:=Range;S.Write(w, SizeOf(w)); { Write listview range } END; {--TListViewer--------------------------------------------------------------} { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB } {---------------------------------------------------------------------------} PROCEDURE TListViewer.HandleEvent (Var Event: TEvent); CONST MouseAutosToSkip = 4; VAR Oi, Ni: Sw_Integer; Ct, Cw: Word; Mouse: TPoint; PROCEDURE MoveFocus (Req: Sw_Integer); BEGIN FocusItemNum(Req); { Focus req item } DrawView; { Redraw focus box } END; BEGIN Inherited HandleEvent(Event); { Call ancestor } Case Event.What Of evNothing: Exit; { Speed up exit } evKeyDown: Begin { Key down event } If (Event.CharCode = ' ') AND (Focused < Range){ Spacebar select } Then Begin SelectItem(Focused); { Select focused item } Ni := Focused; { Hold new item } End Else Case CtrlToArrow(Event.KeyCode) Of kbUp: Ni := Focused - 1; { One item up } kbDown: Ni := Focused + 1; { One item down } kbRight: If (NumCols > 1) Then Ni := Focused + Size.Y Else Exit; { One column right } kbLeft: If (NumCols > 1) Then Ni := Focused - Size.Y Else Exit; { One column left } kbPgDn: Ni := Focused + Size.Y * NumCols; { One page down } kbPgUp: Ni := Focused - Size.Y * NumCols; { One page up } kbHome: Ni := TopItem; { Move to top } kbEnd: Ni := TopItem + (Size.Y*NumCols)-1; { Move to bottom } kbCtrlPgDn: Ni := Range - 1; { Move to last item } kbCtrlPgUp: Ni := 0; { Move to first item } Else Exit; End; MoveFocus(Ni); { Move the focus } ClearEvent(Event); { Event was handled } End; evBroadcast: Begin { Broadcast event } If (Options AND ofSelectable <> 0) Then { View is selectable } If (Event.Command = cmScrollBarClicked) AND { Scrollbar click } ((Event.InfoPtr = HScrollBar) OR (Event.InfoPtr = VScrollBar)) Then Select { Scrollbar selects us } Else If (Event.Command = cmScrollBarChanged) { Scrollbar changed } Then Begin If (VScrollBar = Event.InfoPtr) Then Begin MoveFocus(VScrollBar^.Value); { Focus us to item } End Else If (HScrollBar = Event.InfoPtr) Then DrawView; { Redraw the view } End; End; evMouseDown: Begin { Mouse down event } Cw := Size.X DIV NumCols + 1; { Column width } Oi := Focused; { Hold focused item } MakeLocal(Event.Where, Mouse); { Localize mouse } If MouseInView(Event.Where) Then Ni := Mouse.Y + (Size.Y*(Mouse.X DIV Cw))+TopItem { Calc item to focus } Else Ni := Oi; { Focus old item } Ct := 0; { Clear count value } Repeat If (Ni <> Oi) Then Begin { Item is different } MoveFocus(Ni); { Move the focus } Oi := Focused; { Hold as focused item } End; MakeLocal(Event.Where, Mouse); { Localize mouse } If NOT MouseInView(Event.Where) Then Begin If (Event.What = evMouseAuto) Then Inc(Ct);{ Inc auto count } If (Ct = MouseAutosToSkip) Then Begin Ct := 0; { Reset count } If (NumCols = 1) Then Begin { Only one column } If (Mouse.Y < 0) Then Ni := Focused-1; { Move up one item } If (Mouse.Y >= Size.Y) Then Ni := Focused+1; { Move down one item } End Else Begin { Multiple columns } If (Mouse.X < 0) Then { Mouse x below zero } Ni := Focused-Size.Y; { Move down 1 column } If (Mouse.X >= Size.X) Then { Mouse x above width } Ni := Focused+Size.Y; { Move up 1 column } If (Mouse.Y < 0) Then { Mouse y below zero } Ni := Focused-Focused MOD Size.Y; { Move up one item } If (Mouse.Y > Size.Y) Then { Mouse y above height } Ni := Focused-Focused MOD Size.Y+Size.Y-1; { Move down one item } End; End; End Else Ni := Mouse.Y + (Size.Y*(Mouse.X DIV Cw))+TopItem; { New item to focus } Until NOT MouseEvent(Event, evMouseMove + evMouseAuto); { Mouse stopped } If (Oi <> Ni) Then MoveFocus(Ni); { Focus moved again } If (Event.Double AND (Range > Focused)) Then SelectItem(Focused); { Select the item } ClearEvent(Event); { Event was handled } End; End; END; {--TListViewer--------------------------------------------------------------} { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TListViewer.ChangeBounds (Var Bounds: TRect); BEGIN Inherited ChangeBounds(Bounds); { Call ancestor } If (HScrollBar <> Nil) Then { Valid horz scrollbar } HScrollBar^.SetStep(Size.X DIV NumCols, HScrollBar^.ArStep); { Update horz bar } If (VScrollBar <> Nil) Then { Valid vert scrollbar } VScrollBar^.SetStep(Size.Y * NumCols, VScrollBar^.ArStep); { Update vert bar } END; {***************************************************************************} { TListViewer OBJECT PRIVATE METHODS } {***************************************************************************} {--TListViewer--------------------------------------------------------------} { FocusItemNum -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TListViewer.FocusItemNum (Item: Sw_Integer); BEGIN If (Item < 0) Then Item := 0 Else { Restrain underflow } If (Item >= Range) AND (Range > 0) Then Item := Range-1; { Restrain overflow } If (Range <> 0) Then FocusItem(Item); { Set focus value } END; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { TWindow OBJECT METHODS } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {--TWindow------------------------------------------------------------------} { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB } {---------------------------------------------------------------------------} CONSTRUCTOR TWindow.Init (Var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer); BEGIN Inherited Init(Bounds); { Call ancestor } State := State OR sfShadow; { View is shadowed } Options := Options OR (ofSelectable+ofTopSelect); { Select options set } GrowMode := gfGrowAll + gfGrowRel; { Set growmodes } Flags := wfMove + wfGrow + wfClose + wfZoom; { Set flags } Title := NewStr(ATitle); { Hold title } Number := ANumber; { Hold number } Palette := wpBlueWindow; { Default palette } InitFrame; { Initialize frame } If (Frame <> Nil) Then Insert(Frame); { Insert any frame } GetBounds(ZoomRect); { Default zoom rect } END; {--TWindow------------------------------------------------------------------} { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} { This load method will read old original TV data from a stream however } { although a frame view is read for compatability it is disposed of. } {---------------------------------------------------------------------------} CONSTRUCTOR TWindow.Load (Var S: TStream); VAR I: Integer; BEGIN Inherited Load(S); { Call ancestor } S.Read(Flags, SizeOf(Flags)); { Read window flags } S.Read(i, SizeOf(i)); Number:=i; { Read window number } S.Read(i, SizeOf(i)); Palette:=i; { Read window palette } S.Read(i, SizeOf(i)); ZoomRect.A.X:=i; { Read zoom area x1 } S.Read(i, SizeOf(i)); ZoomRect.A.Y:=i; { Read zoom area y1 } S.Read(i, SizeOf(i)); ZoomRect.B.X:=i; { Read zoom area x2 } S.Read(i, SizeOf(i)); ZoomRect.B.Y:=i; { Read zoom area y2 } GetSubViewPtr(S, Frame); { Now read frame object } Title := S.ReadStr; { Read title } END; {--TWindow------------------------------------------------------------------} { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} DESTRUCTOR TWindow.Done; BEGIN Inherited Done; { Call ancestor } If (Title <> Nil) Then DisposeStr(Title); { Dispose title } END; {--TWindow------------------------------------------------------------------} { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TWindow.GetPalette: PPalette; CONST P: ARRAY [wpBlueWindow..wpGrayWindow] Of String[Length(CBlueWindow)] = (CBlueWindow, CCyanWindow, CGrayWindow); { Always normal string } BEGIN GetPalette := @P[Palette]; { Return palette } END; {--TWindow------------------------------------------------------------------} { GetTitle -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } { Modified 31may2002 PM (No number included anymore) } {---------------------------------------------------------------------------} FUNCTION TWindow.GetTitle (MaxSize: Sw_Integer): TTitleStr; VAR S: String; BEGIN If (Title <> Nil) Then S:=Title^ Else S := ''; if Length(S)>MaxSize then GetTitle:=Copy(S,1,MaxSize) else GetTitle:=S; END; {--TWindow------------------------------------------------------------------} { StandardScrollBar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION TWindow.StandardScrollBar (AOptions: Word): PScrollBar; VAR R: TRect; S: PScrollBar; BEGIN GetExtent(R); { View extents } If (AOptions AND sbVertical = 0) Then R.Assign(R.A.X+2, R.B.Y-1, R.B.X-2, R.B.Y) { Horizontal scrollbar } Else R.Assign(R.B.X-1, R.A.Y+1, R.B.X, R.B.Y-1); { Vertical scrollbar } S := New(PScrollBar, Init(R)); { Create scrollbar } Insert(S); { Insert scrollbar } If (AOptions AND sbHandleKeyboard <> 0) Then S^.Options := S^.Options or ofPostProcess; { Post process } StandardScrollBar := S; { Return scrollbar } END; {--TWindow------------------------------------------------------------------} { Zoom -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TWindow.Zoom; VAR R: TRect; Max, Min: TPoint; BEGIN SizeLimits(Min, Max); { Return size limits } If ((Size.X <> Max.X) OR (Size.Y <> Max.Y)) { Larger size possible } Then Begin GetBounds(ZoomRect); { Get zoom bounds } R.A.X := 0; { Zero x origin } R.A.Y := 0; { Zero y origin } R.B := Max; { Bounds to max size } Locate(R); { Locate the view } End Else Locate(ZoomRect); { Move to zoom rect } END; {--TWindow------------------------------------------------------------------} { Close -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TWindow.Close; BEGIN If Valid(cmClose) Then Free; { Dispose of self } END; {--TWindow------------------------------------------------------------------} { InitFrame -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB } {---------------------------------------------------------------------------} PROCEDURE TWindow.InitFrame; VAR R: TRect; BEGIN GetExtent(R); Frame := New(PFrame, Init(R)); END; {--TWindow------------------------------------------------------------------} { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Mar98 LdB } {---------------------------------------------------------------------------} PROCEDURE TWindow.SetState (AState: Word; Enable: Boolean); VAR WindowCommands: TCommandSet; BEGIN Inherited SetState(AState, Enable); { Call ancestor } If (AState = sfSelected) Then SetState(sfActive, Enable); { Set active state } If (AState = sfSelected) OR ((AState = sfExposed) AND (State AND sfSelected <> 0)) Then Begin { View is selected } WindowCommands := [cmNext, cmPrev]; { Set window commands } If (Flags AND (wfGrow + wfMove) <> 0) Then WindowCommands := WindowCommands + [cmResize]; { Add resize command } If (Flags AND wfClose <> 0) Then WindowCommands := WindowCommands + [cmClose]; { Add close command } If (Flags AND wfZoom <> 0) Then WindowCommands := WindowCommands + [cmZoom]; { Add zoom command } If Enable Then EnableCommands(WindowCommands) { Enable commands } Else DisableCommands(WindowCommands); { Disable commands } End; END; {--TWindow------------------------------------------------------------------} { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Mar98 LdB } {---------------------------------------------------------------------------} { You can save data to the stream compatable with the old original TV by } { temporarily turning off the ofGrafVersion making the call to this store } { routine and resetting the ofGrafVersion flag after the call. } {---------------------------------------------------------------------------} PROCEDURE TWindow.Store (Var S: TStream); VAR i: Integer; BEGIN TGroup.Store(S); { Call group store } S.Write(Flags, SizeOf(Flags)); { Write window flags } i:=Number;S.Write(i, SizeOf(i)); { Write window number } i:=Palette;S.Write(i, SizeOf(i)); { Write window palette } i:=ZoomRect.A.X;S.Write(i, SizeOf(i)); { Write zoom area x1 } i:=ZoomRect.A.Y;S.Write(i, SizeOf(i)); { Write zoom area y1 } i:=ZoomRect.B.X;S.Write(i, SizeOf(i)); { Write zoom area x2 } i:=ZoomRect.B.Y;S.Write(i, SizeOf(i)); { Write zoom area y2 } PutSubViewPtr(S, Frame); { Write any frame } S.WriteStr(Title); { Write title string } END; {--TWindow------------------------------------------------------------------} { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11Aug99 LdB } {---------------------------------------------------------------------------} PROCEDURE TWindow.HandleEvent (Var Event: TEvent); VAR Min, Max: TPoint; Limits: TRect; PROCEDURE DragWindow (Mode: Byte); VAR Limits: TRect; Min, Max: TPoint; BEGIN Owner^.GetExtent(Limits); { Get owner extents } SizeLimits(Min, Max); { Restrict size } DragView(Event, DragMode OR Mode, Limits, Min, Max); { Drag the view } ClearEvent(Event); { Clear the event } END; BEGIN Inherited HandleEvent(Event); { Call ancestor } Case Event.What Of evNothing: Exit; { Speeds up exit } evCommand: { COMMAND EVENT } Case Event.Command Of { Command type case } cmResize: { RESIZE COMMAND } If (Flags AND (wfMove + wfGrow) <> 0) { Window can resize } AND (Owner <> Nil) Then Begin { Valid owner } Owner^.GetExtent(Limits); { Owners extents } SizeLimits(Min, Max); { Check size limits } DragView(Event, DragMode OR (Flags AND (wfMove + wfGrow)), Limits, Min, Max); { Drag the view } ClearEvent(Event); { Clear the event } End; cmClose: { CLOSE COMMAND } If (Flags AND wfClose <> 0) AND { Close flag set } ((Event.InfoPtr = Nil) OR { None specific close } (Event.InfoPtr = @Self)) Then Begin { Close to us } ClearEvent(Event); { Clear the event } If (State AND sfModal = 0) Then Close { Non modal so close } Else Begin { Modal window } Event.What := evCommand; { Command event } Event.Command := cmCancel; { Cancel command } PutEvent(Event); { Place on queue } ClearEvent(Event); { Clear the event } End; End; cmZoom: { ZOOM COMMAND } If (Flags AND wfZoom <> 0) AND { Zoom flag set } ((Event.InfoPtr = Nil) OR { No specific zoom } (Event.InfoPtr = @Self)) Then Begin Zoom; { Zoom our window } ClearEvent(Event); { Clear the event } End; End; evBroadcast: { BROADCAST EVENT } If (Event.Command = cmSelectWindowNum) AND (Event.InfoInt = Number) AND { Select our number } (Options AND ofSelectable <> 0) Then Begin { Is view selectable } Select; { Select our view } ClearEvent(Event); { Clear the event } End; evKeyDown: Begin { KEYDOWN EVENT } Case Event.KeyCode Of kbTab: Begin { TAB KEY } FocusNext(False); { Select next view } ClearEvent(Event); { Clear the event } End; kbShiftTab: Begin { SHIFT TAB KEY } FocusNext(True); { Select prior view } ClearEvent(Event); { Clear the event } End; End; End; End; { Event.What case end } END; {--TWindow------------------------------------------------------------------} { SizeLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TWindow.SizeLimits (Var Min, Max: TPoint); BEGIN Inherited SizeLimits(Min, Max); { View size limits } Min.X := MinWinSize.X; { Set min x size } Min.Y := MinWinSize.Y; { Set min y size } END; {--TView--------------------------------------------------------------------} { Exposed -> Platforms DOS/DPMI/WIN/OS2 - Checked 17Sep97 LdB } {---------------------------------------------------------------------------} function TView.do_ExposedRec1(x1,x2:sw_integer; p:PView):boolean; var G : PGroup; dy,dx : sw_integer; begin while true do begin p:=p^.Next; G:=p^.Owner; if p=staticVar2.target then begin do_exposedRec1:=do_exposedRec2(x1,x2,G); Exit; end; dy:=p^.origin.y; dx:=p^.origin.x; if ((p^.state and sfVisible)<>0) and (staticVar2.y>=dy) then begin if staticVar2.ydx+p^.size.x then begin if do_exposedRec1(x1,dx,p) then begin do_exposedRec1:=True; Exit; end; x1:=dx+p^.size.x; end else x2:=dx; end else begin if x1=x2 then begin do_exposedRec1:=False; Exit; end; end; end; end; end; end; function TView.do_ExposedRec2(x1,x2:Sw_integer; p:PView):boolean; var G : PGroup; savedStat : TStatVar2; begin if (p^.state and sfVisible)=0 then do_ExposedRec2:=false else begin G:=p^.Owner; if (G=Nil) or (G^.Buffer<>Nil) then do_ExposedRec2:=true else begin savedStat:=staticVar2; inc(staticVar2.y,p^.origin.y); inc(x1,p^.origin.x); inc(x2,p^.origin.x); staticVar2.target:=p; if (staticVar2.y=G^.clip.b.y) then do_ExposedRec2:=false else begin if (x1G^.clip.b.x) then x2:=G^.clip.b.x; if (x1>=x2) then do_ExposedRec2:=false else do_ExposedRec2:=do_exposedRec1(x1,x2,G^.Last); end; staticVar2 := savedStat; end; end; end; function TView.Exposed: Boolean; var OK : boolean; y : sw_integer; begin if ((State and sfExposed)<>0) and (Size.X>0) and (Size.Y>0) then begin OK:=false; y:=0; while (y Platforms DOS/DPMI/WIN/OS2 - Checked 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.MakeLocal (Source: TPoint; Var Dest: TPoint); var cur : PView; begin cur:=@Self; Dest:=Source; repeat dec(Dest.X,cur^.Origin.X); if dest.x<0 then break; dec(Dest.Y,cur^.Origin.Y); if dest.y<0 then break; cur:=cur^.Owner; until cur=nil; end; {--TView--------------------------------------------------------------------} { MakeGlobal -> Platforms DOS/DPMI/WIN/OS2 - Checked 12Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.MakeGlobal (Source: TPoint; Var Dest: TPoint); var cur : PView; begin cur:=@Self; Dest:=Source; repeat inc(Dest.X,cur^.Origin.X); inc(Dest.Y,cur^.Origin.Y); cur:=cur^.Owner; until cur=nil; end; procedure TView.do_writeViewRec1(x1,x2:Sw_integer; p:PView; shadowCounter:Sw_integer); var G : PGroup; c : Word; BufPos, SrcPos, l,dx : Sw_integer; begin repeat p:=p^.Next; if (p=staticVar2.target) then begin G:=p^.Owner; if (G^.buffer<>Nil) then begin BufPos:=G^.size.x * staticVar2.y + x1; SrcPos:=x1 - staticVar2.offset; l:=x2-x1; if (shadowCounter=0) then move(staticVar1^[SrcPos],PVideoBuf(G^.buffer)^[BufPos],l shl 1) else begin { paint with shadowAttr } while (l>0) do begin c:=staticVar1^[SrcPos]; WordRec(c).hi:=shadowAttr; PVideoBuf(G^.buffer)^[BufPos]:=c; inc(BufPos); inc(SrcPos); dec(l); end; end; end; if G^.lockFlag=0 then do_writeViewRec2(x1,x2,G,shadowCounter); exit; end; { p=staticVar2.target } if ((p^.state and sfVisible)<>0) and (staticVar2.y>=p^.Origin.Y) then begin if staticVar2.y0) and (staticVar2.y>=p^.origin.y+shadowSize.y) then if (x1>dx) then continue else begin inc(shadowCounter); if (x2<=dx) then continue else begin do_writeViewRec1(x1,dx,p,shadowCounter); x1:=dx; dec(shadowCounter); continue; end; end else continue; end; if ((p^.state and sfShadow)<>0) and (staticVar2.y=dx then continue; inc(shadowCounter); if x2<=dx then continue else begin do_writeViewRec1(x1,dx,p,shadowCounter); x1:=dx; dec(shadowCounter); end; end; end; until false; end; procedure TView.do_writeViewRec2(x1,x2:Sw_integer; p:PView; shadowCounter:Sw_integer); var savedStatics : TstatVar2; dx : Sw_integer; G : PGroup; begin G:=P^.Owner; if ((p^.State and sfVisible) <> 0) and (G<>Nil) then begin savedStatics:=staticVar2; inc(staticVar2.y,p^.Origin.Y); dx:=p^.Origin.X; inc(x1,dx); inc(x2,dx); inc(staticVar2.offset,dx); staticVar2.target:=p; if (staticVar2.y >= G^.clip.a.y) and (staticVar2.y < G^.clip.b.y) then begin if (x1g^.clip.b.x) then x2 := g^.clip.b.x; if x1=0) and (ySize.X then x2:=Size.X; if x10 then for i:= 0 to h-1 do do_writeView(X,X+W,Y+i,TVideoBuf(Buf)[W*i]); end; procedure TView.WriteChar(X,Y:Sw_Integer; C:Char; Color:Byte; Count:Sw_Integer); var B : TDrawBuffer; myChar : word; i : Sw_integer; begin myChar:=MapColor(Color); myChar:=(myChar shl 8) + ord(C); if Count>0 then begin if Count>maxViewWidth then Count:=maxViewWidth; for i:=0 to Count-1 do B[i]:=myChar; do_writeView(X,X+Count,Y,B); end; DrawScreenBuf; end; procedure TView.WriteLine(X, Y, W, H: Sw_Integer; var Buf); var i:Sw_integer; begin if h>0 then for i:=0 to h-1 do do_writeView(x,x+w,y+i,buf); DrawScreenBuf; end; procedure TView.WriteStr(X, Y: Sw_Integer; Str: String; Color: Byte); var l,i : Sw_word; B : TDrawBuffer; myColor : word; begin l:=length(Str); if l>0 then begin if l>maxViewWidth then l:=maxViewWidth; MyColor:=MapColor(Color); MyColor:=MyColor shl 8; for i:=0 to l-1 do B[i]:=MyColor+ord(Str[i+1]); do_writeView(x,x+l,y,b); end; DrawScreenBuf; end; procedure TView.DragView(Event: TEvent; Mode: Byte; var Limits: TRect; MinSize, MaxSize: TPoint); var P, S: TPoint; SaveBounds: TRect; 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: Sw_Integer); begin if (Mode and dmDragMove <> 0) and (Event.KeyShift{GetShiftState} and $03 = 0) then begin Inc(P.X, DX); Inc(P.Y, DY); end else if (Mode and dmDragGrow <> 0) and (Event.KeyShift{GetShiftState} and $03 <> 0) then begin Inc(S.X, DX); Inc(S.Y, DY); end; end; procedure Update(X, Y: Sw_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; {***************************************************************************} { TScroller OBJECT METHODS } {***************************************************************************} PROCEDURE TScroller.ScrollDraw; VAR D: TPoint; BEGIN If (HScrollBar<>Nil) Then D.X := HScrollBar^.Value Else D.X := 0; { Horz scroll value } If (VScrollBar<>Nil) Then D.Y := VScrollBar^.Value Else D.Y := 0; { Vert scroll value } If (D.X<>Delta.X) OR (D.Y<>Delta.Y) Then Begin { View has moved } SetCursor(Cursor.X+Delta.X-D.X, Cursor.Y+Delta.Y-D.Y); { Move the cursor } Delta := D; { Set new delta } If (DrawLock<>0) Then DrawFlag := True { Draw will need draw } Else DrawView; { Redraw the view } End; END; PROCEDURE TScroller.SetLimit (X, Y: Sw_Integer); VAR PState: Word; BEGIN Limit.X := X; { Hold x limit } Limit.Y := Y; { Hold y limit } Inc(DrawLock); { Set draw lock } If (HScrollBar<>Nil) Then Begin PState := HScrollBar^.State; { Hold bar state } HScrollBar^.State := PState AND NOT sfVisible; { Temp not visible } HScrollBar^.SetParams(HScrollBar^.Value, 0, X-Size.X, Size.X-1, HScrollBar^.ArStep); { Set horz scrollbar } HScrollBar^.State := PState; { Restore bar state } End; If (VScrollBar<>Nil) Then Begin PState := VScrollBar^.State; { Hold bar state } VScrollBar^.State := PState AND NOT sfVisible; { Temp not visible } VScrollBar^.SetParams(VScrollBar^.Value, 0, Y-Size.Y, Size.Y-1, VScrollBar^.ArStep); { Set vert scrollbar } VScrollBar^.State := PState; { Restore bar state } End; Dec(DrawLock); { Release draw lock } CheckDraw; { Check need to draw } END; {***************************************************************************} { TScroller OBJECT PRIVATE METHODS } {***************************************************************************} PROCEDURE TScroller.CheckDraw; BEGIN If (DrawLock = 0) AND DrawFlag Then Begin { Clear & draw needed } DrawFlag := False; { Clear draw flag } DrawView; { Draw now } End; END; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { TGroup OBJECT METHODS } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {--TGroup-------------------------------------------------------------------} { Lock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB } {---------------------------------------------------------------------------} {$ifndef NoLock} {$define UseLock} {$endif ndef NoLock} PROCEDURE TGroup.Lock; BEGIN {$ifdef UseLock} {If (Buffer <> Nil) OR (LockFlag <> 0) Then} Inc(LockFlag); { Increment count } {$endif UseLock} END; {--TGroup-------------------------------------------------------------------} { UnLock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB } {---------------------------------------------------------------------------} PROCEDURE TGroup.Unlock; BEGIN {$ifdef UseLock} If (LockFlag <> 0) Then Begin Dec(LockFlag); { Decrement count } If (LockFlag = 0) Then DrawView; { Lock release draw } End; {$endif UseLock} END; {***************************************************************************} { INTERFACE ROUTINES } {***************************************************************************} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { WINDOW MESSAGE ROUTINES } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {---------------------------------------------------------------------------} { Message -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION Message (Receiver: PView; What, Command: Word; InfoPtr: Pointer): Pointer; VAR Event: TEvent; BEGIN Message := Nil; { Preset nil } If (Receiver <> Nil) Then Begin { Valid receiver } Event.What := What; { Set what } Event.Command := Command; { Set command } Event.Id := 0; { Zero id field } Event.Data := 0; { Zero data field } Event.InfoPtr := InfoPtr; { Set info ptr } Receiver^.HandleEvent(Event); { Pass to handler } If (Event.What = evNothing) Then Message := Event.InfoPtr; { Return handler } End; END; {---------------------------------------------------------------------------} { NewMessage -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Sep97 LdB } {---------------------------------------------------------------------------} FUNCTION NewMessage (P: PView; What, Command: Word; Id: Sw_Integer; Data: Real; InfoPtr: Pointer): Pointer; VAR Event: TEvent; BEGIN NewMessage := Nil; { Preset failure } If (P <> Nil) Then Begin Event.What := What; { Set what } Event.Command := Command; { Set event command } Event.Id := Id; { Set up Id } Event.Data := Data; { Set up data } Event.InfoPtr := InfoPtr; { Set up event ptr } P^.HandleEvent(Event); { Send to view } If (Event.What = evNothing) Then NewMessage := Event.InfoPtr; { Return handler } End; END; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { NEW VIEW ROUTINES } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {---------------------------------------------------------------------------} { CreateIdScrollBar -> Platforms DOS/DPMI/WIN/NT/OS2 - Checked 22May97 LdB } {---------------------------------------------------------------------------} FUNCTION CreateIdScrollBar (X, Y, Size, Id: Sw_Integer; Horz: Boolean): PScrollBar; VAR R: TRect; P: PScrollBar; BEGIN If Horz Then R.Assign(X, Y, X+Size, Y+1) Else { Horizontal bar } R.Assign(X, Y, X+1, Y+Size); { Vertical bar } P := New(PScrollBar, Init(R)); { Create scrollbar } If (P <> Nil) Then Begin P^.Id := Id; { Set scrollbar id } P^.Options := P^.Options OR ofPostProcess; { Set post processing } End; CreateIdScrollBar := P; { Return scrollbar } END; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} { OBJECT REGISTRATION PROCEDURES } {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {---------------------------------------------------------------------------} { RegisterViews -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May97 LdB } {---------------------------------------------------------------------------} PROCEDURE RegisterViews; BEGIN RegisterType(RView); { Register views } RegisterType(RFrame); { Register frame } RegisterType(RScrollBar); { Register scrollbar } RegisterType(RScroller); { Register scroller } RegisterType(RListViewer); { Register listview } RegisterType(RGroup); { Register group } RegisterType(RWindow); { Register window } END; END. { $Log$ Revision 1.57 2005-02-14 17:13:18 peter * truncate log Revision 1.56 2005/01/07 22:29:48 florian + tview.draw clears the back ground }