paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-27 17:53:43 +02:00
Code Issues Packages Projects Releases Wiki Activity
3c2db9436f
fpc/fv/views.pas
marco 533d59eb3a * CVS log and ID tags
2000-08-24 12:00:20 +00:00

6635 lines
340 KiB
ObjectPascal
Raw Blame History

{ $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 ]******************}
{ 16 and 32 Bit compilers }
{ DOS - Turbo Pascal 7.0 + (16 Bit) }
{ DPMI - Turbo Pascal 7.0 + (16 Bit) }
{ - FPC 0.9912+ (GO32V2) (32 Bit) }
{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
{ - Delphi 1.0+ (16 Bit) }
{ WIN95/NT - Delphi 2.0+ (32 Bit) }
{ - Virtual Pascal 2.0+ (32 Bit) }
{ - Speedsoft Sybil 2.0+ (32 Bit) }
{ - FPC 0.9912+ (32 Bit) }
{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ }
{******************[ REVISION HISTORY ]********************}
{ Version Date Fix }
{ ------- --------- --------------------------------- }
{ 1.00 10 Nov 96 First multi platform release }
{ 1.10 29 Aug 97 Platform.inc sort added. }
{ 1.20 12 Sep 97 FPK pascal 0.92 conversion added. }
{ 1.30 10 Jun 98 Virtual pascal 2.0 code added. }
{ 1.40 10 Jul 99 Sybil 2.0 code added }
{ 1.41 03 Nov 99 FPC Windows support added. }
{ 1.50 26 Nov 99 Graphics stuff moved to GFVGraph }
{**********************************************************}
UNIT Views;
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{====Include file to sort compiler platform out =====================}
{$I Platform.inc}
{====================================================================}
{==== Compiler directives ===========================================}
{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
{$F+} { Force far calls - Used because of the FirstThat, ForNext ... }
{$A+} { Word Align Data }
{$B-} { Allow short circuit boolean evaluations }
{$O+} { This unit may be overlaid }
{$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
{$P-} { Normal string variables }
{$N-} { No 80x87 code generation }
{$E+} { Emulation is on }
{$ENDIF}
{$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 }
{$IFNDEF PPC_SPEED} { NON SPEEDSOFT SYBIL2+ }
{$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard unit }
{$ELSE} { OTHER COMPILERS }
WinTypes, WinProcs, { Stardard units }
{$ENDIF}
{$IFDEF PPC_BP} Win31, {$ENDIF} { Standard 3.1 unit }
{$IFDEF PPC_DELPHI} Messages, {$ENDIF} { Delphi3+ unit }
{$ELSE} { SPEEDSOFT SYBIL2+ }
WinBase, WinDef, WinUser, WinGDI, { Standard unit }
{$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
OS2Def, OS2Base, OS2PMAPI, { Standard units }
{$ENDIF}
Common, GFVGraph, Objects, Drivers; { 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 }
ofGFVModeView = $4000; { View is in GFV mode }
{---------------------------------------------------------------------------}
{ 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 << TView OPTION MASKS }
{---------------------------------------------------------------------------}
CONST
goThickFramed = $0001; { Thick framed mask }
goDrawFocus = $0002; { Draw focus mask }
goTitled = $0004; { Draw titled mask }
goTabSelect = $0008; { Tab selectable }
goEveryKey = $0020; { Report every key }
goEndModal = $0040; { End modal }
goGraphView = $1000; { Raw graphic view }
goGraphical = $2000; { Graphical view }
goNativeClass = $4000; { Native class window }
goNoDrawView = $8000; { View does not draw }
{---------------------------------------------------------------------------}
{ >> 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 }
{---------------------------------------------------------------------------}
{ 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 = 132; { Max view width }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFDEF BIT_16} { WINDOWS 16 BIT CODE }
{---------------------------------------------------------------------------}
{ WIN16 LABEL CONSTANTS FOR WINDOW PROPERTY CALLS }
{---------------------------------------------------------------------------}
CONST
ViewSeg = 'TVWINSEG'+#0; { View segment label }
ViewOfs = 'TVWINOFS'+#0; { View offset label }
{$ENDIF}
{$IFDEF BIT_32} { WINDOWS 32 BIT CODE }
{---------------------------------------------------------------------------}
{ WIN32/NT LABEL CONSTANTS FOR WINDOW PROPERTY CALLS }
{---------------------------------------------------------------------------}
CONST
ViewPtr = 'TVWINPTR'+#0; { View ptr label }
{$ENDIF}
{$ENDIF}
{***************************************************************************}
{ 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 = PACKED RECORD
X1, Y1 : Integer; { Top left corner }
X2, Y2 : 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 }
DrawMask : Byte; { Draw masks }
TabMask : Byte; { Tab move masks }
ColourOfs : Integer; { View palette offset }
HelpCtx : Word; { View help context }
State : Word; { View state masks }
Options : Word; { View options masks }
EventMask : Word; { View event masks }
GOptions : Word; { Graphics options }
Origin : TPoint; { View origin }
Size : TPoint; { View size }
Cursor : TPoint; { Cursor position }
RawOrigin : TPoint; { View raw origin }
RawSize : TPoint; { View raw size }
Next : PView; { Next peerview }
Owner : PGroup; { Owner group }
HoldLimit : PComplexArea; { Hold limit values }
{$IFDEF OS_WINDOWS} { WIN/NT DATA ONLY }
ExStyle : LongInt; { Extended style }
Dc : HDc; { Device context }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 DATA ONLY }
lStyle : LongInt; { Style }
Client : HWnd; { Client handle }
Ps : HPs; { Paint structure }
{$ENDIF}
{$IFNDEF OS_DOS} { WIN/NT/OS2 DATA ONLY }
FrameSize : Integer; { Frame size (X) }
CaptSize : Integer; { Caption size (Y) }
HWindow : HWnd; { Window handle }
{$ENDIF}
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: Word; Virtual;
FUNCTION TopView: PView;
FUNCTION PrevView: PView;
FUNCTION NextView: PView;
FUNCTION GetHelpCtx: Word; Virtual;
FUNCTION EventAvail: Boolean;
FUNCTION GetPalette: PPalette; Virtual;
FUNCTION GetColor (Color: Word): Word;
FUNCTION Valid (Command: Word): Boolean; Virtual;
FUNCTION GetState (AState: Word): Boolean;
FUNCTION TextWidth (Txt: String): Integer;
FUNCTION MouseInView (Point: TPoint): Boolean;
FUNCTION CommandEnabled (Command: Word): Boolean;
FUNCTION OverLapsArea (X1, Y1, X2, Y2: Integer): Boolean;
FUNCTION MouseEvent (Var Event: TEvent; Mask: Word): Boolean;
PROCEDURE Hide;
PROCEDURE Show;
PROCEDURE Draw; Virtual;
PROCEDURE Select;
PROCEDURE Awaken; Virtual;
PROCEDURE DrawView;
PROCEDURE MakeFirst;
PROCEDURE DrawFocus; Virtual;
PROCEDURE DrawCursor; Virtual;
PROCEDURE DrawBorder; Virtual;
PROCEDURE HideCursor;
PROCEDURE ShowCursor;
PROCEDURE BlockCursor;
PROCEDURE NormalCursor;
PROCEDURE FocusFromTop; Virtual;
PROCEDURE SetViewLimits;
PROCEDURE DrawBackGround; Virtual;
PROCEDURE ReleaseViewLimits;
PROCEDURE MoveTo (X, Y: Integer);
PROCEDURE GrowTo (X, Y: Integer);
PROCEDURE SetDrawMask (Mask: Byte);
PROCEDURE EndModal (Command: Word); Virtual;
PROCEDURE SetCursor (X, Y: Integer);
PROCEDURE PutInFrontOf (Target: PView);
PROCEDURE DisplaceBy (Dx, Dy: Integer); Virtual;
PROCEDURE SetCommands (Commands: TCommandSet);
PROCEDURE ReDrawArea (X1, Y1, X2, Y2: Integer);
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;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
FUNCTION GetClassId: LongInt; Virtual;
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassText: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
FUNCTION GetNotifyCmd: LongInt; Virtual;
FUNCTION GetMsgHandler: Pointer; Virtual;
{$ENDIF}
FUNCTION Exposed: Boolean; { This needs help!!!!! }
PROCEDURE GraphLine (X1, Y1, X2, Y2: Integer; Colour: Byte);
PROCEDURE GraphRectangle (X1, Y1, X2, Y2: Integer; Colour: Byte);
PROCEDURE ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
PROCEDURE GraphArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad: Integer;
Colour: Byte);
PROCEDURE FilletArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad, Ht: Integer;
Colour: Byte);
PROCEDURE BicolorRectangle (X1, Y1, X2, Y2: Integer; Light, Dark: Byte;
Down: Boolean);
PROCEDURE WriteBuf (X, Y, W, H: Integer; Var Buf);
PROCEDURE WriteLine (X, Y, W, H: Integer; Var Buf);
PROCEDURE MakeLocal (Source: TPoint; Var Dest: TPoint);
PROCEDURE MakeGlobal (Source: TPoint; Var Dest: TPoint);
PROCEDURE WriteStr (X, Y: Integer; Str: String; Color: Byte);
PROCEDURE WriteChar (X, Y: Integer; C: Char; Color: Byte;
Count: Integer);
PROCEDURE DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
MinSize, MaxSize: TPoint);
FUNCTION FontWidth: Integer;
FUNCTION Fontheight: Integer;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
{$ENDIF}
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: 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 Awaken; Virtual;
PROCEDURE ReDraw;
PROCEDURE SelectDefaultView;
PROCEDURE Insert (P: PView);
PROCEDURE Delete (P: PView);
PROCEDURE ForEach (P: Pointer); Virtual;
PROCEDURE EndModal (Command: Word); Virtual;
PROCEDURE DisplaceBy (Dx, Dy: Integer); 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);
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
{$ENDIF}
PRIVATE
LockFlag: Byte;
Clip : TRect;
FUNCTION IndexOf (P: PView): 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);
END;
{---------------------------------------------------------------------------}
{ TFrame OBJECT - FRAME VIEW OBJECT }
{---------------------------------------------------------------------------}
TYPE
TFrame = OBJECT (TView)
CONSTRUCTOR Init (Var Bounds: TRect);
FUNCTION GetPalette: PPalette; Virtual;
END;
PFrame = ^TFrame;
{---------------------------------------------------------------------------}
{ TScrollBar OBJECT - SCROLL BAR OBJECT }
{---------------------------------------------------------------------------}
TYPE
TScrollChars = Array [0..4] of Char;
TScrollBar = OBJECT (TView)
Value : Integer; { Scrollbar value }
Min : Integer; { Scrollbar minimum }
Max : Integer; { Scrollbar maximum }
PgStep: Integer; { One page step }
ArStep: Integer; { One range step }
Id : Integer; { Scrollbar ID }
CONSTRUCTOR Init (Var Bounds: TRect);
CONSTRUCTOR Load (Var S: TStream);
FUNCTION GetPalette: PPalette; Virtual;
FUNCTION ScrollStep (Part: Integer): Integer; Virtual;
PROCEDURE Draw; Virtual;
PROCEDURE ScrollDraw; Virtual;
PROCEDURE DrawBackGround; Virtual;
PROCEDURE SetValue (AValue: Integer);
PROCEDURE SetRange (AMin, AMax: Integer);
PROCEDURE SetStep (APgStep, AArStep: Integer);
PROCEDURE SetParams (AValue, AMin, AMax, APgStep, AArStep: Integer);
PROCEDURE Store (Var S: TStream);
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
{$ENDIF}
PRIVATE
Chars: TScrollChars; { Scrollbar chars }
FUNCTION GetPos: Integer;
FUNCTION GetSize: Integer;
PROCEDURE DrawPos (Pos: Integer);
PROCEDURE ClearPos (Pos: 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: Integer);
PROCEDURE ScrollTo (X, Y: 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 : Integer; { Number of columns }
TopItem : Integer; { Top most item }
Focused : Integer; { Focused item }
Range : Integer; { Range of listview }
HScrollBar: PScrollBar; { Horz scrollbar }
VScrollBar: PScrollBar; { Vert scrollbar }
CONSTRUCTOR Init (Var Bounds: TRect; ANumCols: Word; AHScrollBar,
AVScrollBar: PScrollBar);
CONSTRUCTOR Load (Var S: TStream);
FUNCTION GetPalette: PPalette; Virtual;
FUNCTION IsSelected (Item: Integer): Boolean; Virtual;
FUNCTION GetText (Item: Integer; MaxLen: Integer): String; Virtual;
PROCEDURE DrawFocus; Virtual;
PROCEDURE DrawBackGround; Virtual;
PROCEDURE FocusItem (Item: Integer); Virtual;
PROCEDURE SetTopItem (Item: Integer);
PROCEDURE SetRange (ARange: Integer);
PROCEDURE SelectItem (Item: 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;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
FUNCTION GetNotifyCmd: LongInt; Virtual;
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
{$ENDIF}
PRIVATE
PROCEDURE FocusItemNum (Item: Integer); Virtual;
END;
PListViewer = ^TListViewer;
{---------------------------------------------------------------------------}
{ TWindow OBJECT - WINDOW OBJECT ANCESTOR }
{---------------------------------------------------------------------------}
TYPE
TWindow = OBJECT (TGroup)
Flags : Byte; { Window flags }
Number : Integer; { Window number }
Palette : Integer; { Window palette }
ZoomRect: TRect; { Zoom rectangle }
Frame : PFrame; { Frame view object }
Title : PString; { Title string }
CONSTRUCTOR Init (Var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
CONSTRUCTOR Load (Var S: TStream);
DESTRUCTOR Done; Virtual;
FUNCTION GetPalette: PPalette; Virtual;
FUNCTION GetTitle (MaxSize: Integer): TTitleStr; Virtual;
FUNCTION StandardScrollBar (AOptions: Word): PScrollBar;
PROCEDURE Zoom; Virtual;
PROCEDURE Close; Virtual;
PROCEDURE InitFrame; Virtual;
PROCEDURE DrawBorder; 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;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
FUNCTION GetClassText: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
{$ENDIF}
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: 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: Integer; Horz: Boolean): PScrollBar;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ NEW WIN/NT/OS2 VERSION SPECIFIC INTERFACE ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{-TvViewMsgHandler---------------------------------------------------
This is the default WIN/NT handler for TView objects. Descendant
objects may need to call back to this handler so it must be provided
on the interface.
11Aug99 LdB
---------------------------------------------------------------------}
FUNCTION TvViewMsgHandler (Wnd: hWnd; iMessage, wParam: Sw_Word;
lParam: LongInt): LongInt;
{$IFDEF BIT_16} EXPORT; {$ENDIF}
{$IFDEF BIT_32} {$IFDEF PPC_SPEED} CDECL; {$ELSE} STDCALL; {$ENDIF} {$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
{-TvViewMsgHandler---------------------------------------------------
This is the default OS2 handler for TView objects. Descendant objects
may need to call back to this handler so it must be provided on the
interface.
11Aug99 LdB
---------------------------------------------------------------------}
FUNCTION TvViewMsgHandler(Wnd: HWnd; Msg: ULong; Mp1, Mp2: MParam): MResult;
CDECL; EXPORT;
{$ENDIF}
{***************************************************************************}
{ INITIALIZED PUBLIC VARIABLES }
{***************************************************************************}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
TYPE TColorRef = LongInt; { TColorRef defined }
{$ENDIF}
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
TYPE TColorRef = LongInt; { TColorRef defined }
TPaintStruct = PaintStruct;
TWindowPos = WindowPos;
TSize = Size;
TWndClass = WndClass;
{$ENDIF}
{---------------------------------------------------------------------------}
{ INITIALIZED WIN/NT VARIABLES }
{---------------------------------------------------------------------------}
CONST
ColRef: Array [0..15] Of TColorRef = { Standard colour refs }
(rgb_Black, rgb_Blue, rgb_Green, rgb_Cyan,
rgb_Red, rgb_Magenta, rgb_Brown, rgb_LightGray,
rgb_DarkGray, rgb_LightBlue, rgb_LightGreen,
rgb_LightCyan, rgb_LightRed, rgb_LightMagenta,
rgb_Yellow, rgb_White);
ColBrush: Array [0..15] Of HBrush =
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
ColPen: Array [0..15] Of HPen =
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
{---------------------------------------------------------------------------}
{ INITIALIZED OS2 VARIABLES }
{---------------------------------------------------------------------------}
CONST
ColRef: Array [0..15] Of LongInt =
(clr_Black, clr_DarkBlue, clr_DarkGreen, clr_DarkCyan,
clr_DarkRed, clr_DarkPink, clr_Brown, clr_PaleGray,
clr_DarkGray, clr_Blue, clr_Green, clr_Cyan,
clr_Red, clr_Pink, clr_Yellow, clr_White);
{$ENDIF}
{---------------------------------------------------------------------------}
{ 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: 1; { Register id = 1 }
{$IFDEF BP_VMTLink}
VmtLink: Ofs(TypeOf(TView)^); { BP style VMT link }
{$ELSE}
VmtLink: TypeOf(TView); { Alt style VMT link }
{$ENDIF}
Load: @TView.Load; { Object load method }
Store: @TView.Store { Object store method }
);
{---------------------------------------------------------------------------}
{ TFrame STREAM REGISTRATION }
{---------------------------------------------------------------------------}
CONST
RFrame: TStreamRec = (
ObjType: 2; { Register id = 2 }
{$IFDEF BP_VMTLink}
VmtLink: Ofs(TypeOf(TFrame)^); { BP style VMT link }
{$ELSE}
VmtLink: TypeOf(TFrame); { Alt style VMT link }
{$ENDIF}
Load: @TFrame.Load; { Frame load method }
Store: @TFrame.Store { Frame store method }
);
{---------------------------------------------------------------------------}
{ TScrollBar STREAM REGISTRATION }
{---------------------------------------------------------------------------}
CONST
RScrollBar: TStreamRec = (
ObjType: 3; { Register id = 3 }
{$IFDEF BP_VMTLink}
VmtLink: Ofs(TypeOf(TScrollBar)^); { BP style VMT link }
{$ELSE}
VmtLink: TypeOf(TScrollBar); { Alt style VMT link }
{$ENDIF}
Load: @TScrollBar.Load; { Object load method }
Store: @TScrollBar.Store { Object store method }
);
{---------------------------------------------------------------------------}
{ TScroller STREAM REGISTRATION }
{---------------------------------------------------------------------------}
CONST
RScroller: TStreamRec = (
ObjType: 4; { Register id = 4 }
{$IFDEF BP_VMTLink}
VmtLink: Ofs(TypeOf(TScroller)^); { BP style VMT link }
{$ELSE}
VmtLink: TypeOf(TScroller); { Alt style VMT link }
{$ENDIF}
Load: @TScroller.Load; { Object load method }
Store: @TScroller.Store { Object store method }
);
{---------------------------------------------------------------------------}
{ TListViewer STREAM REGISTRATION }
{---------------------------------------------------------------------------}
CONST
RListViewer: TStreamRec = (
ObjType: 5; { Register id = 5 }
{$IFDEF BP_VMTLink}
VmtLink: Ofs(TypeOf(TListViewer)^); { BP style VMT link }
{$ELSE}
VmtLink: TypeOf(TListViewer); { Alt style VMT link }
{$ENDIF}
Load: @TListViewer.Load; { Object load method }
Store: @TLIstViewer.Store { Object store method }
);
{---------------------------------------------------------------------------}
{ TGroup STREAM REGISTRATION }
{---------------------------------------------------------------------------}
CONST
RGroup: TStreamRec = (
ObjType: 6; { Register id = 6 }
{$IFDEF BP_VMTLink}
VmtLink: Ofs(TypeOf(TGroup)^); { BP style VMT link }
{$ELSE}
VmtLink: TypeOf(TGroup); { Alt style VMT link }
{$ENDIF}
Load: @TGroup.Load; { Object load method }
Store: @TGroup.Store { Object store method }
);
{---------------------------------------------------------------------------}
{ TWindow STREAM REGISTRATION }
{---------------------------------------------------------------------------}
CONST
RWindow: TStreamRec = (
ObjType: 7; { Register id = 7 }
{$IFDEF BP_VMTLink}
VmtLink: Ofs(TypeOf(TWindow)^); { BP style VMT link }
{$ELSE}
VmtLink: TypeOf(TWindow); { Alt style VMT link }
{$ENDIF}
Load: @TWindow.Load; { Object load method }
Store: @TWindow.Store { Object store method }
);
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{***************************************************************************}
{ PRIVATE CONSTANT DEFINITIONS }
{***************************************************************************}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
CONST WM_Notify = $004E; { Value was left out }
{$ENDIF}
{$ENDIF}
{***************************************************************************}
{ 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 }
{***************************************************************************}
{ PRIVATE INTERNAL ROUTINES }
{***************************************************************************}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{---------------------------------------------------------------------------}
{ TvViewMsgHandler -> Platforms WIN/NT - Updated 09Aug99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TvViewMsgHandler (Wnd: hWnd; iMessage, wParam: Sw_Word;
lParam: LongInt): LongInt; {$IFDEF PPC_FPC} STDCALL; {$ENDIF}
VAR Bc: Byte; I: LongInt; W: Word; Event: TEvent; P, Tp: PView;
Q: PScrollBar; Ps: TPaintStruct; Wp: ^TWindowPos;
BEGIN
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
PtrRec(P).Seg := GetProp(Wnd, ViewSeg); { Fetch seg property }
PtrRec(P).Ofs := GetProp(Wnd, ViewOfs); { Fetch ofs property }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
LongInt(P) := GetProp(Wnd, ViewPtr); { Fetch view pointer }
{$ENDIF}
If (P <> Nil) Then Begin { Valid view pointer }
TvViewMsgHandler := 0; { Preset return zero }
Event.What := evNothing; { Preset no event }
Case iMessage Of
WM_Close: Begin { CLOSE COMMAND }
If (P^.GetState(sfFocused) = False) Then
P^.FocusFromTop; { Focus if behind }
Event.What := evCommand; { Command event }
Event.Command := cmClose; { Quit command }
Event.InfoPtr := P; { Pointer to view }
End;
WM_LButtonDown: Begin { LEFT MOUSE DOWN }
Event.What := evMouseDown; { Mouse down event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons OR mbLeftButton;{ Set button mask }
End;
WM_LButtonUp: Begin { LEFT MOUSE UP }
Event.What := evMouseUp; { Mouse up event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons AND NOT
mbLeftButton; { Clear button mask }
End;
WM_LButtonDBLClk: Begin { LEFT MOUSE DBL CLK }
Event.What := evMouseDown; { Mouse down event }
Event.Double := True; { Double click }
MouseButtons := MouseButtons OR mbLeftButton;{ Set button mask }
End;
WM_RButtonDown: Begin { RIGHT MOUSE DOWN }
Event.What := evMouseDown; { Mouse down event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons OR
mbRightButton; { Set button mask }
End;
WM_RButtonUp: Begin { RIGHT MOUSE UP }
Event.What := evMouseUp; { Mouse up event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons AND NOT
mbRightButton; { Clear button mask }
End;
WM_RButtonDBLClk: Begin { RIGHT MOUSE DBL CLK }
Event.What := evMouseDown; { Mouse down event }
Event.Double := True; { Double click }
MouseButtons := MouseButtons OR
mbLeftButton; { Set button mask }
End;
WM_MButtonDown: Begin { MIDDLE MOUSE DOWN }
Event.What := evMouseDown; { Mouse down event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons OR
mbMiddleButton; { Set button mask }
End;
WM_MButtonUp: Begin { MIDDLE MOUSE UP }
Event.What := evMouseUp; { Mouse up event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons AND NOT
mbMiddleButton; { Clear button mask }
End;
WM_MButtonDBLClk: Begin { MIDDLE MOUSE DBL CLK }
Event.What := evMouseDown; { Mouse down event }
Event.Double := True; { Double click }
MouseButtons := MouseButtons OR
mbMiddleButton; { Set button mask }
End;
WM_MouseMove: Begin { MOUSE MOVEMENT }
Event.What := evMouseMove; { Mouse move event }
Event.Double := False; { Not double click }
MouseButtons := 0; { Preset clear buttons }
If (wParam AND mk_LButton <> 0) Then
MouseButtons := MouseButtons OR
mbLeftButton; { Left button mask }
If (wParam AND mk_MButton <> 0) Then
MouseButtons := MouseButtons OR
mbLeftButton; { Middle button mask }
If (wParam AND mk_RButton <> 0) Then
MouseButtons := MouseButtons OR
mbRightButton; { Set right button mask }
End;
{$IFDEF BIT_32}
WM_Notify: Begin
I := 0;
End;
{$ENDIF}
WM_EraseBkGnd: TvViewMsgHandler := 1; { BACKGROUND MESSAGE }
WM_Paint: If (P^.Dc = 0) Then Begin { PAINT MESSAGE }
P^.Dc := BeginPaint(Wnd, Ps); { Fetch structure }
SelectObject(ps.hDC, DefGFVFont); { Select default font }
P^.DrawMask := P^.DrawMask OR vdNoChild; { Draw this view only }
P^.ReDrawArea(Ps.rcPaint.Left + P^.RawOrigin.X,
Ps.rcPaint.Top + P^.RawOrigin.Y,
Ps.rcPaint.Right + P^.RawOrigin.X-1,
Ps.rcPaint.Bottom + P^.RawOrigin.Y-1); { Redraw the area }
P^.DrawMask := P^.DrawMask AND NOT vdNoChild;{ Child draws enabled }
P^.Dc := 0; { Zero device context }
EndPaint(Wnd, Ps); { End painting }
End Else PostMessage(Wnd, iMessage, wParam,
lParam); { Busy repost message }
WM_HScroll, WM_VScroll: Begin { SCROLLBAR MESSAGES }
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
PtrRec(Q).Seg := GetProp(HiWord(lParam),
ViewSeg); { Fetch seg property }
PtrRec(Q).Ofs := GetProp(HiWord(lParam),
ViewOfs); { Fetch ofs property }
W := wParam; { Transfer word }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
LongInt(Q) := GetProp(lParam, ViewPtr); { Fetch seg property }
W := LoWord(wParam); { Low param part }
{$ENDIF}
If (Q <> Nil) Then Begin { Valid scrollbar }
If (Q^.GetState(sfFocused) = False) Then
Q^.FocusFromTop; { Focus up to us }
Bc := 0; { Preset do call }
Case W Of
SB_TOP: Q^.SetValue(Q^.Min); { Set to minimum }
SB_BOTTOM: Q^.SetValue(Q^.Max); { Set to maximum }
SB_ENDSCROLL: Bc := 1; { Fail this call }
SB_LINEDOWN: Q^.SetValue(Q^.Value +
Q^.ScrollStep(sbDownArrow)); { One line down }
SB_LINEUP: Q^.SetValue(Q^.Value +
Q^.ScrollStep(sbUpArrow)); { One line up }
SB_PAGEDOWN: Q^.SetValue(Q^.Value +
Q^.ScrollStep(sbPageDown)); { One page down }
SB_PAGEUP: Q^.SetValue(Q^.Value +
Q^.ScrollStep(sbPageUp)); { One page up }
SB_THUMBPOSITION, SB_THUMBTRACK:
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
Q^.SetValue(LoWord(lParam)); { Set to position }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
Q^.SetValue(HiWord(wParam)); { Set to position }
{$ENDIF}
Else Bc := 1; { Fail other cases }
End;
If (Bc=0) Then NewMessage(Q^.Owner,
evBroadcast, cmScrollBarClicked, Q^.Id,
Q^.Value, Q); { Old TV style message }
End;
End;
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
WM_CtlColor: If (HiWord(lParam) = CtlColor_Btn){ COLOUR CONTROL }
OR (HiWord(lParam) = CtlColor_ListBox)
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
WM_CtlColorListBox, WM_CtlColorBtn: { COLOUR LISTBOX/BUTTON }
If (lParam <> 0) { Valid handle }
{$ENDIF}
Then Begin
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
PtrRec(P).Seg := GetProp(LoWord(lParam),
ViewSeg); { Get view segment }
PtrRec(P).Ofs := GetProp(LoWord(lParam),
ViewOfs); { Get view segment }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
LongInt(P) := GetProp(LoWord(lParam),
ViewPtr); { Get view pointer }
{$ENDIF}
If (P <> Nil) Then Begin { Valid view }
Bc := P^.GetColor(1) AND $F0 SHR 4; { Background colour }
SetTextColor(wParam, ColRef[P^.GetColor(1)
AND $0F]); { Set text colour }
SetBkColor(wParam, ColRef[Bc]); { Set background colour }
TvViewMsgHandler := ColBrush[Bc]; { Return colour brush }
End Else TvViewMsgHandler := DefWindowProc(
Wnd, iMessage, wParam, lParam); { Call default handler }
End Else TvViewMsgHandler := DefWindowProc(
Wnd, iMessage, wParam, lParam); { Call default handler }
WM_SysCommand: Begin { SYSTEM COMMAND MESSAGE }
If (P^.GetState(sfFocused) = False) Then
P^.FocusFromTop; { Focus if behind }
TvViewMsgHandler := DefWindowProc(
Wnd, iMessage, wParam, lParam);
If IsIconic(Wnd) Then BringWindowToTop(Wnd);
End;
WM_Command: Begin { COMMAND MESSAGE }
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
W := HiWord(lParam); { Message of lParam }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
W := HiWord(wParam); { Handle high of wParam }
{$ENDIF}
Case W Of
cbn_SelChange: Begin { COMBO/LIST SELECTION }
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
PtrRec(Tp).Seg := GetProp(LoWord(lParam),
ViewSeg); { Fetch combo seg }
PtrRec(Tp).Ofs := GetProp(LoWord(lParam),
ViewOfs); { Fetch combo ofs }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
LongInt(Tp) := GetProp(LoWord(lParam),
ViewPtr); { Fetch combo ptr }
{$ENDIF}
If (Tp <> Nil) Then Begin { View is valid }
I := SendMessage(LoWord(lParam),
Tp^.GetNotifyCmd, 0, 0); { Get current state }
Event.What := evCommand; { Command event }
Event.Command := cmNotify; { Notify command }
Event.data := I; { Load data value }
Event.InfoPtr := Tp; { Pointer to view }
End;
End;
cbn_SetFocus: Begin { DROP BOX FOCUSED }
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
PtrRec(Tp).Seg := GetProp(LoWord(lParam),
ViewSeg); { Fetch combo seg }
PtrRec(Tp).Ofs := GetProp(LoWord(lParam),
ViewOfs); { Fetch combo ofs }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
LongInt(Tp) := GetProp(LoWord(lParam),
ViewPtr); { Fetch combo ptr }
{$ENDIF}
If (Tp <> Nil) AND { Combo box valid }
(Tp^.GetState(sfFocused) = False) Then { We have not focus }
Tp^.FocusFromTop; { Focus up to us }
End;
lbn_SetFocus: Begin { LIST BOX FOCUSED }
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
PtrRec(Tp).Seg := GetProp(LoWord(lParam),
ViewSeg); { Fetch listbox seg }
PtrRec(Tp).Ofs := GetProp(LoWord(lParam),
ViewOfs); { Fetch listbox ofs }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
LongInt(Tp) := GetProp(LoWord(lParam),
ViewPtr); { Fetch listbox ptr }
{$ENDIF}
If (Tp <> Nil) Then Begin { Listbox is valid }
If (Tp^.GetState(sfFocused) = False) { We have not focus }
Then Tp^.FocusFromTop; { Focus up to us }
End;
End;
Else TvViewMsgHandler := DefWindowProc(
Wnd, iMessage, wParam, lParam); { Call default handler }
End;
End;
WM_Activate, WM_ChildActivate: Begin
If (P^.Options AND ofTopSelect <> 0) { Top selectable view }
AND (P^.Options AND ofSelectable <> 0) { View is selectable }
Then P^.FocusFromTop; { Focus us from top }
End;
WM_WindowPosChanged: Begin { WINDOW HAS MOVED }
If (NOT ISIconic(Wnd)) AND (lParam <> 0) { Window not iconic }
Then Begin
Wp := Pointer(lParam); { TWindowpos structure }
If (Wp^.Flags AND swp_NoMove = 0) { No move flag is clear }
Then Begin
If (P^.Owner <> Nil) Then
P^.DisplaceBy(Wp^.X + P^.Owner^.RawOrigin.X -
P^.RawOrigin.X + P^.Owner^.FrameSize,
Wp^.Y + P^.Owner^.RawOrigin.Y -
P^.RawOrigin.Y + P^.Owner^.CaptSize) { Displace the window }
Else P^.DisplaceBy(Wp^.X + P^.RawOrigin.X,
Wp^.Y - P^.RawOrigin.Y); { Displace the window }
End;
If (Wp^.Flags AND swp_NoSize = 0) { No resize flag clear }
Then Begin
P^.RawSize.X := Wp^.Cx; { Size the window x }
P^.RawSize.Y := Wp^.Cy; { Size the window y }
End;
End;
TvViewMsgHandler := DefWindowProc(Wnd,
iMessage, wParam, lParam); { Default handler }
End;
Else TvViewMsgHandler := DefWindowProc(Wnd,
iMessage, wParam, lParam); { Call Default handler }
End; { End of case }
If (Event.What <> evNothing) Then Begin { Check any GFV event }
If (Event.What AND evMouse <> 0) Then Begin { Mouse event }
If (P <> Nil) Then Begin { Valid view pointer }
Event.Where.X := LoWord(lParam) +
P^.RawOrigin.X + P^.FrameSize; { X mouse co-ordinate }
Event.Where.Y := HiWord(lParam) +
P^.RawOrigin.Y + P^.CaptSize; { Y mouse co-ordinate }
MouseWhere := Event.Where; { Update mouse where }
Event.Buttons := MouseButtons; { Return mouse buttons }
End Else Exit; { View is not valid }
End;
PutEventInQueue(Event); { Put event in queue }
End;
End Else TvViewMsgHandler := DefWindowProc(Wnd,
iMessage, wParam, lParam); { Call Default handler }
END;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
{---------------------------------------------------------------------------}
{ TvViewMsgHandler -> Platforms OS2 - Updated 09Aug99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TvViewMsgHandler(Wnd: HWnd; Msg: ULong; Mp1, Mp2: MParam): MResult;
VAR Bc: Byte; R: RectL; Event: TEvent; P: PView; Pt: PointL; PS: hPs; Sp: Swp;
Q: PScrollBar; Sh: HWnd;
BEGIN
P := Nil; { Clear the pointer }
WinQueryPresParam(Wnd, PP_User, 0, Nil,
SizeOf(Pointer), @P, 0); { Fetch view pointer }
If (P <> Nil) Then Begin { PView is valid }
TvViewMSgHandler := 0; { Preset handled }
Event.What := evNothing; { Preset no event }
Case Msg Of
WM_Close: Begin { CLOSE COMMAND }
If (P^.GetState(sfFocused) = False) Then
P^.FocusFromTop; { Focus if behind }
Event.What := evCommand; { Command event }
Event.Command := cmClose; { Quit command }
Event.InfoPtr := P; { Pointer to view }
End;
WM_EraseBackGround: TvViewMsgHandler := { BACKGROUND ERASE }
LongInt(False); { Return false }
WM_Paint: If (P^.Ps = 0) Then Begin { PAINT MESSAGE }
P^.Ps := WinBeginPaint(Wnd, 0, @R); { Fetch structure }
P^.DrawMask := P^.DrawMask OR vdNoChild; { Draw this view only }
P^.ReDrawArea(R.xLeft + P^.RawOrigin.X,
R.yBottom + P^.RawOrigin.Y,
R.xRight + P^.RawOrigin.X,
R.yTop + P^.RawOrigin.Y); { Redraw the area }
P^.DrawMask := P^.DrawMask AND NOT vdNoChild;{ Child draws enabled }
P^.Ps := 0; { Zero device context }
WinEndPaint(Ps); { End painting }
End Else WinPostMsg(Wnd, Msg, Mp1, Mp2); { Busy repost message }
WM_Button1Down: Begin { LEFT MOUSE DOWN }
Event.What := evMouseDown; { Mouse down event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons OR
mbLeftButton; { Set button mask }
End;
WM_Button1Up: Begin { LEFT MOUSE UP }
Event.What := evMouseUp; { Mouse up event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons AND NOT
mbLeftButton; { Clear button mask }
End;
WM_Button1DBLClk: Begin { LEFT MOUSE DBL CLK }
Event.What := evMouseDown; { Mouse down event }
Event.Double := True; { Double click }
MouseButtons := MouseButtons OR
mbLeftButton; { Set button mask }
End;
WM_Button2Down: Begin { RIGHT MOUSE DOWN }
Event.What := evMouseDown; { Mouse down event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons OR
mbRightButton; { Set button mask }
End;
WM_Button2Up: Begin { RIGHT MOUSE UP }
Event.What := evMouseUp; { Mouse up event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons AND NOT
mbRightButton; { Clear button mask }
End;
WM_Button2DBLClk: Begin { RIGHT MOUSE DBL CLK }
Event.What := evMouseDown; { Mouse down event }
Event.Double := True; { Double click }
MouseButtons := MouseButtons OR
mbLeftButton; { Set button mask }
End;
WM_Button3Down: Begin { MIDDLE MOUSE DOWN }
Event.What := evMouseDown; { Mouse down event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons OR
mbMiddleButton; { Set button mask }
End;
WM_Button3Up: Begin { MIDDLE MOUSE UP }
Event.What := evMouseUp; { Mouse up event }
Event.Double := False; { Not double click }
MouseButtons := MouseButtons AND NOT
mbMiddleButton; { Clear button mask }
End;
WM_Button3DBLClk: Begin { MIDDLE MOUSE DBL CLK }
Event.What := evMouseDown; { Mouse down event }
Event.Double := True; { Double click }
MouseButtons := MouseButtons OR
mbMiddleButton; { Set button mask }
End;
WM_MouseMove: Begin { MOUSE MOVEMENT }
Event.What := evMouseMove; { Mouse move event }
Event.Double := False; { Not double click }
If (WinQueryPointer(HWND_Desktop) <>
DefPointer) Then { Check mouse ptr }
WinSetPointer(HWND_DeskTop, DefPointer); { Set mouse ptr }
End;
WM_HScroll, WM_VScroll: Begin { SCROLLBAR MESSAGES }
Q := Nil; { Clear the pointer }
Sh := WinQueryFocus(HWnd_DeskTop); { Scrollbar has focus }
If (Sh <> 0) Then WinQueryPresParam(Sh,
PP_User, 0, Nil, SizeOf(Pointer), @Q, 0); { Fetch scrollbar ptr }
If (Q <> Nil) AND (Q^.GOptions AND
goNativeClass <> 0) Then Begin { Valid scrollbar }
If (Q^.GetState(sfFocused) = False) Then
Q^.FocusFromTop; { Focus up to us }
Bc := 0; { Preset do call }
Case Short2FromMP(Mp2) Of { Scrollbar message }
SB_ENDSCROLL:;
SB_LINEDOWN: Q^.SetValue(Q^.Value +
Q^.ScrollStep(sbDownArrow)); { One line down }
SB_LINEUP: Q^.SetValue(Q^.Value +
Q^.ScrollStep(sbUpArrow)); { One line up }
SB_PAGEDOWN: Q^.SetValue(Q^.Value +
Q^.ScrollStep(sbPageDown)); { One page down }
SB_PAGEUP: Q^.SetValue(Q^.Value +
Q^.ScrollStep(sbPageUp)); { One page up }
SB_SLIDERPOSITION, SB_SLIDERTRACK:
Q^.SetValue(Short1FromMP(Mp2)); { Set to position }
Else Bc := 1; { Fail other cases }
End;
If (Bc=0) Then NewMessage(Q^.Owner,
evBroadcast, cmScrollBarClicked, Q^.Id,
Q^.Value, Q); { Old TV style message }
End;
End;
WM_QueryTrackInfo: Begin { WINDOW HAS MOVED }
(*If (NOT ISIconic(Wnd)) AND (lParam <> 0) { Window not iconic }
Then Begin*)
(*Sp := PSwp(Mp1)^; { New SWP data }
If (Sp.Fl AND swp_Size <> 0) Then Begin { Size change request }
P^.RawSize.X := Sp.Cx-1; { Size the window x }
P^.RawSize.Y := Sp.Cy-1; { Size the window y }
End;*)
(*P^.DisplaceBy(Sp1.X - Sp2.X,
-(Sp1.Y - Sp2.Y));*)
TvViewMSgHandler := 0;
End;
Else TvViewMSgHandler := WinDefWindowProc(
Wnd, Msg, Mp1, Mp2); { Call default handler }
End;
If (Event.What <> evNothing) Then Begin { Check any FV event }
If (Event.What AND evMouse <> 0) Then Begin { Mouse event }
WinQueryWindowPos(Wnd, Sp); { Query client area }
Event.Where.X := Short1FromMP(Mp1)-1
+ P^.RawOrigin.X; { X mouse co-ordinate }
Event.Where.Y := Sp.Cy -
Short2FromMP(Mp1)-1 + P^.RawOrigin.Y; { Y mouse co-ordinate }
Event.Buttons := MouseButtons; { Return buttons }
MouseWhere := Event.Where; { Update mouse where }
End;
PutEventInQueue(Event); { Put event in queue }
End;
End Else TvViewMSgHandler := WinDefWindowProc(Wnd,
Msg, Mp1, Mp2); { Call default handler }
END;
{$ENDIF}
{***************************************************************************}
{ OBJECT METHODS }
{***************************************************************************}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ TView OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{---------------------------------------------------------------------------}
{ TView WINDOW CLASS NAME CONSTANT }
{---------------------------------------------------------------------------}
CONST TvViewClassName = 'TVIEW'; { TView window class }
{$ENDIF}
{--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 }
GOptions := goTabSelect; { Set new options }
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);
BEGIN
Inherited Init; { Call ancestor }
S.Read(Origin.X, 2); { Read origin x value }
S.Read(Origin.Y, 2); { Read origin y value }
S.Read(Size.X, 2); { Read view x size }
S.Read(Size.Y, 2); { Read view y size }
S.Read(Cursor.X, 2); { Read cursor x size }
S.Read(Cursor.Y, 2); { Read cursor y size }
S.Read(GrowMode, 1); { Read growmode flags }
S.Read(DragMode, 1); { Read dragmode flags }
S.Read(HelpCtx, 2); { Read help context }
S.Read(State, 2); { Read state masks }
S.Read(Options, 2); { Read options masks }
S.Read(Eventmask, 2); { Read event masks }
If (Options AND ofGFVModeView <> 0) Then Begin { STREAM HAS GFV TVIEW }
S.Read(GOptions, 2); { Read new option masks }
S.Read(TabMask, 1); { Read new tab masks }
S.Read(RawOrigin.X, 2); { Read raw x origin point }
S.Read(RawOrigin.Y, 2); { Read raw y origin point }
S.Read(RawSize.X, 2); { Read raw x size }
S.Read(RawSize.Y, 2); { Read raw y size }
S.Read(ColourOfs, 2); { Read palette offset }
End Else Begin { STREAM HAS OLD TView }
RawOrigin.X := Origin.X * FontWidth; { Set x origin pt }
RawOrigin.Y := Origin.Y * FontHeight; { Set y origin pt }
RawSize.X := (Size.X * FontWidth) - 1; { Calc raw x size }
RawSize.Y := (Size.Y * FontHeight) - 1; { Calc raw y size }
End;
END;
{--TView--------------------------------------------------------------------}
{ Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Nov99 LdB }
{---------------------------------------------------------------------------}
DESTRUCTOR TView.Done;
VAR P: PComplexArea; {$IFNDEF OS_DOS} S: String; {$ENDIF}
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;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
If (HWindow <> 0) Then Begin { Handle valid }
S := GetClassName + #0; { Make asciiz }
{$IFDEF OS_WINDOWS} { WIN/NT CODE}
{$IFDEF BIT_16} { 16 BIT CODE }
RemoveProp(HWindow, ViewSeg); { Remove seg property }
RemoveProp(HWindow, ViewOfs); { Remove offs property }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT CODE }
RemoveProp(HWindow, ViewPtr); { Remove view property }
{$ENDIF}
DestroyWindow(HWindow); { Destroy window }
If (GOptions AND goNativeClass = 0) Then { Not native class check }
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
UnRegisterClass(CString(@S[1]), 0); { Unregister class }
{$ELSE} { OTHER COMPILERS }
UnRegisterClass(@S[1], HInstance); { Unregister class }
{$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
WinRemovePresParam(HWindow, PP_User); { Remove self ptr }
WinDestroyWindow(HWindow); { Destroy window }
If (GOptions AND goNativeClass = 0) Then { Not native class check }
WinDeregisterObjectClass(@S[1]); { Unregister class }
{$ENDIF}
End;
{$ENDIF}
END;
{--TView--------------------------------------------------------------------}
{ Prev -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
FUNCTION TView.Prev: PView;
VAR P: PView;
BEGIN
P := @Self; { Start with self }
While (P^.Next <> Nil) AND (P^.Next <> @Self)
Do P := P^.Next; { Locate next view }
Prev := P; { Return result }
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: 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--------------------------------------------------------------------}
{ 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 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 (Txt: String): Integer;
VAR I: Integer; S: String;
{$IFNDEF OS_DOS} P: Pointer; Wnd: HWnd; {$ENDIF}
{$IFDEF OS_WINDOWS} ODc: HDc; M: TSize; {$ENDIF}
{$IFDEF OS_OS2} OPs: HPs; Pt: Array [0..3] Of PointL; {$ENDIF}
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 }
{$IFDEF OS_DOS} { DOS/DPMI CODE }
TextWidth := Length(S) * SysFontWidth; { Calc text length }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
ODc := Dc; { Hold device context }
If (Dc = 0) Then Begin { No context set }
If (HWindow = 0) OR (State AND sfVisible = 0) { Check window valid }
OR (State AND sfExposed = 0)
Then Wnd := AppWindow Else Wnd := HWindow; { Select window or app }
Dc := GetDC(Wnd); { Get device context }
End;
SelectObject(Dc, DefGFVFont); { Select the font }
P := @S[1]; { Pointer to text }
{$IFDEF BIT_32} { WINDOWS 32 BIT CODE }
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
If (GetTextExtentPoint(Dc, CString(P),
Length(S), M)=False) Then M.Cx := 0; { Get text extents }
{$ELSE} { OTHER COMPILERS }
{$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
If (GetTextExtentPoint(Dc, P, Length(S),
@M)=False) Then M.Cx := 0; { Get text extents }
{$ELSE} { ALL OTHER COMPILERS }
If (GetTextExtentPoint(Dc, P, Length(S),
M)=False) Then M.Cx := 0; { Get text extents }
{$ENDIF}
{$ENDIF}
{$ELSE} { WINDOWS 16 BIT CODE }
{$IFDEF PPC_DELPHI} { DELPHI1 COMPILER }
If (GetTextExtentPoint(Dc, @S[1], Length(S),
M)=False)Then M.Cx := 0; { Get text extents }
{$ELSE} { OTHER COMPILERS }
If (GetTextExtentPoint(Dc, @S[1], Length(S),
M.Cx)=False)Then M.Cx := 0; { Get text extents }
{$ENDIF}
{$ENDIF}
TextWidth := M.Cx; { Return text width }
If (ODc = 0) Then ReleaseDC(Wnd, Dc); { Release context }
Dc := ODc; { Original context set }
{$ENDIF}
{$IFDEF OS_OS2}
OPs := Ps; { Hold pres space }
If (Ps = 0) Then Begin
If (HWindow = 0) OR (State AND sfVisible = 0) { Check window valid }
OR (State AND sfExposed = 0)
Then Wnd := AppWindow Else Wnd := Client; { Select window or app }
Ps := WinGetPS(Wnd); { Get pres space }
End;
GPISetCharSet(PS, DefGFVFont); { Set the font style }
P := @S[1]; { Pointer to text }
GpiQueryTextBox(Ps, Length(S), P, 3, Pt[0]); { Get text extents }
TextWidth := Pt[2].X; { Return text width }
If (OPs = 0) Then WinReleasePS(Ps); { Release pres space }
Ps := OPs; { Original pres space }
{$ENDIF}
END;
{--TView--------------------------------------------------------------------}
{ MouseInView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
FUNCTION TView.MouseInView (Point: TPoint): Boolean;
BEGIN
MouseInView := False; { Preset false }
If (Point.X < RawOrigin.X) Then Exit; { Point to left }
If (Point.X > (RawOrigin.X+RawSize.X)) Then Exit; { Point to right }
If (Point.Y < RawOrigin.Y) Then Exit; { Point is above }
If (Point.Y > (RawOrigin.Y+RawSize.Y)) Then Exit; { Point is below }
MouseInView := True; { Return true }
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: Integer): Boolean;
BEGIN
OverLapsArea := False; { Preset false }
If (RawOrigin.X > X2) Then Exit; { Area to the left }
If ((RawOrigin.X + RawSize.X) < X1) Then Exit; { Area to the right }
If (RawOrigin.Y > Y2) Then Exit; { Area is above }
If ((RawOrigin.Y + RawSize.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;
BEGIN { Abstract method }
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--------------------------------------------------------------------}
{ DrawView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawView;
VAR ViewPort: ViewPortType; { Common variables }
{$IFDEF OS_WINDOWS} ODc: HDc; {$ENDIF} { WIN/NT variables }
{$IFDEF OS_OS2} OPs: HPs; {$ENDIF} { OS2 variables }
BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) AND { View is exposed }
(State AND sfIconised = 0) Then Begin { View not iconised }
SetViewLimits; { Set view limits }
GetViewSettings(ViewPort); { Get set viewport }
If OverlapsArea(ViewPort.X1, ViewPort.Y1,
ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
{$IFDEF OS_DOS} { DOS/DPMI CODE }
HideMouseCursor; { Hide mouse cursor }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (HWindow <> 0) Then Begin { Valid window }
ODc := Dc; { Hold device context }
If (Dc = 0) Then Dc := GetDc(HWindow); { Get device context }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (HWindow <> 0) Then Begin { Valid window }
OPs := Ps; { Hold paint struct }
If (Ps = 0) Then Ps := WinGetPS(Client); { Create paint struct }
{$ENDIF}
If (DrawMask = 0) OR (DrawMask = vdNoChild) { No special masks set }
Then Begin { Treat as a full redraw }
DrawBackGround; { Draw background }
Draw; { Draw interior }
If (GOptions AND goDrawFocus <> 0) Then
DrawFocus; { Draw focus }
If (State AND sfCursorVis <> 0)
Then DrawCursor; { Draw any cursor }
If (Options AND ofFramed <> 0) OR
(GOptions AND goThickFramed <> 0) { View has border }
Then DrawBorder; { Draw border }
End Else Begin { Masked draws only }
If (DrawMask AND vdBackGnd <> 0) Then { Chk background mask }
DrawBackGround; { Draw background }
If (DrawMask AND vdInner <> 0) Then { Check Inner mask }
Draw; { Draw interior }
If (DrawMask AND vdFocus <> 0)
AND (GOptions AND goDrawFocus <> 0)
Then DrawFocus; { Check focus mask }
If (DrawMask AND vdCursor <> 0) Then { Check cursor mask }
DrawCursor; { Draw any cursor }
If (DrawMask AND vdBorder <> 0) Then { Check border mask }
DrawBorder; { Draw border }
End;
{$IFDEF OS_DOS} { DOS/DPMI CODE }
ShowMouseCursor; { Show mouse cursor }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (ODc = 0) Then ReleaseDc(HWindow, Dc); { Release context }
Dc := ODc; { Reset held context }
End;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (OPs = 0) Then WinReleasePS(Ps); { Free paint struct }
Ps := OPs; { Reset held struct }
End;
{$ENDIF}
End;
ReleaseViewLimits; { Release the limits }
End;
DrawMask := 0; { Clear the draw mask }
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 }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (HWindow <> 0) Then { Valid window }
SetWindowPos(HWindow, HWND_TOP, 0, 0, 0, 0,
swp_NoSize OR swp_NoMove); { Bring window to top }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (HWindow <> 0) Then { Valid window }
WinSetWindowPos(HWindow, HWND_TOP, 0, 0, 0, 0,
swp_ZOrder); { Bring window to top }
{$ENDIF}
End;
END;
{--TView--------------------------------------------------------------------}
{ DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawFocus;
BEGIN { Abstract method }
END;
{--TView--------------------------------------------------------------------}
{ DrawCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawCursor;
BEGIN { Abstract method }
END;
{--TView--------------------------------------------------------------------}
{ DrawBorder -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawBorder;
BEGIN
{$IFDEF OS_DOS} { DOS/DPMI CODE ONLY }
BiColorRectangle(0, 0, RawSize.X, RawSize.Y, White,
DarkGray, False); { Draw 3d effect }
If (GOptions AND goThickFramed <> 0) Then Begin { Thick frame at work }
GraphRectangle(1, 1, RawSize.X-1, RawSize.Y-1,
LightGray); { Draw frame part 1 }
GraphRectangle(2, 2, RawSize.X-2, RawSize.Y-2,
LightGray); { Fraw frame part 2 }
BiColorRectangle(3, 3, RawSize.X-3, RawSize.Y-3,
White, DarkGray, True); { Draw highlights }
End;
{$ENDIF}
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--------------------------------------------------------------------}
{ SetViewLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetViewLimits;
VAR X1, Y1, X2, Y2: Integer; P: PGroup; ViewPort: ViewPortType; Ca: PComplexArea;
BEGIN
If (MaxAvail >= SizeOf(TComplexArea)) Then Begin { Check enough memory }
GetMem(Ca, SizeOf(TComplexArea)); { Allocate memory }
GetViewSettings(ViewPort); { Fetch view port }
Ca^.X1 := ViewPort.X1; { Hold current X1 }
Ca^.Y1 := ViewPort.Y1; { Hold current Y1 }
Ca^.X2 := ViewPort.X2; { Hold current X2 }
Ca^.Y2 := ViewPort.Y2; { Hold current Y2 }
Ca^.NextArea := HoldLimit; { Pointer to next }
HoldLimit := Ca; { Move down chain }
X1 := RawOrigin.X; { Xfer x raw origin }
Y1 := RawOrigin.Y; { Xfer y raw origin }
X2 := X1 + RawSize.X; { Calc right value }
Y2 := Y1 + RawSize.Y; { Calc lower value }
P := Owner; { Start on owner }
While (P <> Nil) Do Begin { While owner valid }
If (X1 < P^.RawOrigin.X) Then
X1 := P^.RawOrigin.X; { X minimum contain }
If (Y1 < P^.RawOrigin.Y) Then
Y1 := P^.RawOrigin.Y; { Y minimum contain }
If (X2 > P^.RawOrigin.X + P^.RawSize.X)
Then X2 := P^.RawOrigin.X + P^.RawSize.X; { X maximum contain }
If (Y2 > P^.RawOrigin.Y + P^.RawSize.Y)
Then Y2 := P^.RawOrigin.Y + P^.RawSize.Y; { Y maximum contain }
P := P^.Owner; { Move to owners owner }
End;
If (LimitsLocked <> Nil) Then Begin { Locked = area redraw }
If (X2 < ViewPort.X1) Then Exit; { View left of locked }
If (X1 > ViewPort.X2) Then Exit; { View right of locked }
If (Y2 < ViewPort.Y1) Then Exit; { View above locked }
If (Y1 > ViewPort.Y2) Then Exit; { View below locked }
If (X1 < ViewPort.X1) Then X1 := ViewPort.X1; { Adjust x1 to locked }
If (Y1 < ViewPort.Y1) Then Y1 := ViewPort.Y1; { Adjust y1 to locked }
If (X2 > ViewPort.X2) Then X2 := ViewPort.X2; { Adjust x2 to locked }
If (Y2 > ViewPort.Y2) Then Y2 := ViewPort.Y2; { Adjust y2 to locked }
End;
SetViewPort(X1, Y1, X2, Y2, ClipOn); { Set new clip limits }
End;
END;
{--TView--------------------------------------------------------------------}
{ DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 21Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawBackGround;
VAR Bc: Byte; X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
{$IFDEF OS_OS2} Ptl: PointL; {$ENDIF}
BEGIN
If (GOptions AND goNoDrawView = 0) Then Begin { Non draw views exit }
If (State AND sfDisabled = 0) Then
Bc := GetColor(1) AND $F0 SHR 4 Else { Select back colour }
Bc := GetColor(4) AND $F0 SHR 4; { Disabled back colour }
GetViewSettings(ViewPort); { Get view settings }
If (ViewPort.X1 <= RawOrigin.X) Then X1 := 0 { Right to left edge }
Else X1 := ViewPort.X1-RawOrigin.X; { Offset from left }
If (ViewPort.Y1 <= RawOrigin.Y) Then Y1 := 0 { Right to top edge }
Else Y1 := ViewPort.Y1-RawOrigin.Y; { Offset from top }
If (ViewPort.X2 >= RawOrigin.X+RawSize.X) Then
X2 := RawSize.X Else { Right to right edge }
X2 := ViewPort.X2-RawOrigin.X; { Offset from right }
If (ViewPort.Y2 >= RawOrigin.Y+RawSize.Y) Then
Y2 := RawSize.Y Else { Right to bottom edge }
Y2 := ViewPort.Y2-RawOrigin.Y; { Offset from bottom }
{$IFDEF OS_DOS} { DOS/DPMI CODE }
SetFillStyle(SolidFill, Bc); { Set fill colour }
Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (Dc <> 0) Then Begin { Valid device context }
SelectObject(Dc, ColBrush[Bc]); { Select brush }
SelectObject(Dc, ColPen[Bc]); { Select pen }
Rectangle(Dc, X1, Y1, X2+1, Y2+1); { Clear the view area }
End;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (Ps <> 0) Then Begin { Valid pres space }
GpiSetColor(Ps, ColRef[Bc]); { Select colour }
Ptl.X := X1; { X1 position }
Ptl.Y := RawSize.Y - Y1; { Y1 position }
GpiMove(PS, Ptl); { Move to position }
Ptl.X := X2; { X2 position }
Ptl.Y := RawSize.Y - Y2; { Y2 position }
GpiBox(Ps, dro_Fill, Ptl, 0, 0); { Clear the view area }
End;
{$ENDIF}
End;
END;
{--TView--------------------------------------------------------------------}
{ ReleaseViewLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.ReleaseViewLimits;
VAR P: PComplexArea;
BEGIN
P := HoldLimit; { Transfer pointer }
If (P <> Nil) Then Begin { Valid complex area }
HoldLimit := P^.NextArea; { Move to prior area }
SetViewPort(P^.X1, P^.Y1, P^.X2, P^.Y2, ClipOn); { Restore clip limits }
FreeMem(P, SizeOf(TComplexArea)); { Release memory }
End;
END;
{--TView--------------------------------------------------------------------}
{ MoveTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.MoveTo (X, Y: 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: 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--------------------------------------------------------------------}
{ SetDrawMask -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetDrawMask (Mask: Byte);
BEGIN
If (Options AND ofFramed = 0) AND { Check for no frame }
(GOptions AND goThickFramed = 0) AND { Check no thick frame }
(GOptions AND goTitled = 0) Then { Check for title }
Mask := Mask AND NOT vdBorder; { Clear border draw }
If (State AND sfCursorVis = 0) Then { Check for no cursor }
Mask := Mask AND NOT vdCursor; { Clear cursor draw }
If (GOptions AND goDrawFocus = 0) Then { Check no focus draw }
Mask := Mask AND NOT vdFocus; { Clear focus draws }
DrawMask := DrawMask OR Mask; { Set draw masks }
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: Integer);
BEGIN
Cursor.X := X; { New x position }
Cursor.Y := Y; { New y position }
If (State AND sfCursorVis <> 0) Then Begin { Cursor visible }
SetDrawMask(vdCursor); { Set draw mask }
DrawView; { Draw the cursor }
End;
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
If (Owner <> Nil) Then Owner^.ReDrawArea(
RawOrigin.X, RawOrigin.Y, RawOrigin.X +
RawSize.X, RawOrigin.Y + RawSize.Y); { Redraw old area }
Owner^.RemoveView(@Self); { Remove from list }
Owner^.InsertView(@Self, Target); { Insert into list }
State := State OR sfVisible; { Allow drawing again }
If (LastView <> Target) Then DrawView; { Draw the view now }
If (Options AND ofSelectable <> 0) Then { View is selectable }
If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset current }
End;
END;
{ ******************************* REMARK ****************************** }
{ The original TV origin data is only adjusted incase the user uses }
{ the values directly. New views should rely only on RawOrigin values. }
{ ****************************** END REMARK *** Leon de Boer, 15May98 * }
{--TView--------------------------------------------------------------------}
{ DisplaceBy -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.DisplaceBy (Dx, Dy: Integer);
BEGIN
RawOrigin.X := RawOrigin.X + Dx; { Displace raw x }
RawOrigin.Y := RawOrigin.Y + Dy; { Displace raw y }
Origin.X := RawOrigin.X DIV FontWidth; { Calc new x origin }
Origin.Y := RawOrigin.Y DIV FontHeight; { Calc new y origin }
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--------------------------------------------------------------------}
{ ReDrawArea -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.ReDrawArea (X1, Y1, X2, Y2: Integer);
VAR HLimit: PView; ViewPort: ViewPortType;
BEGIN
GetViewSettings(ViewPort); { Hold view port }
SetViewPort(X1, Y1, X2, Y2, ClipOn); { Set new clip limits }
HLimit := LimitsLocked; { Hold lock limits }
LimitsLocked := @Self; { We are the lock view }
DrawView; { Redraw the area }
LimitsLocked := HLimit; { Release our lock }
SetViewPort(ViewPort.X1, ViewPort.Y1,
ViewPort.X2, ViewPort.Y2, ClipOn); { Reset old limits }
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;
BEGIN
If Enable Then State := State OR AState { Set state mask }
Else State := State AND NOT AState; { Clear state mask }
If (AState AND sfVisible <> 0) Then Begin { Visibilty change }
If (Owner <> Nil) AND { valid owner }
(Owner^.State AND sfExposed <> 0) { If owner exposed }
Then SetState(sfExposed, Enable); { Expose this view }
{$IFDEF OS_DOS} { DOS/DPMI CODE }
If Enable Then DrawView Else { Draw the view }
If (Owner <> Nil) Then Owner^.ReDrawArea( { Owner valid }
RawOrigin.X, RawOrigin.Y, RawOrigin.X +
RawSize.X, RawOrigin.Y + RawSize.Y); { Owner redraws area }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (HWindow <> 0) Then Begin { Window handle valid }
If Enable Then ShowWindow(HWindow, sw_Show) { Show the window }
Else ShowWindow(HWindow, sw_Hide); { Hide the window }
End;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (HWindow <> 0) Then Begin { Window handle valid }
If Enable Then WinSetWindowPos(HWindow, 0, 0,
0, 0, 0, swp_Show) { Show the window }
Else WinSetWindowPos(HWindow, 0, 0, 0, 0, 0,
swp_Hide); { Hide the window }
End;
{$ENDIF}
If (Options AND ofSelectable <> 0) Then { View is selectable }
If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset selected }
End;
If (AState AND sfFocused <> 0) Then Begin { Focus change }
If (Owner <> Nil) Then Begin { Owner valid }
If Enable Then Command := cmReceivedFocus { View gaining focus }
Else Command := cmReleasedFocus; { View losing focus }
Message(Owner, evBroadcast, Command, @Self); { Send out message }
End;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (HWindow <> 0) Then { Window handle valid }
If Enable Then SetFocus(HWindow); { Focus the window }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (HWindow <> 0) Then { Window handle valid }
If Enable Then WinSetFocus(HWND_DESKTOP,
HWindow); { Focus the window }
{$ENDIF}
If (GOptions AND goDrawFocus <> 0) Then Begin { Draw focus view }
SetDrawMask(vdFocus); { Set focus draw mask }
DrawView; { Redraw focus change }
End;
End;
If (AState AND (sfCursorVis + sfCursorIns) <> 0) { Change cursor state }
Then Begin
SetDrawMask(vdCursor); { Set cursor draw mask }
DrawView; { Redraw the cursor }
End;
If (AState AND sfDisabled <> 0) Then Begin { Disbale change }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (HWindow <> 0) Then { Window handle valid }
If Enable Then EnableWindow(HWindow, False) { Disable the window }
Else EnableWindow(HWindow, True); { Enable the window }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (HWindow <> 0) Then { Window handle valid }
If Enable Then WinEnableWindow(HWindow,False) { Disable the window }
Else WinEnableWindow(HWindow, True); { Enable the window }
{$ENDIF}
End;
If (AState AND sfShadow <> 0) Then Begin End; { Change shadow state }
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 }
{---------------------------------------------------------------------------}
{ You can save data to the stream compatable with the old original TV by }
{ temporarily turning off the ofGFVModeView making the call to this store }
{ routine and resetting the ofGFVModeView flag after the call. }
{---------------------------------------------------------------------------}
PROCEDURE TView.Store (Var S: TStream);
VAR SaveState: Word;
BEGIN
SaveState := State; { Hold current state }
State := State AND NOT (sfActive OR sfSelected OR
sfFocused OR sfExposed); { Clear flags }
S.Write(Origin.X, 2); { Write view x origin }
S.Write(Origin.Y, 2); { Write view y origin }
S.Write(Size.X, 2); { Write view x size }
S.Write(Size.Y, 2); { Write view y size }
S.Write(Cursor.X, 2); { Write cursor x size }
S.Write(Cursor.Y, 2); { Write cursor y size }
S.Write(GrowMode, 1); { Write growmode flags }
S.Write(DragMode, 1); { Write dragmode flags }
S.Write(HelpCtx, 2); { Write help context }
S.Write(State, 2); { Write state masks }
S.Write(Options, 2); { Write options masks }
S.Write(Eventmask, 2); { Write event masks }
If (Options AND ofGFVModeView <> 0) Then Begin { GFV GRAPHICAL TVIEW }
S.Write(GOptions, 2); { Write new option masks }
S.Write(TabMask, 1); { Write new tab masks }
S.Write(RawOrigin.X, 2); { Write raw origin x point }
S.Write(RawOrigin.Y, 2); { Write raw origin y point }
S.Write(RawSize.X, 2); { Write raw x size }
S.Write(RawSize.Y, 2); { Write raw y size }
S.Write(ColourOfs, 2); { Write Palette offset }
End;
State := SaveState; { Reset state masks }
END;
{--TView--------------------------------------------------------------------}
{ Locate -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.Locate (Var Bounds: TRect);
VAR {$IFDEF OS_DOS} X1, Y1, X2, Y2: Integer; {$ENDIF}
Min, Max: TPoint; R: TRect;
FUNCTION Range(Val, Min, Max: Integer): 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
{$IFDEF OS_DOS} { DOS/DPMI CODE }
X1 := RawOrigin.X; { Current x origin }
Y1 := RawOrigin.Y; { Current y origin }
X2 := RawOrigin.X + RawSize.X; { Current x size }
Y2 := RawOrigin.Y + RawSize.Y; { Current y size }
{$ENDIF}
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 }
{$IFDEF OS_DOS} { DOS/DPMI CODE }
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) AND (Owner <> Nil) { Check view exposed }
Then Owner^.ReDrawArea(X1, Y1, X2, Y2); { Owner redraw }
DrawView; { Redraw the view }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (HWindow <> 0) Then Begin { Valid window handle }
If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner }
Then MoveWindow(HWindow, RawOrigin.X-Owner^.RawOrigin.X,
RawOrigin.Y-Owner^.RawOrigin.Y, RawSize.X+1,
RawSize.Y+1, True) Else { Move window in owner }
MoveWindow(HWindow, RawOrigin.X, RawOrigin.Y,
RawSize.X+1, RawSize.Y+1, True); { Move window raw }
End;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (HWindow <> 0) Then Begin { Valid window handle }
If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner }
Then WinSetWindowPos(HWindow, 0,
RawOrigin.X - Owner^.RawOrigin.X,
(Owner^.RawOrigin.Y + Owner^.RawSize.Y) -
(RawOrigin.Y + RawSize.Y), RawSize.X,
RawSize.Y, swp_Size OR swp_Move) Else { Move window in owner }
WinSetWindowPos(HWindow, 0, RawOrigin.X,
SysScreenHeight - (RawOrigin.Y + RawSize.Y),
RawSize.X, RawSize.Y, swp_Size OR swp_Move); { Move window raw }
End;
{$ENDIF}
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 }
If (Owner <> Nil) Then
Bounds.Move(-Owner^.Origin.X, -Owner^.Origin.Y); { Sub owner offset }
END;
{--TView--------------------------------------------------------------------}
{ SetBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetBounds (Var Bounds: TRect);
VAR D, COrigin: TPoint;
BEGIN
If (Bounds.B.X > 0) AND (Bounds.B.Y > 0) { Normal text co-ords }
AND (GOptions AND goGraphView = 0) Then Begin { Normal text view }
If (Owner <> Nil) Then Begin { Owner is valid }
COrigin.X := Origin.X - Owner^.Origin.X; { Corrected x origin }
COrigin.Y := Origin.Y - Owner^.Origin.Y; { Corrected y origin }
D.X := Bounds.A.X - COrigin.X; { X origin disp }
D.Y := Bounds.A.Y - COrigin.Y; { Y origin disp }
If ((D.X <> 0) OR (D.Y <> 0)) Then
DisplaceBy(D.X*FontWidth, D.Y*FontHeight); { Offset the view }
End Else Origin := Bounds.A; { Hold as origin }
Size.X := Bounds.B.X-Bounds.A.X; { Hold view x size }
Size.Y := Bounds.B.Y-Bounds.A.Y; { Hold view y size }
RawOrigin.X := Origin.X * FontWidth; { Raw x origin }
RawOrigin.Y := Origin.Y * FontHeight; { Raw y origin }
RawSize.X := Size.X * FontWidth - 1; { Set raw x size }
RawSize.Y := Size.Y * FontHeight - 1; { Set raw y size }
End Else Begin { Graphical co-ords }
If (Owner <> Nil) Then Begin { Owner is valid }
COrigin.X := RawOrigin.X - Owner^.RawOrigin.X; { Corrected x origin }
COrigin.Y := RawOrigin.Y - Owner^.RawOrigin.Y; { Corrected y origin }
D.X := Bounds.A.X - COrigin.X; { X origin disp }
D.Y := Bounds.A.Y - COrigin.Y; { Y origin disp }
If ((D.X <> 0) OR (D.Y <> 0)) Then
DisplaceBy(D.X, D.Y); { Offset the view }
End Else RawOrigin := Bounds.A; { Hold as origin }
RawSize.X := Abs(Bounds.B.X) - Bounds.A.X; { Set raw x size }
RawSize.Y := Abs(Bounds.B.Y) - Bounds.A.Y; { Set raw y size }
Origin.X := RawOrigin.X DIV FontWidth; { Rough x position }
Origin.Y := RawOrigin.Y DIV FontHeight; { Rough y position }
Size.X := RawSize.X DIV FontWidth; { Rough x size }
Size.Y := RawSize.Y DIV FontHeight; { Rough y size }
End;
Options := Options OR ofGFVModeView; { Now in GFV mode }
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 }
If (Event.What = evKeyDown) AND { Key down event }
(Options OR ofGFVModeView <> 0) Then Begin { GFV mode view check }
If (Owner <> Nil) AND (TabMask <> 0) AND { Owner and tab masks }
(State AND sfFocused <> 0) Then Begin { View has focus }
Case Event.KeyCode Of
kbTab: If (TabMask AND tmTab <> 0) Then { Tab key mask set }
Owner^.FocusNext(False) Else Exit; { Focus next view }
kbEnter: If (TabMask AND tmEnter <> 0) Then { Enter key mask set }
Owner^.FocusNext(False) Else Exit; { Focus next view }
kbShiftTab: If (TabMask AND tmShiftTab <> 0) { Shit tab mask set }
Then Owner^.FocusNext(True) Else Exit; { Focus prior view }
kbLeft: If (TabMask AND tmLeft <> 0) Then { Left arrow mask set }
Owner^.FocusNext(True) Else Exit; { Focus prior view }
kbRight: If (TabMask AND tmRight <> 0) Then { Right arrow mask set }
Owner^.FocusNext(False) Else Exit; { Focus next view }
kbUp: If (TabMask AND tmUp <> 0) Then { Up arrow mask set }
Owner^.FocusNext(True) Else Exit; { Focus prior view }
kbDown: If (TabMask AND tmDown <> 0) Then { Down arrow mask set }
Owner^.FocusNext(False) Else Exit; { Focus next view }
Else Exit; { Not a tab key }
End;
ClearEvent(Event); { Clear handled events }
End;
End;
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) Then Begin
Max.X := $7FFF; { Max possible x size }
Max.Y := $7FFF; { Max possible y size }
End Else Max := Owner^.Size; { Max owner size }
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, 2); { 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, 2); { Write the index }
END;
{--TView--------------------------------------------------------------------}
{ CalcBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.CalcBounds (Var Bounds: TRect; Delta: TPoint);
VAR S, D: Integer; Min, Max: TPoint;
FUNCTION Range (Val, Min, Max: Integer): 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 Grow (Var I: Integer);
BEGIN
If (GrowMode AND gfGrowRel = 0) Then Inc(I, D)
Else I := (I * S + (S - D) SHR 1) DIV (S - D); { 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
Grow(Bounds.A.X); { Grow left side }
If (GrowMode AND gfGrowHiX <> 0) Then
Grow(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
Grow(Bounds.A.Y); { Grow top side }
If (GrowMode AND gfGrowHiY <> 0) Then
Grow(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;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TView OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
{--TView--------------------------------------------------------------------}
{ GetClassId -> Platforms WIN/NT/OS2 - Updated 29Jul99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TView.GetClassId: LongInt;
BEGIN
GetClassId := 0; { No view class id }
END;
{--TView--------------------------------------------------------------------}
{ GetClassName -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TView.GetClassName: String;
BEGIN
GetClassName := TvViewClassName; { View class name }
END;
{--TView--------------------------------------------------------------------}
{ GetClassText -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TView.GetClassText: String;
BEGIN
GetClassText := ''; { Return empty string }
END;
{--TView--------------------------------------------------------------------}
{ GetClassAttr -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TView.GetClassAttr: LongInt;
VAR Li: LongInt;
BEGIN
If (State AND sfVisible = 0) Then Li := 0 { View not visible }
Else Li := ws_Visible; { View is visible }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (State AND sfDisabled <> 0) Then { Check disabled flag }
Li := Li OR ws_Disabled; { Set disabled flag }
If (GOptions AND goTitled <> 0) Then Begin
Li := Li OR ws_Caption; { View has a caption }
CaptSize := GetSystemMetrics(SM_CYCaption); { Caption height }
End;
If (GOptions AND goThickFramed <> 0) Then Begin
Li := Li OR ws_ThickFrame; { Thick frame on view }
FrameSize := GetSystemMetrics(SM_CXFrame); { Frame width }
If (GOptions AND goTitled = 0) Then
CaptSize := GetSystemMetrics(SM_CYFrame); { Frame height }
End Else If (Options AND ofFramed <> 0) Then Begin
Li := Li OR ws_Border; { Normal frame on view }
FrameSize := GetSystemMetrics(SM_CXBorder); { Frame width }
If (GOPtions AND goTitled = 0) Then
CaptSize := GetSystemMetrics(SM_CYBorder); { Frame height }
End;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
Li := Li OR fcf_NoByteAlign; { Not byte aligned }
If (GOptions AND goTitled <> 0) Then Begin
Li := Li OR fcf_TitleBar; { View has a caption }
CaptSize := WinQuerySysValue(HWND_Desktop,
SV_CYTitleBar); { Caption height }
End;
If (GOptions AND goThickFramed <> 0) Then Begin
Li := Li OR fcf_DlgBorder; { Thick frame on view }
FrameSize := WinQuerySysValue(HWND_DeskTop,
SV_CXSizeBorder); { Frame width }
CaptSize := CaptSize + WinQuerySysValue(
HWND_DeskTop, SV_CYSizeBorder); { Frame height }
End Else If (Options AND ofFramed <> 0) Then Begin
Li := Li OR fcf_Border; { Normal frame on view }
FrameSize := WinQuerySysValue(HWND_Desktop,
SV_CXBorder); { Frame width }
CaptSize := CaptSize + WinQuerySysValue(
HWND_DeskTop, SV_CYBorder); { Frame height }
End;
{$ENDIF}
Li := Li OR ws_ClipChildren OR ws_ClipSiblings; { By default clip others }
GetClassAttr := Li; { Return attributes }
END;
{--TView--------------------------------------------------------------------}
{ GetNotifyCmd -> Platforms WIN/NT/OS2 - Updated 06Aug99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TView.GetNotifyCmd: LongInt;
BEGIN
GetNotifyCmd := -1; { No notify cmd }
END;
{--TView--------------------------------------------------------------------}
{ GetMsgHandler -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TView.GetMsgHandler: Pointer;
BEGIN
GetMsgHandler := @TvViewMsgHandler; { Default msg handler }
END;
{$ENDIF}
{***************************************************************************}
{ 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 }
GOptions := GOptions OR goNoDrawView; { Non drawing view }
GetExtent(Clip); { Get clip extents }
EventMask := $FFFF; { See all events }
GOptions := GOptions OR goTabSelect; { Set graphic options }
END;
{--TGroup-------------------------------------------------------------------}
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
{---------------------------------------------------------------------------}
CONSTRUCTOR TGroup.Load (Var S: TStream);
VAR I, 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, 2); { 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: 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; ASSEMBLER;
{&USES EBX, ECX, ESI, EDI} {&FRAME-}
{$IFDEF BIT_16} VAR HoldLast: Pointer; {$ENDIF}
{$IFDEF BIT_16} { 16 BIT CODE }
ASM
LES DI, Self; { Load self pointer }
LES DI, ES:[DI].TGroup.Last; { Fetch last view }
MOV AX, ES;
OR AX, DI; { Check for nil }
JZ @@Exit; { No subviews exit }
MOV WORD PTR HoldLast[2], ES;
MOV WORD PTR HoldLast[0], DI; { Hold this last view }
@@LoopPoint:
LES DI, ES:[DI].TView.Next; { Move to next view }
PUSH ES; { * Save this view for }
PUSH DI; { post call to proc P * }
PUSH ES;
PUSH DI; { Push view for proc P }
MOV AX, [BP]; { Get our frame }
{$IFNDEF OS_DOS} { WIN/OS2 CODE }
AND AL, 0FEH; { Must be even }
{$ENDIF}
PUSH AX; { Push this frame }
CALL P; { Call the procedure P }
POP DI; { * Restore the view }
POP ES; { we saved above * }
OR AL, AL; { Look for true result }
JNZ @@TrueReturned; { Branch if true }
CMP DI, WORD PTR HoldLast[0]; { HoldLast ofs match? }
JNZ @@LoopPoint; { No match the continue }
MOV AX, ES;
CMP AX, WORD PTR HoldLast[2]; { HoldLast seg match? }
JNZ @@LoopPoint; { No match continue }
XOR DI, DI;
MOV ES, DI; { No matches return nil }
@@TrueReturned:
MOV SP, BP; { Restore stack pointer }
@@Exit:
MOV AX, DI;
MOV DX, ES; { Return result pointer }
END;
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT CODE }
{$IFNDEF PPC_FPC} { NONE FPC COMPILERS }
ASM
MOV EAX, Self; { Fetch self pointer }
MOV EAX, [EAX].TGroup.Last; { Fetch last view }
OR EAX, EAX; { Check for nil }
JZ @@Exit; { No subviews exit }
MOV ECX, EAX; { Hold this last view }
MOV EBX, P; { Procedure to call }
@@LoopPoint:
MOV EAX, [EAX].TView.Next; { Fetch next view }
PUSH ECX; { Save holdlast view }
PUSH EBX; { Save procedure address }
PUSH EAX; { Save for recovery }
PUSH EAX; { [1]:Pointer = PView }
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL 2.0+ }
DB $66;
DB $FF;
DB $D1; { Doesn't know CALL ECX }
{$ELSE}
CALL EBX; { Call the test function }
{$ENDIF}
TEST AL, AL; { True result check }
POP EAX; { PView recovered }
POP EBX; { Restore procedure addr }
POP ECX; { Restore holdlast view }
JNZ @@Exit; { Exit if true }
CMP EAX, ECX; { Check if last view }
JNZ @@LoopPoint; { Reloop if not last }
XOR EAX, EAX; { No matches return nil }
@@Exit:
END;
{$ELSE} { FPC COMPILER }
ASM
MOVL 8(%EBP), %ESI; { Self pointer }
MOVL TGroup.Last(%ESI), %EAX; { Load last view }
ORL %EAX, %EAX; { Check for nil }
JZ .L_Exit; { No subviews exit }
MOVL %EAX, %ECX; { Hold last view }
MOVL P, %EBX; { Procedure to call }
.L_LoopPoint:
MOVL TView.Next(%EAX), %EAX; { Fetch next pointer }
PUSHL %ECX; { Save holdlast view }
PUSHL %EBX; { Save procedure address }
PUSHL %EAX; { Save for recovery }
PUSHL %EAX; { PView pushed }
MOVL (%EBP), %EAX; { Fetch self ptr }
PUSH %EAX; { Push self ptr }
CALL %EBX; { Call the procedure }
ORB %AL, %AL; { Test for true }
POPL %EAX; { Recover next PView }
POPL %EBX; { Restore procedure addr }
POPL %ECX; { Restore holdlast view }
JNZ .L_Exit; { Call returned true }
CMPL %ECX, %EAX; { Check if last view }
JNZ .L_LoopPoint; { Continue to last }
XOR %EAX, %EAX; { No views gave true }
.L_Exit:
MOVL %EAX, -4(%EBP); { Return result }
END;
{$ENDIF}
{$ENDIF}
{--TGroup-------------------------------------------------------------------}
{ Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
FUNCTION TGroup.Valid (Command: Word): Boolean;
FUNCTION IsInvalid (P: PView): Boolean; FAR;
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;
{--TGroup-------------------------------------------------------------------}
{ Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TGroup.Draw;
VAR P: PView;
BEGIN
If (DrawMask AND vdNoChild = 0) Then Begin { No draw child clear }
P := Last; { Start on Last }
While (P <> Nil) Do Begin
P^.DrawView; { Redraw each subview }
P := P^.PrevView; { Move to prior view }
End;
End;
END;
{--TGroup-------------------------------------------------------------------}
{ Awaken -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TGroup.Awaken;
PROCEDURE DoAwaken (P: PView); FAR;
BEGIN
If (P <> Nil) Then P^.Awaken; { Awaken view }
END;
BEGIN
ForEach(@DoAwaken); { Awaken each view }
END;
{--TGroup-------------------------------------------------------------------}
{ ReDraw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TGroup.ReDraw;
BEGIN
DrawView; { For compatability }
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;
{--TGroup-------------------------------------------------------------------}
{ Insert -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TGroup.Insert (P: PView);
BEGIN
If (P <> Nil) Then { View is valid }
If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
P^.DisplaceBy(RawOrigin.X, RawOrigin.Y) Else { We are in GFV mode }
P^.DisplaceBy(Origin.X*FontWidth,
Origin.Y*FontHeight); { Displace old view }
InsertBefore(P, First); { Insert the view }
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
If (HWindow <> 0) Then { We are created }
If (P^.HWindow = 0) Then { Child not created }
P^.CreateWindowNow(0); { Create child window }
{$ENDIF}
END;
{--TGroup-------------------------------------------------------------------}
{ Delete -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TGroup.Delete (P: PView);
VAR SaveState: Word;
BEGIN
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; { Show view }
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); ASSEMBLER;
{&USES EBX, ECX, EDI} {&FRAME-}
VAR HoldLast: Pointer;
{$IFDEF BIT_16} { 16 BIT CODE }
ASM
LES DI, Self; { Load self pointer }
LES DI, ES:[DI].TGroup.Last; { Fetch last view }
MOV AX, ES;
OR AX, DI; { Check for nil }
JZ @@Exit; { No subviews exit }
MOV WORD PTR HoldLast[2], ES;
MOV WORD PTR HoldLast[0], DI; { Hold this last view }
LES DI, ES:[DI].TView.Next; { Move to next view }
@@LoopPoint:
CMP DI, WORD PTR HoldLast[0]; { HoldLast ofs match? }
JNZ @@2; { No match continue }
MOV AX, ES;
CMP AX, WORD PTR HoldLast[2]; { HoldLast seg match? }
JZ @@3; { Branch if last }
@@2:
PUSH WORD PTR ES:[DI].TView.Next[2]; { * Save this view }
PUSH WORD PTR ES:[DI].TView.Next[0]; { for recovery later * }
PUSH ES;
PUSH DI; { Push view to test }
MOV AX, [BP]; { Get our frame }
{$IFNDEF OS_DOS} { WIN/OS2 CODE }
AND AL, 0FEH; { Must be even }
{$ENDIF}
PUSH AX; { Push our frame }
CALL P; { Call the proc P }
POP DI; { * Recover the view }
POP ES; { we saved earlier * }
JMP @@LoopPoint; { Continue on }
@@3:
MOV AX, [BP]; { Get our frame }
{$IFNDEF OS_DOS} { WIN/OS2 CODE }
AND AL, 0FEH; { Must be even }
{$ENDIF}
PUSH AX; { Push our frame }
CALL P; { Call the proc P }
@@Exit:
END;
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT CODE }
{$IFNDEF PPC_FPC} { NON FPC COMPILERS }
ASM
MOV ECX, Self; { Load self pointer }
MOV ECX, [ECX].TGroup.Last; { Fetch last view }
OR ECX, ECX; { Check for nil }
JZ @@Exit; { No subviews exit }
MOV HoldLast, ECX; { Hold last view }
MOV ECX, [ECX].TView.Next; { Fetch next pointer }
MOV EBX, P; { Fetch proc address }
@@LoopPoint:
CMP ECX, HoldLast; { Check if last view }
JZ @@2; { Branch if last view }
MOV EAX, [ECX].TView.Next; { Fetch next view }
PUSH EBX; { Save procedure address }
PUSH EAX; { Save next view }
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
MOV EAX, ECX; { Use register parameter }
MOV ESI, ECX;
{$ELSE} { OTHER COMPILERS }
PUSH ECX; { Push view to do }
{$ENDIF}
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL 2.0+ }
DB $66;
DB $FF;
DB $D3; { Can't do CALL EBX }
{$ELSE}
CALL EBX; { Call the proc P }
{$ENDIF}
POP ECX; { Recover saved view }
POP EBX; { Recover procedure addr }
JMP @@LoopPoint; { Continue on }
@@2:
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILERS }
MOV EAX, ECX; { Use register parameter }
{$ELSE} { OTHER COMPILERS }
PUSH ECX; { Push view to do }
{$ENDIF}
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL 2.0+ }
DB $66;
DB $FF;
DB $D3; { Can't do CALL EBX }
{$ELSE}
CALL EBX; { Call the proc P }
{$ENDIF}
@@Exit:
END;
{$ELSE} { FPC COMPILER }
ASM
MOVL 8(%EBP), %ESI; { Self pointer }
MOVL TGroup.Last(%ESI), %ECX; { Load last view }
ORL %ECX, %ECX; { Check for nil }
JZ .L_Exit; { No subviews exit }
MOVL %ECX, HOLDLAST; { Hold last view }
MOVL TView.Next(%ECX), %ECX; { Fetch next pointer }
.L_LoopPoint:
MOVL P, %EBX; { Fetch proc address }
CMPL HOLDLAST, %ECX; { Check if last view }
JZ .L_2; { Exit if last view }
MOVL TView.Next(%ECX), %EAX; { Fetch next pointer }
PUSHL %EAX; { Save next view ptr }
PUSHL %ECX; { Push view to do }
MOVL (%EBP), %EAX;
PUSH %EAX;
CALL %EBX; { Call the procedure }
POPL %ECX; { Recover next view }
JMP .L_LoopPoint; { Redo loop }
.L_2:
PUSHL %ECX; { Push view to do }
MOVL (%EBP), %EAX;
PUSH %EAX;
CALL %EBX; { Call the procedure }
.L_Exit:
END;
{$ENDIF}
{$ENDIF}
{--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-------------------------------------------------------------------}
{ DisplaceBy -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TGroup.DisplaceBy (Dx, Dy: Integer);
VAR P: PView;
BEGIN
P := First; { Get first view }
While (P <> Nil) Do Begin
P^.DisplaceBy(Dx, Dy); { Displace subviews }
P := P^.NextView; { Next view }
End;
Inherited DisplaceBy(Dx, Dy); { 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, I: 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 Begin { Centre on x axis }
If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
I := RawSize.X Else I := Size.X * FontWidth; { Calc owner x size }
If (P^.Options AND ofGFVModeView <> 0) { GFV mode view check }
Then Begin
I := (I - P^.RawSize.X) DIV 2; { Calc view offset }
I := I - P^.RawOrigin.X; { Subtract x origin }
End Else Begin
I := (I - (P^.Size.X * FontWidth)) DIV 2; { Calc view offset }
I := I - (P^.Origin.X * FontWidth); { Subtract x origin }
End;
P^.DisplaceBy(I, 0); { Displace the view }
End;
If (P^.Options AND ofCenterY <> 0) Then Begin { Centre on y axis }
If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
I := RawSize.Y Else I := Size.Y * FontHeight;{ Calc owner y size }
If (P^.Options AND ofGFVModeView <> 0) { GFV mode view check }
Then Begin
I := (I - P^.RawSize.Y) DIV 2; { Calc view offset }
I := I - P^.RawOrigin.Y; { Subtract y origin }
End Else Begin
I := (I - (P^.Size.Y * FontHeight)) DIV 2; { Calc view offset }
I := I - (P^.Origin.Y * FontHeight); { Subtract y origin }
End;
P^.DisplaceBy(0, I); { Displace the view }
End;
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); FAR;
BEGIN
If (P <> Nil) Then P^.SetState(AState, Enable); { Set subview state }
END;
PROCEDURE DoExpose (P: PView); FAR;
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: If (Current <> Nil) Then
Current^.SetState(sfFocused, Enable); { Focus current view }
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: 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: 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: Integer; OwnerSave: PGroup;
PROCEDURE DoPut (P: PView); FAR;
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, 2); { 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; FAR;
BEGIN
ContainsMouse := (P^.State AND sfVisible <> 0) { Is view visible }
AND P^.MouseInView(Event.Where); { Is point in view }
END;
PROCEDURE DoHandleEvent (P: PView); FAR;
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); FAR;
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 }
DrawView; { 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: Word; Q: PView;
BEGIN
Index := 0; { Zero index value }
S.Read(Index, 2); { 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: Word;
BEGIN
If (P = Nil) Then Index := 0 Else { Nil view, Index = 0 }
Index := IndexOf(P); { Calc view index }
S.Write(Index, 2); { Write the index }
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TGroup OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
{--TGroup-------------------------------------------------------------------}
{ CreateWindowNow -> Platforms WIN/NT/OS2 - Updated 23Mar98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TGroup.CreateWindowNow (CmdShow: Integer);
VAR P: PView;
BEGIN
Inherited CreateWindowNow (CmdShow); { Call ancestor }
P := Last; { Start on Last }
While (P <> Nil) Do Begin
If (P^.HWindow = 0) Then { No window created }
P^.CreateWindowNow(0); { Create each subview }
P := P^.PrevView; { Move to prev view }
End;
END;
{$ENDIF}
{***************************************************************************}
{ TGroup OBJECT PRIVATE METHODS }
{***************************************************************************}
{--TGroup-------------------------------------------------------------------}
{ IndexOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
FUNCTION TGroup.IndexOf (P: PView): Integer;
VAR I: 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) AND { Selectable }
(P^.GOptions AND goTabSelect <> 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; FAR;
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;
{--TFrame-------------------------------------------------------------------}
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TFrame.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CFrame; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CFrame)] = CFrame; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ TScrollBar OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{---------------------------------------------------------------------------}
{ TScrollBar WINDOW CLASS NAME CONSTANT }
{---------------------------------------------------------------------------}
{$IFDEF OS_WINDOWS} { WIN/NT CLASSNAME }
CONST TvScrollBarName = 'SCROLLBAR'; { Native classname }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CLASSNAME }
CONST TvScrollBarName = '#8'; { Native classname }
{$ENDIF}
{--TScrollBar---------------------------------------------------------------}
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
{---------------------------------------------------------------------------}
CONSTRUCTOR TScrollBar.Init (Var Bounds: TRect);
CONST VChars: TScrollChars = (#30, #31, #177, #254, #178);
HChars: TScrollChars = (#17, #16, #177, #254, #178);
BEGIN
Inherited Init(Bounds); { Call ancestor }
{$IFDEF OS_OS2} { OS2 CODE }
If (Size.X = 1) Then RawSize.X := WinQuerySysValue(
HWND_Desktop, SV_CXVScroll) Else
RawSize.Y := WinQuerySysValue(HWND_Desktop,
SV_CYHScroll); { Set approp size }
{$ENDIF}
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; { Vertical chars }
End Else Begin { Horizontal scrollbar }
GrowMode := gfGrowLoY + gfGrowHiX + gfGrowHiY; { Grow horizontal }
Chars := HChars; { 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);
BEGIN
Inherited Load(S); { Call ancestor }
S.Read(Value, 2); { Read current value }
S.Read(Min , 2); { Read min value }
S.Read(Max, 2); { Read max value }
S.Read(PgStep, 2); { Read page step size }
S.Read(ArStep, 2); { Read arrow step size }
S.Read(Chars, SizeOf(Chars)); { Read scroll chars }
If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
S.Read(Id, 2); { Read id }
END;
{--TScrollBar---------------------------------------------------------------}
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TScrollBar.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CScrollBar; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CScrollBar)] = CScrollBar; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
{--TScrollBar---------------------------------------------------------------}
{ ScrollStep -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TScrollBar.ScrollStep (Part: Integer): Integer;
VAR Step: 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---------------------------------------------------------------}
{ Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TScrollBar.Draw;
BEGIN
If (GOptions AND goNativeClass = 0) Then
DrawPos(GetPos); { Draw position }
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---------------------------------------------------------------}
{ DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TScrollBar.DrawBackGround;
VAR Bc: Byte;
BEGIN
If (GOptions AND goNativeClass = 0) Then Begin { Non natives draw }
Inherited DrawBackGround; { Call ancestor }
Bc := GetColor(1) AND $F0 SHR 4; { Background colour }
ClearArea(0, 0, FontWidth-1, FontHeight-1, Bc); { Clear top/left area }
BiColorRectangle(0, 0, FontWidth-1, FontHeight-1,
15, 0, False); { Draw 3d effect }
ClearArea(RawSize.X-FontWidth+1, RawSize.Y-
FontHeight+1, RawSize.X, RawSize.Y, Bc); { Clr right/lower area }
BiColorRectangle(RawSize.X-FontWidth+1,
RawSize.Y-FontHeight+1,RawSize.X, RawSize.Y,
15, 0, False); { Draw 3d effect }
End;
END;
{--TScrollBar---------------------------------------------------------------}
{ SetValue -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TScrollBar.SetValue (AValue: 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: 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: 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: 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 }
If (Value <> AValue) OR (Min <> AMin) OR
(Max <> AMax) Then Begin { Something changed }
If (Min <> AMin) OR (Max <> AMax) Then Begin { Range has changed }
If (GOptions AND goNativeClass = 0) Then
ClearPos(GetPos); { Clear old position }
Min := AMin; { Set new minimum }
Max := AMax; { Set new maximum }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (GOptions AND goNativeClass <> 0) AND { In native class mode }
(HWindow <> 0) Then
SetScrollRange(HWindow, sb_Ctl, Min, Max, { Set range }
AValue = Value); { Value=AValue redraws }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (GOptions AND goNativeClass <> 0) AND { In native class mode }
(HWindow <> 0) AND ((Min <> 0) OR (Max <> 0))
Then Begin { Valid window }
WinSendMsg(HWindow, sbm_SetScrollBar, Value,
(LongInt(Max-1) SHL 16) OR Min); { Post the message }
End;
{$ENDIF}
{ This was removed as found not needed but if you
change limits but value unchanged scrollbar is not redrawm..LdB }
{If (Value = AValue) AND (State and sfVisible <> 0)
Then ScrollDraw;} { Send message out }
End Else Begin
If (GOptions AND goNativeClass = 0) Then { Not in native mode }
ClearPos(GetPos); { Clear old position }
End;
If (Value <> AValue) Then Begin { Position moved }
Value := AValue; { Set new value }
If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
SetDrawMask(vdInner); { Set draw masks }
DrawView; { Redraw changed }
End;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (GOptions AND goNativeClass <> 0) AND { In native class mode }
(HWindow <> 0) Then { Valid handle }
SetScrollPos(HWindow, sb_Ctl, Value, True); { Set scrollbar pos }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (GOptions AND goNativeClass <> 0) AND { In native class mode }
(HWindow <> 0) Then Begin { Valid window }
WinSendMsg(HWindow, sbm_SetPos, Value, 0); { Dispatch the message }
End;
{$ENDIF}
If (State AND sfVisible <> 0) Then ScrollDraw; { Send update message }
End;
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);
BEGIN
TView.Store(S); { TView.Store called }
S.Write(Value, 2); { Write current value }
S.Write(Min, 2); { Write min value }
S.Write(Max, 2); { Write max value }
S.Write(PgStep, 2); { Write page step size }
S.Write(ArStep, 2); { Write arrow step size }
S.Write(Chars, SizeOf(Chars)); { Write scroll chars }
If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
S.Write(Id, 2); { Write scrollbar id }
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: Integer;
Mouse: TPoint; Extent: TRect;
FUNCTION GetPartCode: Integer;
VAR Mark, Part, J: 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 - FontHeight; { Calc position }
J := FontHeight; { Font height }
End Else Begin { Horizontal bar }
Mark := Mouse.X - FontWidth; { Calc position }
J := FontWidth; { Font width }
End;
If (Mark >= P) AND (Mark < P+J) 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 - RawOrigin.X; { Localize x value }
Mouse.Y := Event.Where.Y - RawOrigin.Y; { Localize y value }
Extent.A.X := 0; { Zero x extent value }
Extent.A.Y := 0; { Zero y extent value }
Extent.B.X := RawSize.X; { Set extent x value }
Extent.B.Y := RawSize.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-RawOrigin.X; { Localize x value }
Mouse.Y := Event.Where.Y-RawOrigin.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 - RawOrigin.X; { Localize x value }
Mouse.Y := Event.Where.Y - RawOrigin.Y; { Localize y value }
Tracking := Extent.Contains(Mouse); { Check contains }
If Tracking Then Begin { Tracking mouse }
If (Size.X=1) Then
I := Mouse.Y-FontHeight Else { Calc vert position }
I := Mouse.X-FontWidth; { 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;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TScrollBar OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
{--TScrollBar---------------------------------------------------------------}
{ GetClassName -> Platforms WIN/NT/OS2 - Updated 21May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TScrollBar.GetClassName: String;
BEGIN
If UseNativeClasses Then Begin
GetClassName := TvScrollBarName; { Windows class name }
GOptions := GOptions OR goNativeClass; { Native class window }
End Else GetClassName := Inherited GetClassName; { Use standard class }
END;
{--TScrollBar---------------------------------------------------------------}
{ GetClassAttr -> Platforms WIN/NT/OS2 - Updated 20May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TScrollBar.GetClassAttr: LongInt;
VAR Li: LongInt;
BEGIN
Li := Inherited GetClassAttr; { Call ancestor }
If UseNativeClasses Then Begin
If (Size.Y = 1) Then
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
Li := Li OR sbs_Horz OR sbs_TopAlign Else { Horizontal scrollbar }
Li := Li OR sbs_Vert OR sbs_LeftAlign; { Vertical scollbar }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
lStyle :=lStyle OR sbs_Horz OR sbs_AutoSize { Horizontal scrollbar }
Else lStyle := lStyle OR sbs_Vert OR
sbs_AutoSize; { Vertical scollbar }
{$ENDIF}
End;
GetClassAttr := Li; { Return attributes }
END;
{--TScrollBar---------------------------------------------------------------}
{ CreateWindowNow -> Platforms WIN/NT/OS2 - Updated 22May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TScrollBar.CreateWindowNow (CmdShow: Integer);
{$IFDEF OS_OS2} VAR Mp1, Mp2: MParam; {$ENDIF}
BEGIN
Inherited CreateWindowNow(0); { Call inherited }
If (GOptions AND goNativeClass <> 0) AND { In native class mode }
(HWindow <> 0) AND ((Min <> 0) OR (Max <> 0))
Then Begin { Scrollbar created }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
SetScrollRange(HWindow, sb_Ctl, Min,Max, True); { Set scrollbar range }
SetScrollPos(HWindow, sb_Ctl, Value, True); { Set scrollbar pos }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
WinSendMsg(HWindow, sbm_SetScrollBar, Value,
(LongInt(Max-1) SHL 16) OR Min); { Post the message }
{$ENDIF}
End;
END;
{$ENDIF}
{***************************************************************************}
{ TScrollBar OBJECT PRIVATE METHODS }
{***************************************************************************}
{--TScrollBar---------------------------------------------------------------}
{ GetPos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TScrollBar.GetPos: Integer;
VAR R: Integer;
BEGIN
R := Max - Min; { Get full range }
If (R = 0) Then GetPos := 0 Else { Return zero }
GetPos := LongInt((LongInt(Value-Min) * GetSize)
+ (R SHR 1)) DIV R; { Calc position }
END;
{--TScrollBar---------------------------------------------------------------}
{ GetSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TScrollBar.GetSize: Integer;
VAR S: Integer;
BEGIN
If (Size.X = 1) Then S := RawSize.Y-3*FontHeight+1 { Vertical bar }
Else S := RawSize.X-3*FontWidth+1; { Horizontal bar }
If (S < 1) Then S := 1; { Fix minimum size }
GetSize := S; { Return size }
END;
{--TScrollBar---------------------------------------------------------------}
{ DrawPos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27OctMay99 LdB }
{---------------------------------------------------------------------------}
{ This could be called from a message handling event so it must check the }
{ view is visible, exposed and not obstructed before drawing the thumbnail }
{ square area. }
{---------------------------------------------------------------------------}
PROCEDURE TScrollBar.DrawPos (Pos: Integer);
VAR X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) AND { View is exposed }
(Max <> Min) Then Begin { View has some size }
SetViewLimits; { Set view limits }
GetViewSettings(ViewPort); { Get set viewport }
If OverlapsArea(ViewPort.X1, ViewPort.Y1,
ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
{$IFDEF OS_DOS}
HideMouseCursor; { Hide the mouse }
{$ENDIF}
X1 := 0; { Initial x position }
Y1 := 0; { Initial y position }
If (Size.X=1) Then Y1 := Pos + FontHeight { Vertical bar }
Else X1 := Pos + FontWidth; { Horizontal bar }
X2 := X1 + FontWidth - 1; { Right side point }
Y2 := Y1 + FontHeight - 1; { Lower side point }
ClearArea(X1, Y1, X2, Y2, GetColor(2) AND $0F);{ Thumbnail back }
BiColorRectangle(X1, Y1, X2, Y2, 15, 8, False);{ Draw highlight }
Y1 := (Y2 + Y1) DIV 2; { Middle of thumb }
Y2 := Y1+1; { One line down }
Inc(X1, 1); { One in off left }
Dec(X2, 1); { One in off right }
BiColorRectangle(X1, Y1, X2, Y2, 15, 8, True); { Draw line marker }
{$IFDEF OS_DOS}
ShowMouseCursor; { Show the mouse }
{$ENDIF}
End;
ReleaseViewLimits; { Release the limits }
End;
END;
{--TScrollBar---------------------------------------------------------------}
{ ClearPos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
{---------------------------------------------------------------------------}
{ This could be called from a message handling event so it must check the }
{ view is visible, exposed and not obstructed before clearing the old }
{ thumbnail area. }
{---------------------------------------------------------------------------}
PROCEDURE TScrollBar.ClearPos (Pos: Integer);
VAR X, Y: Integer; ViewPort: ViewPortType;
BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) Then Begin { View is exposed }
SetViewLimits; { Set view limits }
GetViewSettings(ViewPort); { Get set viewport }
If OverlapsArea(ViewPort.X1, ViewPort.Y1,
ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
{$IFDEF OS_DOS}
HideMouseCursor; { Hide the mouse }
{$ENDIF}
X := 0; { Initial x position }
Y := 0; { Initial y position }
If (Size.X=1) Then Y := Pos + FontHeight { Vertical bar }
Else X := Pos + FontWidth; { Horizontal bar }
ClearArea(X, Y, X+FontWidth-1, Y+FontHeight-1,
GetColor(1) AND $F0 SHR 4); { Clear the area }
{$IFDEF OS_DOS}
ShowMouseCursor; { Show the mouse }
{$ENDIF}
End;
ReleaseViewLimits; { Release the limits }
End;
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);
BEGIN
Inherited Load(S); { Call ancestor }
GetPeerViewPtr(S, HScrollBar); { Load horz scrollbar }
GetPeerViewPtr(S, VScrollBar); { Load vert scrollbar }
S.Read(Delta.X, 2); { Read delta x value }
S.Read(Delta.Y, 2); { Read delta y value }
S.Read(Limit.X, 2); { Read limit x value }
S.Read(Limit.Y, 2); { Read limit y value }
END;
{--TScroller----------------------------------------------------------------}
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TScroller.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CScroller; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CScroller)] = CScroller; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Scroller palette }
END;
{--TScroller----------------------------------------------------------------}
{ ScrollTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TScroller.ScrollTo (X, Y: 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);
BEGIN
TView.Store(S); { Call TView explicitly }
PutPeerViewPtr(S, HScrollBar); { Store horz bar }
PutPeerViewPtr(S, VScrollBar); { Store vert bar }
S.Write(Delta.X, 2); { Write delta x value }
S.Write(Delta.Y, 2); { Write delta y value }
S.Write(Limit.X, 2); { Write limit x value }
S.Write(Limit.Y, 2); { 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: Word; AHScrollBar,
AVScrollBar: PScrollBar);
VAR ArStep, PgStep: 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 }
GOptions := GOptions OR goDrawFocus; { Draw focus changes }
END;
{--TListViewer--------------------------------------------------------------}
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
{---------------------------------------------------------------------------}
CONSTRUCTOR TListViewer.Load (Var S: TStream);
BEGIN
Inherited Load(S); { Call ancestor }
GetPeerViewPtr(S, HScrollBar); { Get horz scrollbar }
GetPeerViewPtr(S, VScrollBar); { Get vert scrollbar }
S.Read(NumCols, 2); { Read column number }
S.Read(TopItem, 2); { Read top most item }
S.Read(Focused, 2); { Read focused item }
S.Read(Range, 2); { Read listview range }
END;
{--TListViewer--------------------------------------------------------------}
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TListViewer.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CListViewer; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CListViewer)] = CListViewer; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
{--TListViewer--------------------------------------------------------------}
{ IsSelected -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TListViewer.IsSelected (Item: 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: Integer; MaxLen: Integer): String;
BEGIN { Abstract method }
END;
{--TListViewer--------------------------------------------------------------}
{ DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TListViewer.DrawBackGround;
VAR SCOff: Byte; I, J, ColWidth, Item, Indent, CurCol: Integer; Color: Word;
Text: String; B: TDrawBuffer;
{$IFDEF OS_WINDOWS} S: String; {$ENDIF} { WIN/NT CODE }
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 }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (GOptions AND goNativeClass <> 0) Then Begin { Native class mode }
If (Range <> SendMessage(HWindow, lb_GetCount,
0, 0)) Then SendMessage(HWindow,lb_ResetContent, { If ranges differ }
0, 0); { Clear all strings }
For I := 1 To Range Do Begin { For each item }
J := SendMessage(HWindow, lb_GetText, 0,
LongInt(@S[1])); { Get current text }
If (J <> lb_Err) Then Begin { Check for error }
{$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(S, J); { Set string length }
{$ELSE} { OTHER COMPILERS }
S[0] := Chr(J); { Set string legth }
{$ENDIF}
End Else S := ''; { Error no string }
Text := GetText(I-1, ColWidth + Indent); { Fetch text }
Text := Copy(Text, Indent, ColWidth) + #0; { Select right bit }
If (S <> Text) Then Begin { Strings differ }
If (J <> lb_Err) Then SendMessage(HWindow,
lb_DeleteString, I-1, 0); { Delete current string }
SendMessage(HWindow, lb_InsertString, I-1,
LongInt(@Text[1])); { Set string in list }
End;
End;
If (Options AND ofSelectable <> 0) Then
SendMessage(HWindow, lb_SetCurSel, Focused, 0); { Focus selected item }
TopItem := SendMessage(HWindow, lb_GetTopIndex,
0, 0); { Synchronize }
UpdateWindow(HWindow); { Redraw new strings }
Exit; { Native mode is done }
End;
{$ENDIF}
Inherited DrawBackGround; { Call ancestor }
Color := GetColor(2); { Normal colour }
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 }
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--------------------------------------------------------------}
{ DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TListViewer.DrawFocus;
VAR DrawIt: Boolean; I, J, Item, CurCol, ColWidth: Integer;
Color: Word;
Indent: Integer;
B: TDrawBuffer;
Text,S: String;
SCOff: Byte;
BEGIN
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (GOptions AND goNativeClass <> 0) Then Exit; { Native class exits }
{$ENDIF}
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 }
DrawIt := False; { Preset false }
If (State AND (sfSelected + sfActive) =
(sfSelected + sfActive)) AND (Focused = Item) { Focused item }
AND (Range > 0) Then Begin
DrawIt := True; { Draw this item }
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
DrawIt := True; { Draw this item }
If (State AND sfActive <> 0) Then
Color := GetColor(4) Else { Selected colour }
Color := GetColor(2); { Remove focus }
SCOff := 2; { Colour offset=2 }
End;
If DrawIt Then Begin { We are drawing item }
ClearArea(0, I*FontHeight, ColWidth*FontWidth,
(I+1)*FontHeight-1, Color AND $F0 SHR 4); { Draw the bar }
MoveChar(B[CurCol], ' ', Color, ColWidth);
if Item < Range then begin
Text := GetText(Item, ColWidth + Indent);
Text := Copy(Text,Indent,ColWidth);
MoveStr(B[CurCol+1], Text, Color);
if ShowMarkers then begin
WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
end;
end;
MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
WriteLine(0, I, Size.X, 1, B);
End;
End;
End;
END;
{--TListViewer--------------------------------------------------------------}
{ FocusItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TListViewer.FocusItem (Item: Integer);
BEGIN
Focused := Item; { Set focus to item }
If (VScrollBar <> Nil) Then
VScrollBar^.SetValue(Item); { Scrollbar to value }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (GOptions AND goNativeClass <> 0) Then Begin { Native class mode }
If (HWindow <> 0) Then Begin { Check window valid }
If (Options AND ofSelectable <> 0) Then
SendMessage(HWindow, lb_SetCurSel, Focused, 0);{ Focus selected item }
TopItem := SendMessage(HWindow, lb_GetTopIndex,
0, 0); { Synchronize }
End;
Exit; { Native mode done }
End;
{$ENDIF}
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: Integer);
BEGIN
TopItem := Item; { Set the top item }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (GOptions AND goNativeClass <> 0) AND { Native class mode }
(HWindow <> 0) Then { Window valid }
SendMessage(HWindow, lb_SetTopIndex, Item, 0); { Synchronize }
{$ENDIF}
END;
{--TListViewer--------------------------------------------------------------}
{ SetRange -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TListViewer.SetRange (ARange: 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: 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;
PROCEDURE LoseFocus;
VAR Cs: Integer;
BEGIN
If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
Cs := State; { Hold current state }
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
State := State AND (sfActive XOR $FFFF); { Weird bug!!! }
{$ELSE} { OTHER COMPILERS }
State := State AND NOT sfActive; { Must remove focus }
{$ENDIF}
SetDrawmask(vdFocus); { Set focus mask }
DrawView; { Remove focus box }
State := Cs; { Reset state masks }
End;
END;
BEGIN
Inherited SetState(AState, Enable); { Call ancestor }
If (AState AND sfFocused <> 0) Then { Focus change }
If NOT Enable Then LoseFocus; { Redraw drop focus }
If (AState AND (sfSelected + sfActive + sfVisible) <> 0)
Then Begin { Check states }
SetDrawMask(vdFocus);
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);
BEGIN
TView.Store(S); { Call TView explicitly }
PutPeerViewPtr(S, HScrollBar); { Put horz scrollbar }
PutPeerViewPtr(S, VScrollBar); { Put vert scrollbar }
S.Write(NumCols, 2); { Write column number }
S.Write(TopItem, 2); { Write top most item }
S.Write(Focused, 2); { Write focused item }
S.Write(Range, 2); { 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: Integer; Ct, Cw: Word; Mouse: TPoint;
PROCEDURE MoveFocus (Req: Integer);
VAR Ti, Cs: Integer;
BEGIN
If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
Ti := TopItem; { Hold top item }
Cs := State; { Hold current state }
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
State := State AND (sfActive XOR $FFFF); { Weird bug!!!! }
{$ELSE} { OTHER COMPILERS }
State := State AND NOT sfActive; { Must remove focus }
{$ENDIF}
SetDrawmask(vdFocus); { Set focus mask }
DrawView; { Remove focus box }
State := Cs; { Reset state masks }
End;
FocusItemNum(Req); { Focus req item }
If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
If (Ti <> TopItem) Then DrawView Else Begin { Redraw all view }
SetDrawmask(vdFocus); { Set focus mask }
DrawView; { Redraw focus box }
End;
End;
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;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
evCommand: If (Event.Command = cmNotify) Then { Notify command }
Begin
FocusItem(Round(Event.Data)); { Focus the item }
SelectItem(Focused); { Select the item }
ClearEvent(Event); { Event was handled }
End Else Exit; { Not handled command }
{$ENDIF}
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;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{***************************************************************************}
{ TListViewer OBJECT WIN/NT ONLY METHODS }
{***************************************************************************}
{--TListViewer--------------------------------------------------------------}
{ GetNotifyCmd -> Platforms WIN/NT/OS2 - Updated 06Aug99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TListViewer.GetNotifyCmd: LongInt;
BEGIN
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
GetNotifyCmd := lb_GetCurSel; { Listbox get selection }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
GetNotifyCmd := lm_QuerySelection; { Listbox get selection }
{$ENDIF}
END;
{--TListViewer--------------------------------------------------------------}
{ GetClassName -> Platforms WIN/NT - Updated 27Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TListViewer.GetClassName: String;
BEGIN
If UseNativeClasses Then Begin { Use native classes }
GetClassName := TvListViewerName; { Windows class name }
GOptions := GOptions OR goNativeClass; { Native class window }
End Else GetClassName := Inherited GetClassName; { Use standard class }
END;
{--TListViewer--------------------------------------------------------------}
{ GetClassAttr -> Platforms WIN/NT - Updated 27Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TListViewer.GetClassAttr: LongInt;
VAR Li: LongInt;
BEGIN
Li := Inherited GetClassAttr; { Call ancestor }
Li := Li OR lbs_HasStrings OR lbs_Notify; { Set has strings mask }
If (NumCols > 1) Then
Li := Li OR lbs_MultiColumn; { Has multiple columns }
Li := Li OR LBS_NOINTEGRALHEIGHT ;
GetClassAttr := Li; { Return attributes }
END;
{--TListViewer--------------------------------------------------------------}
{ CreateWindowNow -> Platforms WIN/NT - Updated 27Oct99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TListViewer.CreateWindowNow (CmdShow: Integer);
BEGIN
Inherited CreateWindowNow(CmdShow); { Call ancestor }
DrawView; { Redraw the view }
END;
{$ENDIF}
{***************************************************************************}
{ TListViewer OBJECT PRIVATE METHODS }
{***************************************************************************}
{--TListViewer--------------------------------------------------------------}
{ FocusItemNum -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TListViewer.FocusItemNum (Item: 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: 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 }
GOptions := GOptions OR goThickFramed; { Thick frame }
GOptions := GOptions OR goTitled; { Title window }
GOptions := GOptions AND NOT goNoDrawView; { View does draw self }
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);
BEGIN
Inherited Load(S); { Call ancestor }
S.Read(Flags, 1); { Read window flags }
S.Read(Number, 2); { Read window number }
S.Read(Palette, 2); { Read window palette }
S.Read(ZoomRect.A.X, 2); { Read zoom area x1 }
S.Read(ZoomRect.A.Y, 2); { Read zoom area y1 }
S.Read(ZoomRect.B.X, 2); { Read zoom area x2 }
S.Read(ZoomRect.B.Y, 2); { Read zoom area y2 }
GetSubViewPtr(S, Frame); { Now read frame object }
If (Frame <> Nil) Then Begin
Dispose(Frame, Done); { Kill we don't use it }
Frame := Nil; { Clear the pointer }
End;
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;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: ARRAY [wpBlueWindow..wpGrayWindow] Of String =
(CBlueWindow, CCyanWindow, CGrayWindow); { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: ARRAY [wpBlueWindow..wpGrayWindow] Of String[Length(CBlueWindow)] =
(CBlueWindow, CCyanWindow, CGrayWindow); { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P[Palette]; { Return palette }
END;
{--TWindow------------------------------------------------------------------}
{ GetTitle -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
FUNCTION TWindow.GetTitle (MaxSize: Integer): TTitleStr;
VAR S: String;
BEGIN
If (Number <> 0) Then begin { Valid window number }
Str(Number, S); { Window number }
S := '(' + S + ') '; { Insert in brackets }
End Else S := ''; { Empty string }
If (Title <> Nil) Then GetTitle := S + Title^
Else GetTitle := S; { Return title }
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;
BEGIN { Compatability only }
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);
BEGIN
TGroup.Store(S); { Call group store }
S.Write(Flags, 1); { Write window flags }
S.Write(Number, 2); { Write window number }
S.Write(Palette, 2); { Write window palette }
S.Write(ZoomRect.A.X, 2); { Write zoom area x1 }
S.Write(ZoomRect.A.Y, 2); { Write zoom area y1 }
S.Write(ZoomRect.B.X, 2); { Write zoom area x2 }
S.Write(ZoomRect.B.Y, 2); { 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 {$IFDEF OS_DOS} I, J: Integer; {$ENDIF} Min, Max: TPoint; Limits: TRect;
{$IFDEF OS_DOS} { DOS/DPMI CODE }
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;
{$ENDIF}
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;
{$IFDEF OS_DOS} { DOS/DPMI CODE ONLY }
evMouseDown: { MOUSE DOWN EVENT }
If (GOptions AND goTitled <> 0) Then Begin { Must have title area }
If (GOptions AND goThickFramed <> 0) Then
I := 5 Else { Thick frame adjust }
If (Options AND ofFramed <> 0) Then I := 1 { Frame adjust }
Else I := 0; { No frame size }
If (Event.Where.Y > (RawOrigin.Y + I)) AND
(Event.Where.Y < RawOrigin.Y+FontHeight+I)
Then Begin { Within top line }
If (Current <> Nil) AND
(Current^.Options AND ofSelectable <> 0)
Then Current^.FocusFromTop Else
FocusFromTop;
If (Flags AND wfClose <> 0) Then Begin { Has close icon }
J := I + FontWidth; { Set X value }
If (Event.Where.X > RawOrigin.X+J) AND
(Event.Where.X < RawOrigin.X+J+2*FontWidth)
Then Begin { In close area }
Event.What := evCommand; { Command event }
Event.Command := cmClose; { Close command }
Event.InfoPtr := Nil; { Clear pointer }
PutEvent(Event); { Put event on queue }
ClearEvent(Event); { Clear the event }
Exit; { Now exit }
End;
End;
If (Owner <> Nil) AND (Flags AND wfMove <> 0)
Then DragWindow(dmDragMove); { Drag the window }
End Else If (Event.Where.X >= RawOrigin.X + RawSize.X-2*FontWidth) AND
(Event.Where.Y >= RawOrigin.Y + RawSize.Y - FontHeight)
Then If (Flags AND wfGrow <> 0) Then { Check grow flags }
DragWindow(dmDragGrow); { Change window size }
End;
{$ENDIF}
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;
{$IFNDEF OS_DOS}
{***************************************************************************}
{ TWindow OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
{--TWindow------------------------------------------------------------------}
{ GetClassText -> Platforms WIN/NT/OS2 - Updated 18Jul99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TWindow.GetClassText: String;
BEGIN
GetClassText := GetTitle(255); { Return window title }
END;
{--TWindow------------------------------------------------------------------}
{ GetClassAttr -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TWindow.GetClassAttr: LongInt;
VAR Li: LongInt;
BEGIN
Li := Inherited GetClassAttr; { Call ancestor }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (Flags AND wfZoom <> 0) Then Li := Li OR { Check zoom flags }
ws_MinimizeBox OR ws_MaximizeBox; { Add min/max boxes }
If (Flags AND wfClose <> 0) Then { Check close option }
Li := Li OR ws_SysMenu; { Set menu flag }
Li := Li OR ws_ClipSiblings OR ws_ClipChildren; { Clip other windows }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (Flags AND wfZoom <> 0) Then Li := Li OR { Check zoom flags }
fcf_MinButton OR fcf_MaxButton; { Add min/max boxes }
If (Flags AND wfClose <> 0) Then { Check close option }
Li := Li OR fcf_SysMenu; { Set menu flag }
{$ENDIF}
GetClassAttr := Li; { Return masks }
END;
{$ENDIF}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ UNCOMPLETED OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{--TView--------------------------------------------------------------------}
{ Exposed -> Platforms DOS/DPMI/WIN/OS2 - Checked 17Sep97 LdB }
{---------------------------------------------------------------------------}
{ This needs big help!!!!! }
FUNCTION TView.Exposed: Boolean;
VAR ViewPort: ViewPortType;
BEGIN
GetViewSettings(ViewPort); { Fetch viewport }
If (State AND sfVisible<>0) AND { View visible }
(State AND sfExposed<>0) AND { View exposed }
OverlapsArea(ViewPort.X1, ViewPort.Y1,
ViewPort.X2, ViewPort.Y2) Then Exposed := True { Must be exposed }
Else Exposed := False; { Is hidden }
END;
{--TView--------------------------------------------------------------------}
{ GraphLine -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.GraphLine (X1, Y1, X2, Y2: Integer; Colour: Byte);
VAR {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF} { DOS/DPMI VARIABLES }
{$IFDEF OS_WINDOWS} I: Word; ODc: hDc; {$ENDIF} { WIN/NT VARIABLES }
{$IFDEF OS_OS2} I: LongInt; Lp: PointL; OPs: HPs; {$ENDIF}{ OS2 VARIABLES }
BEGIN
{$IFDEF OS_DOS} { DOS/DPMI CODE }
GetViewSettings(ViewPort); { Get viewport settings }
SetColor(Colour); { Set line colour }
Line(RawOrigin.X + X1 - ViewPort.X1,
RawOrigin.Y + Y1 - ViewPort.Y1, RawOrigin.X + X2
- ViewPort.X1, RawOrigin.Y + Y2-ViewPort.Y1); { Draw the line }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (HWindow <> 0) Then Begin { Valid window }
X1 := X1 - FrameSize; { Adjust X1 for frame }
X2 := X2 - FrameSize; { Adjust X2 for frame }
Y1 := Y1 - CaptSize; { Adjust Y1 for title }
Y2 := Y2 - CaptSize; { Adjust Y2 for title }
ODc := Dc; { Hold device context }
If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
SelectObject(Dc, ColPen[Colour]); { Select line colour }
Case WriteMode Of
NormalPut: I := R2_CopyPen; { Normal overwrite }
AndPut: I := R2_MaskPen; { AND colour write }
OrPut: I := R2_MergePen; { OR colour write }
XorPut: I := R2_XORPen; { XOR colour write }
NotPut: I := R2_Not; { NOT colour write }
End;
SetRop2(Dc, I); { Set write mode }
{$IFDEF BIT_16} { 16 BIT WIN CODE }
WinProcs.MoveTo(Dc, X1, Y1); { Move to first point }
{$ELSE} { 32 BIT WIN/NT CODE }
MoveToEx(Dc, X1, Y1, Nil); { Move to first point }
{$ENDIF}
If (Abs(X2-X1) > 1) OR (Abs(Y2-Y1) > 1) Then { Not single point }
LineTo(Dc, X2, Y2); { Line to second point }
SetPixel(Dc, X2, Y2, ColRef[Colour]); { Draw last point }
If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
Dc := ODc; { Reset held context }
End;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (HWindow <> 0) Then Begin { Valid window }
X1 := X1 - FrameSize; { Adjust X1 for frame }
X2 := X2 - FrameSize; { Adjust X2 for frame }
Y1 := Y1 - CaptSize; { Adjust Y1 for title }
Y2 := Y2 - CaptSize; { Adjust Y2 for title }
OPs := Ps; { Hold paint struct }
If (Ps = 0) Then Ps := WinGetPS(Client); { Create paint struct }
Case WriteMode Of
NormalPut: I := fm_Overpaint; { Normal overwrite }
AndPut: I := fm_And; { AND colour write }
OrPut: I := fm_Or; { OR colour write }
XorPut: I := fm_Xor; { XOR colour write }
NotPut: I := fm_Invert; { NOT colour write }
End;
GPISetMix(Ps, I); { Set write mode }
GPISetColor(Ps, ColRef[Colour]);
Lp.X := X1; { Transfer x1 value }
Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
GPIMove(Ps, Lp); { Move to first point }
Lp.X := X2; { Transfer x2 value }
Lp.Y := RawSize.Y-Y2; { Transfer y2 value }
GPILine(Ps, Lp); { Line to second point }
If (OPs = 0) Then WinReleasePS(Ps); { Release paint struct }
Ps := OPs; { Reset held struct }
End;
{$ENDIF}
END;
PROCEDURE TView.GraphRectangle (X1, Y1, X2, Y2: Integer; Colour: Byte);
VAR {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
{$IFDEF OS_WINDOWS} I: Word; ODc: hDc; {$ENDIF}
{$IFDEF OS_OS2} Lp: PointL; OPs: HPs; {$ENDIF}
BEGIN
{$IFDEF OS_DOS} { DOS/DPMI CODE }
SetColor(Colour); { Set line colour }
GetViewSettings(ViewPort);
Rectangle(RawOrigin.X + X1 - ViewPort.X1, RawOrigin.Y + Y1
- ViewPort.Y1, RawOrigin.X + X2 - ViewPort.X1,
RawOrigin.Y+Y2-ViewPort.Y1); { Draw a rectangle }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (HWindow <> 0) Then Begin { Valid window }
X1 := X1 - FrameSize;
X2 := X2 - FrameSize;
Y1 := Y1 - CaptSize;
Y2 := Y2 - CaptSize;
ODc := Dc; { Hold device context }
If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
SelectObject(Dc, ColPen[Colour]);
Case WriteMode Of
NormalPut: I := R2_CopyPen; { Normal overwrite }
AndPut: I := R2_MaskPen; { AND colour write }
OrPut: I := R2_MergePen; { OR colour write }
XorPut: I := R2_XORPen; { XOR colour write }
NotPut: I := R2_Not; { NOT colour write }
End;
SetRop2(Dc, I);
{$IFDEF WIN32}
MoveToEx(Dc, X1, Y1, Nil); { Move to first point }
{$ELSE}
WinProcs.MoveTo(Dc, X1, Y1); { Move to first point }
{$ENDIF}
LineTo(Dc, X2, Y1); { Line to second point }
LineTo(Dc, X2, Y2); { Line to third point }
LineTo(Dc, X1, Y2); { Line to fourth point }
LineTo(Dc, X1, Y1); { Line to first point }
If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
Dc := ODc; { Reset held context }
End;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (HWindow <> 0) Then Begin { Valid window }
X1 := X1 - FrameSize; { Adjust X1 for frame }
X2 := X2 - FrameSize; { Adjust X2 for frame }
Y1 := Y1 - CaptSize; { Adjust Y1 for title }
Y2 := Y2 - CaptSize; { Adjust Y2 for title }
OPs := Ps; { Hold paint struct }
If (Ps = 0) Then Ps := WinGetPS(Client); { Create paint struct }
GPISetColor(Ps, ColRef[Colour]); { Set colour }
Lp.X := X1; { Transfer x1 value }
Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
GPIMove(Ps, Lp); { Move to first point }
Lp.X := X2; { Transfer x2 value }
Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
GPILine(Ps, Lp); { Line to second point }
Lp.X := X2; { Transfer x2 value }
Lp.Y := RawSize.Y-Y2; { Transfer y2 value }
GPILine(Ps, Lp); { Line to third point }
Lp.X := X1; { Transfer x1 value }
Lp.Y := RawSize.Y-Y2; { Transfer y2 value }
GPILine(Ps, Lp); { Line to fourth point }
Lp.X := X1; { Transfer x1 value }
Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
GPILine(Ps, Lp); { Line to first point }
If (OPs = 0) Then WinReleasePS(Ps); { Release paint struct }
Ps := OPs; { Reset held struct }
End;
{$ENDIF}
END;
{--TView--------------------------------------------------------------------}
{ ClearArea -> Platforms DOS/DPMI/WIN/OS2 - Checked 19Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
VAR {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
{$IFDEF OS_WINDOWS} ODc: hDc; {$ENDIF}
{$IFDEF OS_OS2} Lp: PointL; OPs: HPs; {$ENDIF}
BEGIN
{$IFDEF OS_DOS} { DOS/DPMI CODE }
GetViewSettings(ViewPort); { Get viewport }
SetFillStyle(SolidFill, Colour); { Set colour up }
Bar(RawOrigin.X+X1-ViewPort.X1, RawOrigin.Y+Y1-
ViewPort.Y1, RawOrigin.X+X2-ViewPort.X1,
RawOrigin.Y+Y2-ViewPort.Y1); { Clear the area }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (HWindow <> 0) Then Begin { Valid window }
X1 := X1 - FrameSize; { Correct for frame }
Y1 := Y1 - CaptSize; { Correct for caption }
X2 := X2 - FrameSize; { Correct for frame }
Y2 := Y2 - CaptSize; { Correct for caption }
ODc := Dc; { Hold device context }
If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
SelectObject(Dc, ColPen[Colour]);
SelectObject(Dc, ColBrush[Colour]);
{$IFNDEF PPC_SPEED}
Rectangle(Dc, X1, Y1, X2+1, Y2+1);
{$ELSE} { SPEEDSOFT SYBIL2+ }
WinGDI.Rectangle(Dc, X1, Y1, X2+1, Y2+1);
{$ENDIF}
If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
Dc := ODc; { Reset held context }
End;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (HWindow <> 0) Then Begin { Valid window }
X1 := X1 - FrameSize; { Adjust X1 for frame }
X2 := X2 - FrameSize; { Adjust X2 for frame }
Y1 := Y1 - CaptSize; { Adjust Y1 for title }
Y2 := Y2 - CaptSize; { Adjust Y2 for title }
OPs := Ps; { Hold paint struct }
If (Ps = 0) Then Ps := WinGetPs(Client); { Create paint struct }
GpiSetColor(Ps, ColRef[Colour]);
Lp.X := X1;
Lp.Y := RawSize.Y-Y1;
GpiMove(Ps, Lp);
Lp.X := X2;
Lp.Y := RawSize.Y-Y2;
GpiBox(Ps, dro_Fill, Lp, 0, 0);
If (OPs = 0) Then WinReleasePS(Ps); { Release paint struct }
Ps := OPs; { Reset held struct }
End;
{$ENDIF}
END;
PROCEDURE TView.GraphArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad: Integer;
Colour: Byte);
CONST RadConv = 57.2957795130823229; { Degrees per radian }
VAR X1, Y1, X2, Y2: Integer; {$IFDEF OS_WINDOWS} ODc: hDc; {$ENDIF}
BEGIN
{$IFDEF OS_WINDOWS}
Xc := Xc - FrameSize;
Yc := Yc - CaptSize;
{$ENDIF}
While (Ea < -360) Do Ea := Ea + 360; { Max of a full circle }
While (Ea > 360) Do Ea := Ea - 360; { Max of a full circle }
Sa := Sa/RadConv; { Convert to radians }
Ea := Ea/RadConv; { Convert to radians }
X1 := Xc + Round(Sin(Sa)*XRad); { Calc 1st x value }
Y1 := Yc - Round(Cos(Sa)*YRad); { Calc 1st y value }
X2 := Xc + Round(Sin(Sa+Ea)*XRad); { Calc 2nd x value }
Y2 := Yc - Round(Cos(Sa+Ea)*YRad); { Calc 2nd y value }
{$IFDEF OS_WINDOWS}
If (HWindow <> 0) Then Begin { Valid window }
ODc := Dc; { Hold device context }
If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
SelectObject(Dc, ColPen[Colour]); { Pen colour }
If (XRad > 2 ) AND (YRAd > 2) Then Begin { Must exceed 2x2 arc }
If (Ea < 0) Then
Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad,
X1, Y1, X2, Y2) Else { Draw c/clkwise arc }
Arc(Dc, Xc-XRad, Yc+YRad, Xc+XRad, Yc-YRad,
X2, Y2, X1, Y1); { Draw clockwise arc }
End;
If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
Dc := ODc; { Reset held context }
End;
{$ENDIF}
END;
PROCEDURE TView.FilletArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad, Ht: Integer;
Colour: Byte);
CONST RadConv = 57.2957795130823229; { Degrees per radian }
{$IFDEF OS_WINDOWS} VAR X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; ODc: hDc; {$ENDIF}
BEGIN
{$IFDEF OS_WINDOWS}
If (HWindow <> 0) Then Begin { Valid window }
Xc := Xc - FrameSize;
Yc := Yc - CaptSize;
ODc := Dc; { Hold device context }
If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
Ea := (Ea-Sa);
While (Ea<-360) Do Ea := Ea+360; { One lap only }
While (Ea>360) Do Ea := Ea-360; { One lap only }
X1 := Round(Sin(Sa/RadConv)*XRad);
Y1 := -Round(Cos(Sa/RadConv)*YRad); { Calc 1st values }
X2 := Round(Sin((Sa+Ea)/RadConv)*XRad);
Y2 := -Round(Cos((Sa+Ea)/RadConv)*YRad); { Calc 2nd values }
X3 := Round(Sin(Sa/RadConv)*(XRad+Ht));
Y3 := -Round(Cos(Sa/RadConv)*(YRad+Ht)); { Calc 3rd values }
X4 := Round(Sin((Sa+Ea)/RadConv)*(XRad+Ht));
Y4 := -Round(Cos((Sa+Ea)/RadConv)*(YRad+Ht)); { Calc 4th values }
SelectObject(Dc, ColPen[Colour]); { Pen colour }
{$IFDEF WIN32}
MoveToEx(Dc, Xc+X1, Yc+Y1, Nil); { Move to first point }
{$ELSE}
WinProcs.MoveTo(Dc, Xc+X1, Yc+Y1); { Move to first point }
{$ENDIF}
LineTo(Dc, Xc+X3, Yc+Y3);
{$IFDEF WIN32}
MoveToEx(Dc, Xc+X2, Yc+Y2, Nil);
{$ELSE}
WinProcs.MoveTo(Dc, Xc+X2, Yc+Y2);
{$ENDIF}
LineTo(Dc, Xc+X4, Yc+Y4);
If (Ea < 0) Then
Arc(Dc, Xc-XRad-Ht, Yc-YRad-Ht, Xc+XRad+Ht, Yc+YRad+Ht,
Xc+X1, Yc+Y1, Xc+X2, Yc+Y2) Else
Arc(Dc, Xc-XRad-Ht, Yc-YRad-Ht, Xc+XRad+Ht, Yc+YRad+Ht,
Xc+X2, Yc+Y2, Xc+X1, Yc+Y1); { Draw arc }
If (Ea < 0) Then
Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad,
Xc+X3, Yc+Y3, Xc+X4, Yc+Y4) Else
Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad,
Xc+X4, Yc+Y4, Xc+X3, Yc+Y3); { Draw arc }
If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
Dc := ODc; { Reset held context }
End;
{$ENDIF}
END;
{--TView--------------------------------------------------------------------}
{ BiColorRectangle -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.BicolorRectangle (X1, Y1, X2, Y2: Integer; Light, Dark: Byte;
Down: Boolean);
VAR UpperLeft, RightDown: Byte;
BEGIN
If Down Then Begin
UpperLeft := Dark; { Dark upper left }
RightDown := Light; { Light down }
End Else Begin
UpperLeft := Light; { Light upper left }
RightDown := Dark; { Dark down }
End;
GraphLine(X1, Y1, X1, Y2, UpperLeft); { Draw left side }
GraphLine(X1, Y1, X2, Y1, UpperLeft); { Draw top line }
GraphLine(X1, Y2, X2, Y2, RightDown); { Draw bottom line }
GraphLine(X2, Y1, X2, Y2, RightDown); { Draw right line }
END;
PROCEDURE TView.WriteBuf (X, Y, W, H: Integer; Var Buf);
VAR I, J, K, L, CW: Integer; P: PDrawBuffer;
{$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
{$IFDEF OS_WINDOWS} ODc: HDc; {$ENDIF}
{$IFDEF OS_OS2} OPs: HPs; Pt: PointL; {$ENDIF}
BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfIconised = 0) AND { View is not icon}
(State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed }
{$IFNDEF OS_DOS} AND (HWindow <> 0) {$ENDIF} { WIN/NT/OS2 CODE }
Then Begin
P := @TDrawBuffer(Buf); { Set draw buffer ptr }
L := 0; { Set buffer position }
If (GOptions AND (goGraphical + goGraphView)= 0) Then Begin { Not raw graphical }
X := X * SysFontWidth; { X graphical adjust }
Y := Y * SysFontHeight; { Y graphical adjust }
End;
{$IFDEF OS_DOS} { DOS/DPMI CODE }
GetViewSettings(ViewPort); { Get current viewport }
X := X + RawOrigin.X - ViewPort.X; { Calc x position }
Y := Y + RawOrigin.Y - ViewPort.Y; { Calc y position }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
ODc := Dc; { Hold device context }
If (Dc = 0) Then Dc := GetDC(HWindow); { If needed get context }
SelectObject(Dc, DefGFVFont); { Select the font }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
OPs := Ps; { Hold pres space }
If (Ps = 0) Then Ps := WinGetPS(Client); { If needed get PS }
GPISetCharSet(Ps, DefGFVFont); { Select the font }
GpiSetBackMix(Ps, bm_OverPaint); { Set overpaint mode }
{$ENDIF}
For J := 1 To H Do Begin { For each line }
K := X; { Reset x position }
For I := 0 To (W-1) Do Begin { For each character }
Cw := TextWidth(Chr(Lo(P^[L]))); { Width of this char }
{$IFDEF OS_DOS} { DOS/DPMI CODE }
SetFillStyle(SolidFill, Hi(P^[L]) AND $F0
SHR 4); { Set back colour }
SetColor(Hi(P^[L]) AND $0F); { Set text colour }
Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
OutTextXY(K, Y+2, Chr(Lo(P^[L]))); { Write text char }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
SetBkColor(Dc, ColRef[Hi(P^[L]) AND $F0
SHR 4]); { Set back colour }
SetTextColor(Dc, ColRef[Hi(P^[L])
AND $0F]); { Set text colour }
TextOut(Dc, K, Y, @P^[L], 1); { Write text char }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
GPISetBackColor(Ps, ColRef[Hi(P^[L])
AND $F0 SHR 4]); { Set back colour }
GpiSetColor(Ps, ColRef[Hi(P^[L])
AND $0F]); { Set text colour }
Pt.X := K;
Pt.Y := RawSize.Y - Y - FontHeight + 5;
GpiCharStringAt(Ps, Pt, 1, @P^[L]); { Write text char }
{$ENDIF}
K := K + Cw; { Add char width }
Inc(L); { Next character }
End;
Y := Y + SysFontHeight; { Next line down }
End;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
Dc := ODc; { Restore old context }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (OPs = 0) Then WinReleasePS(Ps); { Release pres space }
Ps := OPs; { Restore original PS }
{$ENDIF}
End;
END;
PROCEDURE TView.WriteLine (X, Y, W, H: Integer; Var Buf);
VAR I, J, K, Cw: Integer; P: PDrawBuffer;
{$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
{$IFDEF OS_WINDOWS} ODc: HDc; {$ENDIF}
{$IFDEF OS_OS2} OPs: HPs; Pt: PointL; {$ENDIF}
BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfIconised = 0) AND { View is not icon}
(State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed }
{$IFNDEF OS_DOS} AND (HWindow <> 0) {$ENDIF} { WIN/NT/OS2 CODE }
Then Begin
P := @TDrawBuffer(Buf); { Set draw buffer ptr }
If (GOptions AND (goGraphical + goGraphView)= 0) Then Begin { Not raw graphical }
X := X * SysFontWidth; { X graphical adjust }
Y := Y * SysFontHeight; { Y graphical adjust }
End;
{$IFDEF OS_DOS} { DOS/DPMI CODE }
GetViewSettings(ViewPort); { Get current viewport }
X := X + RawOrigin.X - ViewPort.X; { Calc x position }
Y := Y + RawOrigin.Y - ViewPort.Y; { Calc y position }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
ODc := Dc; { Hold device context }
If (Dc = 0) Then Dc := GetDC(HWindow); { If needed get context }
SelectObject(Dc, DefGFVFont); { Select the font }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
OPs := Ps; { Hold pres space }
If (Ps = 0) Then Ps := WinGetPS(Client); { If needed get PS }
GPISetCharSet(Ps, DefGFVFont); { Select the font }
GpiSetBackMix(Ps, bm_OverPaint); { Set overpaint mode }
{$ENDIF}
For J := 1 To H Do Begin { For each line }
K := X; { Reset x position }
For I := 0 To (W-1) Do Begin { For each character }
Cw := TextWidth(Chr(Lo(P^[I]))); { Width of this char }
{$IFDEF OS_DOS} { DOS/DPMI CODE }
SetFillStyle(SolidFill, Hi(P^[I]) AND $F0
SHR 4); { Set back colour }
SetColor(Hi(P^[I]) AND $0F); { Set text colour }
Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
OutTextXY(K, Y+2, Chr(Lo(P^[I]))); { Write text char }
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
SetBkColor(Dc, ColRef[Hi(P^[I]) AND $F0
SHR 4]); { Set back colour }
SetTextColor(Dc, ColRef[Hi(P^[I])
AND $0F]); { Set text colour }
TextOut(Dc, K, Y, @P^[I], 1); { Write text char }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
GPISetBackColor(Ps, ColRef[Hi(P^[I])
AND $F0 SHR 4]); { Set back colour }
GpiSetColor(Ps, ColRef[Hi(P^[I])
AND $0F]); { Set text colour }
Pt.X := K;
Pt.Y := RawSize.Y - Y - FontHeight + 5;
GpiCharStringAt(Ps, Pt, 1, @P^[I]); { Write text char }
{$ENDIF}
K := K + Cw; { Add char width }
End;
Y := Y + SysFontHeight; { Next line down }
End;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
Dc := ODc; { Restore old context }
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
If (OPs = 0) Then WinReleasePS(Ps); { Release pres space }
Ps := OPs; { Restore original PS }
{$ENDIF}
End;
END;
{--TView--------------------------------------------------------------------}
{ MakeLocal -> Platforms DOS/DPMI/WIN/OS2 - Checked 12Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.MakeLocal (Source: TPoint; Var Dest: TPoint);
BEGIN
If (Options AND ofGFVModeView <> 0) Then Begin { GFV MODE TVIEW }
Dest.X := (Source.X-RawOrigin.X) DIV FontWidth; { Local x value }
Dest.Y := (Source.Y-RawOrigin.Y) DIV FontHeight; { Local y value }
End Else Begin { OLD MODE TVIEW }
Dest.X := Source.X - Origin.X; { Local x value }
Dest.Y := Source.Y - Origin.Y; { Local y value }
End;
END;
{--TView--------------------------------------------------------------------}
{ MakeGlobal -> Platforms DOS/DPMI/WIN/OS2 - Checked 12Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.MakeGlobal (Source: TPoint; Var Dest: TPoint);
BEGIN
If (Options AND ofGFVModeView <> 0) Then Begin { GFV MODE TVIEW }
Dest.X := Source.X*FontWidth + RawOrigin.X; { Global x value }
Dest.Y := Source.Y*FontHeight + RawOrigin.Y; { Global y value }
End Else Begin { OLD MODE TVIEW }
Dest.X := Source.X + Origin.X; { Global x value }
Dest.Y := Source.Y + Origin.Y; { Global y value }
End;
END;
PROCEDURE TView.WriteStr (X, Y: Integer; Str: String; Color: Byte);
VAR Fc, Bc: Byte; X1, Y1, X2, Y2: Integer;
{$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
{$IFDEF OS_WINDOWS} ODc: HDc; P: Pointer; {$ENDIF}
{$IFDEF OS_OS2} OPs: HPs; P: Pointer; Pt: PointL; {$ENDIF}
BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) AND { View is exposed }
(State AND sfIconised = 0) AND { View not iconized }
(Length(Str) > 0) Then Begin { String is valid }
Fc := GetColor(Color); { Get view color }
Bc := Fc AND $F0 SHR 4; { Calc back colour }
Fc := Fc AND $0F; { Calc text colour }
{$IFDEF OS_DOS}
If (X >= 0) AND (Y >= 0) Then Begin
X := RawOrigin.X+X*FontWidth; { X position }
Y := RawOrigin.Y+Y*FontHeight; { Y position }
End Else Begin
X := RawOrigin.X + Abs(X);
Y := RawOrigin.Y + Abs(Y);
End;
GetViewSettings(ViewPort);
SetFillStyle(SolidFill, Bc); { Set fill style }
Bar(X-ViewPort.X1, Y-ViewPort.Y1,
X-ViewPort.X1+Length(Str)*FontWidth, Y-ViewPort.Y1+FontHeight-1);
SetColor(Fc);
OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1+2, Str); { Write text char }
{$ENDIF}
{$IFDEF OS_WINDOWS}
If (HWindow <> 0) Then Begin
ODc := Dc; { Hold device handle }
If (Dc = 0) Then Dc := GetDC(HWindow); { Chk capture context }
SelectObject(Dc, DefGFVFont);
SetTextColor(Dc, ColRef[Fc]); { Set text colour }
SetBkColor(Dc, ColRef[Bc]); { Set back colour }
If (GOptions AND goGraphView <> 0) OR (X < 0)
OR (Y < 0) Then Begin
X := Abs(X);
Y := Abs(Y);
X1 := X - FrameSize; { Left position }
Y1 := Y - CaptSize; { Top position }
X2 := X1 + TextWidth(Str); { Right position }
End Else Begin
X1 := X * FontWidth - FrameSize; { Left position }
Y1 := Y * FontHeight - CaptSize; { Top position }
X2 := X1 + Length(Str)*FontWidth; { Right position }
End;
Y2 := Y1 + FontHeight; { Bottom position }
SelectObject(Dc, ColPen[Bc]); { Select pen }
SelectObject(Dc, ColBrush[Bc]); { Select brush }
P := @Str[1];
Rectangle(Dc, X1, Y1, X2, Y2); { Clear the area }
{$IFNDEF PPC_SPEED}
TextOut(Dc, X1, Y1, P, Length(Str)); { Write text data }
{$ELSE} { SPEEDSOFT SYBIL2+ }
TextOut(Dc, X1, Y1, CString(P), Length(Str)); { Write text data }
{$ENDIF}
If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
Dc := ODc; { Clear device handle }
End;
{$ENDIF}
{$IFDEF OS_OS2}
If (HWindow <> 0) Then Begin
OPs := Ps; { Hold device handle }
If (Ps = 0) Then Ps := WinGetPs(Client); { Chk capture context }
{SelectObject(Dc, DefGFVFont);}
If (GOptions AND goGraphView <> 0) OR (X < 0)
OR (Y < 0) Then Begin
X := Abs(X);
Y := Abs(Y);
X1 := X - FrameSize; { Left position }
Y1 := Y - CaptSize; { Top position }
X2 := X1 + TextWidth(Str); { Right position }
End Else Begin
X1 := X * FontWidth - FrameSize; { Left position }
Y1 := Y * FontHeight - CaptSize; { Top position }
X2 := X1 + Length(Str)*FontWidth; { Right position }
End;
Y2 := Y1 + FontHeight; { Bottom position }
{SelectObject(Dc, ColPen[Bc]);} { Select pen }
{SelectObject(Dc, ColBrush[Bc]);} { Select brush }
P := @Str[1];
(*Pt.X := X1;
Pt.Y := RawSize.Y - Y1;
GpiMove(Ps, Pt);
Pt.X := X2;
Pt.Y := RawSize.Y - Y2;
GpiSetColor(Ps, ColRef[Bc]); { Set text colour }
GpiBox(Ps, dro_Fill, Pt, 0, 0);*)
GpiSetColor(Ps, ColRef[Fc]); { Set text colour }
GpiSetBackColor(Ps, ColRef[Bc]); { Set back colour }
GpiSetBackMix(Ps, bm_OverPaint );
Pt.X := X1;
Pt.Y := RawSize.Y - Y1 - FontHeight + 5;
GpiCharStringAt(Ps, Pt, Length(Str), P); { Write text char }
If (OPs = 0) Then WinReleasePs(Ps); { Release context }
Ps := OPs; { Clear device handle }
End;
{$ENDIF}
End;
END;
PROCEDURE TView.WriteChar (X, Y: Integer; C: Char; Color: Byte;
Count: Integer);
VAR Fc, Bc: Byte; I: Integer; Col: Word; S: String; ViewPort: ViewPortType;
BEGIN
{$IFDEF OS_DOS}
If (State AND sfVisible <> 0) AND { View visible }
(State AND sfExposed <> 0) Then Begin { View exposed }
GetViewSettings(ViewPort);
Col := GetColor(Color); { Get view color }
Fc := Col AND $0F; { Foreground colour }
Bc := Col AND $F0 SHR 4; { Background colour }
X := RawOrigin.X + X*FontWidth; { X position }
Y := RawOrigin.Y + Y*FontHeight; { Y position }
FillChar(S[1], 255, C); { Fill the string }
While (Count>0) Do Begin
If (Count>255) Then I := 255 Else I := Count; { Size to make }
S[0] := Chr(I); { Set string length }
SetFillStyle(SolidFill, Bc); { Set fill style }
Bar(X-ViewPort.X1, Y-ViewPort.Y1,
X-ViewPort.X1+Length(S)*FontWidth, Y-ViewPort.Y1+FontHeight-1);
SetColor(Fc);
OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1, S); { Write text char }
Count := Count - I; { Subtract count }
X := X + I*FontWidth; { Move x position }
End;
End;
{$ENDIF}
END;
PROCEDURE TView.DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
MinSize, MaxSize: TPoint);
VAR PState: Word; Mouse, Q, R, P, S, Op1, Op2: TPoint; SaveBounds: TRect;
FUNCTION Min (I, J: Integer): Integer;
BEGIN
If (I < J) Then Min := I Else Min := J; { Select minimum }
END;
FUNCTION Max (I, J: Integer): Integer;
BEGIN
If (I > J) Then Max := I Else Max := J; { Select maximum }
END;
PROCEDURE MoveGrow (P, S: TPoint);
VAR R: TRect;
BEGIN
S.X := Min(Max(S.X, MinSize.X), MaxSize.X); { Minimum S.X value }
S.Y := Min(Max(S.Y, MinSize.Y), MaxSize.Y); { Minimum S.Y value }
P.X := Min(Max(P.X, Limits.A.X - S.X + 1),
Limits.B.X - 1); { Minimum P.X value }
P.Y := Min(Max(P.Y, Limits.A.Y - S.Y + 1),
Limits.B.Y - 1); { Mimimum P.Y value }
If (Mode AND dmLimitLoX <> 0) Then
P.X := Max(P.X, Limits.A.X); { Left side move }
If (Mode AND dmLimitLoY <> 0) Then
P.Y := Max(P.Y, Limits.A.Y); { Top side move }
If (Mode AND dmLimitHiX <> 0) Then
P.X := Min(P.X, Limits.B.X - S.X); { Right side move }
If (Mode AND dmLimitHiY <> 0) Then
P.Y := Min(P.Y, Limits.B.Y - S.Y); { Bottom side move }
R.Assign(P.X, P.Y, P.X + S.X, P.Y + S.Y); { Assign area }
Locate(R); { Locate view }
END;
PROCEDURE Change (DX, DY: Integer);
BEGIN
If (Mode AND dmDragMove <> 0) AND
(GetShiftState AND $03 = 0) Then Begin
Inc(P.X, DX); Inc(P.Y, DY); { Adjust values }
End Else If (Mode AND dmDragGrow <> 0) AND
(GetShiftState AND $03 <> 0) Then Begin
Inc(S.X, DX); Inc(S.Y, DY); { Adjust values }
End;
END;
PROCEDURE Update (X, Y: Integer);
BEGIN
If (Mode AND dmDragMove <> 0) Then Begin
P.X := X; P.Y := Y; { Adjust values }
End;
END;
BEGIN
SetState(sfDragging, True); { Set drag state }
If (Event.What = evMouseDown) Then Begin { Mouse down event }
Q.X := Event.Where.X DIV FontWidth - Origin.X; { Offset mouse x origin }
Q.Y := Event.Where.Y DIV FontHeight - Origin.Y; { Offset mouse y origin }
Op1.X := RawOrigin.X; Op1.Y := RawOrigin.Y; { Hold origin point }
Op2.X := RawOrigin.X+RawSize.X; { Right side x value }
Op2.Y := RawOrigin.Y+RawSize.Y; { Right side y value }
PState := State; { Hold current state }
State := State AND NOT sfVisible; { Temp not visible }
{$IFDEF OS_DOS} { DOS/DPMI CODE }
HideMouseCursor; { Hide the mouse }
{$ENDIF}
SetWriteMode(XORPut);
GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red);
SetWriteMode(NormalPut);
{$IFDEF OS_DOS} { DOS/DPMI CODE }
ShowMouseCursor; { Show the mouse }
{$ENDIF}
Repeat
Mouse.X := Round(Event.Where.X/FontWidth)-Q.X; { New x origin point }
Mouse.Y := Round(Event.Where.Y/FontHeight)-Q.Y;{ New y origin point }
If (Mode AND dmDragMove<>0) Then Begin
If (Owner<>Nil) Then Begin
Dec(Mouse.X, Owner^.Origin.X); { Sub owner x origin }
Dec(Mouse.Y, Owner^.Origin.Y); { Sub owner y origin }
End;
R := Mouse; Mouse := Size; { Exchange values }
End Else Begin
R := Origin; { Start at origin }
If (Owner<>Nil) Then Begin
Dec(R.X, Owner^.Origin.X); { Sub owner x origin }
Dec(R.Y, Owner^.Origin.Y); { Sub owner y origin }
End;
Mouse.X := Mouse.X+Q.X-Origin.X;
Mouse.Y := Mouse.Y+Q.Y-Origin.Y;
End;
{$IFDEF OS_DOS} { DOS/DPMI CODE }
HideMouseCursor; { Hide the mouse }
{$ENDIF}
SetWriteMode(XORPut);
GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red);
SetWriteMode(NormalPut);
MoveGrow(R, Mouse); { Resize the view }
SetWriteMode(XORPut);
GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red);
SetWriteMode(NormalPut);
{$IFDEF OS_DOS} { DOS/DPMI CODE }
ShowMouseCursor; { Show the mouse }
{$ENDIF}
Until NOT MouseEvent(Event, evMouseMove); { Finished moving }
State := PState; { Restore view state }
If (Owner<>Nil) Then
Owner^.ReDrawArea(Op1.X, Op1.Y, Op2.X, Op2.Y); { Redraw old area }
SetState(sfDragging, False); { Clr dragging flag }
DrawView; { Now redraw the view }
End Else Begin
GetBounds(SaveBounds); { Get current bounds }
Repeat
P := Origin; S := Size; { Set values }
KeyEvent(Event); { Get key event }
Case Event.KeyCode AND $FF00 Of
kbLeft: Change(-1, 0); { Move left }
kbRight: Change(1, 0); { Move right }
kbUp: Change(0, -1); { Move up }
kbDown: Change(0, 1); { Move down }
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); { Now move the view }
Until (Event.KeyCode = kbEnter) OR
(Event.KeyCode = kbEsc);
If (Event.KeyCode=kbEsc) Then Locate(SaveBounds);{ Restore original }
End;
SetState(sfDragging, False); { Clr dragging flag }
END;
FUNCTION TView.FontWidth: Integer;
BEGIN
FontWidth := SysFontWidth;
END;
FUNCTION TView.FontHeight: Integer;
BEGIN
FontHeight := SysFontHeight;
END;
{$IFNDEF OS_DOS}
{***************************************************************************}
{ TView OBJECT WIN/NT ONLY METHODS }
{***************************************************************************}
{--TView--------------------------------------------------------------------}
{ CreateWindowNow -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.CreateWindowNow (CmdShow: Integer);
VAR Li: LongInt; S: String; Cp, Ct: Array[0..256] Of Char;
{$IFDEF OS_WINDOWS} VAR WndClass: TWndClass; {$ENDIF}
{$IFDEF OS_OS2} VAR P: Pointer; WndClass: ClassInfo; {$ENDIF}
BEGIN
If (HWindow = 0) Then Begin { Window not created }
S := GetClassName; { Fetch classname }
FillChar(Cp, SizeOf(Cp), #0); { Clear buffer }
Move(S[1], Cp, Length(S)); { Transfer classname }
S := GetClassText; { Fetch class text }
FillChar(Ct, SizeOf(Ct), #0); { Clear buffer }
Move(S[1], Ct, Length(S)); { Transfer class text }
If (GOptions AND goNativeClass = 0) AND { Not native class }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFNDEF PPC_SPEED}
{$IFDEF PPC_FPC}
NOT GetClassInfo(HInstance, Cp, @WndClass)
{$ELSE}
NOT GetClassInfo(HInstance, Cp, WndClass)
{$ENDIF}
{$ELSE} { SPEEDSOFT SYBIL2+ }
NOT GetClassInfo(0, CString(Cp), WndClass)
{$ENDIF}
Then Begin { Class not registered }
WndClass.Style := CS_HRedraw OR CS_VReDraw OR
CS_DBLClks; { Class styles }
{$IFDEF PPC_SPEED}
WndClass.lpfnWndProc:= WndProc(GetMsgHandler); { Message handler }
{$ELSE}
Pointer(WndClass.lpfnWndProc) := GetMsgHandler;{ Message handler }
{$ENDIF}
WndClass.cbClsExtra := 0; { No extra data }
WndClass.cbWndExtra := 0; { No extra data }
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
WndClass.hInstance := 0;
WndClass.hIcon := Idi_Application; { Set icon }
{$ELSE}
WndClass.hInstance := HInstance; { Set instance }
WndClass.hIcon := LoadIcon(0, Idi_Application);{ Set icon }
{$ENDIF}
WndClass.hCursor := LoadCursor(0, Idc_Arrow); { Set cursor }
WndClass.hbrBackground := GetStockObject(
Null_Brush); { Class brush }
WndClass.lpszMenuName := Nil; { No menu }
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
WndClass.lpszClassName := @Cp; { Set class name }
{$ELSE} { OTHER COMPILERS }
WndClass.lpszClassName := Cp; { Set class name }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT CODE }
If (RegisterClass(WndClass) = 0)
{$ENDIF}
{$IFDEF BIT_16} { 16 BIT CODE }
If (RegisterClass(WndClass) = False)
{$ENDIF}
Then Begin
MessageBox(GetFocus, 'Can not Register Class',
'UnKnown Error Cause?', mb_OK); { Failed to register }
Halt; { Halt on failure }
End;
End;
If (GOptions AND goNativeClass <> 0) Then
Li := 1 Else Li := 0;
If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner window }
Then HWindow := CreateWindowEx(ExStyle,
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
CString(Cp), Ct, GetClassAttr OR ws_Child,
RawOrigin.X-Owner^.RawOrigin.X-Owner^.FrameSize,
RawOrigin.Y-Owner^.RawOrigin.Y-Owner^.CaptSize+Li,
RawSize.X+1,
RawSize.Y+1, Owner^.HWindow, GetClassId, 0, Nil)
{$ELSE}
Cp, Ct, GetClassAttr OR ws_Child,
RawOrigin.X-Owner^.RawOrigin.X-Owner^.FrameSize,
RawOrigin.Y-Owner^.RawOrigin.Y-Owner^.CaptSize+Li,
RawSize.X+1,
RawSize.Y+1, Owner^.HWindow, GetClassId, hInstance, Nil)
{$ENDIF}
Else HWindow := CreateWindowEx(ExStyle,
{$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
CString(Cp), Ct, GetClassAttr,
RawOrigin.X, RawOrigin.Y, RawSize.X+1, RawSize.Y+1,
AppWindow, GetClassId, 0, Nil); { Create the window }
{$ELSE}
Cp, Ct, GetClassAttr,
RawOrigin.X, RawOrigin.Y, RawSize.X+1, RawSize.Y+1,
AppWindow, GetClassId, hInstance, Nil); { Create the window }
{$ENDIF}
If (HWindow <> 0) Then Begin { Window created ok }
SendMessage(HWindow, WM_SetFont, DefGFVFont, 1);
Li := LongInt(@Self); { Address of self }
{$IFDEF BIT_16} { 16 BIT CODE }
SetProp(HWindow, ViewSeg, Li AND $FFFF0000
SHR 16); { Set seg property }
SetProp(HWindow, ViewOfs, Li AND $FFFF); { Set ofs propertry }
{$ENDIF}
{$IFDEF BIT_32} { 32 BIT CODE }
SetProp(HWindow, ViewPtr, Li ); { Set view property }
{$ENDIF}
If (CmdShow <> 0) Then
ShowWindow(HWindow, cmdShow); { Execute show cmd }
If (State AND sfVisible <> 0) Then Begin
UpdateWindow(HWindow); { Update the window }
BringWindowToTop(HWindow); { Bring window to top }
End;
If (State AND sfDisabled <> 0) Then
EnableWindow(HWindow, False); { Disable the window }
End;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
(WinQueryClassInfo(Anchor, Cp, WndClass) = False)
Then Begin { Class not registered }
P := GetMsgHandler; { Message handler }
If (WinRegisterClass(Anchor, Cp, P,
cs_SizeRedraw, SizeOf(Pointer))= False) { Register the class }
Then Begin
WinMessageBox(0, 0, 'Can not Register Class',
'UnKnown Error Cause?', 0, mb_OK); { Failed to register }
Halt; { Halt on failure }
End;
End;
Li := GetClassAttr; { Class attributes }
If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner window }
Then Begin
HWindow := WinCreateStdWindow(Owner^.Client,
0, Li, Cp, Ct, lStyle, 0, 0, @Client);
If (HWindow <> 0) Then Begin { Window created ok }
Li := LongInt(@Self); { Address of self }
WinSetPresParam(Client, PP_User,
SizeOf(Pointer), @Li); { Hold as property }
WinSetWindowPos(HWindow, 0, RawOrigin.X-Owner^.RawOrigin.X,
(Owner^.RawOrigin.Y + Owner^.RawSize.Y) -
(RawOrigin.Y + RawSize.Y),
RawSize.X+1, RawSize.Y+1,
swp_Move + swp_Size + swp_Activate + swp_Show);
If (GOptions AND goNativeClass <> 0) Then Begin
WinSetOwner(Client, Owner^.Client);
End;
If (State AND sfDisabled <> 0) Then
WinEnableWindow(HWindow, False); { Disable the window }
End;
End Else Begin
HWindow := WinCreateStdWindow(HWND_Desktop,
0, Li, Cp, Ct, lStyle, 0, 0, @Client);
If (HWindow <> 0) Then Begin { Window created ok }
Li := LongInt(@Self); { Address of self }
WinSetPresParam(Client, PP_User,
SizeOf(Pointer), @Li); { Hold as property }
WinSetWindowPos(HWindow, 0, RawOrigin.X,
WinQuerySysValue(hwnd_Desktop, sv_CyScreen)-RawSize.Y,
RawSize.X, RawSize.Y,
swp_Move + swp_Size + swp_Activate OR cmdShow);
End;
End;
{$ENDIF}
End;
END;
{$ENDIF}
{<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
{<7B> TScroller OBJECT METHODS <20>}
{<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
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: 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 }
{---------------------------------------------------------------------------}
PROCEDURE TGroup.Lock;
BEGIN
If (Buffer <> Nil) OR (LockFlag <> 0)
Then Inc(LockFlag); { Increment count }
END;
{--TGroup-------------------------------------------------------------------}
{ UnLock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TGroup.Unlock;
BEGIN
If (LockFlag <> 0) Then Begin
Dec(LockFlag); { Decrement count }
{If (LockFlag = 0) Then DrawView;} { Lock release draw }
End;
END;
PROCEDURE TWindow.DrawBorder;
VAR Fc, Bc: Byte; X, Y: Integer; S: String; ViewPort: ViewPortType;
BEGIN
{$IFDEF OS_DOS}
Fc := GetColor(2) AND $0F; { Foreground colour }
Bc := 9; { Background colour }
If (Options AND ofFramed<>0) Then Y := 1
Else Y := 0; { Initial value }
If (GOptions AND goThickFramed<>0) Then Inc(Y, 3); { Adjust position }
ClearArea(0, Y, RawSize.X, Y+FontHeight, Bc); { Clear background }
If (Title<>Nil) AND (GOptions AND goTitled<>0)
Then Begin { View has a title }
GetViewSettings(ViewPort);
X := (RawSize.X DIV 2); { Half way point }
X := X - (Length(Title^)*FontWidth) DIV 2; { Calc start point }
SetColor(Fc);
OutTextXY(RawOrigin.X+X-ViewPort.X1,
RawOrigin.Y+Y+1-ViewPort.Y1+2, Title^); { Write the title }
End;
If (Number>0) AND (Number<10) Then Begin { Valid number }
Str(Number, S); { Make number string }
SetColor(GetColor(2) AND $0F);
OutTextXY(RawOrigin.X+RawSize.X-2*FontWidth-ViewPort.X1,
RawOrigin.Y+Y+1-ViewPort.Y1+2, S); { Write number }
End;
If (Flags AND wfClose<>0) Then Begin { Close icon request }
SetColor(Fc);
OutTextXY(RawOrigin.X+Y+FontWidth-ViewPort.X1,
RawOrigin.Y+Y+1-ViewPort.Y1+2, '[*]'); { Write close icon }
End;
If (Flags AND wfZoom<>0) Then Begin
SetColor(GetColor(2) AND $0F);
OutTextXY(RawOrigin.X+RawSize.X-4*FontWidth-Y-ViewPort.X1,
RawOrigin.Y+Y+1-ViewPort.Y1+2, '['+#24+']'); { Write zoom icon }
End;
BiColorRectangle(Y+1, Y+1, RawSize.X-Y-1, Y+FontHeight,
White, DarkGray, False); { Draw 3d effect }
BiColorRectangle(Y+1, Y+1, RawSize.X-Y-2, Y+FontHeight-1,
White, DarkGray, False); { Draw 3d effect }
Inherited DrawBorder;
{$ENDIF}
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: 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: 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.2 2000-08-24 12:00:22 marco
* CVS log and ID tags
}
Reference in New Issue View Git Blame Copy Permalink