paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 00:59:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ some improovements made

Browse Source
This commit is contained in:
pierre 2001-05-10 16:46:26 +00:00
parent ed24a184b2
commit b2a9118a86
10 changed files with 998 additions and 4218 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

186
fv/app.pas
View File

@ -22,28 +22,9 @@
{ 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) }
{ - FPC 0.9912+ (32 Bit) }
{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ }
{******************[ REVISION HISTORY ]********************}
{ Version Date Fix }
{ ------- --------- --------------------------------- }
{ 1.00 12 Dec 96 First multi platform release }
{ 1.10 12 Sep 97 FPK pascal 0.92 conversion added. }
{ 1.20 29 Aug 97 Platform.inc sort added. }
{ 1.30 05 May 98 Virtual pascal 2.0 code added. }
{ 1.40 22 Oct 99 Object registration added. }
{ 1.50 22 Oct 99 Complete recheck preformed }
{ 1.51 03 Nov 99 FPC Windows support added }
{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
{ Only Free Pascal Compiler supported }
{ }
{**********************************************************}
UNIT App;
@ -58,17 +39,6 @@ UNIT App;
{==== Compiler directives ===========================================}
{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
{$F-} { Near calls are okay }
{$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 }
@ -79,21 +49,7 @@ UNIT App;
USES
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
{$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard units }
{$ELSE} { OTHER COMPILERS }
WinTypes,WinProcs, { Standard units }
{$ENDIF}
{$IFNDEF PPC_DELPHI} { NON DELPHI1 COMPILER }
{$IFDEF BIT_16} Win31, {$ENDIF} { 16 BIT WIN 3.1 UNIT }
{$ENDIF}
{$ELSE} { SPEEDSOFT COMPILER }
WinBase, WinDef, { Standard units }
{$ENDIF}
{$IFDEF PPC_DELPHI} { DELPHI COMPILERS }
Messages, { Standard unit }
{$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
@ -162,8 +118,7 @@ CONST
{ Turbo Vision 2.0 Color Palettes }
CAppColor =
{$IFDEF OS_WINDOWS}#$81+{$ELSE}#$71+{$ENDIF}
#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
#$71#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
#$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E +
#$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 +
#$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 +
@ -356,11 +311,7 @@ PROCEDURE RegisterApp;
CONST
RBackGround: TStreamRec = (
ObjType: 30; { Register id = 30 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TBackGround)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TBackGround);
{$ENDIF}
Load: @TBackGround.Load; { Object load method }
Store: @TBackGround.Store { Object store method }
);
@ -371,11 +322,7 @@ CONST
CONST
RDeskTop: TStreamRec = (
ObjType: 31; { Register id = 31 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TDeskTop)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TDeskTop);
{$ENDIF}
Load: @TDeskTop.Load; { Object load method }
Store: @TDeskTop.Store { Object store method }
);
@ -398,10 +345,8 @@ CONST
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{$ifdef Use_API}
uses
Video,Mouse;
{$endif Use_API}
{***************************************************************************}
{ PRIVATE DEFINED CONSTANTS }
@ -416,80 +361,6 @@ CONST
{---------------------------------------------------------------------------}
CONST Pending: TEvent = (What: evNothing); { Pending event }
{***************************************************************************}
{ PRIVATE INTERNAL ROUTINES }
{***************************************************************************}
{$IFDEF OS_WINDOWS}
{---------------------------------------------------------------------------}
{ AppMsgHandler -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 13May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TvAppMsgHandler (Wnd: hWnd; iMessage, wParam: Sw_Word;
lParam: LongInt): LongInt; {$IFDEF BIT_16} EXPORT; {$ELSE} STDCALL; {$ENDIF}
VAR Event: TEvent; P: PView; Mm: ^TMinMaxInfo;
BEGIN
{$IFDEF BIT_16} { 16 BIT 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 CODE }
LongInt(P) := GetProp(Wnd, ViewPtr); { Fetch view property }
{$ENDIF}
TvAppMsgHandler := 0; { Preset zero return }
Event.What := evNothing; { Preset no event }
Case iMessage Of
WM_Destroy:; { Destroy window }
WM_Close: Begin
Event.What := evCommand; { Command event }
Event.Command := cmQuit; { Quit command }
Event.InfoPtr := Nil; { Clear info ptr }
End;
WM_GetMinMaxInfo: Begin { Get minmax info }
TvAppMsgHandler := DefWindowProc(Wnd,
iMessage, wParam, lParam); { Default handler }
Mm := Pointer(lParam); { Create pointer }
Mm^.ptMaxSize.X := SysScreenWidth; { Max x size }
Mm^.ptMaxSize.Y := SysScreenHeight; { Max y size }
Mm^.ptMinTrackSize.X := MinWinSize.X *
SysFontWidth; { Drag min x size }
Mm^.ptMinTrackSize.Y := MinWinSize.Y *
SysFontHeight; { Drag min y size }
Mm^.ptMaxTrackSize.X := SysScreenWidth; { Drag max x size }
Mm^.ptMaxTrackSize.Y := SysScreenHeight; { Drag max y size }
End;
Else Begin { Unhandled message }
TvAppMsgHandler := DefWindowProc(Wnd,
iMessage, wParam, lParam); { Default handler }
Exit; { Now exit }
End;
End;
If (Event.What <> evNothing) Then { Check any FV event }
PutEventInQueue(Event); { Put event in queue }
END;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
FUNCTION TvAppMsgHandler(Wnd: HWnd; Msg: ULong; Mp1, Mp2: MParam): MResult; CDECL;
VAR Event: TEvent; P: PView;
BEGIN
Event.What := evNothing; { Preset no event }
TvAppMsgHandler := 0; { Preset zero return }
Case Msg Of
WM_Destroy:; { Destroy window }
WM_Close: Begin
Event.What := evCommand; { Command event }
Event.Command := cmQuit; { Quit command }
Event.InfoPtr := Nil; { Clear info ptr }
End;
Else Begin { Unhandled message }
TvAppMsgHandler := WinDefWindowProc(Wnd,
Msg, Mp1, Mp2); { Call std handler }
Exit; { Now exit }
End;
End;
If (Event.What <> evNothing) Then { Check any FV event }
PutEventInQueue(Event); { Put event in queue }
END;
{$ENDIF}
{---------------------------------------------------------------------------}
{ Tileable -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
{---------------------------------------------------------------------------}
@ -558,11 +429,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
FUNCTION TBackGround.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CBackGround; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CBackGround)] = CbackGround; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@ -776,7 +643,6 @@ END;
{ TProgram OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
CONST TvProgramClassName = 'TVPROGRAM'+#0; { TV program class }
{--TProgram-----------------------------------------------------------------}
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
@ -784,11 +650,11 @@ CONST TvProgramClassName = 'TVPROGRAM'+#0; { TV program class }
CONSTRUCTOR TProgram.Init;
VAR I: Integer; R: TRect;
BEGIN
Application := @Self; { Set application ptr }
InitScreen; { Initialize screen }
R.Assign(0, 0, -(GetMaxX(TextModeGFV)+1),
-(GetMaxY(TextModeGFV)+1)); { Full screen area }
Inherited Init(R); { Call ancestor }
Application := @Self; { Set application ptr }
InitScreen; { Initialize screen }
State := sfVisible + sfSelected + sfFocused +
sfModal + sfExposed; { Deafult states }
Options := 0; { No options set }
@ -810,6 +676,9 @@ END;
DESTRUCTOR TProgram.Done;
VAR I: Integer;
BEGIN
{ Do not free the Buffer of Video Unit }
If Buffer = Views.PVideoBuf(VideoBuf) then
Buffer:=nil;
If (Desktop <> Nil) Then Dispose(Desktop, Done); { Destroy desktop }
If (MenuBar <> Nil) Then Dispose(MenuBar, Done); { Destroy menu bar }
If (StatusLine <> Nil) Then
@ -916,22 +785,6 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TProgram.InitScreen;
BEGIN
{$ifndef Use_API}
If (Lo(ScreenMode) <> smMono) Then Begin { Coloured mode }
If (ScreenMode AND smFont8x8 <> 0) Then
ShadowSize.X := 1 Else { Single bit shadow }
ShadowSize.X := 2; { Double size }
ShadowSize.Y := 1; ShowMarkers := False; { Set variables }
If (Lo(ScreenMode) = smBW80) Then
AppPalette := apBlackWhite Else { B & W palette }
AppPalette := apColor; { Coloured palette }
End Else Begin
ShadowSize.X := 0; { No x shadow size }
ShadowSize.Y := 0; { No y shadow size }
ShowMarkers := True; { Show markers }
AppPalette := apMonochrome; { Mono palette }
End;
{$else Use_API}
{ the orginal code can't be used here because of the limited
video unit capabilities, the mono modus can't be handled
}
@ -947,7 +800,6 @@ BEGIN
else
AppPalette := apBlackWhite;
Buffer := Views.PVideoBuf(VideoBuf);
{$endif Use_API}
END;
{--TProgram-----------------------------------------------------------------}
@ -1023,6 +875,10 @@ BEGIN
NextQueuedEvent(Event); { Next queued event }
If (Event.What = evNothing) Then Begin
GetKeyEvent(Event); { Fetch key event }
{$ifdef DEBUG}
If (Event.What = evKeyDown) then
Writeln(stderr,'Key pressed scancode = ',hexstr(Event.Keycode,4));
{$endif}
If (Event.What = evNothing) Then Begin { No mouse event }
Drivers.GetMouseEvent(Event); { Load mouse event }
If (Event.What = evNothing) Then Idle; { Idle if no event }
@ -1227,7 +1083,10 @@ END;
END.
{
$Log$
Revision 1.8 2001-05-07 22:22:03 pierre
Revision 1.9 2001-05-10 16:46:26 pierre
+ some improovements made
Revision 1.8 2001/05/07 22:22:03 pierre
* removed NO_WINDOW cond, added GRAPH_API
Revision 1.7 2001/05/04 15:43:45 pierre
@ -1247,8 +1106,17 @@ END.
Revision 1.2 2000/08/24 11:43:13 marco
* Added CVS log and ID entries.
}
{******************[ REVISION HISTORY ]********************}
{ Version Date Fix }
{ ------- --------- --------------------------------- }
{ 1.00 12 Dec 96 First multi platform release }
{ 1.10 12 Sep 97 FPK pascal 0.92 conversion added. }
{ 1.20 29 Aug 97 Platform.inc sort added. }
{ 1.30 05 May 98 Virtual pascal 2.0 code added. }
{ 1.40 22 Oct 99 Object registration added. }
{ 1.50 22 Oct 99 Complete recheck preformed }
{ 1.51 03 Nov 99 FPC Windows support added }
{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }

216
fv/dialogs.pas
View File

@ -1,4 +1,4 @@
{ $Id: }
{ $Id$ }
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{ }
{ System independent GRAPHICAL clone of DIALOGS.PAS }
@ -21,29 +21,9 @@
{ 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 11 Nov 96 First DOS/DPMI platform release. }
{ 1.10 13 Jul 97 Windows platform code added. }
{ 1.20 29 Aug 97 Platform.inc sort added. }
{ 1.30 13 Oct 97 Delphi 2 32 bit code added. }
{ 1.40 05 May 98 Virtual pascal 2.0 code added. }
{ 1.50 27 Oct 99 All objects completed and checked }
{ 1.51 03 Nov 99 FPC windows support added }
{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
{ Only Free Pascal Compiler supported }
{ }
{**********************************************************}
UNIT Dialogs;
@ -58,16 +38,6 @@ UNIT Dialogs;
{==== Compiler directives ===========================================}
{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
{$F-} { Short calls are okay }
{$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 }
@ -79,18 +49,7 @@ UNIT Dialogs;
USES
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
{$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard units }
{$ELSE} { OTHER COMPILERS }
WinTypes,WinProcs, { Standard units }
{$ENDIF}
{$ELSE} { SPEEDSOFT COMPILER }
WinBase, WinDef, WinUser, WinGDI, { Standard units }
{$ENDIF}
{$IFDEF PPC_DELPHI} { DELPHI COMPILERS }
Messages, { Standard unit }
{$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
@ -127,14 +86,6 @@ CONST
CDialog = CGrayDialog; { Default palette }
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{---------------------------------------------------------------------------}
{ NEW WIN/NT/OS2 COMMAND CODES }
{---------------------------------------------------------------------------}
CONST
cmTvClusterButton = $2001; { Cluster button cmd id }
{$ENDIF}
{---------------------------------------------------------------------------}
{ TDialog PALETTE COLOUR CONSTANTS }
{---------------------------------------------------------------------------}
@ -492,11 +443,7 @@ PROCEDURE RegisterDialogs;
CONST
RDialog: TStreamRec = (
ObjType: 10; { Register id = 10 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TDialog)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TDialog);
{$ENDIF}
Load: @TDialog.Load; { Object load method }
Store: @TDialog.Store { Object store method }
);
@ -507,11 +454,7 @@ CONST
CONST
RInputLine: TStreamRec = (
ObjType: 11; { Register id = 11 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TInputLine)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TInputLine);
{$ENDIF}
Load: @TInputLine.Load; { Object load method }
Store: @TInputLine.Store { Object store method }
);
@ -522,11 +465,7 @@ CONST
CONST
RButton: TStreamRec = (
ObjType: 12; { Register id = 12 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TButton)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TButton);
{$ENDIF}
Load: @TButton.Load; { Object load method }
Store: @TButton.Store { Object store method }
);
@ -537,11 +476,7 @@ CONST
CONST
RCluster: TStreamRec = (
ObjType: 13; { Register id = 13 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TCluster)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TCluster);
{$ENDIF}
Load: @TCluster.Load; { Object load method }
Store: @TCluster.Store { Objects store method }
);
@ -552,11 +487,7 @@ CONST
CONST
RRadioButtons: TStreamRec = (
ObjType: 14; { Register id = 14 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TRadioButtons)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TRadioButtons);
{$ENDIF}
Load: @TRadioButtons.Load; { Object load method }
Store: @TRadioButtons.Store { Object store method }
);
@ -567,11 +498,7 @@ CONST
CONST
RCheckBoxes: TStreamRec = (
ObjType: 15; { Register id = 15 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TCheckBoxes)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TCheckBoxes);
{$ENDIF}
Load: @TCheckBoxes.Load; { Object load method }
Store: @TCheckBoxes.Store { Object store method }
);
@ -582,11 +509,7 @@ CONST
CONST
RMultiCheckBoxes: TStreamRec = (
ObjType: 27; { Register id = 27 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TMultiCheckBoxes)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TMultiCheckBoxes);
{$ENDIF}
Load: @TMultiCheckBoxes.Load; { Object load method }
Store: @TMultiCheckBoxes.Store { Object store method }
);
@ -597,11 +520,7 @@ CONST
CONST
RListBox: TStreamRec = (
ObjType: 16; { Register id = 16 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TListBox)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TListBox);
{$ENDIF}
Load: @TListBox.Load; { Object load method }
Store: @TListBox.Store { Object store method }
);
@ -612,11 +531,7 @@ CONST
CONST
RStaticText: TStreamRec = (
ObjType: 17; { Register id = 17 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TStaticText)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TStaticText);
{$ENDIF}
Load: @TStaticText.Load; { Object load method }
Store: @TStaticText.Store { Object store method }
);
@ -627,11 +542,7 @@ CONST
CONST
RLabel: TStreamRec = (
ObjType: 18; { Register id = 18 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TLabel)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TLabel);
{$ENDIF}
Load: @TLabel.Load; { Object load method }
Store: @TLabel.Store { Object store method }
);
@ -642,11 +553,7 @@ CONST
CONST
RHistory: TStreamRec = (
ObjType: 19; { Register id = 19 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(THistory)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(THistory);
{$ENDIF}
Load: @THistory.Load; { Object load method }
Store: @THistory.Store { Object store method }
);
@ -657,11 +564,7 @@ CONST
CONST
RParamText: TStreamRec = (
ObjType: 20; { Register id = 20 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TParamText)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TParamText);
{$ENDIF}
Load: @TParamText.Load; { Object load method }
Store: @TParamText.Store { Object store method }
);
@ -679,10 +582,7 @@ USES HistList; { Standard GFV unit }
{---------------------------------------------------------------------------}
{ LEFT AND RIGHT ARROW CHARACTER CONSTANTS }
{---------------------------------------------------------------------------}
{$IFDEF OS_DOS} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
{$IFDEF OS_LINUX} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
{$IFDEF OS_WINDOWS} CONST LeftArr = #$AB; RightArr = #$BB; {$ENDIF}
{$IFDEF OS_OS2} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
CONST LeftArr = #17; RightArr = #16;
{---------------------------------------------------------------------------}
{ TButton MESSAGES }
@ -730,10 +630,6 @@ BEGIN
GrowMode := 0; { Clear grow mode }
Flags := wfMove + wfClose; { Close/moveable flags }
Palette := dpGrayDialog; { Default gray colours }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
GOptions := GOptions AND NOT goThickFramed; { Turn thick frame off }
ExStyle := ws_Ex_DlgModalFrame; { Set extended style }
{$ENDIF}
END;
{--TDialog------------------------------------------------------------------}
@ -752,13 +648,8 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TDialog.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: Array[dpBlueDialog..dpGrayDialog] Of String =
(CBlueDialog, CCyanDialog, CGrayDialog); { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: Array[dpBlueDialog..dpGrayDialog] Of String[Length(CBlueDialog)] =
(CBlueDialog, CCyanDialog, CGrayDialog); { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P[Palette]; { Return palette }
END;
@ -844,11 +735,7 @@ BEGIN
If (MaxAvail > MaxLen+1) Then Begin { Check enough memory }
GetMem(Data, MaxLen + 1); { Allocate memory }
S.Read(Data^[1], Length(Data^)); { Read string data }
{$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(Data^, B); { Xfer string length }
{$ELSE} { OTHER COMPILERS }
Data^[0] := Chr(B); { Set string length }
{$ENDIF}
End Else S.Seek(S.GetPos + B); { Move to position }
If (Options AND ofVersion >= ofVersion20) Then { Version 2 or above }
Validator := PValidator(S.Get); { Get any validator }
@ -883,11 +770,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TInputLine.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CInputLine; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CInputLine)] = CInputLine; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@ -1048,18 +931,11 @@ END;
{ SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.SetData (Var Rec);
{$IFDEF PPC_DELPHI3} VAR Buf: Array [0..256] Of Char; {$ENDIF}
BEGIN
If (Data <> Nil) Then Begin { Data ptr valid }
If (Validator = Nil) OR (Validator^.Transfer(
Data^, @Rec, vtSetData) = 0) Then { No validator/data }
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
Move(Rec, Buf, DataSize); { Fetch our data }
Move(Buf[1], Data^[1], Ord(Buf[0])); { Tranfer string }
SetLength(Data^, Ord(Buf[0])); { Set string length }
{$ELSE} { OTHER COMPILERS }
Move(Rec, Data^[0], DataSize); { Set our data }
{$ENDIF}
End;
SelectAll(True); { Now select all }
END;
@ -1169,11 +1045,7 @@ Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Integer;
If NOT Validator^.IsValidInput(NewData,
NoAutoFill) Then RestoreState Else Begin
If (Length(NewData) > MaxLen) Then { Exceeds maximum }
{$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(NewData, MaxLen); { Set string length }
{$ELSE} { OTHER COMPILERS }
NewData[0] := Chr(MaxLen); { Set string length }
{$ENDIF}
If (Data <> Nil) Then Data^ := NewData; { Set data value }
If (Data <> Nil) AND (CurPos >= OldLen) { Cursor beyond end }
AND (Length(Data^) > OldLen) Then { Cursor beyond string }
@ -1210,11 +1082,7 @@ BEGIN
SelectAll(True) Else Begin { Select whole text }
Anchor := MousePos; { Start of selection }
Repeat
{$IFDEF OS_DOS} { DOS/DPMI CODE }
If (Event.What = evMouseAuto) { Mouse auto event }
{$ELSE} { WIN/NT/OS2 CODE }
If (Event.What = evMouseMove) { Mouse move event }
{$ENDIF}
Then Begin
Delta := MouseDelta; { New position }
If CanScroll(Delta) Then { If can scroll }
@ -1304,11 +1172,7 @@ BEGIN
If (Data <> Nil) Then OldData := Copy(Data^,
FirstPos+1, CurPos-FirstPos) { Text area string }
Else OldData := ''; { Empty string }
{$IFDEF OS_DOS} { DOS/DPMI CODE }
Delta := FontWidth; { Safety = 1 char }
{$ELSE} { WIN/NT CODE }
Delta := 2*FontWidth; { Safety = 2 char }
{$ENDIF}
While (TextWidth(OldData) > ((RawSize.X+1)-Delta)
- TextWidth(LeftArr) - TextWidth(RightArr)) { Check text fits }
Do Begin
@ -1396,11 +1260,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TButton.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CButton; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CButton)] = CButton; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Get button palette }
END;
@ -1455,15 +1315,15 @@ BEGIN
I := (RawSize.X - I) DIV 2; { Centre in button }
End Else I := FontWidth; { Left edge of button }
MoveCStr(Db, Title^, Bc); { Move title to buffer }
{$ifndef USE_API}
GOptions := GOptions OR goGraphView; { Graphics co-ords mode }
WriteLine(I, FontHeight DIV 2, CStrLen(Title^),
1, Db); { Write the title }
GOptions := GOptions AND NOT goGraphView; { Return to normal mode }
{$else USE_API}
WriteLine(I div SysFontWidth, 0, CStrLen(Title^),
1, Db); { Write the title }
{$endif USE_API}
If not TextModeGFV then Begin
GOptions := GOptions OR goGraphView; { Graphics co-ords mode }
WriteLine(I, FontHeight DIV 2, CStrLen(Title^),
1, Db); { Write the title }
GOptions := GOptions AND NOT goGraphView; { Return to normal mode }
End Else Begin
WriteLine(I div SysFontWidth, 0, CStrLen(Title^),
1, Db); { Write the title }
End;
End;
END;
@ -1671,11 +1531,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TCluster.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CCluster; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CCluster)] = CCluster; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Cluster palette }
END;
@ -1950,7 +1806,6 @@ BEGIN
Exit; { Now exit }
End;
End;
{$IFDEF OS_DOS} { DOS/DPMI CODE }
If (Event.CharCode = ' ') AND { Spacebar key }
(State AND sfFocused <> 0) AND { Check focused view }
ButtonState(Sel) Then Begin { Check item enabled }
@ -1959,7 +1814,6 @@ BEGIN
DrawView; { Now draw changes }
ClearEvent(Event); { Event was handled }
End;
{$ENDIF}
End;
End;
End;
@ -2275,7 +2129,6 @@ END;
{ NewList -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TListBox.NewList (AList: PCollection);
{$IFDEF OS_WINDOWS} VAR I: Integer; S: String; P: PString; {$ENDIF}
BEGIN
If (List <> Nil) Then Dispose(List, Done); { Dispose old list }
List := AList; { Hold new list }
@ -2348,11 +2201,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TStaticText.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CStaticText; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CStaticText)] = CStaticText; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@ -2509,11 +2358,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TLabel.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CLabel; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CLabel)] = CLabel; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@ -2620,11 +2465,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistoryViewer.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CHistoryViewer; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistoryViewer)] = CHistoryViewer;{ Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@ -2684,11 +2525,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistoryWindow.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CHistoryWindow; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistoryWindow)] = CHistoryWindow;{ Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return the palette }
END;
@ -2739,11 +2576,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistory.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CHistory; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistory)] = CHistory; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return the palette }
END;
@ -2816,11 +2649,7 @@ BEGIN
If (C = cmOk) Then Begin { Result was okay }
Rslt := HistoryWindow^.GetSelection; { Get history selection }
If Length(Rslt) > Link^.MaxLen Then
{$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(Rslt, Link^.MaxLen); { Hold new length }
{$ELSE}
Rslt[0] := Char(Link^.MaxLen); { Hold new length }
{$ENDIF}
Link^.Data^ := Rslt; { Hold new selection }
Link^.SelectAll(True); { Select all string }
Link^.DrawView; { Redraw link view }
@ -2881,7 +2710,10 @@ END;
END.
{
$Log$
Revision 1.7 2001-05-07 22:22:03 pierre
Revision 1.8 2001-05-10 16:46:27 pierre
+ some improovements made
Revision 1.7 2001/05/07 22:22:03 pierre
* removed NO_WINDOW cond, added GRAPH_API
Revision 1.6 2001/05/04 10:46:01 pierre
@ -2898,6 +2730,16 @@ END.
Revision 1.2 2000/08/24 12:00:20 marco
* CVS log and ID tags
}
{******************[ REVISION HISTORY ]********************}
{ Version Date Fix }
{ ------- --------- --------------------------------- }
{ 1.00 11 Nov 96 First DOS/DPMI platform release. }
{ 1.10 13 Jul 97 Windows platform code added. }
{ 1.20 29 Aug 97 Platform.inc sort added. }
{ 1.30 13 Oct 97 Delphi 2 32 bit code added. }
{ 1.40 05 May 98 Virtual pascal 2.0 code added. }
{ 1.50 27 Oct 99 All objects completed and checked }
{ 1.51 03 Nov 99 FPC windows support added }
{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
{**********************************************************}

1659
fv/drivers.pas
View File

File diff suppressed because it is too large Load Diff

22
fv/gfvgraph.pas
View File

@ -293,25 +293,28 @@ END;
PROCEDURE SetViewPort (X1, Y1, X2, Y2: Integer; Clip, TextMode: Boolean);
BEGIN
{$IFDEF GRAPH_API}
If TextMode Then Begin { TEXT MODE GFV }
If TextMode Then Begin { TEXT MODE GFV }
{$ENDIF GRAPH_API}
If (X1 < 0) Then X1 := 0; { X1 negative fix }
If (X1 > SysScreenWidth) Then
X1 := SysScreenWidth; { X1 off screen fix }
If (X1 >SysScreenWidth) Then
X1 := SysScreenWidth; { X1 off screen fix }
If (Y1 < 0) Then Y1 := 0; { Y1 negative fix }
If (Y1 > SysScreenHeight) Then
Y1 := SysScreenHeight; { Y1 off screen fix }
Y1 := SysScreenHeight; { Y1 off screen fix }
If (X2 < 0) Then X2 := 0; { X2 negative fix }
If (X2 > SysScreenWidth) Then
X2 := SysScreenWidth; { X2 off screen fix }
X2 := SysScreenWidth; { X2 off screen fix }
If (Y2 < 0) Then Y2 := 0; { Y2 negative fix }
If (Y2 > SysScreenHeight) Then
Y2 := SysScreenHeight; { Y2 off screen fix }
Y2 := SysScreenHeight; { Y2 off screen fix }
ViewPort.X1 := X1; { Set X1 port value }
ViewPort.Y1 := Y1; { Set Y1 port value }
ViewPort.X2 := X2; { Set X2 port value }
ViewPort.Y2 := Y2; { Set Y2 port value }
ViewPort.Clip := Clip; { Set port clip value }
{$ifdef DEBUG}
Writeln(stderr,'New ViewPort(',X1,',',Y1,',',X2,',',Y2,')');
{$endif DEBUG}
Cxp := X1; { Set current x pos }
Cyp := Y1; { Set current y pos }
{$IFDEF GRAPH_API}
@ -333,7 +336,7 @@ BEGIN
{$IFDEF GRAPH_API}
If TextMode Then
{$ENDIF GRAPH_API}
GetMaxX := SysScreenWidth-1 { Screen width }
GetMaxX := SysScreenWidth-1 { Screen width }
{$IFDEF GRAPH_API}
Else GetMaxX := Graph.GetMaxX; { Call graph func }
{$ENDIF GRAPH_API}
@ -398,7 +401,10 @@ END;
END.
{
$Log$
Revision 1.7 2001-05-07 23:36:35 pierre
Revision 1.8 2001-05-10 16:46:28 pierre
+ some improovements made
Revision 1.7 2001/05/07 23:36:35 pierre
NO_WINDOW cond removed
Revision 1.6 2001/05/07 22:22:03 pierre

525
fv/views.pas
View File

@ -57,17 +57,6 @@ UNIT Views;
{==== 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 }
@ -164,6 +153,7 @@ CONST
goTabSelect = $0008; { Tab selectable }
goEveryKey = $0020; { Report every key }
goEndModal = $0040; { End modal }
goNoShadow = $0080; { Do not write shadows }
goGraphView = $1000; { Raw graphic view }
goGraphical = $2000; { Graphical view }
@ -297,15 +287,6 @@ CONST
wnNoNumber = 0; { Window has no num }
MaxViewWidth = 132; { Max view width }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{---------------------------------------------------------------------------}
{ WIN32/NT LABEL CONSTANTS FOR WINDOW PROPERTY CALLS }
{---------------------------------------------------------------------------}
CONST
ViewPtr = 'TVWINPTR'+#0; { View ptr label }
{$ENDIF}
{***************************************************************************}
{ PUBLIC TYPE DEFINITIONS }
@ -420,6 +401,7 @@ TYPE
PROCEDURE DrawFocus; Virtual;
PROCEDURE DrawCursor; Virtual;
PROCEDURE DrawBorder; Virtual;
PROCEDURE DrawShadow; Virtual;
PROCEDURE HideCursor;
PROCEDURE ShowCursor;
PROCEDURE BlockCursor;
@ -480,7 +462,8 @@ TYPE
Count: Integer);
PROCEDURE DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
MinSize, MaxSize: TPoint);
PROCEDURE WriteAbs(X, Y, L :Integer;var Buf);
PROCEDURE WriteShadow(X1, Y1, X2, Y2 : Integer);
FUNCTION FontWidth: Integer;
FUNCTION Fontheight: Integer;
@ -725,37 +708,6 @@ FUNCTION CreateIdScrollBar (X, Y, Size, Id: Integer; Horz: Boolean): PScrollBar;
{ INITIALIZED PUBLIC VARIABLES }
{***************************************************************************}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
TYPE TColorRef = LongInt; { TColorRef defined }
{---------------------------------------------------------------------------}
{ 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 }
@ -1201,10 +1153,17 @@ END;
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 }
If TextModeGFV then Begin
If (Origin.X > X2) Then Exit; { Area to the left }
If ((Origin.X + Size.X) < X1) Then Exit; { Area to the right }
If (Origin.Y > Y2) Then Exit; { Area is above }
If ((Origin.Y + Size.Y) < Y1) Then Exit; { Area is below }
End Else Begin
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 }
End;
OverLapsArea := True; { Return true }
END;
@ -1267,7 +1226,14 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawView;
VAR ViewPort: ViewPortType; { Common variables }
Parent : PGroup;
BEGIN
Parent:=Owner;
While Assigned(Parent) do Begin
If (Parent^.LockFlag>0) then
exit;
Parent:=Parent^.Owner;
End;
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 }
@ -1277,6 +1243,7 @@ BEGIN
ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
HideMouseCursor; { Hide mouse cursor }
If (DrawMask = 0) OR (DrawMask = vdNoChild) { No special masks set }
{ OR Assigned(LimitsLocked) }
Then Begin { Treat as a full redraw }
DrawBackGround; { Draw background }
Draw; { Draw interior }
@ -1287,18 +1254,36 @@ BEGIN
If (Options AND ofFramed <> 0) OR
(GOptions AND goThickFramed <> 0) { View has border }
Then DrawBorder; { Draw border }
If ((State AND sfShadow) <> 0) AND
(GOptions And goNoShadow = 0) Then
DrawShadow;
End Else Begin { Masked draws only }
If (DrawMask AND vdBackGnd <> 0) Then { Chk background mask }
DrawBackGround; { Draw background }
Begin
DrawMask := DrawMask and Not vdBackGnd;
DrawBackGround; { Draw background }
end;
If (DrawMask AND vdInner <> 0) Then { Check Inner mask }
Draw; { Draw interior }
Begin
DrawMask := DrawMask and Not vdInner;
Draw; { Draw interior }
End;
If (DrawMask AND vdFocus <> 0)
AND (GOptions AND goDrawFocus <> 0)
Then DrawFocus; { Check focus mask }
AND (GOptions AND goDrawFocus <> 0) then
Begin
DrawMask := DrawMask and Not vdFocus;
DrawFocus; { Check focus mask }
End;
If (DrawMask AND vdCursor <> 0) Then { Check cursor mask }
DrawCursor; { Draw any cursor }
Begin
DrawMask := DrawMask and Not vdCursor;
DrawCursor; { Draw any cursor }
End;
If (DrawMask AND vdBorder <> 0) Then { Check border mask }
DrawBorder; { Draw border }
Begin
DrawMask := DrawMask and Not vdBorder;
DrawBorder; { Draw border }
End;
End;
ShowMouseCursor; { Show mouse cursor }
End;
@ -1342,6 +1327,8 @@ VAR I : sw_integer;
VerticalBar,
LeftLowCorner,
RightLowCorner : Char;
Color : Byte;
Focused : Boolean;
BEGIN
If (TextModeGFV = FALSE) Then Begin { GRAPHICS GFV MODE }
BiColorRectangle(0, 0, RawSize.X, RawSize.Y,
@ -1355,7 +1342,10 @@ BEGIN
White, DarkGray, True); { Draw highlights }
End;
End Else Begin { TEXT GFV MODE }
If not Focus or (GOptions AND goThickFramed = 0) then
Focused:=(State AND (sfSelected + sfModal)<>0);
if Assigned(Owner) then
Focused := Focused AND (@Self = Owner^.First);
If not Focused or (GOptions AND goThickFramed = 0) then
begin
LeftUpCorner:='Ú';
RightUpCorner:='¿';
@ -1373,20 +1363,49 @@ BEGIN
LeftLowCorner:='È';
RightLowCorner:='¼';
end;
WriteChar(0,0,LeftUpCorner,1,1);
WriteChar(1,0,HorizontalBar,1,Size.X-2);
WriteChar(Size.X-1,0,RightUpcorner,1,1);
if Focused then
Color := 2
else
Color := 1;
WriteChar(0,0,LeftUpCorner,Color,1);
WriteChar(1,0,HorizontalBar,Color,Size.X-2);
WriteChar(Size.X-1,0,RightUpcorner,Color,1);
For i:=1 to Size.Y -1 do
begin
WriteChar(0,i,VerticalBar,1,1);
WriteChar(Size.X-1,i,VerticalBar,1,1);
WriteChar(0,i,VerticalBar,Color,1);
WriteChar(Size.X-1,i,VerticalBar,Color,1);
end;
WriteChar(0,Size.Y-1,LeftLowCorner,1,1);
WriteChar(1,Size.Y-1,HorizontalBar,1,Size.X-2);
WriteChar(Size.X-1,Size.Y-1,RightLowCorner,1,1);
WriteChar(0,Size.Y-1,LeftLowCorner,Color,1);
WriteChar(1,Size.Y-1,HorizontalBar,Color,Size.X-2);
WriteChar(Size.X-1,Size.Y-1,RightLowCorner,Color,1);
End;
END;
PROCEDURE TView.DrawShadow;
VAR X1, Y1, X2, Y2 : Integer;
BEGIN
If not TextModeGFV then
exit;
If Assigned(Owner) Then Begin
X1:=RawOrigin.X+RawSize.X+1;
X2:=X1+ShadowSize.X*SysFontWidth;
Y1:=RawOrigin.Y+SysFontHeight;
Y2:=RawOrigin.Y+RawSize.Y+1+ShadowSize.Y*SysFontHeight;
GOptions := GOptions OR goNoShadow;
Owner^.RedrawArea(X1,Y1,X2,Y2);
WriteShadow(X1 div SysFontWidth, Y1 div SysFontHeight,
X2 div SysFontWidth, Y2 div SysFontHeight);
X1:=RawOrigin.X+SysFontWidth;
X2:=RawOrigin.X+RawSize.X+1;
Y1:=RawOrigin.Y+RawSize.Y+1;
Y2:=RawOrigin.Y+RawSize.Y+1+ShadowSize.Y*SysFontHeight;
Owner^.RedrawArea(X1,Y1,X2,Y2);
WriteShadow(X1 div SysFontWidth, Y1 div SysFontHeight,
X2 div SysFontWidth, Y2 div SysFontHeight);
GOptions := GOptions AND not goNoShadow;
End;
END;
{--TView--------------------------------------------------------------------}
{ HideCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
{---------------------------------------------------------------------------}
@ -1462,6 +1481,13 @@ BEGIN
Then Y2 := P^.RawOrigin.Y + P^.RawSize.Y; { Y maximum contain }
P := P^.Owner; { Move to owners owner }
End;
If TextModeGFV then Begin
X1 := X1 div SysFontWidth;
X2 := (X2 +SysFontWidth - 1) div SysFontWidth;
Y1 := Y1 div SysFontHeight;
Y2 := (Y2 +SysFontHeight -1) div SysFontHeight;
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 }
@ -1482,38 +1508,48 @@ END;
PROCEDURE TView.DrawBackGround;
VAR Bc: Byte; X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
X, Y: Integer;
Buf : TDrawBuffer;
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, TextModeGFV); { 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 }
If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
SetFillStyle(SolidFill, Bc); { Set fill colour }
Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
End Else Begin { TEXT MODE GFV }
X1 := (RawOrigin.X+X1) DIV SysFontWidth;
Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight;
X2 := (RawOrigin.X+X2) DIV SysFontWidth;
Y2 := (RawOrigin.Y+Y2) DIV SysFontHeight;
If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
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 }
SetFillStyle(SolidFill, Bc); { Set fill colour }
Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
End Else Begin { TEXT MODE GFV }
If (ViewPort.X1 <= Origin.X) Then
X1 := Origin.X { Right to left edge }
Else X1 := ViewPort.X1; { Offset from left }
If (ViewPort.Y1 <= Origin.Y) Then
Y1 := Origin.Y { Right to top edge }
Else Y1 := ViewPort.Y1; { Offset from top }
If (ViewPort.X2 >= Origin.X+Size.X) Then
X2 := Origin.X + Size.X Else { Right to right edge }
X2 := ViewPort.X2; { Offset from right }
If (ViewPort.Y2 >= Origin.Y+Size.Y) Then
Y2 := Origin.Y + Size.Y Else { Right to bottom edge }
Y2 := ViewPort.Y2; { Offset from bottom }
If (State AND sfDisabled = 0) Then
Bc := GetColor(1) Else { Select back colour }
Bc := GetColor(4); { Disabled back colour }
For Y := Y1 To Y2 Do
For X := X1 To X2 Do Begin
{ FIXME: we shouldn't write direct here }
VideoBuf^[(Y*Drivers.ScreenWidth+X)] := (Bc shl 8) or $20;
End;
For X := X1 To X2 Do Begin
Buf[X-X1]:=(Bc shl 8) or $20;
End;
For Y := Y1 To Y2 Do Begin
WriteAbs(X1,Y, X2-X1, Buf);
End;
{ FIXME: we shouldn't update always here }
UpdateScreen(false);
End;
@ -1560,6 +1596,8 @@ END;
{ SetDrawMask -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetDrawMask (Mask: Byte);
VAR
OldMask : byte;
BEGIN
If (Options AND ofFramed = 0) AND { Check for no frame }
(GOptions AND goThickFramed = 0) AND { Check no thick frame }
@ -1569,7 +1607,20 @@ BEGIN
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 }
OldMask:=DrawMask;
DrawMask := DrawMask OR Mask; { Set draw masks }
(*If TextModeGFV and (DrawMask<>0) and (DrawMask<>OldMask) then Begin
Mask:=vdBackGnd OR vdInner OR vdBorder OR vdCursor OR vdFocus;
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; *)
END;
{--TView--------------------------------------------------------------------}
@ -1620,12 +1671,14 @@ BEGIN
If (Owner <> Nil) Then Owner^.ReDrawArea(
RawOrigin.X, RawOrigin.Y, RawOrigin.X +
RawSize.X, RawOrigin.Y + RawSize.Y); { Redraw old area }
Owner^.Lock;
Owner^.RemoveView(@Self); { Remove from list }
Owner^.InsertView(@Self, Target); { Insert into list }
State := State OR sfVisible; { Allow drawing again }
If (LastView <> Target) Then DrawView; { Draw the view now }
If (Options AND ofSelectable <> 0) Then { View is selectable }
If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset current }
Owner^.Unlock;
End;
END;
@ -1662,6 +1715,12 @@ PROCEDURE TView.ReDrawArea (X1, Y1, X2, Y2: Integer);
VAR HLimit: PView; ViewPort: ViewPortType;
BEGIN
GetViewSettings(ViewPort, TextModeGFV); { Hold view port }
If TextModeGFV then Begin
X1 := X1 div SysFontWidth;
X2 := (X2 +SysFontWidth - 1) div SysFontWidth;
Y1 := Y1 div SysFontHeight;
Y2 := (Y2 +SysFontHeight -1) div SysFontHeight;
End;
SetViewPort(X1, Y1, X2, Y2, ClipOn, TextModeGFV); { Set new clip limits }
HLimit := LimitsLocked; { Hold lock limits }
LimitsLocked := @Self; { We are the lock view }
@ -1695,10 +1754,13 @@ END;
{ SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetState (AState: Word; Enable: Boolean);
VAR Command: Word;
VAR OldState, Command: Word;
ShouldDraw : Boolean;
BEGIN
OldState := State;
If Enable Then State := State OR AState { Set state mask }
Else State := State AND NOT AState; { Clear state mask }
ShouldDraw:=false;
If (AState AND sfVisible <> 0) Then Begin { Visibilty change }
If (Owner <> Nil) AND { valid owner }
(Owner^.State AND sfExposed <> 0) { If owner exposed }
@ -1715,17 +1777,22 @@ BEGIN
If Enable Then Command := cmReceivedFocus { View gaining focus }
Else Command := cmReleasedFocus; { View losing focus }
Message(Owner, evBroadcast, Command, @Self); { Send out message }
SetDrawMask(vdBorder); { Set border draw mask }
ShouldDraw:=true;
End;
If (GOptions AND goDrawFocus <> 0) Then Begin { Draw focus view }
If (GOptions AND goDrawFocus <> 0) AND
(((AState XOR OldState) AND sfFocused) <> 0) Then Begin { Draw focus view }
SetDrawMask(vdFocus); { Set focus draw mask }
DrawView; { Redraw focus change }
ShouldDraw:=true;
End;
End;
If (AState AND (sfCursorVis + sfCursorIns) <> 0) { Change cursor state }
Then Begin
SetDrawMask(vdCursor); { Set cursor draw mask }
DrawView; { Redraw the cursor }
ShouldDraw:=true;
End;
If ShouldDraw then
DrawView; { Redraw the border }
END;
{--TView--------------------------------------------------------------------}
@ -2270,7 +2337,7 @@ FUNCTION TGroup.FirstThat (P: Pointer): PView; ASSEMBLER;
JNZ .L_LoopPoint; { Continue to last }
XOR %EAX, %EAX; { No views gave true }
.L_Exit:
MOVL %EAX, __RESULT; { Return result }
{MOVL %EAX, __RESULT;not needed for assembler functions Return result }
END;
{--TGroup-------------------------------------------------------------------}
@ -2529,7 +2596,7 @@ BEGIN
If (Current <> Nil) Then
Current^.SetState(sfFocused, Enable); { Focus current view }
If TextModeGFV then
SetDrawMask(vdBackGnd OR vdFocus OR vdInner); { Set redraw masks }
SetDrawMask(vdBackGnd OR vdFocus OR vdInner OR vdBorder); { Set redraw masks }
End;
sfExposed: Begin
ForEach(@DoExpose); { Expose each subview }
@ -4135,6 +4202,7 @@ END;
PROCEDURE TView.ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
VAR
X, Y: Integer; ViewPort: ViewPortType;
Buf : TDrawBuffer;
BEGIN
GetViewSettings(ViewPort, TextModeGFV); { Get viewport }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL GFV MODE }
@ -4147,11 +4215,12 @@ BEGIN
Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight;
X2 := (RawOrigin.X+X2-1) DIV SysFontWidth;
Y2 := (RawOrigin.Y+Y2-1) DIV SysFontHeight;
For X := X1 To X2 Do Begin
Buf[X-X1]:=(Colour shl 12) or $20;
End;
For Y := Y1 To Y2 Do
For X := X1 To X2 Do Begin
VideoBuf^[(Y*Drivers.ScreenWidth+X)] := (Colour shl 12) or $20;
End;
UpdateScreen(false);
WriteAbs(X1,Y, X2-X1, Buf);
UpdateScreen(false);
End;
END;
@ -4197,7 +4266,7 @@ BEGIN
Dc := ODc; { Reset held context }
End;
{$ENDIF}
{$ENDIF not NOT_IMPLEMENTED}
{$ENDIF NOT_IMPLEMENTED}
END;
PROCEDURE TView.FilletArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad, Ht: Integer;
@ -4205,7 +4274,7 @@ 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
{$IFNDEF NOT_IMPLEMENTED}
{$IFDEF NOT_IMPLEMENTED}
{$IFDEF OS_WINDOWS}
If (HWindow <> 0) Then Begin { Valid window }
Xc := Xc - FrameSize;
@ -4250,7 +4319,7 @@ BEGIN
Dc := ODc; { Reset held context }
End;
{$ENDIF}
{$ENDIF not NOT_IMPLEMENTED}
{$ENDIF NOT_IMPLEMENTED}
END;
{--TView--------------------------------------------------------------------}
@ -4300,28 +4369,26 @@ BEGIN
Y := Y - ViewPort.Y1; { Calc y position }
End;
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 }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
If (TextModeGFV) Then Begin { TEXT MODE GFV }
WriteAbs(X,Y,W,P^[L]);
Inc(Y);
Inc(L,W);
End Else Begin
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 }
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 }
$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 }
Inc(K,Cw);
End else Begin
VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[L];
Inc(K);
Inc(L); { Next character }
End;
Inc(L); { Next character }
End;
If Not TextModeGFV then
Y := Y + SysFontHeight { Next line down }
Else
Inc(Y); { Next line down }
end;
Y := Y + SysFontHeight; { Next line down }
end;
Video.UpdateScreen(false);
End;
end;
END;
@ -4351,25 +4418,22 @@ BEGIN
Y := Y - ViewPort.Y1; { Calc y position }
End;
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 }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
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 }
Inc(K,Cw);
End Else Begin { TEXT MODE GFV }
VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[I];
Inc(K);
End;
If (TextModeGFV) Then Begin { TEXT MODE GFV }
WriteAbs(X,Y,W,P^);
Inc(Y);
End Else Begin
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 }
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 }
Inc(K,Cw);
End;
Y := Y + SysFontHeight; { Next line down }
End;
If Not TextModeGFV then
Y := Y + SysFontHeight { Next line down }
Else
Inc(Y); { Next line down }
end;
Video.UpdateScreen(false);
End;
@ -4406,6 +4470,7 @@ END;
PROCEDURE TView.WriteStr (X, Y: Integer; Str: String; Color: Byte);
VAR Fc, Bc, B: Byte; X1, Y1, X2, Y2: Integer;
Tix, Tiy, Ti: Integer; ViewPort: ViewPortType;
Buf : TDrawBuffer;
BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) AND { View is exposed }
@ -4441,9 +4506,9 @@ BEGIN
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
For Ti := 1 To length(Str) Do Begin
VideoBuf^[((Tiy * Drivers.ScreenWidth)+Tix)] := (GetColor(Color) shl 8) or Ord(Str[Ti]);
Inc(Tix);
Buf[Ti-1]:=(GetColor(Color) shl 8) or Ord(Str[Ti]);
end;
WriteAbs(Tix,TiY,Length(Str),Buf);
End;
UpdateScreen(false);
End;
@ -4452,6 +4517,7 @@ END;
PROCEDURE TView.WriteChar (X, Y: Integer; C: Char; Color: Byte;
Count: Integer);
VAR Fc, Bc: Byte; I, Ti, Tix, Tiy: Integer; Col: Word; S: String; ViewPort: ViewPortType;
Buf : TDrawBuffer;
BEGIN
If (State AND sfVisible <> 0) AND { View visible }
(State AND sfExposed <> 0) Then Begin { View exposed }
@ -4459,26 +4525,31 @@ BEGIN
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 }
If (X >= 0) AND (Y >= 0) AND ((GOptions and goGraphView)=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;
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 }
If (Count>Size.X) Then I := Size.X Else I := Count; { Size to make }
S[0] := Chr(I); { Set string length }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
SetFillStyle(SolidFill, Bc); { Set fill style }
Bar(X-ViewPort.X1, Y-ViewPort.Y1,
X-ViewPort.X1+Length(S)*FontWidth,
X-ViewPort.X1+I*FontWidth,
Y-ViewPort.Y1+FontHeight-1);
SetColor(Fc);
OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1, S); { Write text char }
End Else Begin { TEXT MODE GFV }
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
For Ti := 1 To length(S) Do Begin
VideoBuf^[((Tiy * Drivers.ScreenWidth)+Tix)] := (GetColor(Color) shl 8) or Ord(S[Ti]);
Inc(Tix);
For Ti := 1 To I Do Begin
Buf[Ti-1]:=(GetColor(Color) shl 8) or Ord(S[Ti]);
End;
WriteAbs(TiX,TiY,Length(S),Buf);
End;
Count := Count - I; { Subtract count }
If TextModeGFV then
@ -4491,6 +4562,138 @@ BEGIN
End;
END;
{define DirectWrite}
PROCEDURE TView.WriteAbs(X, Y, L : Integer; Var Buf);
VAR
P: PGroup;
PrevP,PP : PView;
CurOrigin : TPoint;
I,XI : longint;
ViewPort : ViewPortType;
BEGIN
{ Direct wrong method }
GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
{$ifdef DirectWrite}
For i:=0 to L-1 do Begin
if (X+I>=ViewPort.X1) AND (Y>=ViewPort.Y1) AND
(X+I<ViewPort.X2) AND (Y<ViewPort.Y2) Then
VideoBuf^[Y*ScreenWidth+X+i]:=TDrawBuffer(Buf)[i];
End;
{$else not DirectWrite}
{ Pedestrian character method }
{ Must be in area }
If (X+L<ViewPort.X1) OR (Y<ViewPort.Y1) OR
(X>=ViewPort.X2) OR (Y>=ViewPort.Y2) Then
Exit;
For I:=0 to L-1 do Begin
P:=Owner;
PrevP :=@Self;
XI:=X+I;
{ Must be in area }
If (XI<ViewPort.X1) OR
(XI>=ViewPort.X2) Then
Continue;
While Assigned(P) do Begin
if not assigned(P^.Buffer) AND
(((P^.State AND sfVisible) = 0) OR
(P^.Origin.X>XI) OR (P^.Origin.X+P^.Size.X<=XI) OR
(P^.Origin.Y>Y) OR (P^.Origin.Y+P^.Size.Y<=Y)) then
continue;
{ Here we must check if X,Y is exposed for this view }
PP:=P^.Last;
{ move to first }
If Assigned(PP) then
PP:=PP^.Next;
While Assigned(PP) and (PP<>P^.Last) and (PP<>PrevP) do Begin
If ((PP^.State AND sfVisible) <> 0) AND
(PP^.Origin.X>=XI) AND
(PP^.Origin.X+PP^.Size.X<XI) AND
(PP^.Origin.Y>=Y) AND
(PP^.Origin.Y+PP^.Size.Y<Y) then
exit;
PP:=PP^.Next;
End;
If Assigned(P^.Buffer) then Begin
P^.Buffer^[(Y-P^.Origin.Y)*P^.size.X+(XI-P^.Origin.X)]:=TDrawBuffer(Buf)[I];
End;
PrevP:=P;
P:=P^.Owner;
End;
End;
{$endif not DirectWrite}
END;
{define DirectWriteShadow}
PROCEDURE TView.WriteShadow(X1, Y1, X2, Y2 : Integer);
VAR
P: PGroup;
PrevP,PP : PView;
CurOrigin : TPoint;
I,J : longint;
B : Word;
ViewPort : ViewPortType;
BEGIN
{ Direct wrong method }
GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
{$ifdef DirectWriteShadow}
For J:=Y1 to Y2-1 do Begin
For i:=X1 to X2-1 do Begin
{ if (I>=ViewPort.X1) AND (J>=ViewPort.Y1) AND
(I<ViewPort.X2) AND (J<ViewPort.Y2) Then }
Begin
B:=VideoBuf^[J*ScreenWidth+i];
VideoBuf^[J*ScreenWidth+i]:= (B and $7FF);
End;
End;
End;
{$else not DirectWriteShadow}
{ Pedestrian character method }
{ Must be in area }
{If (X+L<ViewPort.X1) OR (Y<ViewPort.Y1) OR
(X>=ViewPort.X2) OR (Y>=ViewPort.Y2) Then
Exit;}
For J:=Y1 to Y2-1 do Begin
For i:=X1 to X2-1 do Begin
P:=Owner;
PrevP :=@Self;
{ Must be in area
If (XI<ViewPort.X1) OR
(XI>=ViewPort.X2) Then
Continue; }
While Assigned(P) do Begin
if not assigned(P^.Buffer) AND
(((P^.State AND sfVisible) = 0) OR
(P^.Origin.X>I) OR (P^.Origin.X+P^.Size.X<=I) OR
(P^.Origin.Y>J) OR (P^.Origin.Y+P^.Size.Y<=J)) then
continue;
{ Here we must check if X,Y is exposed for this view }
PP:=P^.Last;
{ move to first }
If Assigned(PP) then
PP:=PP^.Next;
While Assigned(PP) and (PP<>P^.Last) and (PP<>PrevP) do Begin
If ((PP^.State AND sfVisible) <> 0) AND
(PP^.Origin.X>=I) AND
(PP^.Origin.X+PP^.Size.X<I) AND
(PP^.Origin.Y>=J) AND
(PP^.Origin.Y+PP^.Size.Y<J) then
continue;
PP:=PP^.Next;
End;
If Assigned(P^.Buffer) then Begin
B:=P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)];
P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)]:= (B and $7FF);
End;
PrevP:=P;
P:=P^.Owner;
End;
End;
End;
{$endif not DirectWriteShadow}
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;
@ -4705,10 +4908,15 @@ END;
{--TGroup-------------------------------------------------------------------}
{ Lock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB }
{---------------------------------------------------------------------------}
{$ifndef NoLock}
{$define UseLock}
{$endif ndef NoLock}
PROCEDURE TGroup.Lock;
BEGIN
If (Buffer <> Nil) OR (LockFlag <> 0)
Then Inc(LockFlag); { Increment count }
{$ifdef UseLock}
{If (Buffer <> Nil) OR (LockFlag <> 0)
Then} Inc(LockFlag); { Increment count }
{$endif UseLock}
END;
{--TGroup-------------------------------------------------------------------}
@ -4716,10 +4924,12 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TGroup.Unlock;
BEGIN
{$ifdef UseLock}
If (LockFlag <> 0) Then Begin
Dec(LockFlag); { Decrement count }
{If (LockFlag = 0) Then DrawView;} { Lock release draw }
If (LockFlag = 0) Then DrawView; { Lock release draw }
End;
{$endif UseLock}
END;
PROCEDURE TWindow.DrawBorder;
@ -4878,7 +5088,10 @@ END.
{
$Log$
Revision 1.9 2001-05-07 23:36:35 pierre
Revision 1.10 2001-05-10 16:46:28 pierre
+ some improovements made
Revision 1.9 2001/05/07 23:36:35 pierre
NO_WINDOW cond removed
Revision 1.8 2001/05/04 15:43:46 pierre

186
fvision/app.pas
View File

@ -22,28 +22,9 @@
{ 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) }
{ - FPC 0.9912+ (32 Bit) }
{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ }
{******************[ REVISION HISTORY ]********************}
{ Version Date Fix }
{ ------- --------- --------------------------------- }
{ 1.00 12 Dec 96 First multi platform release }
{ 1.10 12 Sep 97 FPK pascal 0.92 conversion added. }
{ 1.20 29 Aug 97 Platform.inc sort added. }
{ 1.30 05 May 98 Virtual pascal 2.0 code added. }
{ 1.40 22 Oct 99 Object registration added. }
{ 1.50 22 Oct 99 Complete recheck preformed }
{ 1.51 03 Nov 99 FPC Windows support added }
{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
{ Only Free Pascal Compiler supported }
{ }
{**********************************************************}
UNIT App;
@ -58,17 +39,6 @@ UNIT App;
{==== Compiler directives ===========================================}
{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
{$F-} { Near calls are okay }
{$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 }
@ -79,21 +49,7 @@ UNIT App;
USES
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
{$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard units }
{$ELSE} { OTHER COMPILERS }
WinTypes,WinProcs, { Standard units }
{$ENDIF}
{$IFNDEF PPC_DELPHI} { NON DELPHI1 COMPILER }
{$IFDEF BIT_16} Win31, {$ENDIF} { 16 BIT WIN 3.1 UNIT }
{$ENDIF}
{$ELSE} { SPEEDSOFT COMPILER }
WinBase, WinDef, { Standard units }
{$ENDIF}
{$IFDEF PPC_DELPHI} { DELPHI COMPILERS }
Messages, { Standard unit }
{$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
@ -162,8 +118,7 @@ CONST
{ Turbo Vision 2.0 Color Palettes }
CAppColor =
{$IFDEF OS_WINDOWS}#$81+{$ELSE}#$71+{$ENDIF}
#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
#$71#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
#$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E +
#$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 +
#$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 +
@ -356,11 +311,7 @@ PROCEDURE RegisterApp;
CONST
RBackGround: TStreamRec = (
ObjType: 30; { Register id = 30 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TBackGround)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TBackGround);
{$ENDIF}
Load: @TBackGround.Load; { Object load method }
Store: @TBackGround.Store { Object store method }
);
@ -371,11 +322,7 @@ CONST
CONST
RDeskTop: TStreamRec = (
ObjType: 31; { Register id = 31 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TDeskTop)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TDeskTop);
{$ENDIF}
Load: @TDeskTop.Load; { Object load method }
Store: @TDeskTop.Store { Object store method }
);
@ -398,10 +345,8 @@ CONST
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{$ifdef Use_API}
uses
Video,Mouse;
{$endif Use_API}
{***************************************************************************}
{ PRIVATE DEFINED CONSTANTS }
@ -416,80 +361,6 @@ CONST
{---------------------------------------------------------------------------}
CONST Pending: TEvent = (What: evNothing); { Pending event }
{***************************************************************************}
{ PRIVATE INTERNAL ROUTINES }
{***************************************************************************}
{$IFDEF OS_WINDOWS}
{---------------------------------------------------------------------------}
{ AppMsgHandler -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 13May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TvAppMsgHandler (Wnd: hWnd; iMessage, wParam: Sw_Word;
lParam: LongInt): LongInt; {$IFDEF BIT_16} EXPORT; {$ELSE} STDCALL; {$ENDIF}
VAR Event: TEvent; P: PView; Mm: ^TMinMaxInfo;
BEGIN
{$IFDEF BIT_16} { 16 BIT 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 CODE }
LongInt(P) := GetProp(Wnd, ViewPtr); { Fetch view property }
{$ENDIF}
TvAppMsgHandler := 0; { Preset zero return }
Event.What := evNothing; { Preset no event }
Case iMessage Of
WM_Destroy:; { Destroy window }
WM_Close: Begin
Event.What := evCommand; { Command event }
Event.Command := cmQuit; { Quit command }
Event.InfoPtr := Nil; { Clear info ptr }
End;
WM_GetMinMaxInfo: Begin { Get minmax info }
TvAppMsgHandler := DefWindowProc(Wnd,
iMessage, wParam, lParam); { Default handler }
Mm := Pointer(lParam); { Create pointer }
Mm^.ptMaxSize.X := SysScreenWidth; { Max x size }
Mm^.ptMaxSize.Y := SysScreenHeight; { Max y size }
Mm^.ptMinTrackSize.X := MinWinSize.X *
SysFontWidth; { Drag min x size }
Mm^.ptMinTrackSize.Y := MinWinSize.Y *
SysFontHeight; { Drag min y size }
Mm^.ptMaxTrackSize.X := SysScreenWidth; { Drag max x size }
Mm^.ptMaxTrackSize.Y := SysScreenHeight; { Drag max y size }
End;
Else Begin { Unhandled message }
TvAppMsgHandler := DefWindowProc(Wnd,
iMessage, wParam, lParam); { Default handler }
Exit; { Now exit }
End;
End;
If (Event.What <> evNothing) Then { Check any FV event }
PutEventInQueue(Event); { Put event in queue }
END;
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
FUNCTION TvAppMsgHandler(Wnd: HWnd; Msg: ULong; Mp1, Mp2: MParam): MResult; CDECL;
VAR Event: TEvent; P: PView;
BEGIN
Event.What := evNothing; { Preset no event }
TvAppMsgHandler := 0; { Preset zero return }
Case Msg Of
WM_Destroy:; { Destroy window }
WM_Close: Begin
Event.What := evCommand; { Command event }
Event.Command := cmQuit; { Quit command }
Event.InfoPtr := Nil; { Clear info ptr }
End;
Else Begin { Unhandled message }
TvAppMsgHandler := WinDefWindowProc(Wnd,
Msg, Mp1, Mp2); { Call std handler }
Exit; { Now exit }
End;
End;
If (Event.What <> evNothing) Then { Check any FV event }
PutEventInQueue(Event); { Put event in queue }
END;
{$ENDIF}
{---------------------------------------------------------------------------}
{ Tileable -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
{---------------------------------------------------------------------------}
@ -558,11 +429,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
FUNCTION TBackGround.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CBackGround; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CBackGround)] = CbackGround; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@ -776,7 +643,6 @@ END;
{ TProgram OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
CONST TvProgramClassName = 'TVPROGRAM'+#0; { TV program class }
{--TProgram-----------------------------------------------------------------}
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
@ -784,11 +650,11 @@ CONST TvProgramClassName = 'TVPROGRAM'+#0; { TV program class }
CONSTRUCTOR TProgram.Init;
VAR I: Integer; R: TRect;
BEGIN
Application := @Self; { Set application ptr }
InitScreen; { Initialize screen }
R.Assign(0, 0, -(GetMaxX(TextModeGFV)+1),
-(GetMaxY(TextModeGFV)+1)); { Full screen area }
Inherited Init(R); { Call ancestor }
Application := @Self; { Set application ptr }
InitScreen; { Initialize screen }
State := sfVisible + sfSelected + sfFocused +
sfModal + sfExposed; { Deafult states }
Options := 0; { No options set }
@ -810,6 +676,9 @@ END;
DESTRUCTOR TProgram.Done;
VAR I: Integer;
BEGIN
{ Do not free the Buffer of Video Unit }
If Buffer = Views.PVideoBuf(VideoBuf) then
Buffer:=nil;
If (Desktop <> Nil) Then Dispose(Desktop, Done); { Destroy desktop }
If (MenuBar <> Nil) Then Dispose(MenuBar, Done); { Destroy menu bar }
If (StatusLine <> Nil) Then
@ -916,22 +785,6 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TProgram.InitScreen;
BEGIN
{$ifndef Use_API}
If (Lo(ScreenMode) <> smMono) Then Begin { Coloured mode }
If (ScreenMode AND smFont8x8 <> 0) Then
ShadowSize.X := 1 Else { Single bit shadow }
ShadowSize.X := 2; { Double size }
ShadowSize.Y := 1; ShowMarkers := False; { Set variables }
If (Lo(ScreenMode) = smBW80) Then
AppPalette := apBlackWhite Else { B & W palette }
AppPalette := apColor; { Coloured palette }
End Else Begin
ShadowSize.X := 0; { No x shadow size }
ShadowSize.Y := 0; { No y shadow size }
ShowMarkers := True; { Show markers }
AppPalette := apMonochrome; { Mono palette }
End;
{$else Use_API}
{ the orginal code can't be used here because of the limited
video unit capabilities, the mono modus can't be handled
}
@ -947,7 +800,6 @@ BEGIN
else
AppPalette := apBlackWhite;
Buffer := Views.PVideoBuf(VideoBuf);
{$endif Use_API}
END;
{--TProgram-----------------------------------------------------------------}
@ -1023,6 +875,10 @@ BEGIN
NextQueuedEvent(Event); { Next queued event }
If (Event.What = evNothing) Then Begin
GetKeyEvent(Event); { Fetch key event }
{$ifdef DEBUG}
If (Event.What = evKeyDown) then
Writeln(stderr,'Key pressed scancode = ',hexstr(Event.Keycode,4));
{$endif}
If (Event.What = evNothing) Then Begin { No mouse event }
Drivers.GetMouseEvent(Event); { Load mouse event }
If (Event.What = evNothing) Then Idle; { Idle if no event }
@ -1227,7 +1083,10 @@ END;
END.
{
$Log$
Revision 1.8 2001-05-07 22:22:03 pierre
Revision 1.9 2001-05-10 16:46:26 pierre
+ some improovements made
Revision 1.8 2001/05/07 22:22:03 pierre
* removed NO_WINDOW cond, added GRAPH_API
Revision 1.7 2001/05/04 15:43:45 pierre
@ -1247,8 +1106,17 @@ END.
Revision 1.2 2000/08/24 11:43:13 marco
* Added CVS log and ID entries.
}
{******************[ REVISION HISTORY ]********************}
{ Version Date Fix }
{ ------- --------- --------------------------------- }
{ 1.00 12 Dec 96 First multi platform release }
{ 1.10 12 Sep 97 FPK pascal 0.92 conversion added. }
{ 1.20 29 Aug 97 Platform.inc sort added. }
{ 1.30 05 May 98 Virtual pascal 2.0 code added. }
{ 1.40 22 Oct 99 Object registration added. }
{ 1.50 22 Oct 99 Complete recheck preformed }
{ 1.51 03 Nov 99 FPC Windows support added }
{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }

216
fvision/dialogs.pas
View File

@ -1,4 +1,4 @@
{ $Id: }
{ $Id$ }
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{ }
{ System independent GRAPHICAL clone of DIALOGS.PAS }
@ -21,29 +21,9 @@
{ 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 11 Nov 96 First DOS/DPMI platform release. }
{ 1.10 13 Jul 97 Windows platform code added. }
{ 1.20 29 Aug 97 Platform.inc sort added. }
{ 1.30 13 Oct 97 Delphi 2 32 bit code added. }
{ 1.40 05 May 98 Virtual pascal 2.0 code added. }
{ 1.50 27 Oct 99 All objects completed and checked }
{ 1.51 03 Nov 99 FPC windows support added }
{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
{ Only Free Pascal Compiler supported }
{ }
{**********************************************************}
UNIT Dialogs;
@ -58,16 +38,6 @@ UNIT Dialogs;
{==== Compiler directives ===========================================}
{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
{$F-} { Short calls are okay }
{$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 }
@ -79,18 +49,7 @@ UNIT Dialogs;
USES
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
{$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard units }
{$ELSE} { OTHER COMPILERS }
WinTypes,WinProcs, { Standard units }
{$ENDIF}
{$ELSE} { SPEEDSOFT COMPILER }
WinBase, WinDef, WinUser, WinGDI, { Standard units }
{$ENDIF}
{$IFDEF PPC_DELPHI} { DELPHI COMPILERS }
Messages, { Standard unit }
{$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
@ -127,14 +86,6 @@ CONST
CDialog = CGrayDialog; { Default palette }
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{---------------------------------------------------------------------------}
{ NEW WIN/NT/OS2 COMMAND CODES }
{---------------------------------------------------------------------------}
CONST
cmTvClusterButton = $2001; { Cluster button cmd id }
{$ENDIF}
{---------------------------------------------------------------------------}
{ TDialog PALETTE COLOUR CONSTANTS }
{---------------------------------------------------------------------------}
@ -492,11 +443,7 @@ PROCEDURE RegisterDialogs;
CONST
RDialog: TStreamRec = (
ObjType: 10; { Register id = 10 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TDialog)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TDialog);
{$ENDIF}
Load: @TDialog.Load; { Object load method }
Store: @TDialog.Store { Object store method }
);
@ -507,11 +454,7 @@ CONST
CONST
RInputLine: TStreamRec = (
ObjType: 11; { Register id = 11 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TInputLine)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TInputLine);
{$ENDIF}
Load: @TInputLine.Load; { Object load method }
Store: @TInputLine.Store { Object store method }
);
@ -522,11 +465,7 @@ CONST
CONST
RButton: TStreamRec = (
ObjType: 12; { Register id = 12 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TButton)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TButton);
{$ENDIF}
Load: @TButton.Load; { Object load method }
Store: @TButton.Store { Object store method }
);
@ -537,11 +476,7 @@ CONST
CONST
RCluster: TStreamRec = (
ObjType: 13; { Register id = 13 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TCluster)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TCluster);
{$ENDIF}
Load: @TCluster.Load; { Object load method }
Store: @TCluster.Store { Objects store method }
);
@ -552,11 +487,7 @@ CONST
CONST
RRadioButtons: TStreamRec = (
ObjType: 14; { Register id = 14 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TRadioButtons)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TRadioButtons);
{$ENDIF}
Load: @TRadioButtons.Load; { Object load method }
Store: @TRadioButtons.Store { Object store method }
);
@ -567,11 +498,7 @@ CONST
CONST
RCheckBoxes: TStreamRec = (
ObjType: 15; { Register id = 15 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TCheckBoxes)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TCheckBoxes);
{$ENDIF}
Load: @TCheckBoxes.Load; { Object load method }
Store: @TCheckBoxes.Store { Object store method }
);
@ -582,11 +509,7 @@ CONST
CONST
RMultiCheckBoxes: TStreamRec = (
ObjType: 27; { Register id = 27 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TMultiCheckBoxes)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TMultiCheckBoxes);
{$ENDIF}
Load: @TMultiCheckBoxes.Load; { Object load method }
Store: @TMultiCheckBoxes.Store { Object store method }
);
@ -597,11 +520,7 @@ CONST
CONST
RListBox: TStreamRec = (
ObjType: 16; { Register id = 16 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TListBox)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TListBox);
{$ENDIF}
Load: @TListBox.Load; { Object load method }
Store: @TListBox.Store { Object store method }
);
@ -612,11 +531,7 @@ CONST
CONST
RStaticText: TStreamRec = (
ObjType: 17; { Register id = 17 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TStaticText)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TStaticText);
{$ENDIF}
Load: @TStaticText.Load; { Object load method }
Store: @TStaticText.Store { Object store method }
);
@ -627,11 +542,7 @@ CONST
CONST
RLabel: TStreamRec = (
ObjType: 18; { Register id = 18 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TLabel)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TLabel);
{$ENDIF}
Load: @TLabel.Load; { Object load method }
Store: @TLabel.Store { Object store method }
);
@ -642,11 +553,7 @@ CONST
CONST
RHistory: TStreamRec = (
ObjType: 19; { Register id = 19 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(THistory)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(THistory);
{$ENDIF}
Load: @THistory.Load; { Object load method }
Store: @THistory.Store { Object store method }
);
@ -657,11 +564,7 @@ CONST
CONST
RParamText: TStreamRec = (
ObjType: 20; { Register id = 20 }
{$IFDEF BP_VMTLink} { BP style VMT link }
VmtLink: Ofs(TypeOf(TParamText)^);
{$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TParamText);
{$ENDIF}
Load: @TParamText.Load; { Object load method }
Store: @TParamText.Store { Object store method }
);
@ -679,10 +582,7 @@ USES HistList; { Standard GFV unit }
{---------------------------------------------------------------------------}
{ LEFT AND RIGHT ARROW CHARACTER CONSTANTS }
{---------------------------------------------------------------------------}
{$IFDEF OS_DOS} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
{$IFDEF OS_LINUX} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
{$IFDEF OS_WINDOWS} CONST LeftArr = #$AB; RightArr = #$BB; {$ENDIF}
{$IFDEF OS_OS2} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
CONST LeftArr = #17; RightArr = #16;
{---------------------------------------------------------------------------}
{ TButton MESSAGES }
@ -730,10 +630,6 @@ BEGIN
GrowMode := 0; { Clear grow mode }
Flags := wfMove + wfClose; { Close/moveable flags }
Palette := dpGrayDialog; { Default gray colours }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
GOptions := GOptions AND NOT goThickFramed; { Turn thick frame off }
ExStyle := ws_Ex_DlgModalFrame; { Set extended style }
{$ENDIF}
END;
{--TDialog------------------------------------------------------------------}
@ -752,13 +648,8 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TDialog.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: Array[dpBlueDialog..dpGrayDialog] Of String =
(CBlueDialog, CCyanDialog, CGrayDialog); { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: Array[dpBlueDialog..dpGrayDialog] Of String[Length(CBlueDialog)] =
(CBlueDialog, CCyanDialog, CGrayDialog); { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P[Palette]; { Return palette }
END;
@ -844,11 +735,7 @@ BEGIN
If (MaxAvail > MaxLen+1) Then Begin { Check enough memory }
GetMem(Data, MaxLen + 1); { Allocate memory }
S.Read(Data^[1], Length(Data^)); { Read string data }
{$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(Data^, B); { Xfer string length }
{$ELSE} { OTHER COMPILERS }
Data^[0] := Chr(B); { Set string length }
{$ENDIF}
End Else S.Seek(S.GetPos + B); { Move to position }
If (Options AND ofVersion >= ofVersion20) Then { Version 2 or above }
Validator := PValidator(S.Get); { Get any validator }
@ -883,11 +770,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TInputLine.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CInputLine; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CInputLine)] = CInputLine; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@ -1048,18 +931,11 @@ END;
{ SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.SetData (Var Rec);
{$IFDEF PPC_DELPHI3} VAR Buf: Array [0..256] Of Char; {$ENDIF}
BEGIN
If (Data <> Nil) Then Begin { Data ptr valid }
If (Validator = Nil) OR (Validator^.Transfer(
Data^, @Rec, vtSetData) = 0) Then { No validator/data }
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
Move(Rec, Buf, DataSize); { Fetch our data }
Move(Buf[1], Data^[1], Ord(Buf[0])); { Tranfer string }
SetLength(Data^, Ord(Buf[0])); { Set string length }
{$ELSE} { OTHER COMPILERS }
Move(Rec, Data^[0], DataSize); { Set our data }
{$ENDIF}
End;
SelectAll(True); { Now select all }
END;
@ -1169,11 +1045,7 @@ Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Integer;
If NOT Validator^.IsValidInput(NewData,
NoAutoFill) Then RestoreState Else Begin
If (Length(NewData) > MaxLen) Then { Exceeds maximum }
{$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(NewData, MaxLen); { Set string length }
{$ELSE} { OTHER COMPILERS }
NewData[0] := Chr(MaxLen); { Set string length }
{$ENDIF}
If (Data <> Nil) Then Data^ := NewData; { Set data value }
If (Data <> Nil) AND (CurPos >= OldLen) { Cursor beyond end }
AND (Length(Data^) > OldLen) Then { Cursor beyond string }
@ -1210,11 +1082,7 @@ BEGIN
SelectAll(True) Else Begin { Select whole text }
Anchor := MousePos; { Start of selection }
Repeat
{$IFDEF OS_DOS} { DOS/DPMI CODE }
If (Event.What = evMouseAuto) { Mouse auto event }
{$ELSE} { WIN/NT/OS2 CODE }
If (Event.What = evMouseMove) { Mouse move event }
{$ENDIF}
Then Begin
Delta := MouseDelta; { New position }
If CanScroll(Delta) Then { If can scroll }
@ -1304,11 +1172,7 @@ BEGIN
If (Data <> Nil) Then OldData := Copy(Data^,
FirstPos+1, CurPos-FirstPos) { Text area string }
Else OldData := ''; { Empty string }
{$IFDEF OS_DOS} { DOS/DPMI CODE }
Delta := FontWidth; { Safety = 1 char }
{$ELSE} { WIN/NT CODE }
Delta := 2*FontWidth; { Safety = 2 char }
{$ENDIF}
While (TextWidth(OldData) > ((RawSize.X+1)-Delta)
- TextWidth(LeftArr) - TextWidth(RightArr)) { Check text fits }
Do Begin
@ -1396,11 +1260,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TButton.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CButton; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CButton)] = CButton; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Get button palette }
END;
@ -1455,15 +1315,15 @@ BEGIN
I := (RawSize.X - I) DIV 2; { Centre in button }
End Else I := FontWidth; { Left edge of button }
MoveCStr(Db, Title^, Bc); { Move title to buffer }
{$ifndef USE_API}
GOptions := GOptions OR goGraphView; { Graphics co-ords mode }
WriteLine(I, FontHeight DIV 2, CStrLen(Title^),
1, Db); { Write the title }
GOptions := GOptions AND NOT goGraphView; { Return to normal mode }
{$else USE_API}
WriteLine(I div SysFontWidth, 0, CStrLen(Title^),
1, Db); { Write the title }
{$endif USE_API}
If not TextModeGFV then Begin
GOptions := GOptions OR goGraphView; { Graphics co-ords mode }
WriteLine(I, FontHeight DIV 2, CStrLen(Title^),
1, Db); { Write the title }
GOptions := GOptions AND NOT goGraphView; { Return to normal mode }
End Else Begin
WriteLine(I div SysFontWidth, 0, CStrLen(Title^),
1, Db); { Write the title }
End;
End;
END;
@ -1671,11 +1531,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TCluster.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CCluster; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CCluster)] = CCluster; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Cluster palette }
END;
@ -1950,7 +1806,6 @@ BEGIN
Exit; { Now exit }
End;
End;
{$IFDEF OS_DOS} { DOS/DPMI CODE }
If (Event.CharCode = ' ') AND { Spacebar key }
(State AND sfFocused <> 0) AND { Check focused view }
ButtonState(Sel) Then Begin { Check item enabled }
@ -1959,7 +1814,6 @@ BEGIN
DrawView; { Now draw changes }
ClearEvent(Event); { Event was handled }
End;
{$ENDIF}
End;
End;
End;
@ -2275,7 +2129,6 @@ END;
{ NewList -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TListBox.NewList (AList: PCollection);
{$IFDEF OS_WINDOWS} VAR I: Integer; S: String; P: PString; {$ENDIF}
BEGIN
If (List <> Nil) Then Dispose(List, Done); { Dispose old list }
List := AList; { Hold new list }
@ -2348,11 +2201,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TStaticText.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CStaticText; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CStaticText)] = CStaticText; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@ -2509,11 +2358,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TLabel.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CLabel; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CLabel)] = CLabel; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@ -2620,11 +2465,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistoryViewer.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CHistoryViewer; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistoryViewer)] = CHistoryViewer;{ Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@ -2684,11 +2525,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistoryWindow.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CHistoryWindow; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistoryWindow)] = CHistoryWindow;{ Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return the palette }
END;
@ -2739,11 +2576,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistory.GetPalette: PPalette;
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
CONST P: String = CHistory; { Possible huge string }
{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistory)] = CHistory; { Always normal string }
{$ENDIF}
BEGIN
GetPalette := @P; { Return the palette }
END;
@ -2816,11 +2649,7 @@ BEGIN
If (C = cmOk) Then Begin { Result was okay }
Rslt := HistoryWindow^.GetSelection; { Get history selection }
If Length(Rslt) > Link^.MaxLen Then
{$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(Rslt, Link^.MaxLen); { Hold new length }
{$ELSE}
Rslt[0] := Char(Link^.MaxLen); { Hold new length }
{$ENDIF}
Link^.Data^ := Rslt; { Hold new selection }
Link^.SelectAll(True); { Select all string }
Link^.DrawView; { Redraw link view }
@ -2881,7 +2710,10 @@ END;
END.
{
$Log$
Revision 1.7 2001-05-07 22:22:03 pierre
Revision 1.8 2001-05-10 16:46:27 pierre
+ some improovements made
Revision 1.7 2001/05/07 22:22:03 pierre
* removed NO_WINDOW cond, added GRAPH_API
Revision 1.6 2001/05/04 10:46:01 pierre
@ -2898,6 +2730,16 @@ END.
Revision 1.2 2000/08/24 12:00:20 marco
* CVS log and ID tags
}
{******************[ REVISION HISTORY ]********************}
{ Version Date Fix }
{ ------- --------- --------------------------------- }
{ 1.00 11 Nov 96 First DOS/DPMI platform release. }
{ 1.10 13 Jul 97 Windows platform code added. }
{ 1.20 29 Aug 97 Platform.inc sort added. }
{ 1.30 13 Oct 97 Delphi 2 32 bit code added. }
{ 1.40 05 May 98 Virtual pascal 2.0 code added. }
{ 1.50 27 Oct 99 All objects completed and checked }
{ 1.51 03 Nov 99 FPC windows support added }
{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
{**********************************************************}

1659
fvision/drivers.pas
View File

File diff suppressed because it is too large Load Diff

22
fvision/gfvgraph.pas
View File

@ -293,25 +293,28 @@ END;
PROCEDURE SetViewPort (X1, Y1, X2, Y2: Integer; Clip, TextMode: Boolean);
BEGIN
{$IFDEF GRAPH_API}
If TextMode Then Begin { TEXT MODE GFV }
If TextMode Then Begin { TEXT MODE GFV }
{$ENDIF GRAPH_API}
If (X1 < 0) Then X1 := 0; { X1 negative fix }
If (X1 > SysScreenWidth) Then
X1 := SysScreenWidth; { X1 off screen fix }
If (X1 >SysScreenWidth) Then
X1 := SysScreenWidth; { X1 off screen fix }
If (Y1 < 0) Then Y1 := 0; { Y1 negative fix }
If (Y1 > SysScreenHeight) Then
Y1 := SysScreenHeight; { Y1 off screen fix }
Y1 := SysScreenHeight; { Y1 off screen fix }
If (X2 < 0) Then X2 := 0; { X2 negative fix }
If (X2 > SysScreenWidth) Then
X2 := SysScreenWidth; { X2 off screen fix }
X2 := SysScreenWidth; { X2 off screen fix }
If (Y2 < 0) Then Y2 := 0; { Y2 negative fix }
If (Y2 > SysScreenHeight) Then
Y2 := SysScreenHeight; { Y2 off screen fix }
Y2 := SysScreenHeight; { Y2 off screen fix }
ViewPort.X1 := X1; { Set X1 port value }
ViewPort.Y1 := Y1; { Set Y1 port value }
ViewPort.X2 := X2; { Set X2 port value }
ViewPort.Y2 := Y2; { Set Y2 port value }
ViewPort.Clip := Clip; { Set port clip value }
{$ifdef DEBUG}
Writeln(stderr,'New ViewPort(',X1,',',Y1,',',X2,',',Y2,')');
{$endif DEBUG}
Cxp := X1; { Set current x pos }
Cyp := Y1; { Set current y pos }
{$IFDEF GRAPH_API}
@ -333,7 +336,7 @@ BEGIN
{$IFDEF GRAPH_API}
If TextMode Then
{$ENDIF GRAPH_API}
GetMaxX := SysScreenWidth-1 { Screen width }
GetMaxX := SysScreenWidth-1 { Screen width }
{$IFDEF GRAPH_API}
Else GetMaxX := Graph.GetMaxX; { Call graph func }
{$ENDIF GRAPH_API}
@ -398,7 +401,10 @@ END;
END.
{
$Log$
Revision 1.7 2001-05-07 23:36:35 pierre
Revision 1.8 2001-05-10 16:46:28 pierre
+ some improovements made
Revision 1.7 2001/05/07 23:36:35 pierre
NO_WINDOW cond removed
Revision 1.6 2001/05/07 22:22:03 pierre

525
fvision/views.pas
View File

@ -57,17 +57,6 @@ UNIT Views;
{==== 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 }
@ -164,6 +153,7 @@ CONST
goTabSelect = $0008; { Tab selectable }
goEveryKey = $0020; { Report every key }
goEndModal = $0040; { End modal }
goNoShadow = $0080; { Do not write shadows }
goGraphView = $1000; { Raw graphic view }
goGraphical = $2000; { Graphical view }
@ -297,15 +287,6 @@ CONST
wnNoNumber = 0; { Window has no num }
MaxViewWidth = 132; { Max view width }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{---------------------------------------------------------------------------}
{ WIN32/NT LABEL CONSTANTS FOR WINDOW PROPERTY CALLS }
{---------------------------------------------------------------------------}
CONST
ViewPtr = 'TVWINPTR'+#0; { View ptr label }
{$ENDIF}
{***************************************************************************}
{ PUBLIC TYPE DEFINITIONS }
@ -420,6 +401,7 @@ TYPE
PROCEDURE DrawFocus; Virtual;
PROCEDURE DrawCursor; Virtual;
PROCEDURE DrawBorder; Virtual;
PROCEDURE DrawShadow; Virtual;
PROCEDURE HideCursor;
PROCEDURE ShowCursor;
PROCEDURE BlockCursor;
@ -480,7 +462,8 @@ TYPE
Count: Integer);
PROCEDURE DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
MinSize, MaxSize: TPoint);
PROCEDURE WriteAbs(X, Y, L :Integer;var Buf);
PROCEDURE WriteShadow(X1, Y1, X2, Y2 : Integer);
FUNCTION FontWidth: Integer;
FUNCTION Fontheight: Integer;
@ -725,37 +708,6 @@ FUNCTION CreateIdScrollBar (X, Y, Size, Id: Integer; Horz: Boolean): PScrollBar;
{ INITIALIZED PUBLIC VARIABLES }
{***************************************************************************}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
TYPE TColorRef = LongInt; { TColorRef defined }
{---------------------------------------------------------------------------}
{ 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 }
@ -1201,10 +1153,17 @@ END;
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 }
If TextModeGFV then Begin
If (Origin.X > X2) Then Exit; { Area to the left }
If ((Origin.X + Size.X) < X1) Then Exit; { Area to the right }
If (Origin.Y > Y2) Then Exit; { Area is above }
If ((Origin.Y + Size.Y) < Y1) Then Exit; { Area is below }
End Else Begin
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 }
End;
OverLapsArea := True; { Return true }
END;
@ -1267,7 +1226,14 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawView;
VAR ViewPort: ViewPortType; { Common variables }
Parent : PGroup;
BEGIN
Parent:=Owner;
While Assigned(Parent) do Begin
If (Parent^.LockFlag>0) then
exit;
Parent:=Parent^.Owner;
End;
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 }
@ -1277,6 +1243,7 @@ BEGIN
ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
HideMouseCursor; { Hide mouse cursor }
If (DrawMask = 0) OR (DrawMask = vdNoChild) { No special masks set }
{ OR Assigned(LimitsLocked) }
Then Begin { Treat as a full redraw }
DrawBackGround; { Draw background }
Draw; { Draw interior }
@ -1287,18 +1254,36 @@ BEGIN
If (Options AND ofFramed <> 0) OR
(GOptions AND goThickFramed <> 0) { View has border }
Then DrawBorder; { Draw border }
If ((State AND sfShadow) <> 0) AND
(GOptions And goNoShadow = 0) Then
DrawShadow;
End Else Begin { Masked draws only }
If (DrawMask AND vdBackGnd <> 0) Then { Chk background mask }
DrawBackGround; { Draw background }
Begin
DrawMask := DrawMask and Not vdBackGnd;
DrawBackGround; { Draw background }
end;
If (DrawMask AND vdInner <> 0) Then { Check Inner mask }
Draw; { Draw interior }
Begin
DrawMask := DrawMask and Not vdInner;
Draw; { Draw interior }
End;
If (DrawMask AND vdFocus <> 0)
AND (GOptions AND goDrawFocus <> 0)
Then DrawFocus; { Check focus mask }
AND (GOptions AND goDrawFocus <> 0) then
Begin
DrawMask := DrawMask and Not vdFocus;
DrawFocus; { Check focus mask }
End;
If (DrawMask AND vdCursor <> 0) Then { Check cursor mask }
DrawCursor; { Draw any cursor }
Begin
DrawMask := DrawMask and Not vdCursor;
DrawCursor; { Draw any cursor }
End;
If (DrawMask AND vdBorder <> 0) Then { Check border mask }
DrawBorder; { Draw border }
Begin
DrawMask := DrawMask and Not vdBorder;
DrawBorder; { Draw border }
End;
End;
ShowMouseCursor; { Show mouse cursor }
End;
@ -1342,6 +1327,8 @@ VAR I : sw_integer;
VerticalBar,
LeftLowCorner,
RightLowCorner : Char;
Color : Byte;
Focused : Boolean;
BEGIN
If (TextModeGFV = FALSE) Then Begin { GRAPHICS GFV MODE }
BiColorRectangle(0, 0, RawSize.X, RawSize.Y,
@ -1355,7 +1342,10 @@ BEGIN
White, DarkGray, True); { Draw highlights }
End;
End Else Begin { TEXT GFV MODE }
If not Focus or (GOptions AND goThickFramed = 0) then
Focused:=(State AND (sfSelected + sfModal)<>0);
if Assigned(Owner) then
Focused := Focused AND (@Self = Owner^.First);
If not Focused or (GOptions AND goThickFramed = 0) then
begin
LeftUpCorner:='Ú';
RightUpCorner:='¿';
@ -1373,20 +1363,49 @@ BEGIN
LeftLowCorner:='È';
RightLowCorner:='¼';
end;
WriteChar(0,0,LeftUpCorner,1,1);
WriteChar(1,0,HorizontalBar,1,Size.X-2);
WriteChar(Size.X-1,0,RightUpcorner,1,1);
if Focused then
Color := 2
else
Color := 1;
WriteChar(0,0,LeftUpCorner,Color,1);
WriteChar(1,0,HorizontalBar,Color,Size.X-2);
WriteChar(Size.X-1,0,RightUpcorner,Color,1);
For i:=1 to Size.Y -1 do
begin
WriteChar(0,i,VerticalBar,1,1);
WriteChar(Size.X-1,i,VerticalBar,1,1);
WriteChar(0,i,VerticalBar,Color,1);
WriteChar(Size.X-1,i,VerticalBar,Color,1);
end;
WriteChar(0,Size.Y-1,LeftLowCorner,1,1);
WriteChar(1,Size.Y-1,HorizontalBar,1,Size.X-2);
WriteChar(Size.X-1,Size.Y-1,RightLowCorner,1,1);
WriteChar(0,Size.Y-1,LeftLowCorner,Color,1);
WriteChar(1,Size.Y-1,HorizontalBar,Color,Size.X-2);
WriteChar(Size.X-1,Size.Y-1,RightLowCorner,Color,1);
End;
END;
PROCEDURE TView.DrawShadow;
VAR X1, Y1, X2, Y2 : Integer;
BEGIN
If not TextModeGFV then
exit;
If Assigned(Owner) Then Begin
X1:=RawOrigin.X+RawSize.X+1;
X2:=X1+ShadowSize.X*SysFontWidth;
Y1:=RawOrigin.Y+SysFontHeight;
Y2:=RawOrigin.Y+RawSize.Y+1+ShadowSize.Y*SysFontHeight;
GOptions := GOptions OR goNoShadow;
Owner^.RedrawArea(X1,Y1,X2,Y2);
WriteShadow(X1 div SysFontWidth, Y1 div SysFontHeight,
X2 div SysFontWidth, Y2 div SysFontHeight);
X1:=RawOrigin.X+SysFontWidth;
X2:=RawOrigin.X+RawSize.X+1;
Y1:=RawOrigin.Y+RawSize.Y+1;
Y2:=RawOrigin.Y+RawSize.Y+1+ShadowSize.Y*SysFontHeight;
Owner^.RedrawArea(X1,Y1,X2,Y2);
WriteShadow(X1 div SysFontWidth, Y1 div SysFontHeight,
X2 div SysFontWidth, Y2 div SysFontHeight);
GOptions := GOptions AND not goNoShadow;
End;
END;
{--TView--------------------------------------------------------------------}
{ HideCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
{---------------------------------------------------------------------------}
@ -1462,6 +1481,13 @@ BEGIN
Then Y2 := P^.RawOrigin.Y + P^.RawSize.Y; { Y maximum contain }
P := P^.Owner; { Move to owners owner }
End;
If TextModeGFV then Begin
X1 := X1 div SysFontWidth;
X2 := (X2 +SysFontWidth - 1) div SysFontWidth;
Y1 := Y1 div SysFontHeight;
Y2 := (Y2 +SysFontHeight -1) div SysFontHeight;
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 }
@ -1482,38 +1508,48 @@ END;
PROCEDURE TView.DrawBackGround;
VAR Bc: Byte; X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
X, Y: Integer;
Buf : TDrawBuffer;
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, TextModeGFV); { 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 }
If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
SetFillStyle(SolidFill, Bc); { Set fill colour }
Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
End Else Begin { TEXT MODE GFV }
X1 := (RawOrigin.X+X1) DIV SysFontWidth;
Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight;
X2 := (RawOrigin.X+X2) DIV SysFontWidth;
Y2 := (RawOrigin.Y+Y2) DIV SysFontHeight;
If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
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 }
SetFillStyle(SolidFill, Bc); { Set fill colour }
Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
End Else Begin { TEXT MODE GFV }
If (ViewPort.X1 <= Origin.X) Then
X1 := Origin.X { Right to left edge }
Else X1 := ViewPort.X1; { Offset from left }
If (ViewPort.Y1 <= Origin.Y) Then
Y1 := Origin.Y { Right to top edge }
Else Y1 := ViewPort.Y1; { Offset from top }
If (ViewPort.X2 >= Origin.X+Size.X) Then
X2 := Origin.X + Size.X Else { Right to right edge }
X2 := ViewPort.X2; { Offset from right }
If (ViewPort.Y2 >= Origin.Y+Size.Y) Then
Y2 := Origin.Y + Size.Y Else { Right to bottom edge }
Y2 := ViewPort.Y2; { Offset from bottom }
If (State AND sfDisabled = 0) Then
Bc := GetColor(1) Else { Select back colour }
Bc := GetColor(4); { Disabled back colour }
For Y := Y1 To Y2 Do
For X := X1 To X2 Do Begin
{ FIXME: we shouldn't write direct here }
VideoBuf^[(Y*Drivers.ScreenWidth+X)] := (Bc shl 8) or $20;
End;
For X := X1 To X2 Do Begin
Buf[X-X1]:=(Bc shl 8) or $20;
End;
For Y := Y1 To Y2 Do Begin
WriteAbs(X1,Y, X2-X1, Buf);
End;
{ FIXME: we shouldn't update always here }
UpdateScreen(false);
End;
@ -1560,6 +1596,8 @@ END;
{ SetDrawMask -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetDrawMask (Mask: Byte);
VAR
OldMask : byte;
BEGIN
If (Options AND ofFramed = 0) AND { Check for no frame }
(GOptions AND goThickFramed = 0) AND { Check no thick frame }
@ -1569,7 +1607,20 @@ BEGIN
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 }
OldMask:=DrawMask;
DrawMask := DrawMask OR Mask; { Set draw masks }
(*If TextModeGFV and (DrawMask<>0) and (DrawMask<>OldMask) then Begin
Mask:=vdBackGnd OR vdInner OR vdBorder OR vdCursor OR vdFocus;
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; *)
END;
{--TView--------------------------------------------------------------------}
@ -1620,12 +1671,14 @@ BEGIN
If (Owner <> Nil) Then Owner^.ReDrawArea(
RawOrigin.X, RawOrigin.Y, RawOrigin.X +
RawSize.X, RawOrigin.Y + RawSize.Y); { Redraw old area }
Owner^.Lock;
Owner^.RemoveView(@Self); { Remove from list }
Owner^.InsertView(@Self, Target); { Insert into list }
State := State OR sfVisible; { Allow drawing again }
If (LastView <> Target) Then DrawView; { Draw the view now }
If (Options AND ofSelectable <> 0) Then { View is selectable }
If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset current }
Owner^.Unlock;
End;
END;
@ -1662,6 +1715,12 @@ PROCEDURE TView.ReDrawArea (X1, Y1, X2, Y2: Integer);
VAR HLimit: PView; ViewPort: ViewPortType;
BEGIN
GetViewSettings(ViewPort, TextModeGFV); { Hold view port }
If TextModeGFV then Begin
X1 := X1 div SysFontWidth;
X2 := (X2 +SysFontWidth - 1) div SysFontWidth;
Y1 := Y1 div SysFontHeight;
Y2 := (Y2 +SysFontHeight -1) div SysFontHeight;
End;
SetViewPort(X1, Y1, X2, Y2, ClipOn, TextModeGFV); { Set new clip limits }
HLimit := LimitsLocked; { Hold lock limits }
LimitsLocked := @Self; { We are the lock view }
@ -1695,10 +1754,13 @@ END;
{ SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetState (AState: Word; Enable: Boolean);
VAR Command: Word;
VAR OldState, Command: Word;
ShouldDraw : Boolean;
BEGIN
OldState := State;
If Enable Then State := State OR AState { Set state mask }
Else State := State AND NOT AState; { Clear state mask }
ShouldDraw:=false;
If (AState AND sfVisible <> 0) Then Begin { Visibilty change }
If (Owner <> Nil) AND { valid owner }
(Owner^.State AND sfExposed <> 0) { If owner exposed }
@ -1715,17 +1777,22 @@ BEGIN
If Enable Then Command := cmReceivedFocus { View gaining focus }
Else Command := cmReleasedFocus; { View losing focus }
Message(Owner, evBroadcast, Command, @Self); { Send out message }
SetDrawMask(vdBorder); { Set border draw mask }
ShouldDraw:=true;
End;
If (GOptions AND goDrawFocus <> 0) Then Begin { Draw focus view }
If (GOptions AND goDrawFocus <> 0) AND
(((AState XOR OldState) AND sfFocused) <> 0) Then Begin { Draw focus view }
SetDrawMask(vdFocus); { Set focus draw mask }
DrawView; { Redraw focus change }
ShouldDraw:=true;
End;
End;
If (AState AND (sfCursorVis + sfCursorIns) <> 0) { Change cursor state }
Then Begin
SetDrawMask(vdCursor); { Set cursor draw mask }
DrawView; { Redraw the cursor }
ShouldDraw:=true;
End;
If ShouldDraw then
DrawView; { Redraw the border }
END;
{--TView--------------------------------------------------------------------}
@ -2270,7 +2337,7 @@ FUNCTION TGroup.FirstThat (P: Pointer): PView; ASSEMBLER;
JNZ .L_LoopPoint; { Continue to last }
XOR %EAX, %EAX; { No views gave true }
.L_Exit:
MOVL %EAX, __RESULT; { Return result }
{MOVL %EAX, __RESULT;not needed for assembler functions Return result }
END;
{--TGroup-------------------------------------------------------------------}
@ -2529,7 +2596,7 @@ BEGIN
If (Current <> Nil) Then
Current^.SetState(sfFocused, Enable); { Focus current view }
If TextModeGFV then
SetDrawMask(vdBackGnd OR vdFocus OR vdInner); { Set redraw masks }
SetDrawMask(vdBackGnd OR vdFocus OR vdInner OR vdBorder); { Set redraw masks }
End;
sfExposed: Begin
ForEach(@DoExpose); { Expose each subview }
@ -4135,6 +4202,7 @@ END;
PROCEDURE TView.ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
VAR
X, Y: Integer; ViewPort: ViewPortType;
Buf : TDrawBuffer;
BEGIN
GetViewSettings(ViewPort, TextModeGFV); { Get viewport }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL GFV MODE }
@ -4147,11 +4215,12 @@ BEGIN
Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight;
X2 := (RawOrigin.X+X2-1) DIV SysFontWidth;
Y2 := (RawOrigin.Y+Y2-1) DIV SysFontHeight;
For X := X1 To X2 Do Begin
Buf[X-X1]:=(Colour shl 12) or $20;
End;
For Y := Y1 To Y2 Do
For X := X1 To X2 Do Begin
VideoBuf^[(Y*Drivers.ScreenWidth+X)] := (Colour shl 12) or $20;
End;
UpdateScreen(false);
WriteAbs(X1,Y, X2-X1, Buf);
UpdateScreen(false);
End;
END;
@ -4197,7 +4266,7 @@ BEGIN
Dc := ODc; { Reset held context }
End;
{$ENDIF}
{$ENDIF not NOT_IMPLEMENTED}
{$ENDIF NOT_IMPLEMENTED}
END;
PROCEDURE TView.FilletArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad, Ht: Integer;
@ -4205,7 +4274,7 @@ 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
{$IFNDEF NOT_IMPLEMENTED}
{$IFDEF NOT_IMPLEMENTED}
{$IFDEF OS_WINDOWS}
If (HWindow <> 0) Then Begin { Valid window }
Xc := Xc - FrameSize;
@ -4250,7 +4319,7 @@ BEGIN
Dc := ODc; { Reset held context }
End;
{$ENDIF}
{$ENDIF not NOT_IMPLEMENTED}
{$ENDIF NOT_IMPLEMENTED}
END;
{--TView--------------------------------------------------------------------}
@ -4300,28 +4369,26 @@ BEGIN
Y := Y - ViewPort.Y1; { Calc y position }
End;
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 }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
If (TextModeGFV) Then Begin { TEXT MODE GFV }
WriteAbs(X,Y,W,P^[L]);
Inc(Y);
Inc(L,W);
End Else Begin
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 }
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 }
$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 }
Inc(K,Cw);
End else Begin
VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[L];
Inc(K);
Inc(L); { Next character }
End;
Inc(L); { Next character }
End;
If Not TextModeGFV then
Y := Y + SysFontHeight { Next line down }
Else
Inc(Y); { Next line down }
end;
Y := Y + SysFontHeight; { Next line down }
end;
Video.UpdateScreen(false);
End;
end;
END;
@ -4351,25 +4418,22 @@ BEGIN
Y := Y - ViewPort.Y1; { Calc y position }
End;
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 }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
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 }
Inc(K,Cw);
End Else Begin { TEXT MODE GFV }
VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[I];
Inc(K);
End;
If (TextModeGFV) Then Begin { TEXT MODE GFV }
WriteAbs(X,Y,W,P^);
Inc(Y);
End Else Begin
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 }
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 }
Inc(K,Cw);
End;
Y := Y + SysFontHeight; { Next line down }
End;
If Not TextModeGFV then
Y := Y + SysFontHeight { Next line down }
Else
Inc(Y); { Next line down }
end;
Video.UpdateScreen(false);
End;
@ -4406,6 +4470,7 @@ END;
PROCEDURE TView.WriteStr (X, Y: Integer; Str: String; Color: Byte);
VAR Fc, Bc, B: Byte; X1, Y1, X2, Y2: Integer;
Tix, Tiy, Ti: Integer; ViewPort: ViewPortType;
Buf : TDrawBuffer;
BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) AND { View is exposed }
@ -4441,9 +4506,9 @@ BEGIN
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
For Ti := 1 To length(Str) Do Begin
VideoBuf^[((Tiy * Drivers.ScreenWidth)+Tix)] := (GetColor(Color) shl 8) or Ord(Str[Ti]);
Inc(Tix);
Buf[Ti-1]:=(GetColor(Color) shl 8) or Ord(Str[Ti]);
end;
WriteAbs(Tix,TiY,Length(Str),Buf);
End;
UpdateScreen(false);
End;
@ -4452,6 +4517,7 @@ END;
PROCEDURE TView.WriteChar (X, Y: Integer; C: Char; Color: Byte;
Count: Integer);
VAR Fc, Bc: Byte; I, Ti, Tix, Tiy: Integer; Col: Word; S: String; ViewPort: ViewPortType;
Buf : TDrawBuffer;
BEGIN
If (State AND sfVisible <> 0) AND { View visible }
(State AND sfExposed <> 0) Then Begin { View exposed }
@ -4459,26 +4525,31 @@ BEGIN
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 }
If (X >= 0) AND (Y >= 0) AND ((GOptions and goGraphView)=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;
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 }
If (Count>Size.X) Then I := Size.X Else I := Count; { Size to make }
S[0] := Chr(I); { Set string length }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
SetFillStyle(SolidFill, Bc); { Set fill style }
Bar(X-ViewPort.X1, Y-ViewPort.Y1,
X-ViewPort.X1+Length(S)*FontWidth,
X-ViewPort.X1+I*FontWidth,
Y-ViewPort.Y1+FontHeight-1);
SetColor(Fc);
OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1, S); { Write text char }
End Else Begin { TEXT MODE GFV }
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
For Ti := 1 To length(S) Do Begin
VideoBuf^[((Tiy * Drivers.ScreenWidth)+Tix)] := (GetColor(Color) shl 8) or Ord(S[Ti]);
Inc(Tix);
For Ti := 1 To I Do Begin
Buf[Ti-1]:=(GetColor(Color) shl 8) or Ord(S[Ti]);
End;
WriteAbs(TiX,TiY,Length(S),Buf);
End;
Count := Count - I; { Subtract count }
If TextModeGFV then
@ -4491,6 +4562,138 @@ BEGIN
End;
END;
{define DirectWrite}
PROCEDURE TView.WriteAbs(X, Y, L : Integer; Var Buf);
VAR
P: PGroup;
PrevP,PP : PView;
CurOrigin : TPoint;
I,XI : longint;
ViewPort : ViewPortType;
BEGIN
{ Direct wrong method }
GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
{$ifdef DirectWrite}
For i:=0 to L-1 do Begin
if (X+I>=ViewPort.X1) AND (Y>=ViewPort.Y1) AND
(X+I<ViewPort.X2) AND (Y<ViewPort.Y2) Then
VideoBuf^[Y*ScreenWidth+X+i]:=TDrawBuffer(Buf)[i];
End;
{$else not DirectWrite}
{ Pedestrian character method }
{ Must be in area }
If (X+L<ViewPort.X1) OR (Y<ViewPort.Y1) OR
(X>=ViewPort.X2) OR (Y>=ViewPort.Y2) Then
Exit;
For I:=0 to L-1 do Begin
P:=Owner;
PrevP :=@Self;
XI:=X+I;
{ Must be in area }
If (XI<ViewPort.X1) OR
(XI>=ViewPort.X2) Then
Continue;
While Assigned(P) do Begin
if not assigned(P^.Buffer) AND
(((P^.State AND sfVisible) = 0) OR
(P^.Origin.X>XI) OR (P^.Origin.X+P^.Size.X<=XI) OR
(P^.Origin.Y>Y) OR (P^.Origin.Y+P^.Size.Y<=Y)) then
continue;
{ Here we must check if X,Y is exposed for this view }
PP:=P^.Last;
{ move to first }
If Assigned(PP) then
PP:=PP^.Next;
While Assigned(PP) and (PP<>P^.Last) and (PP<>PrevP) do Begin
If ((PP^.State AND sfVisible) <> 0) AND
(PP^.Origin.X>=XI) AND
(PP^.Origin.X+PP^.Size.X<XI) AND
(PP^.Origin.Y>=Y) AND
(PP^.Origin.Y+PP^.Size.Y<Y) then
exit;
PP:=PP^.Next;
End;
If Assigned(P^.Buffer) then Begin
P^.Buffer^[(Y-P^.Origin.Y)*P^.size.X+(XI-P^.Origin.X)]:=TDrawBuffer(Buf)[I];
End;
PrevP:=P;
P:=P^.Owner;
End;
End;
{$endif not DirectWrite}
END;
{define DirectWriteShadow}
PROCEDURE TView.WriteShadow(X1, Y1, X2, Y2 : Integer);
VAR
P: PGroup;
PrevP,PP : PView;
CurOrigin : TPoint;
I,J : longint;
B : Word;
ViewPort : ViewPortType;
BEGIN
{ Direct wrong method }
GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
{$ifdef DirectWriteShadow}
For J:=Y1 to Y2-1 do Begin
For i:=X1 to X2-1 do Begin
{ if (I>=ViewPort.X1) AND (J>=ViewPort.Y1) AND
(I<ViewPort.X2) AND (J<ViewPort.Y2) Then }
Begin
B:=VideoBuf^[J*ScreenWidth+i];
VideoBuf^[J*ScreenWidth+i]:= (B and $7FF);
End;
End;
End;
{$else not DirectWriteShadow}
{ Pedestrian character method }
{ Must be in area }
{If (X+L<ViewPort.X1) OR (Y<ViewPort.Y1) OR
(X>=ViewPort.X2) OR (Y>=ViewPort.Y2) Then
Exit;}
For J:=Y1 to Y2-1 do Begin
For i:=X1 to X2-1 do Begin
P:=Owner;
PrevP :=@Self;
{ Must be in area
If (XI<ViewPort.X1) OR
(XI>=ViewPort.X2) Then
Continue; }
While Assigned(P) do Begin
if not assigned(P^.Buffer) AND
(((P^.State AND sfVisible) = 0) OR
(P^.Origin.X>I) OR (P^.Origin.X+P^.Size.X<=I) OR
(P^.Origin.Y>J) OR (P^.Origin.Y+P^.Size.Y<=J)) then
continue;
{ Here we must check if X,Y is exposed for this view }
PP:=P^.Last;
{ move to first }
If Assigned(PP) then
PP:=PP^.Next;
While Assigned(PP) and (PP<>P^.Last) and (PP<>PrevP) do Begin
If ((PP^.State AND sfVisible) <> 0) AND
(PP^.Origin.X>=I) AND
(PP^.Origin.X+PP^.Size.X<I) AND
(PP^.Origin.Y>=J) AND
(PP^.Origin.Y+PP^.Size.Y<J) then
continue;
PP:=PP^.Next;
End;
If Assigned(P^.Buffer) then Begin
B:=P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)];
P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)]:= (B and $7FF);
End;
PrevP:=P;
P:=P^.Owner;
End;
End;
End;
{$endif not DirectWriteShadow}
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;
@ -4705,10 +4908,15 @@ END;
{--TGroup-------------------------------------------------------------------}
{ Lock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB }
{---------------------------------------------------------------------------}
{$ifndef NoLock}
{$define UseLock}
{$endif ndef NoLock}
PROCEDURE TGroup.Lock;
BEGIN
If (Buffer <> Nil) OR (LockFlag <> 0)
Then Inc(LockFlag); { Increment count }
{$ifdef UseLock}
{If (Buffer <> Nil) OR (LockFlag <> 0)
Then} Inc(LockFlag); { Increment count }
{$endif UseLock}
END;
{--TGroup-------------------------------------------------------------------}
@ -4716,10 +4924,12 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TGroup.Unlock;
BEGIN
{$ifdef UseLock}
If (LockFlag <> 0) Then Begin
Dec(LockFlag); { Decrement count }
{If (LockFlag = 0) Then DrawView;} { Lock release draw }
If (LockFlag = 0) Then DrawView; { Lock release draw }
End;
{$endif UseLock}
END;
PROCEDURE TWindow.DrawBorder;
@ -4878,7 +5088,10 @@ END.
{
$Log$
Revision 1.9 2001-05-07 23:36:35 pierre
Revision 1.10 2001-05-10 16:46:28 pierre
+ some improovements made
Revision 1.9 2001/05/07 23:36:35 pierre
NO_WINDOW cond removed
Revision 1.8 2001/05/04 15:43:46 pierre