diff --git a/fv/app.pas b/fv/app.pas index 56e60a5cbd..ae89b56f02 100644 --- a/fv/app.pas +++ b/fv/app.pas @@ -59,10 +59,7 @@ USES {$ENDIF} {$ENDIF} Dos, -{$ifdef USE_VIDEO_API} Video, -{$endif USE_VIDEO_API} - GFVGraph, { GFV standard unit } FVCommon, Memory, { GFV standard units } Objects, Drivers, Views, Menus, HistList, Dialogs, MsgBox; @@ -660,8 +657,7 @@ END; CONSTRUCTOR TProgram.Init; VAR I: Integer; R: TRect; BEGIN - R.Assign(0, 0, -(GetMaxX(TextModeGFV)+1), - -(GetMaxY(TextModeGFV)+1)); { Full screen area } + R.Assign(0, 0, -(ScreenWidth+1), -(ScreenHeight+1)); { Full screen area } Inherited Init(R); { Call ancestor } Application := @Self; { Set application ptr } InitScreen; { Initialize screen } @@ -670,8 +666,6 @@ BEGIN Options := 0; { No options set } Size.X := ScreenWidth; { Set x size value } Size.Y := ScreenHeight; { Set y size value } - RawSize.X := ScreenWidth * SysFontWidth - 1; { Set rawsize x } - RawSize.Y := ScreenHeight * SysFontHeight - 1; { Set rawsize y } InitStatusLine; { Create status line } InitMenuBar; { Create a bar menu } InitDesktop; { Create desktop } @@ -686,11 +680,9 @@ END; DESTRUCTOR TProgram.Done; VAR I: Integer; BEGIN -{$ifdef USE_VIDEO_API} { Do not free the Buffer of Video Unit } If Buffer = Views.PVideoBuf(VideoBuf) then Buffer:=nil; -{$endif USE_VIDEO_API} If (Desktop <> Nil) Then Dispose(Desktop, Done); { Destroy desktop } If (MenuBar <> Nil) Then Dispose(MenuBar, Done); { Destroy menu bar } If (StatusLine <> Nil) Then @@ -801,28 +793,18 @@ BEGIN video unit capabilities, the mono modus can't be handled } Drivers.InitVideo; -{$ifdef USE_VIDEO_API} if (ScreenMode.Col div ScreenMode.Row<2) then -{$else not USE_VIDEO_API} - if (GetMaxX(true) div GetMaxY(true) <2) then -{$endif USE_VIDEO_API} ShadowSize.X := 1 else ShadowSize.X := 2; ShadowSize.Y := 1; ShowMarkers := False; -{$ifdef USE_VIDEO_API} if ScreenMode.color then -{$else not USE_VIDEO_API} - if ScreenMode<>smMono then -{$endif USE_VIDEO_API} AppPalette := apColor else AppPalette := apBlackWhite; -{$ifdef USE_VIDEO_API} Buffer := Views.PVideoBuf(VideoBuf); -{$endif USE_VIDEO_API} END; @@ -884,19 +866,14 @@ PROCEDURE TProgram.SetScreenMode (Mode: Word); var R: TRect; begin - if TextModeGFV then - begin - HideMouse; - DoneMemory; - InitMemory; - InitScreen; -{$ifdef USE_VIDEO_API} - Buffer := Views.PVideoBuf(VideoBuf); -{$endif USE_VIDEO_API} - R.Assign(0, 0, ScreenWidth, ScreenHeight); - ChangeBounds(R); - ShowMouse; - end; + HideMouse; + DoneMemory; + InitMemory; + InitScreen; + Buffer := Views.PVideoBuf(VideoBuf); + R.Assign(0, 0, ScreenWidth, ScreenHeight); + ChangeBounds(R); + ShowMouse; end; procedure TProgram.SetScreenVideoMode(const Mode: TVideoMode); @@ -909,14 +886,8 @@ begin InitMouse; InitMemory; InitScreen; -{$ifdef USE_VIDEO_API} Video.SetVideoMode(Mode); -{$else USE_VIDEO_API} - SetVideoMode(Mode); -{$endif USE_VIDEO_API} -{$ifdef USE_VIDEO_API} Buffer := Views.PVideoBuf(VideoBuf); -{$endif USE_VIDEO_API} R.Assign(0, 0, ScreenWidth, ScreenHeight); ChangeBounds(R); ShowMouse; @@ -1009,14 +980,9 @@ BEGIN InitResource; InitMsgBox; Inherited Init; { Call ancestor } - if (TextModeGFV) then - begin - { init mouse and cursor } -{$ifdef USE_VIDEO_API} - Video.SetCursorType(crHidden); -{$endif USE_VIDEO_API} - Mouse.SetMouseXY(1,1); - end; + { init mouse and cursor } + Video.SetCursorType(crHidden); + Mouse.SetMouseXY(1,1); END; {--TApplication-------------------------------------------------------------} @@ -1196,7 +1162,10 @@ END; END. { $Log$ - Revision 1.22 2002-09-22 19:42:52 hajny + Revision 1.23 2004-11-03 20:33:05 peter + * removed unnecesasry graphfv stuff + + Revision 1.22 2002/09/22 19:42:52 hajny + FPC/2 support added Revision 1.21 2002/09/09 08:04:05 pierre diff --git a/fv/asciitab.pas b/fv/asciitab.pas index aa67ab0493..3f132bd276 100644 --- a/fv/asciitab.pas +++ b/fv/asciitab.pas @@ -36,17 +36,6 @@ UNIT AsciiTab; {==== 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 } @@ -202,8 +191,8 @@ begin begin If MouseInView(Event.Where) then begin - xpos:=(Event.Where.X -RawOrigin.X) div SysFontWidth; - ypos:=(Event.Where.Y -RawOrigin.Y) div SysFontHeight; + xpos:=Event.Where.X-Origin.X; + ypos:=Event.Where.Y-Origin.Y; SetTo(xpos, ypos); exit; end; @@ -334,7 +323,10 @@ end; END. { $Log$ - Revision 1.3 2002-05-30 22:23:15 pierre + Revision 1.4 2004-11-03 20:33:05 peter + * removed unnecesasry graphfv stuff + + Revision 1.3 2002/05/30 22:23:15 pierre * current char color changed Revision 1.2 2002/05/30 14:52:53 pierre diff --git a/fv/buildfv.pas b/fv/buildfv.pas index 449ca5d195..33707b982c 100644 --- a/fv/buildfv.pas +++ b/fv/buildfv.pas @@ -9,10 +9,7 @@ uses fvcommon, objects, drivers, - fileio, memory, - gfvgraph, - fvconsts, resource, views, @@ -37,7 +34,10 @@ implementation end. { $Log$ - Revision 1.6 2004-11-02 23:53:19 peter + Revision 1.7 2004-11-03 20:33:05 peter + * removed unnecesasry graphfv stuff + + Revision 1.6 2004/11/02 23:53:19 peter * fixed crashes with ide and 1.9.x Revision 1.5 2002/09/07 15:06:36 peter diff --git a/fv/callspec.pas b/fv/callspec.pas deleted file mode 100644 index 5a68a11060..0000000000 --- a/fv/callspec.pas +++ /dev/null @@ -1,460 +0,0 @@ -{ - $Id$ - - This unit provides compiler-independent mechanisms to call special - functions, i.e. local functions/procedures, constructors, methods, - destructors, etc. As there are no procedural variables for these - special functions, there is no Pascal way to call them directly. - - Copyright (c) 1997 Matthias K"oppe - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free - Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - ****************************************************************************} -unit CallSpec; - -{ - As of this version, the following compilers are supported. Please - port CallSpec to other compilers (including earlier versions) and - send your code to the above address. - - Compiler Comments - --------------------------- ------------------------------------- - Turbo Pascal 6.0 - Borland/Turbo Pascal 7.0 - FPC Pascal 0.99.8 -} - -interface - -{$i platform.inc} - -{ - The frame pointer points to the local variables of a procedure. - Use CurrentFramePointer to address the locals of the current procedure; - use PreviousFramePointer to addess the locals of the calling procedure. -} -type -{$ifdef BIT_16} - FramePointer = Word; -{$endif} -{$ifdef BIT_32} - FramePointer = pointer; -{$endif} - -function CurrentFramePointer: FramePointer; -function PreviousFramePointer: FramePointer; - -{ This version of CallSpec supports four classes of special functions. - (Please write if you need other classes.) - For each, two types of argument lists are allowed: - - `Void' indicates special functions with no explicit arguments. - Sample: constructor T.Init; - `Pointer' indicates special functions with one explicit pointer argument. - Sample: constructor T.Load(var S: TStream); -} - -{ Constructor calls. - - Ctor Pointer to the constructor. - Obj Pointer to the instance. NIL if new instance to be allocated. - VMT Pointer to the VMT (obtained by TypeOf()). - returns Pointer to the instance. -} -function CallVoidConstructor(Ctor: pointer; Obj: pointer; VMT: pointer): pointer; -function CallPointerConstructor(Ctor: pointer; Obj: pointer; VMT: pointer; Param1: pointer): pointer; - -{ Method calls. - - Method Pointer to the method. - Obj Pointer to the instance. NIL if new instance to be allocated. - returns Pointer to the instance. -} -function CallVoidMethod(Method: pointer; Obj: pointer): pointer; -function CallPointerMethod(Method: pointer; Obj: pointer; Param1: pointer): pointer; - -{ Local-function/procedure calls. - - Func Pointer to the local function (which must be far-coded). - Frame Frame pointer of the wrapping function. -} - -function CallVoidLocal(Func: pointer; Frame: FramePointer): pointer; -function CallPointerLocal(Func: pointer; Frame: FramePointer; Param1: pointer): pointer; - -{ Calls of functions/procedures local to methods. - - Func Pointer to the local function (which must be far-coded). - Frame Frame pointer of the wrapping method. - Obj Pointer to the object that the method belongs to. -} -function CallVoidMethodLocal(Func: pointer; Frame: FramePointer; Obj: pointer): pointer; -function CallPointerMethodLocal(Func: pointer; Frame: FramePointer; Obj: pointer; Param1: pointer): pointer; - - -implementation - -{$ifdef PPC_FPC} - -{$ifdef CPUI386} -{$ASMMODE ATT} -{$endif CPUI386} - -{ This indicates an FPC version which uses the same call scheme for - method-local and procedure-local procedures, but which expects the - ESI register be loaded with the Self pointer in method-local procs. } - -type - VoidLocal = function(_EBP: FramePointer): pointer; - PointerLocal = function(_EBP: FramePointer; Param1: pointer): pointer; - VoidMethodLocal = function(_EBP: FRAMEPOINTER): pointer; - PointerMethodLocal = function(_EBP: FRAMEPOINTER; Param1: pointer): pointer; - VoidConstructor = function(VMT: pointer; Obj: pointer): pointer; - PointerConstructor = function(VMT: pointer; Obj: pointer; Param1: pointer): pointer; - VoidMethod = function(Obj: pointer): pointer; - PointerMethod = function(Obj: pointer; Param1: pointer): pointer; - - -function CallVoidConstructor(Ctor: pointer; Obj: pointer; VMT: pointer): pointer; -begin -{$ifdef VER1_0} - { load the object pointer } -{$ifdef CPUI386} - asm - movl Obj, %esi - end; -{$endif CPUI386} -{$ifdef CPU68K} - asm - move.l Obj, a5 - end; -{$endif CPU68K} -{$endif VER1_0} - - CallVoidConstructor := VoidConstructor(Ctor)(VMT, Obj) -end; - - -function CallPointerConstructor(Ctor: pointer; Obj: pointer; VMT: pointer; Param1: pointer): pointer; -begin -{$ifdef VER1_0} -{ load the object pointer } -{$ifdef CPUI386} - asm - movl Obj, %esi - end; -{$endif CPUI386} -{$ifdef CPU68K} - asm - move.l Obj, a5 - end; -{$endif CPU68K} -{$endif VER1_0} - CallPointerConstructor := PointerConstructor(Ctor)(VMT, Obj, Param1) -end; - - -function CallVoidMethod(Method: pointer; Obj: pointer): pointer; -begin -{$ifdef VER1_0} - { load the object pointer } -{$ifdef CPUI386} - asm - movl Obj, %esi - end; -{$endif CPUI386} -{$ifdef CPU68K} - asm - move.l Obj, a5 - end; -{$endif CPU68K} -{$endif VER1_0} - CallVoidMethod := VoidMethod(Method)(Obj) -end; - - -function CallPointerMethod(Method: pointer; Obj: pointer; Param1: pointer): pointer; -begin -{$ifdef VER1_0} - { load the object pointer } -{$ifdef CPUI386} - asm - movl Obj, %esi - end; -{$endif CPUI386} -{$ifdef CPU68K} - asm - move.l Obj, a5 - end; -{$endif CPU68K} -{$endif VER1_0} - CallPointerMethod := PointerMethod(Method)(Obj, Param1) -end; - - -function CallVoidLocal(Func: pointer; Frame: FramePointer): pointer; -begin - CallVoidLocal := VoidLocal(Func)(Frame) -end; - - -function CallPointerLocal(Func: pointer; Frame: FramePointer; Param1: pointer): pointer; -begin - CallPointerLocal := PointerLocal(Func)(Frame, Param1) -end; - - -function CallVoidMethodLocal(Func: pointer; Frame: FramePointer; Obj: pointer): pointer; -begin -{$ifdef VER1_0} - { load the object pointer } -{$ifdef CPUI386} - asm - movl Obj, %esi - end; -{$endif CPUI386} -{$ifdef CPU68K} - asm - move.l Obj, a5 - end; -{$endif CPU68K} -{$endif VER1_0} - CallVoidMethodLocal := VoidMethodLocal(Func)(Frame) -end; - - -function CallPointerMethodLocal(Func: pointer; Frame: FramePointer; Obj: pointer; Param1: pointer): pointer; -begin -{$ifdef VER1_0} - { load the object pointer } -{$ifdef CPUI386} - asm - movl Obj, %esi - end; -{$endif CPUI386} -{$ifdef CPU68K} - asm - move.l Obj, a5 - end; -{$endif CPU68K} -{$endif VER1_0} - CallPointerMethodLocal := PointerMethodLocal(Func)(Frame, Param1) -end; - - -function CurrentFramePointer: FramePointer;assembler; -{$ifdef CPUI386} -asm - movl %ebp,%eax -end ['EAX']; -{$endif CPUI386} -{$ifdef CPU68K} -asm - move.l a6, d0 -end['D0']; -{$endif CPU68K} -{$ifdef CPUPOWERPC} -asm - mr r3,r1 -end; -{$endif CPUPOWERPC} - - -function PreviousFramePointer: FramePointer;assembler; -{$ifdef CPUI386} -asm - movl (%ebp),%eax -end ['EAX']; -{$endif CPUI386} -{$ifdef CPU68K} -asm - move.l (a6), d0 -end['D0']; -{$endif CPU68K} -{$ifdef CPUPOWERPC} -asm - lwz r3,0(r1) -end; -{$endif CPUPOWERPC} - -{$endif PPC_FPC} - - -{$ifdef PPC_BP} -type - VoidConstructor = function(VmtOfs: Word; Obj: pointer): pointer; - PointerConstructor = function(Param1: pointer; VmtOfs: Word; Obj: pointer): pointer; - VoidMethod = function(Obj: pointer): pointer; - PointerMethod = function(Param1: pointer; Obj: pointer): pointer; - -function CallVoidConstructor(Ctor: pointer; Obj: pointer; VMT: pointer): pointer; -begin - CallVoidConstructor := VoidConstructor(Ctor)(Ofs(VMT^), Obj) -end; - - -function CallPointerConstructor(Ctor: pointer; Obj: pointer; VMT: pointer; Param1: pointer): pointer; -begin - CallPointerConstructor := PointerConstructor(Ctor)(Param1, Ofs(VMT^), Obj) -end; - - -function CallVoidMethod(Method: pointer; Obj: pointer): pointer; -begin - CallVoidMethod := VoidMethod(Method)(Obj) -end; - - -function CallPointerMethod(Method: pointer; Obj: pointer; Param1: pointer): pointer; -begin - CallPointerMethod := PointerMethod(Method)(Param1, Obj) -end; - - -function CallVoidLocal(Func: pointer; Frame: FramePointer): pointer; assembler; -asm -{$IFDEF Windows} - MOV AX,[Frame] - AND AL,0FEH - PUSH AX -{$ELSE} - push [Frame] -{$ENDIF} - call dword ptr Func -end; - - -function CallPointerLocal(Func: pointer; Frame: FramePointer; Param1: pointer): pointer; assembler; -asm - mov ax, word ptr Param1 - mov dx, word ptr Param1+2 - push dx - push ax -{$IFDEF Windows} - MOV AX,[Frame] - AND AL,0FEH - PUSH AX -{$ELSE} - push [Frame] -{$ENDIF} - call dword ptr Func -end; - - -function CallVoidMethodLocal(Func: pointer; Frame: FramePointer; Obj: pointer): pointer; assembler; -asm -{$IFDEF Windows} - MOV AX,[Frame] - AND AL,0FEH - PUSH AX -{$ELSE} - push [Frame] -{$ENDIF} - call dword ptr Func -end; - - -function CallPointerMethodLocal(Func: pointer; Frame: FramePointer; Obj: pointer; Param1: pointer): pointer; assembler; -asm - mov ax, word ptr Param1 - mov dx, word ptr Param1+2 - push dx - push ax -{$IFDEF Windows} - MOV AX,[Frame] - AND AL,0FEH - PUSH AX -{$ELSE} - push [Frame] -{$ENDIF} - call dword ptr Func -end; - - -function CurrentFramePointer: FramePointer; assembler; -asm - mov ax, bp -end; - - -function PreviousFramePointer: FramePointer; assembler; -asm - mov ax, ss:[bp] -end; - -{$endif PPC_BP} - - -end. -{ - $Log$ - Revision 1.4 2004-02-06 20:56:38 jonas - + powerpc support - - Revision 1.3 2004/02/06 20:08:58 jonas - * version from FV - - Revision 1.4 2003/11/12 15:49:59 peter - * fix crash with 1.9 - - Revision 1.3 2001/07/30 08:27:58 pierre - * fix I386 compilation problem - - Revision 1.2 2001/07/29 20:23:18 pierre - * support for m68k cpu - - Revision 1.1 2001/01/29 21:56:04 peter - * updates for new fpcmake - - Revision 1.1 2001/01/29 11:31:26 marco - * added from API. callspec renamed to .pp - - Revision 1.1 2000/07/13 06:29:38 michael - + Initial import - - Revision 1.1 2000/01/06 01:20:30 peter - * moved out of packages/ back to topdir - - Revision 1.1 1999/12/23 19:36:47 peter - * place unitfiles in target dirs - - Revision 1.1 1999/11/24 23:36:37 peter - * moved to packages dir - - Revision 1.2 1998/12/16 21:57:16 peter - * fixed currentframe,previousframe - + testcall to test the callspec unit - - Revision 1.1 1998/12/04 12:48:24 peter - * moved some dirs - - Revision 1.5 1998/12/04 09:53:44 peter - * removed objtemp global var - - Revision 1.4 1998/11/24 17:14:24 peter - * fixed esi loading - - - Date Version Who Comments - ---------- -------- ------- ------------------------------------- - 19-Sep-97 0.1 mkoeppe Initial version. - 22-Sep-97 0.11 fk 0.9.3 support added, self isn't expected - on the stack in local procedures of methods - 23-Sep-97 0.12 mkoeppe Cleaned up 0.9.3 conditionals. - 03-Oct-97 0.13 mkoeppe Fixed esi load in FPC 0.9 - 22-Oct-98 0.14 pfv 0.99.8 support for FPC -} diff --git a/fv/dialogs.pas b/fv/dialogs.pas index 3b3ec558b7..e30e2565db 100644 --- a/fv/dialogs.pas +++ b/fv/dialogs.pas @@ -53,14 +53,9 @@ USES {$ENDIF} {$IFDEF OS_OS2} { OS2 CODE } - {$IFDEF PPC_FPC} OS2Def, DosCalls, PMWIN, { Standard units } - {$ELSE} - OS2Def, OS2Base, OS2PMAPI, { Standard units } - {$ENDIF} {$ENDIF} - GFVGraph, { GFV standard unit } FVCommon, FVConsts, Objects, Drivers, Views, Validate; { Standard GFV units } {***************************************************************************} @@ -1028,7 +1023,7 @@ USES App,HistList; { Standard GFV unit } {---------------------------------------------------------------------------} { LEFT AND RIGHT ARROW CHARACTER CONSTANTS } {---------------------------------------------------------------------------} -CONST LeftArr = #17; RightArr = #16; +CONST LeftArr = '<'; RightArr = '>'; {---------------------------------------------------------------------------} { TButton MESSAGES } @@ -1380,12 +1375,12 @@ BEGIN If (State AND sfFocused = 0) Then Color := 1 { Not focused colour } Else Color := 2; { Focused colour } If CanScroll(-1) Then WriteStr(0, 0, LeftArr, 4); { Set left scroll mark } - If CanScroll(1) Then WriteStr(-(RawSize.X + 1 - + If CanScroll(1) Then WriteStr(-(Size.X + 1 - TextWidth(RightArr)), 0, RightArr, 4); { Set right scroll mark } If (Data <> Nil) Then S := Copy(Data^, FirstPos+1, Length(Data^)-FirstPos) Else S := ''; { Fetch data string } X := TextWidth(LeftArr); { left arrow width } - While (TextWidth(S) > ((RawSize.X+1)-X-TextWidth( + While (TextWidth(S) > (Size.X-X-TextWidth( RightArr))) Do Delete(S, Length(S), 1); { Cut to right length } If (State AND sfFocused <> 0) Then Begin L := SelStart - FirstPos; { Selected left end } @@ -1422,35 +1417,13 @@ END; { DrawCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Oct99 LdB } {---------------------------------------------------------------------------} PROCEDURE TInputLine.DrawCursor; -VAR I, X: Sw_Integer; S: String; BEGIN If (State AND sfFocused <> 0) Then Begin { Focused window } - if (TextModeGFV) then - begin - Cursor.Y:=0; - Cursor.X:=CurPos-FirstPos+1; - ResetCursor; - end - else - begin - X := TextWidth(LeftArr); { Preset x position } - I := 0; { Preset cursor width } - If (Data <> Nil) Then Begin { Data pointer valid } - S := Copy(Data^, FirstPos+1, CurPos-FirstPos); { Copy the string } - X := X + TextWidth(S); { Calculate position } - If (State AND sfCursorIns <> 0) Then { Check insert mode } - If ((CurPos+1) <= Length(Data^)) Then - I := TextWidth(Data^[CurPos+1]) { Insert caret width } - Else I := FontWidth; { At end use fontwidth } - End; - If (State AND sfCursorIns <> 0) Then Begin { Insert mode } - If ((CurPos+1) <= Length(Data^)) Then { Not beyond end } - WriteStr(-X, 0, Data^[CurPos+1], 5) { Create block cursor } - Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor } - End Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor } - End; - end; + Cursor.Y:=0; + Cursor.X:=CurPos-FirstPos+1; + ResetCursor; + end; END; {--TInputLine---------------------------------------------------------------} @@ -1540,9 +1513,9 @@ Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Sw_Integer; FUNCTION MouseDelta: Sw_Integer; BEGIN - If (Event.Where.X <= RawOrigin.X+TextWidth(LeftArr)) + If (Event.Where.X <= Origin.X+TextWidth(LeftArr)) Then MouseDelta := -1 Else { To left of text area } - If ((Event.Where.X-RawOrigin.X) >= RawSize.X - + If ((Event.Where.X-Origin.X) >= Size.X - TextWidth(RightArr)) Then MouseDelta := 1 { To right of text area } Else MouseDelta := 0; { In area return 0 } END; @@ -1550,7 +1523,7 @@ Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Sw_Integer; FUNCTION MousePos: Sw_Integer; VAR Mp, Tw, Pos: Sw_Integer; S: String; BEGIN - Mp := Event.Where.X - RawOrigin.X; { Mouse position } + Mp := Event.Where.X - Origin.X; { Mouse position } If (Data <> Nil) Then S := Copy(Data^, FirstPos+1, Length(Data^)-FirstPos) Else S := ''; { Text area string } Tw := TextWidth(LeftArr); { Text width } @@ -1747,8 +1720,8 @@ BEGIN If (Data <> Nil) Then OldData := Copy(Data^, FirstPos+1, CurPos-FirstPos) { Text area string } Else OldData := ''; { Empty string } - Delta := FontWidth; { Safety = 1 char } - While (TextWidth(OldData) > ((RawSize.X+1)-Delta) + Delta := 1; { Safety = 1 char } + While (TextWidth(OldData) > (Size.X-Delta) - TextWidth(LeftArr) - TextWidth(RightArr)) { Check text fits } Do Begin Inc(FirstPos); { Advance first pos } @@ -1776,7 +1749,7 @@ BEGIN If (Data = Nil) Then S := '' Else { Data ptr invalid } S := Copy(Data^, FirstPos+1, Length(Data^) - FirstPos); { Fetch max string } - CanScroll := (TextWidth(S)) > (RawSize.X - + CanScroll := (TextWidth(S)) > (Size.X - TextWidth(LeftArr) - TextWidth(RightArr)); { Check scroll right } End Else CanScroll := False; { Zero so no scroll } END; @@ -1863,24 +1836,8 @@ END; PROCEDURE TButton.DrawFocus; VAR B: Byte; I, J, Pos: Sw_Integer; Bc: Word; Db: TDrawBuffer; - StoreUseFixedFont: boolean; C : char; BEGIN - If not TextModeGFV then Begin - If DownFlag Then B := 7 Else B := 0; { Shadow colour } - GraphRectangle(0, 0, RawSize.X, RawSize.Y, B); { Draw backing shadow } - GraphRectangle(1, 1, RawSize.X-1, RawSize.Y-1, B); { Draw backing shadow } - If DownFlag Then B := 0 Else B := 15; { Highlight colour } - GraphLine(0, RawSize.Y, 0, 0, B); - GraphLine(1, RawSize.Y-1, 1, 1, B); { Left highlights } - GraphLine(0, 0, RawSize.X, 0, B); - GraphLine(1, 1, RawSize.X-1, 1, B); { Top highlights } - If DownFlag Then B := 8 Else B := 7; { Select backing } - If (State AND sfFocused <> 0) AND - (DownFlag = False) Then B := 14; { Show as focused } - GraphRectangle(2, 2, RawSize.X-2, RawSize.Y-2, B); { Draw first border } - GraphRectangle(3, 3, RawSize.X-3, RawSize.Y-3, B); { Draw next border } - End; If (State AND sfDisabled <> 0) Then { Button disabled } Bc := GetColor($0404) Else Begin { Disabled colour } Bc := GetColor($0501); { Set normal colour } @@ -1892,50 +1849,40 @@ BEGIN If (Title <> Nil) Then Begin { We have a title } If (Flags AND bfLeftJust = 0) Then Begin { Not left set title } I := CTextWidth(Title^); { Fetch title width } - I := (RawSize.X - I) DIV 2; { Centre in button } - End Else I := FontWidth; { Left edge of button } - If not TextModeGFV then Begin - MoveCStr(Db[0], Title^, Bc); { Move title to buffer } - GOptions := GOptions OR goGraphView; { Graphics co-ords mode } - StoreUseFixedFont:=UseFixedFont; - UseFixedFont:=false; - WriteLine(I, FontHeight DIV 2, CStrLen(Title^), - 1, Db); { Write the title } - GOptions := GOptions AND NOT goGraphView; { Return to normal mode } - UseFixedFont:=StoreUseFixedFont; - End Else Begin - I:=I div SysFontWidth; - If DownFlag then + I := (Size.X - I) DIV 2; { Centre in button } + End + Else + I := 1; { Left edge of button } + If DownFlag then + begin + MoveChar(Db[0],' ',GetColor(8),1); + Pos:=1; + end + else + pos:=0; + For j:=0 to I-1 do + MoveChar(Db[pos+j],' ',Bc,1); + MoveCStr(Db[I+pos], Title^, Bc); { Move title to buffer } + For j:=pos+CStrLen(Title^)+I to size.X-2 do + MoveChar(Db[j],' ',Bc,1); + If not DownFlag then + Bc:=GetColor(8); + MoveChar(Db[Size.X-1],' ',Bc,1); + WriteLine(0, 0, Size.X, + 1, Db); { Write the title } + If Size.Y>1 then Begin + Bc:=GetColor(8); + if not DownFlag then begin - MoveChar(Db[0],' ',GetColor(8),1); - Pos:=1; - end - else - pos:=0; - For j:=0 to I-1 do - MoveChar(Db[pos+j],' ',Bc,1); - MoveCStr(Db[I+pos], Title^, Bc); { Move title to buffer } - For j:=pos+CStrLen(Title^)+I to size.X-2 do - MoveChar(Db[j],' ',Bc,1); - If not DownFlag then - Bc:=GetColor(8); - MoveChar(Db[Size.X-1],' ',Bc,1); - WriteLine(0, 0, Size.X, - 1, Db); { Write the title } - If Size.Y>1 then Begin - Bc:=GetColor(8); - if not DownFlag then - begin - c:='Ü'; - MoveChar(Db,c,Bc,1); - WriteLine(Size.X-1, 0, 1, 1, Db); - end; - MoveChar(Db,' ',Bc,1); - if DownFlag then c:=' ' - else c:='ß'; - MoveChar(Db[1],c,Bc,Size.X-1); - WriteLine(0, 1, Size.X, 1, Db); - End; + c:='Ü'; + MoveChar(Db,c,Bc,1); + WriteLine(Size.X-1, 0, 1, 1, Db); + end; + MoveChar(Db,' ',Bc,1); + if DownFlag then c:=' ' + else c:='ß'; + MoveChar(Db[1],c,Bc,Size.X-1); + WriteLine(0, 1, Size.X, 1, Db); End; End; END; @@ -1995,9 +1942,9 @@ END; PROCEDURE TButton.HandleEvent (Var Event: TEvent); VAR Down: Boolean; C: Char; ButRect: TRect; BEGIN - ButRect.A := RawOrigin; { Get origin point } - ButRect.B.X := RawOrigin.X + RawSize.X; { Calc right side } - ButRect.B.Y := RawOrigin.Y + RawSize.Y; { Calc bottom } + ButRect.A := Origin; { Get origin point } + ButRect.B.X := Origin.X + Size.X; { Calc right side } + ButRect.B.Y := Origin.Y + Size.Y; { Calc bottom } If (Event.What = evMouseDown) Then Begin { Mouse down event } If NOT MouseInView(Event.Where) Then Begin { If point not in view } ClearEvent(Event); { Clear the event } @@ -2091,11 +2038,8 @@ BEGIN Dispose(P); { Dispose prior item } End; Sel := 0; - if TextModeGFV then - begin - SetCursor(2,0); - ShowCursor; - end; + SetCursor(2,0); + ShowCursor; EnableMask := $FFFFFFFF; { Enable bit masks } END; @@ -2120,8 +2064,6 @@ BEGIN EnableMask := $FFFFFFFF; { Enable all masks } Options := Options OR ofVersion20; { Set version 2 mask } End; - If (Options AND ofGFVModeView <> 0) Then { GFV mode view check } - S.Read(Id, Sizeof(Id)); { Read view id } Strings.Load(S); { Load string data } SetButtonState(0, True); { Set button state } END; @@ -2271,8 +2213,7 @@ BEGIN End; WriteBuf(K, K+I, Size.X-K-K, 1, B); { Write buffer } End; - if TextModeGFV then - SetCursor(Column(Sel)+2,Row(Sel)); + SetCursor(Column(Sel)+2,Row(Sel)); END; {--TCluster-----------------------------------------------------------------} @@ -2340,8 +2281,6 @@ BEGIN S.Write(w, SizeOf(Word)); { Write value } S.Write(Sel, SizeOf(Sel)); { Write select item } End; - If (Options AND ofGFVModeView <> 0) Then { GFV mode view check } - S.Write(Id, SizeOf(Id)); { Write new id value } Strings.Store(S); { Store strings } END; @@ -2952,14 +2891,14 @@ BEGIN T := Copy(S, I, P-I); { String to write } Case Just Of 0: J := 0; { Left justify } - 1: J := (RawSize.X - TextWidth(T)) DIV 2; { Centre justify } - 2: J := RawSize.X - TextWidth(T); { Right justify } + 1: J := (Size.X - TextWidth(T)) DIV 2; { Centre justify } + 2: J := Size.X - TextWidth(T); { Right justify } End; While (J < 0) Do Begin { Text to long } J := J + TextWidth(T[1]); { Add width to J } Delete(T, 1, 1); { Delete the char } End; - WriteStr(-J, -(Y*FontHeight), T, 1); { Write the text } + WriteStr(-J, -Y, T, 1); { Write the text } While (P <= L) AND (P-I <= Size.X) AND ((S[P] = #13) OR (S[P] = #10)) Do Inc(P); { Remove CR/LF } Inc(Y); { Next line } @@ -4229,7 +4168,10 @@ END; END. { $Log$ - Revision 1.25 2004-11-03 12:09:08 peter + Revision 1.26 2004-11-03 20:33:05 peter + * removed unnecesasry graphfv stuff + + Revision 1.25 2004/11/03 12:09:08 peter * textwidth doesn't support ~ anymore, added CTextWidth with ~ support Revision 1.24 2004/11/03 10:37:24 peter diff --git a/fv/drivers.pas b/fv/drivers.pas index bc50cafa0c..27c4fe5b02 100644 --- a/fv/drivers.pas +++ b/fv/drivers.pas @@ -87,10 +87,6 @@ USES {$ifdef HasSysMsgUnit} SysMsg, {$endif HasSysMsgUnit} -{$IFDEF GRAPH_API} { GRAPH CODE } - Graph, { Standard unit } -{$ENDIF} - GFVGraph, { GFV graphics unit } FVCommon, Objects; { GFV standard units } {***************************************************************************} @@ -278,11 +274,7 @@ TYPE END; PEvent = ^TEvent; -{$ifdef USE_VIDEO_API} TVideoMode = Video.TVideoMode; { Screen mode } -{$else not USE_VIDEO_API} - TVideoMode = Sw_Word; { Screen mode } -{$endif USE_VIDEO_API} {---------------------------------------------------------------------------} { ERROR HANDLER FUNCTION DEFINITION } @@ -577,16 +569,6 @@ CONST SaveInt09 : Pointer = Nil; { Compatability only } SysErrorFunc : TSysErrorFunc = {$ifdef FPC}@{$endif}SystemError; { System error ptr } -{---------------------------------------------------------------------------} -{ >>> NEW INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES <<< } -{---------------------------------------------------------------------------} -CONST - TextModeGFV : Boolean = False; { DOS/DPMI textmode op } - UseFixedFont : Boolean = True; - DefLineNum : Sw_Integer = 25; { Default line number } - DefFontHeight : Sw_Integer = 0; { Default font height } - SysFontWidth : Sw_Integer = 8; { System font width } - SysFontHeight : Sw_Integer = 16; { System font height } {***************************************************************************} { UNINITIALIZED PUBLIC VARIABLES } @@ -600,11 +582,7 @@ VAR MouseButtons: Byte; { Mouse button state } ScreenWidth : Byte; { Screen text width } ScreenHeight: Byte; { Screen text height } -{$IFNDEF Use_Video_API} - ScreenMode : Sw_Word; { Screen mode } -{$Else Use_Video_API} ScreenMode : TVideoMode; { Screen mode } -{$Endif Use_Video_API} MouseWhere : TPoint; { Mouse position } {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} @@ -613,11 +591,6 @@ VAR { API Units } USES FVConsts, -{$IFDEF GRAPH_API} { GRAPH CODE } -{$ifdef win32} - win32gr, -{$endif} -{$ENDIF GRAPH_API} { GRAPH CODE } Keyboard,Mouse; {***************************************************************************} @@ -789,7 +762,6 @@ END; {---------------------------------------------------------------------------} { DetectVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB } {---------------------------------------------------------------------------} -{$IFDEF Use_Video_API} procedure DetectVideo; VAR @@ -800,107 +772,6 @@ begin GetVideoMode(CurrMode); ScreenMode:=CurrMode; end; -{$else not Use_Video_API} -PROCEDURE DetectVideo; -{$IFDEF OS_DOS} { DOS/DPMI CODE } -ASSEMBLER; - {$IFDEF ASM_BP} { BP COMPATABLE ASM } - ASM - MOV AH, $0F; { Set function id } - PUSH BP; { Safety!! save reg } - INT $10; { Get current crt mode } - POP BP; { Restore register } - PUSH AX; { Hold result } - MOV AX, $1130; { Set function id } - MOV BH, 0; { Zero register } - MOV DL, 0; { Zero register } - PUSH BP; { Safety!! save reg } - INT $10; { Get ext-video mode } - POP BP; { Restore register } - POP AX; { Recover held value } - MOV DH, AH; { Transfer high mode } - CMP DL, 25; { Check screen ht } - SBB AH, AH; { Subtract borrow } - INC AH; { Make #1 if in high } - MOV CL, 1; { Preset value of 1 } - OR DL, DL; { Test for zero } - JNZ @@1; { Branch if not zero } - MOV CL, 0 { Set value to zero } - MOV DL, 24; { Zero = 24 lines } - @@1: - INC DL; { Add one line } - MOV ScreenWidth, DH; { Hold screen width } - MOV ScreenHeight, DL; { Hold screen height } - MOV HiResScreen, CL; { Set hires mask } - CMP AL, smMono; { Is screen mono } - JZ @@Exit1; { Exit of mono } - CMP AL, smBW80; { Is screen B&W } - JZ @@Exit1; { Exit if B&W } - MOV AX, smCO80; { Else set to colour } - @@Exit1: - MOV ScreenMode, AX; { Hold screen mode } - END; - {$ENDIF} - {$IFDEF ASM_FPC} { FPC COMPATABLE ASM } - ASM - MOVB $0x0F, %AH; { Set function id } - PUSHL %EBP; { Save register } - INT $0x10; { Get current crt mode } - POPL %EBP; { Restore register } - PUSHL %EAX; { Hold result } - MOVW $0x1130, %AX; { Set function id } - MOVB $0, %BH; { Zero register } - MOVB $0, %DL; { Zero register } - PUSHL %EBP; { Safety!! save reg } - INT $0x10; { Get ext-video mode } - POPL %EBP; { Restore register } - POPL %EAX; { Recover held value } - MOVB %AH, %DH; { Transfer high mode } - CMPB $25, %DL; { Check screen ht } - SBB %AH, %AH; { Subtract borrow } - INCB %AH; { Make #1 if in high } - MOVB $1, %CL; { Preset value of 1 } - ORB %DL, %DL; { Test for zero } - JNZ .L_JMP1; { Branch if not zero } - MOVB $0, %CL; { Set value to zero } - MOVB $24, %DL; { Zero = 24 lines } - .L_JMP1: - INCB %DL; { Add one line } - MOVB %DH, SCREENWIDTH; { Hold screen width } - MOVB %DL, SCREENHEIGHT; { Hold screen height } - MOVB %CL, HIRESSCREEN; { Set hires mask } - CMPB $07, %AL; { Is screen mono } - JZ .L_Exit1; { Exit of mono } - CMPB $02, %AL; { Is screen B&W } - JZ .L_Exit1; { Exit if B&W } - MOVW $03, %AX; { Else set to colour } - .L_Exit1: - MOVW %AX, SCREENMODE; { Hold screen mode } - END; - {$ENDIF} -{$ENDIF} -{$IFDEF OS_WINDOWS} { WIN/NT CODE } -VAR Dc: HDC; -BEGIN - Dc := GetDc(0); { Get screen context } - If ((GetDeviceCaps(Dc, BitsPixel) > 1) OR { Colour capacity } - (GetDeviceCaps(Dc, Planes) > 1)) Then { Colour capacity } - ScreenMode := smCO80 Else ScreenMode := smMono; { Screen mode } - ReleaseDc(0, Dc); { Release context } -END; -{$ENDIF} -{$IFDEF OS_OS2} { OS2 CODE } -VAR Ps: Hps; Dc: Hdc; Colours: LongInt; -BEGIN - Ps := WinGetPS(HWND_Desktop); { Get desktop PS } - Dc := GpiQueryDevice(Ps); { Get gpi context } - DevQueryCaps(Dc, Caps_Phys_Colors, 1, Colours); { Colour capacity } - If (Colours> 2) Then ScreenMode := smCO80 { Colour screen } - Else ScreenMode := smMono; { Mono screen } - WinReleasePS(Ps); { Release desktop PS } -END; -{$ENDIF} -{$endif not Use_Video_API} {---------------------------------------------------------------------------} { DetectMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB } @@ -1176,8 +1047,8 @@ begin if Mouse.PollMouseEvent(e) then begin Mouse.GetMouseEvent(e); - MouseWhere.X:=e.x * SysFontWidth; - MouseWhere.Y:=e.y * SysFontHeight; + MouseWhere.X:=e.x; + MouseWhere.Y:=e.y; Event.Double:=false; case e.Action of MouseActionMove : @@ -1324,124 +1195,33 @@ const {---------------------------------------------------------------------------} PROCEDURE InitVideo; VAR -{$ifdef GRAPH_API} - I, J: Integer; - Ts : TextSettingsType; -{$else not GRAPH_API} - I, J: Integer; -{$IFDEF OS_WINDOWS} - Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; -{$ENDIF} -{$IFDEF OS_OS2} - Ts, Fs: Sw_Integer; Ps: HPs; Tm: FontMetrics; -{$ENDIF} -{$ENDIF} -{$ifdef USE_VIDEO_API} - StoreScreenMode : TVideoMode; - -{$endif USE_VIDEO_API} + StoreScreenMode : TVideoMode; BEGIN -if VideoInitialized then - begin -{$ifdef USE_VIDEO_API} - StoreScreenMode:=ScreenMode; -{$endif USE_VIDEO_API} - DoneVideo; -{$ifdef USE_VIDEO_API} - end -else - begin + if VideoInitialized then + begin + StoreScreenMode:=ScreenMode; + DoneVideo; + end + else StoreScreenMode.Col:=0; -{$endif USE_VIDEO_API} - end; -{$ifdef GRAPH_API} -if Not TextmodeGFV then - begin -{$ifdef go32v2} - I := VGA; - J := VGAHi; -{$else not go32v2} -{$ifdef win32} - I := VESA; - J := mLargestWindow16; - DefFontHeight:=8; -{$else not win32} - I := Detect; { Detect video card } - J := 0; { Zero select mode } -{$endif win32} -{$endif go32v2} - InitGraph(I, J, ''); { Initialize graphics } - I := Graph.GetMaxX; { Fetch max x size } - J := Graph.GetMaxY; { Fetch max y size } - If (DefFontHeight = 0) Then { Font height not set } - J := (Graph.GetMaxY+1) DIV DefLineNum { Approx font height } - Else J := DefFontHeight; { Use set font height } - I := J DIV (TextHeight('H')+4); { Approx magnification } - If (I < 1) Then I := 1; { Must be 1 or above } - GetTextSettings(Ts); { Get text style } - SetTextStyle(Ts.Font, Ts.Direction, I); { Set new font settings } - SysFontWidth := TextWidth('H'); { Transfer font width } - SysFontHeight := TextHeight('H')+4; { Transfer font height } - ScreenWidth := (Graph.GetMaxX+1) DIV - SysFontWidth; { Calc screen width } - if ScreenWidth > MaxViewWidth then - ScreenWidth := MaxViewWidth; - ScreenHeight := (Graph.GetMaxY+1) DIV - SysFontHeight; { Calc screen height } - UseFixedFont:=true; -{$ifdef USE_VIDEO_API} - if assigned(Video.VideoBuf) then - FreeMem(Video.VideoBuf); - GetMem(Video.VideoBuf,sizeof(word)*ScreenWidth*ScreenHeight); - if assigned(Video.OldVideoBuf) then - FreeMem(Video.OldVideoBuf); - GetMem(Video.OldVideoBuf,sizeof(word)*ScreenWidth*ScreenHeight); - GetMem(GFVGraph.SpVideoBuf,sizeof(pextrainfo)*(ScreenWidth+1)*(ScreenHeight+1)); - FillChar(Video.VideoBuf^,sizeof(word)*ScreenWidth*ScreenHeight,#0); - FillChar(Video.OldVideoBuf^,sizeof(word)*ScreenWidth*ScreenHeight,#0); - FillChar(GFVGraph.SpVideoBuf^,sizeof(pextrainfo)*(ScreenWidth+1)*(ScreenHeight+1),#0); - ScreenMode.color:=true; - ScreenMode.col:=ScreenWidth; - ScreenMode.row:=ScreenHeight; - GfvGraph.SysFontWidth:=SysFontWidth; - GfvGraph.SysFontHeight:=SysFontHeight; - GfvGraph.TextScreenWidth:=ScreenWidth; - GfvGraph.TextScreenHeight:=ScreenHeight; - SetupExtraInfo; -{$endif USE_VIDEO_API} -{$ifdef win32} - SetGraphHooks; -{$endif} - end -else -{$endif GRAPH_API} - begin - Video.InitVideo; -{$ifdef USE_VIDEO_API} - GetVideoMode(ScreenMode); - If (StoreScreenMode.Col<>0) and - ((StoreScreenMode.color<>ScreenMode.color) or - (StoreScreenMode.row<>ScreenMode.row) or - (StoreScreenMode.col<>ScreenMode.col)) then - begin - Video.SetVideoMode(StoreScreenMode); - GetVideoMode(ScreenMode); - end; -{$endif USE_VIDEO_API} - if ScreenWidth > MaxViewWidth then - ScreenWidth := MaxViewWidth; - ScreenWidth:=Video.ScreenWidth; - ScreenHeight:=Video.ScreenHeight; - SetViewPort(0,0,ScreenWidth,ScreenHeight,true,true); - I := ScreenWidth*8 -1; { Mouse width } - J := ScreenHeight*8 -1; { Mouse height } - SysScreenWidth := I + 1; - SysScreenHeight := J + 1; - SysFontWidth := 8; { Font width } - SysFontHeight := 8; { Font height } - end; -VideoInitialized:=true; + Video.InitVideo; + GetVideoMode(ScreenMode); + + If (StoreScreenMode.Col<>0) and + ((StoreScreenMode.color<>ScreenMode.color) or + (StoreScreenMode.row<>ScreenMode.row) or + (StoreScreenMode.col<>ScreenMode.col)) then + begin + Video.SetVideoMode(StoreScreenMode); + GetVideoMode(ScreenMode); + end; + + if ScreenWidth > MaxViewWidth then + ScreenWidth := MaxViewWidth; + ScreenWidth:=Video.ScreenWidth; + ScreenHeight:=Video.ScreenHeight; + VideoInitialized:=true; END; {---------------------------------------------------------------------------} @@ -1451,28 +1231,7 @@ PROCEDURE DoneVideo; BEGIN if not VideoInitialized then exit; -{$ifdef GRAPH_API} - if Not TextmodeGFV then - begin -{$ifdef USE_VIDEO_API} - FreeMem(Video.VideoBuf,sizeof(word)*ScreenWidth*ScreenHeight); - Video.VideoBuf:=nil; - FreeMem(Video.OldVideoBuf,sizeof(word)*ScreenWidth*ScreenHeight); - Video.OldVideoBuf:=nil; - FreeExtraInfo; -{$endif USE_VIDEO_API} - CloseGraph; -{$ifdef win32} - UnsetGraphHooks; -{$endif} - end - else -{$endif GRAPH_API} -{$ifdef USE_video_api} - Video.DoneVideo; -{$else not USE_video_api} - ; { nothing to do } -{$endif not USE_video_api} + Video.DoneVideo; VideoInitialized:=false; END; @@ -1481,18 +1240,7 @@ END; {---------------------------------------------------------------------------} PROCEDURE ClearScreen; BEGIN -{$ifdef GRAPH_API} - if Not TextmodeGFV then - begin - Graph.ClearDevice; - end - else -{$endif GRAPH_API} -{$ifdef USE_video_api} - Video.ClearScreen; -{$else not USE_video_api} - ; { nothing to do } -{$endif not USE_video_api} + Video.ClearScreen; END; {---------------------------------------------------------------------------} @@ -1500,8 +1248,6 @@ END; {---------------------------------------------------------------------------} PROCEDURE SetVideoMode (Mode: Sw_Word); BEGIN - If (Mode > $100) Then DefLineNum := 50 { 50 line mode request } - Else DefLineNum := 24; { Normal 24 line mode } END; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} @@ -1690,12 +1436,7 @@ END; BEGIN ButtonCount := DetectMouse; { Detect mouse } DetectVideo; { Detect video } - { text mode is the default mode } - TextModeGFV:=True; InitKeyboard; - {$ifdef Graph_API} - TextModeGFV:=false; - {$endif Graph_API} {$ifdef HasSysMsgUnit} InitSystemMsg; {$endif HasSysMsgUnit} @@ -1710,7 +1451,10 @@ BEGIN END. { $Log$ - Revision 1.39 2004-11-02 23:53:19 peter + Revision 1.40 2004-11-03 20:33:05 peter + * removed unnecesasry graphfv stuff + + Revision 1.39 2004/11/02 23:53:19 peter * fixed crashes with ide and 1.9.x Revision 1.38 2003/10/01 16:20:27 marco diff --git a/fv/fileio.pas b/fv/fileio.pas deleted file mode 100644 index edc7780167..0000000000 --- a/fv/fileio.pas +++ /dev/null @@ -1,732 +0,0 @@ -{ $Id$ } -{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********} -{ } -{ System independent FILE I/O control } -{ } -{ Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer } -{ ldeboer@attglobal.net - primary e-mail address } -{ ldeboer@projectent.com.au - backup e-mail address } -{ } -{****************[ THIS CODE IS FREEWARE ]*****************} -{ } -{ This sourcecode is released for the purpose to } -{ promote the pascal language on all platforms. You may } -{ redistribute it and/or modify with the following } -{ DISCLAIMER. } -{ } -{ This SOURCE CODE is distributed "AS IS" WITHOUT } -{ WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR } -{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. } -{ } -{*****************[ SUPPORTED PLATFORMS ]******************} -{ 16 and 32 Bit compilers } -{ DOS - Turbo Pascal 7.0 + (16 Bit) } -{ DPMI - Turbo Pascal 7.0 + (16 Bit) } -{ - FPC 0.9912+ (GO32V2) (32 Bit) } -{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) } -{ - Delphi 1.0+ (16 Bit) } -{ WIN95/NT - Delphi 2.0+ (32 Bit) } -{ - Virtual Pascal 2.0+ (32 Bit) } -{ - Speedsoft Sybil 2.0+ (32 Bit) } -{ - FPC 0.9912+ (32 Bit) } -{ OS2 - Virtual Pascal 1.0+ (32 Bit) } -{ - Speed Pascal 1.0+ (32 Bit) } -{ - C'T patch to BP (16 Bit) } -{ LINUX - FPC 1.0.2+ (32 Bit) } -{ } -{******************[ REVISION HISTORY ]********************} -{ Version Date Fix } -{ ------- --------- --------------------------------- } -{ 1.00 12 Jun 96 First DOS/DPMI platform release } -{ 1.10 12 Mar 97 Windows conversion added. } -{ 1.20 29 Aug 97 Platform.inc sort added. } -{ 1.30 12 Jun 98 Virtual pascal 2.0 code added. } -{ 1.40 10 Sep 98 Checks run & commenting added. } -{ 1.50 28 Oct 98 Fixed for FPC version 0.998 } -{ Only Go32v2 supported no Go32v1 } -{ 1.60 14 Jun 99 References to Common.pas added. } -{ 1.61 07 Jul 99 Speedsoft SYBIL 2.0 code added. } -{ 1.62 03 Nov 99 FPC windows support added. } -{ 1.70 10 Nov 00 Revamp using changed common unit } -{**********************************************************} - -UNIT FileIO; - -{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} - INTERFACE -{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} - -{====Include file to sort compiler platform out =====================} -{$I Platform.inc} -{====================================================================} - -{==== 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 } - {$E+} { Emulation is on } - {$N-} { No 80x87 code generation } -{$ENDIF} - -{$X+} { Extended syntax is ok } -{$R-} { Disable range checking } -{$IFNDEF OS_UNIX} -{$S-} { Disable Stack Checking } -{$ENDIF} -{$I-} { Disable IO Checking } -{$Q-} { Disable Overflow Checking } -{$V-} { Turn off strict VAR strings } -{====================================================================} - -{$IFDEF OS_DOS} { DOS/DPMI ONLY } - {$IFDEF PPC_FPC} { FPC COMPILER } - {$IFNDEF GO32V2} { MUST BE GO32V2 } - This only works in GO32V2 mode in FPC! - {$ENDIF} - {$ENDIF} -{$ENDIF} - -USES - {$IFDEF WIN16} WinTypes, WinProcs, {$ENDIF} { Stardard BP units } - FVCommon; { Standard GFV unit } - -{***************************************************************************} -{ PUBLIC CONSTANTS } -{***************************************************************************} - -{---------------------------------------------------------------------------} -{ FILE ACCESS MODE CONSTANTS } -{---------------------------------------------------------------------------} -CONST - fa_Create = $3C00; { Create new file } - fa_OpenRead = $3D00; { Read access only } - fa_OpenWrite = $3D01; { Write access only } - fa_Open = $3D02; { Read/write access } - -{---------------------------------------------------------------------------} -{ FILE SHARE MODE CONSTANTS } -{---------------------------------------------------------------------------} -CONST - fm_DenyAll = $0010; { Exclusive file use } - fm_DenyWrite = $0020; { Deny write access } - fm_DenyRead = $0030; { Deny read access } - fm_DenyNone = $0040; { Deny no access } - -{$IFDEF OS_DOS} { DOS/DPMI CODE } -CONST - HFILE_ERROR = -1; { File handle error } -{$ENDIF} - -{***************************************************************************} -{ PUBLIC TYPE DEFINITIONS } -{***************************************************************************} - -{---------------------------------------------------------------------------} -{ ASCIIZ FILENAME } -{---------------------------------------------------------------------------} -TYPE - AsciiZ = Array [0..255] Of Char; { Filename array } - -{***************************************************************************} -{ INTERFACE ROUTINES } -{***************************************************************************} - -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} -{ FILE CONTROL ROUTINES } -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} - -{-FileClose---------------------------------------------------------- -The file opened by the handle is closed. If close action is successful -true is returned but if the handle is invalid or a file error occurs -false will be returned. -14Nov00 LdB ----------------------------------------------------------------------} -FUNCTION FileClose (Handle: THandle): Boolean; - -{-FileOpen----------------------------------------------------------- -Given a valid filename to file that exists, is not locked with a valid -access mode the file is opened and the file handle returned. If the -name or mode is invalid or an error occurs the return will be zero. -27Oct98 LdB ----------------------------------------------------------------------} -FUNCTION FileOpen (Const FileName: AsciiZ; Mode: Word): THandle; - -{-SetFileSize-------------------------------------------------------- -The file opened by the handle is set the given size. If the action is -successful zero is returned but if the handle is invalid or a file error -occurs a standard file error value will be returned. -21Oct98 LdB ----------------------------------------------------------------------} -FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word; - -{-SetFilePos--------------------------------------------------------- -The file opened by the handle is set the given position in the file. -If the action is successful zero is returned but if the handle is invalid -the position is beyond the file size or a file error occurs a standard -file error value will be returned. -21Oct98 LdB ----------------------------------------------------------------------} -FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word; -Var Actual: LongInt): Word; - -{-FileRead----------------------------------------------------------- -The file opened by the handle has count bytes read from it an placed -into the given buffer. If the read action is successful the actual bytes -transfered is returned in actual and the function returns zero. If an -error occurs the function will return a file error constant and actual -will contain the bytes transfered before the error if any. -22Oct98 LdB ----------------------------------------------------------------------} -FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word; - -{-FileWrite---------------------------------------------------------- -The file opened by the handle has count bytes written to it from the -given buffer. If the write action is successful the actual bytes -transfered is returned in actual and the function returns zero. If an -error occurs the function will return a file error constant and actual -will contain the bytes transfered before the error if any. -22Oct98 LdB ----------------------------------------------------------------------} -FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word; - -{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} - IMPLEMENTATION -{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} - -{$IFDEF OS_WINDOWS} { WIN/NT UNITS } - - {$IFNDEF PPC_SPEED} { NON SPEED COMPILER } - {$IFDEF WIN32} { WIN32 COMPILER } - USES Windows; { Standard unit } - {$ENDIF} - TYPE LongWord = LongInt; { Type fixup } - {$ELSE} { SPEEDSOFT COMPILER } - USES WinNT, WinBase; { Standard units } - {$ENDIF} - -{$ENDIF} - -{$IFDEF OS_OS2} { OS2 COMPILERS } - - {$IFDEF PPC_VIRTUAL} { VIRTUAL PASCAL UNITS } - USES OS2Base; { Standard unit } - {$ENDIF} - - {$IFDEF PPC_SPEED} { SPEED PASCAL UNITS } - USES BseDos, Os2Def; { Standard units } - {$ENDIF} - - {$IFDEF PPC_BPOS2} { C'T PATCH TO BP UNITS } - USES DosTypes, DosProcs; { Standard units } - {$ENDIF} - - {$IFDEF PPC_FPC} { FPC UNITS } - USES DosCalls, OS2Def; { Standard units } - {$ENDIF} - -{$ENDIF} - -{$IFDEF OS_UNIX} { LINUX COMPILER } - USES - {$ifdef VER1_0} - linux; - {$else} - Baseunix,unix; - {$endif} -{$ENDIF} - -{***************************************************************************} -{ INTERFACE ROUTINES } -{***************************************************************************} - -{---------------------------------------------------------------------------} -{ FileClose -> Platforms DOS/DPMI/WIN/NT/OS2/LINUX - Updated 14Nov00 LdB } -{---------------------------------------------------------------------------} -FUNCTION FileClose (Handle: THandle): Boolean; -{$IFDEF OS_DOS} { DOS/DPMI CODE } - {$IFDEF ASM_BP} { BP COMPATABLE ASM } - ASSEMBLER; - ASM - MOV BX, Handle; { DOS file handle } - MOV AX, $3E00; { Close function } - PUSH BP; { Store register } - INT $21; { Close the file } - POP BP; { Reload register } - MOV AL, True; { Preset true } - JNC @@Exit1; { Return success } - MOV AL, False; { Return failure } - @@Exit1: - END; - {$ENDIF} - {$IFDEF ASM_FPC} { FPC COMPATABLE ASM } - VAR Regs: TRealRegs; - BEGIN - Regs.RealEBX := Handle; { Transfer handle } - Regs.RealEAX := $3E00; { Close file function } - SysRealIntr($21, Regs); { Call DOS interrupt } - If (Regs.RealFlags AND $1 = 0) Then { Check carry flag } - FileClose := True Else FileClose := False; { Return true/false } - END; - {$ENDIF} -{$ENDIF} -{$IFDEF OS_WINDOWS} { WIN/NT CODE } -BEGIN - {$IFDEF BIT_16} { 16 BIT WINDOWS CODE } - If (_lclose(Handle) = 0) Then FileClose := True { Close the file } - Else FileClose := False; { Closure failed } - {$ENDIF} - {$IFDEF BIT_32} { 32 BIT WINDOWS CODE } - FileClose := CloseHandle(Handle); { Close the file } - {$ENDIF} -END; -{$ENDIF} -{$IFDEF OS_OS2} { OS2 CODE } -BEGIN - If (DosClose(Handle) = 0) Then FileClose := True { Try to close file } - Else FileClose := False; { Closure failed } -END; -{$ENDIF} -{$IFDEF OS_UNIX} { LINUX CODE } -BEGIN - {$ifdef ver1_0} - fdClose(Handle); - FileClose := LinuxError <= 0 - {$else} - FileClose:=fpclose(Handle)=0; - {$endif}; { Close the file } -END; -{$ENDIF} - -{---------------------------------------------------------------------------} -{ FileOpen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct98 LdB } -{---------------------------------------------------------------------------} -FUNCTION FileOpen (Const FileName: AsciiZ; Mode: Word): THandle; -{$IFDEF OS_DOS} { DOS/DPMI CODE } - {$IFDEF ASM_BP} { BP COMPATABLE ASM } - ASSEMBLER; - ASM - MOV AX, Mode; { Mode to open file } - XOR CX, CX; { No attributes set } - PUSH DS; { Save segment } - LDS DX, FileName; { Filename to open } - PUSH BP; { Store register } - INT $21; { Open/create file } - POP BP; { Restore register } - POP DS; { Restore segment } - JNC @@Exit2; { Check for error } - XOR AX, AX; { Open fail return 0 } - @@Exit2: - END; - {$ENDIF} - {$IFDEF ASM_FPC} { FPC COMPATABLE ASM } - VAR Regs: TRealRegs; - BEGIN - SysCopyToDos(LongInt(@FileName), 256); { Transfer filename } - Regs.RealEDX := Tb MOD 16; - Regs.RealDS := Tb DIV 16; { Linear addr of Tb } - Regs.RealEAX := Mode; { Mode to open with } - Regs.RealECX := 0; { No attributes set } - SysRealIntr($21, Regs); { Call DOS int 21 } - If (Regs.RealFlags AND 1 <> 0) Then FileOpen := 0{ Error encountered } - Else FileOpen := Regs.RealEAX AND $FFFF; { Return file handle } - END; - {$ENDIF} -{$ENDIF} -{$IFDEF OS_WINDOWS} { WIN/NT CODE } -VAR Hnd: Integer; OpenMode: Sw_Word; - {$IFDEF BIT_16} Buf: TOfStruct; {$ENDIF} { 16 BIT VARIABLES } - {$IFDEF BIT_32} ShareMode, Flags: LongInt; {$ENDIF} { 32 BIT VARIABLES } -BEGIN - {$IFDEF BIT_16} { 16 BIT WINDOW CODE } - If (Mode = fa_Create) Then OpenMode := of_Create { Set create mask bit } - Else OpenMode := Mode AND $00FF; { Set open mask bits } - Hnd := OpenFile(FileName, Buf, OpenMode); { Open the file } - {$ENDIF} - {$IFDEF BIT_32} { 32 BIT WINDOWS CODE } - If (Mode = fa_Create) Then Begin { Create file } - OpenMode := Generic_Read OR Generic_Write; { Set access mask bit } - Flags := Create_Always; { Create always mask } - End Else Begin { Open the file } - OpenMode := Generic_Read; { Read only access set } - If (Mode AND $0001 <> 0) Then { Check write flag } - OpenMode := OpenMode AND NOT Generic_Read; { Write only access set } - If (Mode AND $0002 <> 0) Then { Check read/write flag } - OpenMode := OpenMode OR Generic_Write; { Read/Write access } - Flags := Open_Existing; { Open existing mask } - End; - ShareMode := file_Share_Read OR - file_Share_Write; { Deny none flag set } - Hnd := CreateFile(FileName, OpenMode, ShareMode, - Nil, Flags, File_Attribute_Normal, 0); { Open the file } - {$ENDIF} - If (Hnd <> -1) Then FileOpen := Hnd Else { Return handle } - FileOpen := 0; { Return error } -END; -{$ENDIF} -{$IFDEF OS_OS2} { OS2 CODE } -VAR OpenFlags, OpenMode: Word; Handle, ActionTaken: Sw_Word; -BEGIN - If (Mode = fa_Create) Then Begin { Create file } - OpenMode := Open_Flags_NoInherit OR - Open_Share_DenyNone OR - Open_Access_ReadWrite; { Open mode } - OpenFlags := OPEN_ACTION_CREATE_IF_NEW OR - OPEN_ACTION_REPLACE_IF_EXISTS; { Open flags } - End Else Begin - OpenMode := Mode AND $00FF OR - Open_Share_DenyNone; { Set open mode bits } - OpenFlags := OPEN_ACTION_OPEN_IF_EXISTS; { Set open flags } - End; - {$IFDEF PPC_BPOS2} { C'T patched COMPILER } - If (DosOpen(@FileName, Handle, ActionTaken, 0, 0, - OpenFlags, OpenMode, 0) = 0) Then - FileOpen := Handle Else FileOpen := 0; { Return handle/fail } - {$ELSE} { OTHER OS2 COMPILERS } - {$IFDEF PPC_FPC} - If (DosOpen(@FileName, Longint(Handle), ActionTaken, 0, 0, - OpenFlags, OpenMode, Nil) = 0) Then - FileOpen := Handle Else FileOpen := 0; { Return handle/fail } - {$ELSE} - If (DosOpen(FileName, Handle, ActionTaken, 0, 0, - OpenFlags, OpenMode, Nil) = 0) Then - FileOpen := Handle Else FileOpen := 0; { Return handle/fail } - {$ENDIF} - {$ENDIF} -END; -{$ENDIF} -{$IFDEF OS_UNIX} - -{$ifndef ver1_0} - var tmp : ansistring; -{$endif} - -BEGIN - if mode = fa_Create then mode := Open_Creat or Open_RdWr else - if mode = fa_OpenRead then mode := Open_RdOnly else - if mode = fa_OpenWrite then mode := Open_WrOnly else - if mode = fa_Open then mode := Open_RdWr; - {$ifdef ver1_0} - FileOpen := fdOpen(FileName,mode); - {$else} - tmp:=filename; - FileOpen := fpopen(tmp,longint(mode)); - {$endif} -END; -{$ENDIF} - -{---------------------------------------------------------------------------} -{ SetFileSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Feb97 LdB } -{---------------------------------------------------------------------------} -FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word; -{$IFDEF OS_DOS} { DOS/DPMI CODE } - {$IFDEF ASM_BP} { BP COMPATABLE ASM } - ASSEMBLER; - ASM - MOV DX, FileSize.Word[0]; { Load file position } - MOV CX, FileSize.Word[2]; - MOV BX, Handle; { Load file handle } - MOV AX, $4200; { Load function id } - PUSH BP; { Store register } - INT $21; { Position the file } - POP BP; { Reload register } - JC @@Exit3; { Exit if error } - XOR CX, CX; { Force truncation } - MOV BX, Handle; { File handle } - MOV AX, $4000; { Load function id } - PUSH BP; { Store register } - INT $21; { Truncate file } - POP BP; { Reload register } - JC @@Exit3; { Exit if error } - XOR AX, AX; { Return successful } - @@Exit3: - END; - {$ENDIF} - {$IFDEF ASM_FPC} { FPC COMPATABLE ASM } - VAR Regs: TRealRegs; - BEGIN - Regs.RealEDX := FileSize AND $FFFF; { Lo word of filesize } - Regs.RealECX := (FileSize SHR 16) AND $FFFF; { Hi word of filesize } - Regs.RealEBX := LongInt(Handle); { Load file handle } - Regs.RealEAX := $4000; { Load function id } - SysRealIntr($21, Regs); { Call DOS int 21 } - If (Regs.RealFlags AND 1 <> 0) Then - SetFileSize := Regs.RealEAX AND $FFFF { Error encountered } - Else SetFileSize := 0; { Return successful } - END; - {$ENDIF} -{$ENDIF} -{$IFDEF OS_WINDOWS} { WIN/NT CODE } -VAR {$IFDEF BIT_16} Buf, {$ENDIF} Actual: LongInt; -BEGIN - {$IFDEF BIT_16} { 16 BIT WINDOWS CODE } - Actual := _llseek(Handle, FileSize, 0); { Position file } - If (Actual = FileSize) Then Begin { No position error } - Actual := _lwrite(Handle, Pointer(@Buf), 0); { Truncate the file } - If (Actual <> -1) Then SetFileSize := 0 Else { No truncate error } - SetFileSize := 103; { File truncate error } - End Else SetFileSize := 103; { File truncate error } - {$ENDIF} - {$IFDEF BIT_32} { 32 BIT WINDOWS CODE } - Actual := SetFilePointer(Handle, FileSize, Nil, 0);{ Position file } - If (Actual = FileSize) Then Begin { No position error } - If SetEndOfFile(Handle) Then SetFileSize := 0 { No truncate error } - Else SetFileSize := 103; { File truncate error } - End Else SetFileSize := 103; { File truncate error } - {$ENDIF} -END; -{$ENDIF} -{$IFDEF OS_OS2} { OS2 CODE } -BEGIN - {$IFDEF PPC_BPOS2} { C'T patched COMPILER } - SetFileSize := DosNewSize(Handle, FileSize); { Truncate the file } - {$ELSE} { OTHER OS2 COMPILERS } - SetFileSize := DosSetFileSize(Handle, FileSize); { Truncate the file } - {$ENDIF} -END; -{$ENDIF} -{$IFDEF OS_UNIX} -VAR - Actual : LongInt; -BEGIN - Actual := {$ifdef ver1_0}fdSeek{$else} fplseek{$endif}(Handle, FileSize, 0); { Position file } - If (Actual = FileSize) Then Begin { No position error } - if ({$ifdef ver1_0}fdTruncate{$else}fpftruncate{$endif}(Handle,FileSize)){$ifndef ver1_0}=0{$endif} { Truncate the file } - Then SetFileSize := 0 { No truncate error } - else SetFileSize := 103; { File truncate error } - End Else SetFileSize := 103; { File truncate error } -END; -{$ENDIF} - -{---------------------------------------------------------------------------} -{ SetFilePos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Feb97 LdB } -{---------------------------------------------------------------------------} -FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word; -Var Actual: LongInt): Word; -{$IFDEF OS_DOS} { DOS/DPMI CODE } - {$IFDEF ASM_BP} { BP COMPATABLE ASM } - ASSEMBLER; - ASM - MOV AX, MoveType; { Load move type } - MOV AH, $42; { Load function id } - MOV DX, Pos.Word[0]; { Load file position } - MOV CX, Pos.Word[2]; - MOV BX, Handle; { Load file handle } - PUSH BP; { Store register } - INT $21; { Position the file } - POP BP; { Reload register } - JC @@Exit6; - LES DI, Actual; { Actual var addr } - MOV ES:[DI], AX; - MOV ES:[DI+2], DX; { Update actual } - XOR AX, AX; { Set was successful } - @@Exit6: - END; - {$ENDIF} - {$IFDEF ASM_FPC} { FPC COMPATABLE ASM } - VAR Regs: TRealRegs; - BEGIN - Actual := 0; { Zero actual count } - Regs.RealEAX := ($42 SHL 8) + Byte(MoveType); { Set function id } - Regs.RealEBX := LongInt(Handle); { Fetch file handle } - Regs.RealEDX := Pos AND $FFFF; { Keep low word } - Regs.RealECX := Pos SHR 16; { Keep high word } - SysRealIntr($21, Regs); { Call dos interrupt } - If (Regs.RealFlags AND $1 = 0) Then Begin - Actual := Lo(Regs.RealEDX) SHL 16 + - Lo(Regs.RealEAX); { Current position } - SetFilePos := 0; { Function successful } - End Else SetFilePos := Lo(Regs.RealEAX); { I/O error returned } - END; - {$ENDIF} -{$ENDIF} -{$IFDEF OS_WINDOWS} { WINDOWS CODE } -BEGIN - {$IFDEF BIT_16} { 16 BIT WINDOWS CODE } - Actual := _llseek(Handle, Pos, MoveType); { Position file } - If (Actual <> -1) Then SetFilePos := 0 Else { No position error } - SetFilePos := 107; { File position error } - {$ENDIF} - {$IFDEF BIT_32} { 32 BIT WINDOWS CODE } - Actual := SetFilePointer(Handle, Pos, Nil, MoveType);{ Position file } - If (Actual <> -1) Then SetFilePos := 0 Else { No position error } - SetFilePos := 107; { File position error } - {$ENDIF} -END; -{$ENDIF} -{$IFDEF OS_OS2} { OS2 CODE } -BEGIN - {$IFDEF PPC_BPOS2} - If (DosChgFilePtr(Handle, Pos, MoveType, Actual)=0){ Set file position } - Then SetFilePos := 0 Else SetFilePos := 107; { File position error } - {$ELSE} { OTHER OS2 COMPILERS } - If (DosSetFilePtr(Handle, Pos, MoveType, Actual)=0){ Set file position } - Then SetFilePos := 0 Else SetFilePos := 107; { File position error } - {$ENDIF} -END; -{$ENDIF} -{$IFDEF OS_UNIX} -BEGIN - Actual := {$ifdef ver1_0}fdSeek{$else}fplseek{$endif}(Handle, Pos, MoveType); - If (Actual <> -1) Then SetFilePos := 0 Else { No position error } - SetFilePos := 107; { File position error } -END; -{$ENDIF} - -{---------------------------------------------------------------------------} -{ FileRead -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct98 LdB } -{---------------------------------------------------------------------------} -FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word; -{$IFDEF OS_DOS} { DOS/DPMI CODE } - {$IFDEF ASM_BP} { BP COMPATABLE ASM } - ASSEMBLER; - ASM - XOR AX, AX; { Zero register } - LES DI, Actual; { Actual var address } - MOV ES:[DI], AX; { Zero actual var } - PUSH DS; { Save segment } - LDS DX, Buf; { Data destination } - MOV CX, Count; { Amount to read } - MOV BX, Handle; { Load file handle } - MOV AX, $3F00; { Load function id } - PUSH BP; { Store register } - INT $21; { Read from file } - POP BP; { Reload register } - POP DS; { Restore segment } - JC @@Exit4; { Check for error } - LES DI, Actual; { Actual var address } - MOV ES:[DI], AX; { Update bytes moved } - XOR AX, AX; { Return success } - @@Exit4: - END; - {$ENDIF} - {$IFDEF ASM_FPC} { FPC COMPATABLE ASM } - BEGIN - Actual := System.Do_Read(LongInt(Handle), - LongInt(@Buf), Count); { Read data from file } - FileRead := InOutRes; { I/O status returned } - END; - {$ENDIF} -{$ENDIF} -{$IFDEF OS_WINDOWS} { WIN/NT CODE } -BEGIN - {$IFDEF BIT_16} { 16 BIT WINDOWS CODE } - Actual := _lread(Handle, Pointer(@Buf), Count); { Read from file } - If (Actual = Count) Then FileRead := 0 Else { No read error } - FileRead := 104; { File read error } - {$ENDIF} - {$IFDEF BIT_32} { 32 BIT WINDOWS CODE } - If ReadFile(Handle, Buf, Count, DWord(Actual), - Nil) AND (Actual = Count) Then FileRead := 0 { No read error } - Else FileRead := 104; { File read error } - {$ENDIF} -END; -{$ENDIF} -{$IFDEF OS_OS2} { OS2 CODE } -BEGIN - If (DosRead(Handle, Buf, Count, Actual) = 0) AND { Read from file } - (Actual = Count) Then FileRead := 0 Else { No read error } - FileRead := 104; { File read error } -END; -{$ENDIF} -{$IFDEF OS_UNIX} -BEGIN - Actual := {$ifdef ver1_0}fdRead{$else} fpread{$endif}(Handle, Buf, Count); - if (Actual = Count) Then FileRead := 0 { No read error } - Else FileRead := 104; { File read error } -END; -{$ENDIF} - -{---------------------------------------------------------------------------} -{ FileWrite -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct98 LdB } -{---------------------------------------------------------------------------} -FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word; -{$IFDEF OS_DOS} { DOS/DPMI CODE } - {$IFDEF ASM_BP} { BP COMPATABLE ASM } - ASSEMBLER; - ASM - XOR AX, AX; { Zero register } - LES DI, Actual; { Actual var address } - MOV ES:[DI], AX; { Zero actual var } - PUSH DS; { Save segment } - LDS DX, Buf; { Data source buffer } - MOV CX, Count; { Amount to write } - MOV BX, Handle; { Load file handle } - MOV AX, $4000; { Load function id } - PUSH BP; { Store register } - INT $21; { Write to file } - POP BP; { Reload register } - POP DS; { Restore segment } - JC @@Exit5; { Check for error } - LES DI, Actual; { Actual var address } - MOV ES:[DI], AX; { Update bytes moved } - XOR AX, AX; { Write successful } - @@Exit5: - END; - {$ENDIF} - {$IFDEF ASM_FPC} { FPC COMPATABLE ASM } - BEGIN - Actual := System.Do_Write(LongInt(Handle), - LongInt(@Buf), Count); { Write data to file } - FileWrite := InOutRes; { I/O status returned } - END; - {$ENDIF} -{$ENDIF} -{$IFDEF OS_WINDOWS} { WIN/NT CODE } -BEGIN - {$IFDEF BIT_16} { 16 BIT WINDOWS CODE } - Actual := _lwrite(Handle, Pointer(@Buf), Count); { Write to file } - If (Actual = Count) Then FileWrite := 0 Else { No write error } - FileWrite := 105; { File write error } - {$ENDIF} - {$IFDEF BIT_32} { 32 BIT WINDOWS CODE } - If WriteFile(Handle, Buf, Count, DWord(Actual), - Nil) AND (Actual = Count) Then FileWrite := 0 { No write error } - Else FileWrite := 105; { File write error } - {$ENDIF} -END; -{$ENDIF} -{$IFDEF OS_OS2} { OS2 CODE } -BEGIN - If (DosWrite(Handle, Buf, Count, Actual) = 0) AND { Write to file } - (Actual = Count) Then FileWrite := 0 Else { No write error } - FileWrite := 105; { File write error } -END; -{$ENDIF} -{$IFDEF OS_UNIX} -BEGIN - Actual := {$ifdef ver1_0}fdWrite{$else}fpwrite{$endif}(Handle, Buf, Count); - If (Actual = Count) Then FileWrite := 0 Else { No write error } - FileWrite := 105; { File write error } -END; -{$ENDIF} - -END. -{ - $Log$ - Revision 1.12 2003-11-12 22:31:17 marco - * linuxerror dependancy removed for 1.1 - - Revision 1.11 2003/10/01 16:20:27 marco - * baseunix fixes for 1.1 - - Revision 1.10 2002/10/13 20:52:09 hajny - * mistyping corrected - - Revision 1.9 2002/10/12 19:39:00 hajny - * FPC/2 support - - Revision 1.8 2002/09/22 19:42:22 hajny - + FPC/2 support added - - Revision 1.7 2002/09/07 15:06:36 peter - * old logs removed and tabs fixed - - Revision 1.6 2002/06/04 11:12:41 marco - * Renamefest - -} diff --git a/fv/gadgets.pas b/fv/gadgets.pas index 8ae9554cb4..5d629dae3a 100644 --- a/fv/gadgets.pas +++ b/fv/gadgets.pas @@ -214,7 +214,7 @@ begin ColourOfs := 2; { Set colour offset } Inherited DrawBackGround; { Clear the backgound } ColourOfs := HOfs; { Reset any offset } - WriteStr(-(RawSize.X-TextWidth(S)+1), 0, S, 2); { Write the string } + WriteStr(-(Size.X-TextWidth(S)), 0, S, 2); { Write the string } END; Function THeapView.Comma ( n : LongInt) : String; @@ -303,7 +303,10 @@ END; END. { $Log$ - Revision 1.5 2002-09-07 15:06:36 peter + Revision 1.6 2004-11-03 20:33:05 peter + * removed unnecesasry graphfv stuff + + Revision 1.5 2002/09/07 15:06:36 peter * old logs removed and tabs fixed } diff --git a/fv/gfvgraph.pas b/fv/gfvgraph.pas deleted file mode 100644 index ed0cee2969..0000000000 --- a/fv/gfvgraph.pas +++ /dev/null @@ -1,836 +0,0 @@ -{ $Id$ } -{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********} -{ } -{ System independent GFV GRAPHICS UNIT } -{ } -{ Copyright (c) 1999, 2000 by Leon de Boer } -{ ldeboer@attglobal.net - primary e-mail address } -{ ldeboer@projectent.com.au - backup e-mail address } -{ } -{ This unit provides the interlink between the graphics } -{ used in GFV and the graphics API for the different } -{ operating systems. } -{ } -{****************[ THIS CODE IS FREEWARE ]*****************} -{ } -{ This sourcecode is released for the purpose to } -{ promote the pascal language on all platforms. You may } -{ redistribute it and/or modify with the following } -{ DISCLAIMER. } -{ } -{ This SOURCE CODE is distributed "AS IS" WITHOUT } -{ WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR } -{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. } -{ } -{*****************[ SUPPORTED PLATFORMS ]******************} -{ 16 and 32 Bit compilers } -{ 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) } -{ - Speed Pascal 1.0+ (32 Bit) } -{ } -{*****************[ REVISION HISTORY ]*********************} -{ Version Date Fix } -{ ------- --------- ---------------------------------- } -{ 1.00 26 Nov 99 Unit started from relocated code } -{ originally from views.pas } -{ 1.01 21 May 00 GetMaxX and GetMaxY added. } -{ 1.02 05 Dec 00 Fixed DOS/DPMI implementation. } -{**********************************************************} - -UNIT GFVGraph; - -{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} - INTERFACE -{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} - -{====Include file to sort compiler platform out =====================} -{$I Platform.inc} -{====================================================================} - -{==== Compiler directives ===========================================} - -{$IFNDEF PPC_FPC} { FPC doesn't support these switches } - {$F-} { Near far 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 } - {$E+} { Emulation is on } - {$N-} { No 80x87 code generation } -{$ENDIF} - -{$X+} { Extended syntax is ok } -{$R-} { Disable range checking } -{$S-} { Disable Stack Checking } -{$I-} { Disable IO Checking } -{$Q-} { Disable Overflow Checking } -{$V-} { Turn off strict VAR strings } -{====================================================================} - -{$IFDEF GRAPH_API} { GRAPH CODE } -USES Graph; { Standard unit } -{$ENDIF} - -{***************************************************************************} -{ PUBLIC CONSTANTS } -{***************************************************************************} - -{---------------------------------------------------------------------------} -{ STANDARD COLOUR CONSTANTS } -{---------------------------------------------------------------------------} -CONST - Black = 0; { Black } - Blue = 1; { Blue } - Green = 2; { Green } - Cyan = 3; { Cyan } - Red = 4; { Red } - Magenta = 5; { Magenta } - Brown = 6; { Brown } - LightGray = 7; { Light grey } - DarkGray = 8; { Dark grey } - LightBlue = 9; { Light blue } - LightGreen = 10; { Light green } - LightCyan = 11; { Light cyan } - LightRed = 12; { Light red } - LightMagenta = 13; { Light magenta } - Yellow = 14; { Yellow } - White = 15; { White } - -{---------------------------------------------------------------------------} -{ WRITE MODE CONSTANTS } -{---------------------------------------------------------------------------} -CONST - NormalPut = 0; { Normal overwrite } - CopyPut = 0; { Normal put image } - AndPut = 1; { AND colour write } - OrPut = 2; { OR colour write } - XorPut = 3; { XOR colour write } - NotPut = 4; { NOT colour write } - -{---------------------------------------------------------------------------} -{ CLIP CONTROL CONSTANTS } -{---------------------------------------------------------------------------} -CONST - ClipOn = True; { Clipping on } - ClipOff = False; { Clipping off } - -{---------------------------------------------------------------------------} -{ VIDEO CARD DETECTION CONSTANTS } -{---------------------------------------------------------------------------} -CONST - Detect = 0; { Detect video } - -{$IFDEF GRAPH_API} { DOS CODE ONLY } -{---------------------------------------------------------------------------} -{ DOS GRAPHICS SOLID FILL BAR AREA CONSTANT } -{---------------------------------------------------------------------------} -CONST - SolidFill = Graph.SolidFill; - LowAscii : boolean = true; - -type - - textrainfo = array[0..0] of word; - pextrainfo = ^textrainfo; - - TSpVideoBuf = array [0..0] of pextrainfo; - PSpVideoBuf = ^TSpVideoBuf; - -const - SpVideoBuf : PSpVideoBuf = nil; - -{$ELSE not GRAPH_API } -CONST - SolidFill = 0; -{$ENDIF not GRAPH_API} - - -{***************************************************************************} -{ PUBLIC TYPE DEFINITIONS } -{***************************************************************************} - -{---------------------------------------------------------------------------} -{ ViewPortType RECORD DEFINITION } -{---------------------------------------------------------------------------} -TYPE - ViewPortType = PACKED RECORD - X1, Y1, X2, Y2: Integer; { Corners of viewport } - Clip : Boolean; { Clip status } - END; - -{***************************************************************************} -{ INTERFACE ROUTINES } -{***************************************************************************} - -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} -{ GRAPHICS MODE CONTROL ROUTINES } -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} - -{-SetWriteMode------------------------------------------------------- -Sets the current write mode constant all subsequent draws etc. are -then via the set mode. -26Nov99 LdB ----------------------------------------------------------------------} -PROCEDURE SetWriteMode (Mode: Byte; TextMode: Boolean); - -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} -{ VIEWPORT CONTROL ROUTINES } -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} - -{-GetViewSettings---------------------------------------------------- -Returns the current viewport and clip parameters in the variable. -26Nov99 LdB ----------------------------------------------------------------------} -PROCEDURE GetViewSettings (Var CurrentViewPort: ViewPortType; TextMode: Boolean); - -{-SetViewPort-------------------------------------------------------- -Set the current viewport and clip parameters to that requested. -26Nov99 LdB ----------------------------------------------------------------------} -PROCEDURE SetViewPort (X1, Y1, X2, Y2: Integer; Clip, TextMode: Boolean); - - -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} -{ GRAPHICS DEVICE CAPACITY ROUTINES } -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} - -{-GetMaxX------------------------------------------------------------ -Returns X coordinate of maximum value that can be entered in any -graphics routine, that is the actual screen width in pixels - 1. -21May2000 LdB ----------------------------------------------------------------------} -FUNCTION GetMaxX (TextMode: Boolean): Integer; - -{-GetMaxY------------------------------------------------------------ -Returns Y coordinate of maximum value that can be entered in any -graphics routine, that is the actual screen height in pixels - 1. -21May2000 LdB ----------------------------------------------------------------------} -FUNCTION GetMaxY (TextMode: Boolean): Integer; - -PROCEDURE SetColor(Color: Word); -PROCEDURE SetFillStyle (Pattern: Word; Color: Word); -PROCEDURE Bar (X1, Y1, X2, Y2: Integer); -PROCEDURE Line(X1, Y1, X2, Y2: Integer); -PROCEDURE Rectangle(X1, Y1, X2, Y2: Integer); -PROCEDURE OutTextXY(X,Y: Integer; TextString: String); - -{$IFDEF GRAPH_API} -procedure GraphUpdateScreen(Force: Boolean); -procedure SetExtraInfo(x,y,xi,yi : longint; color : word); -procedure SetupExtraInfo; -procedure FreeExtraInfo; - -Const - { Possible cursor types for video interface } - crHidden = 0; - crUnderLine = 1; - crBlock = 2; - crHalfBlock = 3; - EmptyVideoBufCell : pextrainfo = nil; - -{ from video unit } -procedure SetCursorPos(NewCursorX, NewCursorY: Word); -{ Position the cursor to the given position } -function GetCursorType: Word; -{ Return the cursor type: Hidden, UnderLine or Block } -procedure SetCursorType(NewType: Word); -{ Set the cursor to the given type } -{$ENDIF GRAPH_API} - -{***************************************************************************} -{ INITIALIZED PUBLIC VARIABLES } -{***************************************************************************} - -{---------------------------------------------------------------------------} -{ INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES } -{---------------------------------------------------------------------------} -CONST - WriteMode : Byte = 0; { Current write mode } - SysScreenWidth : Integer = 640; { Default screen width } - SysScreenHeight: Integer = 480; { Default screen height} -{$ifdef USE_VIDEO_API} - SysFontWidth : Integer = 8; { System font width } - SysFontHeight : Integer = 16; { System font height } - TextScreenWidth : Integer = 80; - TextScreenHeight : Integer = 25; -{$endif USE_VIDEO_API} - -{$ifdef DEBUG} -const - WriteDebugInfo : boolean = false; -{$endif DEBUG} - -{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} - IMPLEMENTATION -{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} - -{$ifdef USE_VIDEO_API} -USES video; { Standard unit } -{$ENDIF} - -{***************************************************************************} -{ PRIVATE INITIALIZED VARIABLES } -{***************************************************************************} - -{---------------------------------------------------------------------------} -{ DOS/DPMI/WIN/NT/OS2 INITIALIZED VARIABLES } -{---------------------------------------------------------------------------} -CONST - FillCol : Integer = 0; - Cxp : Integer = 0; { Current x position } - Cyp : Integer = 0; { Current y position } - ViewPort: ViewPortType = (X1:0; Y1:0; X2: 639; - Y2: 479; Clip: True); { Default viewport } - -{***************************************************************************} -{ INTERFACE ROUTINES } -{***************************************************************************} - - -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} -{ GRAPHICS MODE CONTROL ROUTINES } -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} - -{---------------------------------------------------------------------------} -{ SetWriteMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB } -{---------------------------------------------------------------------------} -PROCEDURE SetWriteMode (Mode: Byte; TextMode: Boolean); -BEGIN -{$IFDEF GRAPH_API} { GRAPH CODE } - If TextMode Then - WriteMode := Mode { Hold write mode } - Else Graph.SetWriteMode(Mode); { Call graph proc } -{$ELSE not GRAPH_API} - WriteMode := Mode; { Hold write mode } -{$ENDIF not GRAPH_API} -END; - -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} -{ VIEW PORT CONTROL ROUTINES } -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} - -{---------------------------------------------------------------------------} -{ GetViewSettings -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB } -{---------------------------------------------------------------------------} -PROCEDURE GetViewSettings (Var CurrentViewPort: ViewPortType; TextMode: Boolean); -{$IFDEF GRAPH_API} -VAR Ts: Graph.ViewPortType; -{$ENDIF GRAPH_API} -BEGIN -{$IFNDEF GRAPH_API} - CurrentViewPort := ViewPort; { Textmode viewport } -{$ELSE GRAPH_API} - If TextMode Then CurrentViewPort := ViewPort { Textmode viewport } - Else Begin - Graph.GetViewSettings(Ts); { Get graph settings } - CurrentViewPort.X1 := Ts.X1; { Transfer X1 } - CurrentViewPort.Y1 := Ts.Y1; { Transfer Y1 } - CurrentViewPort.X2 := Ts.X2; { Transfer X2 } - CurrentViewPort.Y2 := Ts.Y2; { Transfer Y2 } - CurrentViewPort.Clip := Ts.Clip; { Transfer clip mask } - End; -{$ENDIF GRAPH_API} -END; - -{---------------------------------------------------------------------------} -{ SetViewPort -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB } -{---------------------------------------------------------------------------} -PROCEDURE SetViewPort (X1, Y1, X2, Y2: Integer; Clip, TextMode: Boolean); -BEGIN -{$IFDEF GRAPH_API} - 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 (Y1 < 0) Then Y1 := 0; { Y1 negative fix } - If (Y1 > SysScreenHeight) Then - 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 } - If (Y2 < 0) Then Y2 := 0; { Y2 negative fix } - If (Y2 > SysScreenHeight) Then - 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} - If WriteDebugInfo then - 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} - End Else Begin { GRAPHICS MODE GFV } - Graph.SetViewPort(X1, Y1, X2, Y2, Clip); { Call graph proc } - X1:=X1 div SysFontWidth; - X2:=X2 div SysFontWidth; - Y1:=Y1 div SysFontHeight; - Y2:=Y2 div SysFontHeight; - If (X1 < 0) Then X1 := 0; { X1 negative 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 } - If (X2 < 0) Then X2 := 0; { X2 negative fix } - If (X2 > SysScreenWidth) Then - 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 } - 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 } - Cxp := X1; { Set current x pos } - Cyp := Y1; { Set current y pos } - End; -{$ENDIF GRAPH_API} -END; - -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} -{ GRAPHICS DEVICE CAPACITY ROUTINES } -{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} - -{---------------------------------------------------------------------------} -{ GetMaxX - Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB } -{---------------------------------------------------------------------------} -FUNCTION GetMaxX (TextMode: Boolean): Integer; -BEGIN -{$IFDEF GRAPH_API} - If TextMode Then -{$ENDIF GRAPH_API} - GetMaxX := SysScreenWidth-1 { Screen width } -{$IFDEF GRAPH_API} - Else GetMaxX := Graph.GetMaxX; { Call graph func } -{$ENDIF GRAPH_API} -END; - -{---------------------------------------------------------------------------} -{ GetMaxY - Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB } -{---------------------------------------------------------------------------} -FUNCTION GetMaxY (TextMode: Boolean): Integer; -BEGIN -{$IFDEF GRAPH_API} - If TextMode Then -{$ENDIF GRAPH_API} - GetMaxY := SysScreenHeight-1 { Screen height } -{$IFDEF GRAPH_API} - Else GetMaxY := Graph.GetMaxY; { Call graph func } -{$ENDIF GRAPH_API} -END; - -PROCEDURE SetColor(Color: Word); -BEGIN -{$IFDEF GRAPH_API} - Graph.SetColor(Color); { Call graph proc } -{$ENDIF GRAPH_API} -END; - -PROCEDURE SetFillStyle (Pattern: Word; Color: Word); -BEGIN -{$IFDEF GRAPH_API} - Graph.SetFillStyle(Pattern, Color); { Call graph proc } -{$ENDIF GRAPH_API} -END; - -PROCEDURE Bar (X1, Y1, X2, Y2: Integer); -BEGIN -{$IFDEF GRAPH_API} - Graph.Bar(X1, Y1, X2, Y2); { Call graph proc } -{$ENDIF GRAPH_API} -END; - -PROCEDURE Line(X1, Y1, X2, Y2: Integer); -BEGIN -{$IFDEF GRAPH_API} - Graph.Line(X1, Y1, X2, Y2); { Call graph proc } -{$ENDIF GRAPH_API} -END; - -PROCEDURE Rectangle(X1, Y1, X2, Y2: Integer); -BEGIN -{$IFDEF GRAPH_API} - Graph.Rectangle(X1, Y1, X2, Y2); { Call graph proc } -{$ENDIF GRAPH_API} -END; - -PROCEDURE OutTextXY(X,Y: Integer; TextString: string); -{$IFDEF GRAPH_API} -var - i,j,xi,yj,xs,ys : longint; - Ts: Graph.ViewPortType; - Txs : TextSettingsType; - tw, th : integer; - color : word; -{$ENDIF GRAPH_API} - -BEGIN -{$IFDEF GRAPH_API} - Graph.OutTextXY(X, Y, TextString); { Call graph proc } - if true then - begin - Graph.GetViewSettings(Ts); - Graph.GetTextSettings(Txs); - tw:=TextWidth(TextString); - th:=TextHeight(TextString); - case Txs.Horiz of - centertext : Xs:=(tw shr 1); - lefttext : Xs:=0; - righttext : Xs:=tw; - end; - case txs.vert of - centertext : Ys:=-(th shr 1); - bottomtext : Ys:=-th; - toptext : Ys:=0; - end; - x:=x-xs; - y:=y+ys; - - For j:=0 to tw-1 do - For i:=0 to th-1 do - begin - xi:=x+i+Ts.x1; - yj:=y+j+Ts.y1; - Color:=GetPixel(xi,yj); - SetExtraInfo(xi div SysFontWidth,yj div SysFontHeight, - xi mod SysFontWidth,yj mod SysFontHeight, Color); - end; - end; -{$ENDIF GRAPH_API} -END; - -{$IFDEF GRAPH_API} - -{ from video unit } -Const - CursorX : longint = -1; - CursorY : longint = -1; - CursorType : byte = crHidden; - CursorIsVisible : boolean = false; - LineReversed = true; - LineNormal = false; -TYPE - TCursorInfo = array[0..7] of boolean; - -CONST - DefaultCursors: Array[crUnderline..crHalfBlock] of TCursorInfo = -( - (LineNormal, LineNormal, LineNormal, LineNormal, LineNormal, LineNormal, LineNormal, LineReversed), - (LineReversed, LineReversed, LineReversed, LineReversed, LineReversed, LineReversed, LineReversed, LineReversed), - (LineNormal, LineNormal, LineNormal, LineNormal, LineReversed, LineReversed, LineReversed, LineReversed) -); - -Procedure XorPutCursor; -var - j,YSCale : longint; - Ts: Graph.ViewPortType; - StoreColor : longint; -begin - if CursorType=crHidden then - exit; - Yscale:=(SysFontHeight+1) div 8; - Graph.GetViewSettings(Ts); - graph.SetWriteMode(graph.XORPut); - StoreColor:=Graph.GetColor; - Graph.SetColor(White); - if (CursorX*SysFontWidth>=Ts.X1) and (CursorX*SysFontWidth=Ts.Y1) and (CursorY*SysFontHeight=SysFontHeight*SysFontWidth then - RunError(219); - extrainfo^[l]:=color; - SetExtraInfoCalled:=true; -end; - -procedure SetupExtraInfo; -begin - if not assigned(EmptyVideoBufCell) then - begin - GetMem(EmptyVideoBufCell,SysFontHeight*SysFontWidth*Sizeof(word)); - FillChar(EmptyVideoBufCell^,SysFontHeight*SysFontWidth*Sizeof(word),#255); - end; -end; - -procedure FreeExtraInfo; -var - i : longint; -begin - HideCursor; - if assigned(SpVideoBuf) then - begin - for i:=0 to (TextScreenWidth+1)*(TextScreenHeight+1) - 1 do - if assigned(SpVideoBuf^[i]) and (SpVideoBuf^[i]<>EmptyVideoBufCell) then - FreeMem(SpVideoBuf^[i],SysFontHeight*SysFontWidth*Sizeof(word)); - if assigned(EmptyVideoBufCell) then - FreeMem(EmptyVideoBufCell,SysFontHeight*SysFontWidth*Sizeof(word)); - FreeMem(SpVideoBuf,sizeof(pextrainfo)*(TextScreenWidth+1)*(TextScreenHeight+1)); - SpVideoBuf:=nil; - end; -end; - -{define Use_ONLY_COLOR} - -procedure GraphUpdateScreen(Force: Boolean); -var - smallforce : boolean; - i,x,y : longint; - xi,yi,k,l : longint; - ch : char; - attr : byte; - color : word; - SavedColor : longint; -{$ifndef Use_ONLY_COLOR} - SavedBkColor,CurBkColor : longint; -{$endif not Use_ONLY_COLOR} - CurColor : longint; - NextColor,NextBkColor : longint; - StoreFillSettings: FillSettingsType; - Ts: Graph.ViewPortType; -{$ifdef debug} - ChangedCount, SpecialCount : longint; -{$endif debug} -begin -{$ifdef USE_VIDEO_API} - if force or SetExtraInfoCalled then - smallforce:=true - else - begin - asm - movl VideoBuf,%esi - movl OldVideoBuf,%edi - movl VideoBufSize,%ecx - shrl $2,%ecx - repe - cmpsl - orl %ecx,%ecx - jz .Lno_update - movb $1,smallforce -.Lno_update: - end; - end; - if SmallForce then - begin -{$ifdef debug} - SpecialCount:=0; - ChangedCount:=0; -{$endif debug} - SetExtraInfoCalled:=false; - SavedColor:=Graph.GetColor; -{$ifndef Use_ONLY_COLOR} - SavedBkColor:=Graph.GetBkColor; - CurBkColor:=SavedBkColor; -{$endif not Use_ONLY_COLOR} - CurColor:=SavedColor; - Graph.GetViewSettings(Ts); - Graph.SetViewPort(0,0,Graph.GetMaxX,Graph.GetMaxY,false); - Graph.GetFillSettings(StoreFillSettings); -{$ifdef Use_ONLY_COLOR} - Graph.SetFillStyle(SolidFill,0); -{$else not Use_ONLY_COLOR} - Graph.SetFillStyle(EmptyFill,0); -{$endif not Use_ONLY_COLOR} - Graph.SetWriteMode(CopyPut); - Graph.SetTextJustify(LeftText,TopText); - for y := 0 to TextScreenHeight - 1 do - begin - for x := 0 to TextScreenWidth - 1 do - begin - i:=y*TextScreenWidth+x; - if (OldVideoBuf^[i]<>VideoBuf^[i]) or - (assigned(SpVideoBuf^[i]) and (SpVideoBuf^[i]<>EmptyVideoBufCell)) then - begin - ch:=chr(VideoBuf^[i] and $ff); - if ch<>#0 then - begin - {$ifdef debug} - Inc(ChangedCount); - {$endif debug} - if (SpVideoBuf^[i]=EmptyVideoBufCell) then - SpVideoBuf^[i]:=nil; - Attr:=VideoBuf^[i] shr 8; - NextColor:=Attr and $f; - NextBkColor:=(Attr and $70) shr 4; -{$ifndef Use_ONLY_COLOR} - if NextBkColor<>CurBkColor then - begin - Graph.SetBkColor(NextBkColor); - CurBkColor:=NextBkColor; - end; -{$else Use_ONLY_COLOR} - if NextBkColor<>CurColor then - begin - Graph.SetColor(NextBkColor); - CurColor:=NextBkColor; - end; -{$endif Use_ONLY_COLOR} - if (x=CursorX) and (y=CursorY) then - HideCursor; - Graph.Bar(x*SysFontWidth,y*SysFontHeight,(x+1)*SysFontWidth-1,(y+1)*SysFontHeight-1); - if assigned(SpVideoBuf^[i]) then - begin - {$ifdef debug} - Inc(SpecialCount); - {$endif debug} - For yi:=0 to SysFontHeight-1 do - For xi:=0 to SysFontWidth-1 do - begin - l:=yi*SysFontWidth + xi; - color:=SpVideoBuf^[i]^[l]; - if color<>$ffff then - Graph.PutPixel(x*SysfontWidth+xi,y*SysFontHeight+yi,color); - end; - end; - if NextColor<>CurColor then - begin - Graph.SetColor(NextColor); - CurColor:=NextColor; - end; - { SetBkColor does change the palette index 0 entry... - which leads to troubles if we want to write in dark } - (* if (CurColor=0) and (ch<>' ') and assigned(SpVideoBuf^[i]) then - begin - Graph.SetBkColor(0); - CurBkColor:=0; - end; *) - if ch<>' ' then - Graph.OutTextXY(x*SysFontWidth,y*SysFontHeight+2,ch); - if (x=CursorX) and (y=CursorY) then - ShowCursor; - end; - OldVideoBuf^[i]:=VideoBuf^[i]; - if assigned(SpVideoBuf^[i]) then - begin - if (SpVideoBuf^[i]=EmptyVideoBufCell) then - SpVideoBuf^[i]:=nil - else - begin - FreeMem(SpVideoBuf^[i],SysFontHeight*SysFontWidth*sizeof(word)); - SpVideoBuf^[i]:=EmptyVideoBufCell; - end; - end; - end; - end; - end; - Graph.SetFillStyle(StoreFillSettings.pattern,StoreFillSettings.color); - Graph.SetColor(SavedColor); -{$ifndef Use_ONLY_COLOR} - Graph.SetBkColor(SavedBkColor); -{$endif not Use_ONLY_COLOR} - Graph.SetViewPort(TS.X1,Ts.Y1,ts.X2,ts.Y2,ts.Clip); - end; -{$else not USE_VIDEO_API} - RunError(219); -{$endif USE_VIDEO_API} -end; -{$ENDIF GRAPH_API} - - -END. -{ - $Log$ - Revision 1.18 2002-09-07 15:06:36 peter - * old logs removed and tabs fixed - - Revision 1.17 2002/08/22 13:40:49 pierre - * several graphic mode improovements - - Revision 1.16 2002/06/06 06:41:14 pierre - + Cursor functions for UseFixedFont case - - Revision 1.15 2002/05/31 12:37:47 pierre - * try to enhance graph mode - - Revision 1.14 2002/05/29 22:15:57 pierre - * fix build failure in non graph mode - - Revision 1.13 2002/05/29 19:35:31 pierre - * fix GraphUpdateScreen procedure - - Revision 1.12 2002/05/28 19:42:32 pierre - * fix non graphic mode compilation - - Revision 1.11 2002/05/28 19:13:44 pierre - + GraphUpdateScreen function - -} diff --git a/fv/menus.pas b/fv/menus.pas index 2b34f53298..d12c8412c3 100644 --- a/fv/menus.pas +++ b/fv/menus.pas @@ -94,7 +94,6 @@ USES {$ENDIF} {$ENDIF} - GFVGraph, { GFV standard unit } Objects, Drivers, Views; { GFV standard units } {***************************************************************************} @@ -408,16 +407,12 @@ CONST {---------------------------------------------------------------------------} { INITIALIZED PUBLIC VARIABLES } {---------------------------------------------------------------------------} -CONST - AdvancedMenus: Boolean = False; { Advanced menus } {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} IMPLEMENTATION {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} -{$ifndef GRAPH_API} USES Video; -{$endif not GRAPH_API} CONST SubMenuChar : array[boolean] of char = ('>',#16); @@ -496,8 +491,8 @@ VAR AutoSelect: Boolean; Action: MenuAction; Ch: Char; Res: Word; R: TRect; PROCEDURE TrackMouse; VAR Mouse: TPoint; R: TRect; BEGIN - Mouse.X := E.Where.X - RawOrigin.X; { Local x position } - Mouse.Y := E.Where.Y - RawoRigin.Y; { Local y position } + Mouse.X := E.Where.X - Origin.X; { Local x position } + Mouse.Y := E.Where.Y - oRigin.Y; { Local y position } Current := Menu^.Items; { Start with current } While (Current <> Nil) Do Begin GetItemRectX(Current, R); { Get item rectangle } @@ -539,8 +534,8 @@ VAR AutoSelect: Boolean; Action: MenuAction; Ch: Char; Res: Word; R: TRect; MouseInOwner := False; { Preset false } If (ParentMenu <> Nil) AND (ParentMenu^.Size.Y = 1) Then Begin { Valid parent menu } - Mouse.X := E.Where.X - ParentMenu^.RawOrigin.X;{ Local x position } - Mouse.Y := E.Where.Y - ParentMenu^.RawOrigin.Y;{ Local y position } + Mouse.X := E.Where.X - ParentMenu^.Origin.X;{ Local x position } + Mouse.Y := E.Where.Y - ParentMenu^.Origin.Y;{ Local y position } ParentMenu^.GetItemRectX(ParentMenu^.Current,R);{ Get item rect } MouseInOwner := R.Contains(Mouse); { Return result } End; @@ -666,8 +661,8 @@ BEGIN If (E.What AND (evMouseDown+evMouseMove) <> 0) Then PutEvent(E); { Put event on queue } GetItemRectX(Current, R); { Get area of item } - R.A.X := R.A.X DIV FontWidth + Origin.X; { Left start point } - R.A.Y := R.B.Y DIV FontHeight + Origin.Y;{ Top start point } + R.A.X := R.A.X + Origin.X; { Left start point } + R.A.Y := R.B.Y + Origin.Y;{ Top start point } R.B.X := Owner^.Size.X; { X screen area left } R.B.Y := Owner^.Size.Y; { Y screen area left } Target := TopMenu^.NewSubView(R, SubMenu, @@ -896,10 +891,6 @@ END; PROCEDURE TMenuView.GetItemRect (Item: PMenuItem; Var R: TRect); BEGIN GetItemRectX(Item,R); - R.A.X:=R.A.X div SysFontWidth; - R.A.Y:=R.A.Y div SysFontHeight; - R.B.X:=R.B.X div SysFontWidth; - R.B.Y:=R.B.Y div SysFontHeight; END; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} @@ -954,13 +945,8 @@ BEGIN End; MoveCStr(B, ' '+P^.Name^+' ', Color); { Name to buffer } WriteBuf(I, 0, J, 1, B); { Write the string } - K := I*FontWidth; { X start position } + K := I; { X start position } L := K + CTextWidth(' '+P^.Name^+' '); { X end position } - If AdvancedMenus Then Begin - GraphLine(K, 0, L, 0, White); { Redraw top line } - GraphLine(K, FontHeight-1, L, - FontHeight-1, DarkGray); { Redraw lower line } - End; End; Inc(I, J); { Advance position } End; @@ -1001,8 +987,6 @@ BEGIN P := P^.Next; { Next item } End; End; - If AdvancedMenus Then BiColorRectangle(0, 0, - RawSize.X, RawSize.Y, White, DarkGray, False); { Draw 3d effect } END; {--TMenuBar-----------------------------------------------------------------} @@ -1012,10 +996,10 @@ PROCEDURE TMenuBar.GetItemRectX (Item: PMenuItem; Var R: TRect); VAR I: Integer; P: PMenuItem; BEGIN I := 0; { Preset to zero } - R.Assign(0, 0, 0, FontHeight); { Initial rect size } + R.Assign(0, 0, 0, 1); { Initial rect size } P := Menu^.Items; { First item } While (P <> Nil) Do Begin { While valid item } - R.A.X := I*FontWidth; { Move area along } + R.A.X := I; { Move area along } If (P^.Name <> Nil) Then Begin { Valid name } R.B.X := R.A.X+CTextWidth(' ' + P^.Name^ + ' ');{ Add text width } I := I + CStrLen(P^.Name^) + 2; { Add item length } @@ -1052,7 +1036,7 @@ BEGIN P := P^.Next; { Move to next item } End; End; - W := 5 + (W DIV FontWidth); { Longest text width } + W := 5 + W; { Longest text width } R.Copy(Bounds); { Copy the bounds } If (R.A.X + W < R.B.X) Then R.B.X := R.A.X + W { Shorten if possible } Else R.A.X := R.B.X - W; { Insufficent space } @@ -1061,9 +1045,7 @@ BEGIN Else R.A.Y := R.B.Y - H; { Insufficent height } Inherited Init(R); { Call ancestor } State := State OR sfShadow; { Set shadow state } - Options := Options OR ofPreProcess; { View pre processes } - if TextModeGFV then - Options := Options OR ofFramed; + Options := Options OR ofFramed or ofPreProcess; { View pre processes } Menu := AMenu; { Hold menu } ParentMenu := AParentMenu; { Hold parent } END; @@ -1095,12 +1077,9 @@ BEGIN CSelect := GetColor($0604); { Selected colour } CDisabled := GetColor($0202); { Disabled colour } CSelectDisabled := GetColor($0505); { Selected, but disabled } - If TextModeGFV then - Begin - Color := CNormal; { Normal colour } - CreateBorder(UpperLine); - WriteBuf(0, 0, Size.X, 1, B); { Write the line } - End; + Color := CNormal; { Normal colour } + CreateBorder(UpperLine); + WriteBuf(0, 0, Size.X, 1, B); { Write the line } Y := 1; If (Menu <> Nil) Then Begin { We have a menu } P := Menu^.Items; { Start on first } @@ -1116,96 +1095,47 @@ BEGIN end else If (P = Current) Then Color := CSelect; { Select colour } - If TextModeGFV or UseFixedFont then - Begin - If Not TextModeGFV then - MoveChar(B, ' ', Color, Size.X); { Clear buffer } - If TextModeGFV then - CreateBorder(NormalLine); - Index:=2; - End - Else - Begin - MoveChar(B, ' ', Color, Size.X-4); { Clear buffer } - Index:=0; - End; + CreateBorder(NormalLine); + Index:=2; S := ' ' + P^.Name^ + ' '; { Menu string } MoveCStr(B[Index], S, Color); { Transfer string } if P^.Command = 0 then MoveChar(B[Size.X - 4],SubMenuChar[LowAscii], Byte(Color), 1) else - If (P^.Command <> 0) AND(P^.Param <> Nil) - Then Begin - if TextModeGFV or UseFixedFont then - MoveCStr(B[Size.X - 3 - Length(P^.Param^)], P^.Param^, Color) { Add param chars } - else + If (P^.Command <> 0) AND(P^.Param <> Nil) Then + Begin + MoveCStr(B[Size.X - 3 - Length(P^.Param^)], P^.Param^, Color); { Add param chars } S := S + ' - ' + P^.Param^; { Add to string } End; If (OldItem = Nil) OR (OldItem = P) OR - (Current = P) Then Begin { We need to fix draw } - If TextModeGFV or UseFixedFont then - Begin - if TextModeGFV then - WriteBuf(0, Y, Size.X, 1, B) { Write the whole line } - else - WriteBuf(1, Y, Size.X-2, 1, B[1]); - end - Else - WriteBuf(2, Y, CStrLen(S), 1, B); { Write the line } + (Current = P) Then + Begin { We need to fix draw } + WriteBuf(0, Y, Size.X, 1, B); { Write the whole line } If (P = Current) Then Begin { Selected item } - Tx := 2 * FontWidth; { X offset } - Ty := Y * FontHeight; { Y offset } - BicolorRectangle(Tx, Ty, Tx + CTextWidth(S) - - 1, Ty + FontHeight - 1, White, - DarkGray, False); { Draw higlight box } + Tx := 2; { X offset } + Ty := Y; { Y offset } End; End; End Else Begin { no text NewLine } Color := CNormal; { Normal colour } - If TextModeGFV then - Begin - CreateBorder(SeparationLine); - WriteBuf(0, Y, Size.X, 1, B); { Write the line } - End; + CreateBorder(SeparationLine); + WriteBuf(0, Y, Size.X, 1, B); { Write the line } End; Inc(Y); { Next line down } P := P^.Next; { fetch next item } End; End; - If TextModeGFV then - Begin - Color := CNormal; { Normal colour } - CreateBorder(LowerLine); - WriteBuf(0, Size.Y-1, Size.X, 1, B); { Write the line } - End; + Color := CNormal; { Normal colour } + CreateBorder(LowerLine); + WriteBuf(0, Size.Y-1, Size.X, 1, B); { Write the line } END; {--TMenuBox-----------------------------------------------------------------} { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TMenuBox.DrawBackGround; -VAR X, Y, Y2: Integer; P : PMenuItem; BEGIN - Y2 := FontHeight DIV 2; { Intra offset } - Y := FontHeight; { Initial position } - X := 3*FontWidth; { 2 offset } Inherited DrawBackGround; { Call ancestor } - If (Menu <> Nil) Then Begin { We have a menu } - P := Menu^.Items; { Start on first } - While (P <> Nil) Do Begin - If (P^.Name = Nil) Then { Item has no string } - BiColorRectangle(X, Y+Y2, RawSize.X-X, - Y+Y2+1, White, DarkGray, True); { Draw 3d line effect } - Inc(Y, FontHeight); { Down one line } - P := P^.Next; { Next item now } - End; - End; - BiColorRectangle(3, 3, RawSize.X-3, RawSize.Y-3, - White, DarkGray, False); { Draw 3d effect } - BiColorRectangle(5, 5, RawSize.X-5, RawSize.Y-5, - White, DarkGray, True); { Draw 3d effect } - BiColorRectangle(0, 0, RawSize.X, RawSize.Y, - White, DarkGray, False); { Draw 3d effect } END; {--TMenuBox-----------------------------------------------------------------} @@ -1214,14 +1144,14 @@ END; PROCEDURE TMenuBox.GetItemRectX (Item: PMenuItem; Var R: TRect); VAR X, Y: Integer; P: PMenuItem; BEGIN - Y := FontHeight; { Initial y position } + Y := 1; { Initial y position } P := Menu^.Items; { Initial item } While (P <> Item) Do Begin { Valid item } - Inc(Y, FontHeight); { Inc position } + Inc(Y); { Inc position } P := P^.Next; { Next item } End; - X := 2 * FontWidth; { Left/Right margin } - R.Assign(X, Y, RawSize.X - X, Y + FontHeight); { Assign area } + X := 2; { Left/Right margin } + R.Assign(X, Y, Size.X - X, Y + 1); { Assign area } END; {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} @@ -1469,7 +1399,7 @@ VAR Mouse: TPoint; T, Tt: PStatusItem; VAR X, Xi: Word; T: PStatusItem; BEGIN ItemMouseIsIn := Nil; { Preset fail } - If (Mouse.Y < 0) OR (Mouse.Y > FontHeight) { Outside view height } + If (Mouse.Y < 0) OR (Mouse.Y > 1) { Outside view height } Then Exit; { Not in view exit } X := 0; { Zero x position } T := Items; { Start at first item } @@ -1493,8 +1423,8 @@ BEGIN evMouseDown: Begin T := Nil; { Preset ptr to nil } Repeat - Mouse.X := Event.Where.X - RawOrigin.X; { Local x position } - Mouse.Y := Event.Where.Y - RawOrigin.Y; { Local y position } + Mouse.X := Event.Where.X - Origin.X; { Local x position } + Mouse.Y := Event.Where.Y - Origin.Y; { Local y position } Tt := ItemMouseIsIn; { Find selected item } If (T <> Tt) Then { Item has changed } DrawSelect(Tt); { Draw new item } @@ -1587,8 +1517,6 @@ BEGIN I := I + Length(HintBuf); { Hint length } End; WriteLine(0, 0, I, 1, B); { Write the buffer } - If AdvancedMenus Then BicolorRectangle(0, 0, - RawSize.X, RawSize.Y, White, DarkGray, False); { Add 3d effect } END; {***************************************************************************} @@ -1759,7 +1687,10 @@ END; END. { $Log$ - Revision 1.18 2004-11-03 12:09:08 peter + Revision 1.19 2004-11-03 20:33:05 peter + * removed unnecesasry graphfv stuff + + Revision 1.18 2004/11/03 12:09:08 peter * textwidth doesn't support ~ anymore, added CTextWidth with ~ support Revision 1.17 2004/11/02 23:53:19 peter diff --git a/fv/platform.inc b/fv/platform.inc index 70397f574c..4ef5e8cccb 100644 --- a/fv/platform.inc +++ b/fv/platform.inc @@ -152,14 +152,6 @@ FOR FPC THESE ARE THE TRANSLATIONS {$DEFINE BP_VMTLink} {$DEFINE CPU86} -{---------------------------------------------------------------------------} -{ BORLAND 16 BIT DPMI changes protected mode - Updated 27Aug98 LdB } -{---------------------------------------------------------------------------} -{$IFDEF DPMI} - {$UNDEF PROC_Real} - {$DEFINE PROC_Protected} -{$ENDIF} - {---------------------------------------------------------------------------} { FPC 32 BIT COMPILER changes ASM, 32 bits etc - Updated 27Aug98 LdB } {---------------------------------------------------------------------------} @@ -174,20 +166,9 @@ FOR FPC THESE ARE THE TRANSLATIONS {$DEFINE ASM_FPC} {$UNDEF BP_VMTLink} {$DEFINE Use_API} - {$DEFINE Use_Video_API} {$DEFINE NO_WINDOW} {$ENDIF} -{$IFDEF NoAPI} -{$UNDEF Use_API} -{$UNDEF Use_Video_API} -{$UNDEF NO_WINDOW} -{$ENDIF UseAPI} - -{$ifdef GRAPH_API} -{undef Use_Video_API} -{$endif GRAPH_API} - {---------------------------------------------------------------------------} { FPC LINUX COMPILER changes operating system - Updated 27Aug98 LdB } { Note: Other linux compilers would need to change other details } @@ -301,7 +282,8 @@ FOR FPC THESE ARE THE TRANSLATIONS {$DEFINE PPC_DELPHI3} {$DEFINE PPC_DELPHI4} {$DEFINE PPC_DELPHI5} - {$UNDEF BP_VMTLink} + {$UNDEF BP_VMTLink + } {$ENDIF} {---------------------------------------------------------------------------} @@ -410,7 +392,10 @@ FOR FPC THESE ARE THE TRANSLATIONS { $Log$ - Revision 1.11 2004-02-06 20:59:29 jonas + Revision 1.12 2004-11-03 20:33:05 peter + * removed unnecesasry graphfv stuff + + Revision 1.11 2004/02/06 20:59:29 jonas + darwin support Revision 1.10 2002/09/07 15:06:38 peter diff --git a/fv/views.pas b/fv/views.pas index 92389f6a2b..dc59be04ca 100644 --- a/fv/views.pas +++ b/fv/views.pas @@ -71,17 +71,9 @@ USES {$ENDIF} {$IFDEF OS_OS2} { OS2 CODE } - {$IFDEF PPC_FPC} Os2Def, DosCalls, PmWin, - {$ELSE} - OS2Def, OS2Base, OS2PMAPI, { Standard units } - {$ENDIF} {$ENDIF} -{$IFDEF GRAPH_API} - graph, -{$ENDIF GRAPH_API} - GFVGraph, { GFV standard unit } Objects, FVCommon, Drivers; { GFV standard units } {***************************************************************************} @@ -125,7 +117,6 @@ CONST ofVersion = $3000; { View TV version } ofVersion10 = $0000; { TV version 1 view } ofVersion20 = $1000; { TV version 2 view } - ofGFVModeView = $4000; { View is in GFV mode } {---------------------------------------------------------------------------} { TView GROW MODE MASKS } @@ -161,9 +152,6 @@ CONST goEveryKey = $0020; { Report every key } goEndModal = $0040; { End modal } goNoShadow = $0080; { Do not write shadows } - goGraphView = $1000; { Raw graphic view } - - goGraphical = $2000; { Graphical view } goNativeClass = $4000; { Native class window } goNoDrawView = $8000; { View does not draw } @@ -371,8 +359,6 @@ TYPE Origin : TPoint; { View origin } Size : TPoint; { View size } Cursor : TPoint; { Cursor position } - RawOrigin: TPoint; { View raw origin } - RawSize : TPoint; { View raw size } Next : PView; { Next peerview } Owner : PGroup; { Owner group } HoldLimit: PComplexArea; { Hold limit values } @@ -456,15 +442,7 @@ TYPE PROCEDURE CalcBounds (Var Bounds: TRect; Delta: TPoint); Virtual; FUNCTION Exposed: Boolean; { This needs help!!!!! } - PROCEDURE GraphLine (X1, Y1, X2, Y2: Sw_Integer; Colour: Byte); - PROCEDURE GraphRectangle (X1, Y1, X2, Y2: Sw_Integer; Colour: Byte); PROCEDURE ClearArea (X1, Y1, X2, Y2: Sw_Integer; Colour: Byte); - PROCEDURE GraphArc (Xc, Yc: Sw_Integer; Sa, Ea: Real; XRad, YRad: Sw_Integer; - Colour: Byte); - PROCEDURE FilletArc (Xc, Yc: Sw_Integer; Sa, Ea: Real; XRad, YRad, Ht: Sw_Integer; - Colour: Byte); - PROCEDURE BicolorRectangle (X1, Y1, X2, Y2: Sw_Integer; Light, Dark: Byte; - Down: Boolean); PROCEDURE WriteBuf (X, Y, W, H: Sw_Integer; Var Buf); PROCEDURE WriteLine (X, Y, W, H: Sw_Integer; Var Buf); PROCEDURE MakeLocal (Source: TPoint; Var Dest: TPoint); @@ -477,10 +455,6 @@ TYPE MinSize, MaxSize: TPoint); PROCEDURE WriteAbs(X, Y, L :Sw_Integer;var Buf); PROCEDURE WriteShadow(X1, Y1, X2, Y2 : Sw_Integer); - - FUNCTION FontWidth: Sw_Integer; - FUNCTION Fontheight: Sw_Integer; - END; SelectMode = (NormalSelect, EnterSelect, LeaveSelect); @@ -858,10 +832,9 @@ CONST {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} IMPLEMENTATION {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} -{$IFDEF USE_VIDEO_API} + USES Video; -{$ENDIF USE_VIDEO_API} {***************************************************************************} { PRIVATE TYPE DEFINITIONS } @@ -926,7 +899,6 @@ const procedure DrawScreenBuf; begin -{$ifdef USE_VIDEO_API} if (GetLockScreenCount=0) then begin If MouseUsesVideoBuf then @@ -938,19 +910,62 @@ begin end else HideMouse; - if TextModeGFV then - UpdateScreen(false) -{$IFDEF GRAPH_API} - else - GraphUpdateScreen(false) -{$ENDIF GRAPH_API} - ; + UpdateScreen(false); If not MouseUsesVideoBuf then ShowMouse; end; -{$endif USE_VIDEO_API} end; + +{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} +{ VIEW PORT CONTROL ROUTINES } +{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} + +TYPE + ViewPortType = RECORD + X1, Y1, X2, Y2: Integer; { Corners of viewport } + Clip : Boolean; { Clip status } + END; + +var + ViewPort : ViewPortType; + +{---------------------------------------------------------------------------} +{ GetViewSettings -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB } +{---------------------------------------------------------------------------} +PROCEDURE GetViewSettings (Var CurrentViewPort: ViewPortType); +BEGIN + CurrentViewPort := ViewPort; { Textmode viewport } +END; + +{---------------------------------------------------------------------------} +{ SetViewPort -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB } +{---------------------------------------------------------------------------} +PROCEDURE SetViewPort (X1, Y1, X2, Y2: Integer; Clip: Boolean); +BEGIN + If (X1 < 0) Then X1 := 0; { X1 negative fix } + If (X1 >ScreenWidth) Then + X1 := ScreenWidth; { X1 off screen fix } + If (Y1 < 0) Then Y1 := 0; { Y1 negative fix } + If (Y1 > ScreenHeight) Then + Y1 := ScreenHeight; { Y1 off screen fix } + If (X2 < 0) Then X2 := 0; { X2 negative fix } + If (X2 > ScreenWidth) Then + X2 := ScreenWidth; { X2 off screen fix } + If (Y2 < 0) Then Y2 := 0; { Y2 negative fix } + If (Y2 > ScreenHeight) Then + Y2 := ScreenHeight; { Y2 off screen fix } + ViewPort.X1 := X1; { Set X1 port value } + ViewPort.Y1 := Y1; { Set Y1 port value } + ViewPort.X2 := X2; { Set X2 port value } + ViewPort.Y2 := Y2; { Set Y2 port value } + ViewPort.Clip := Clip; { Set port clip value } +{$ifdef DEBUG} + If WriteDebugInfo then + Writeln(stderr,'New ViewPort(',X1,',',Y1,',',X2,',',Y2,')'); +{$endif DEBUG} +END; + {***************************************************************************} { OBJECT METHODS } {***************************************************************************} @@ -997,20 +1012,6 @@ BEGIN S.Read(State, SizeOf(State)); { Read state masks } S.Read(Options, SizeOf(Options)); { Read options masks } S.Read(Eventmask, SizeOf(Eventmask)); { Read event masks } - If (Options AND ofGFVModeView <> 0) Then Begin { STREAM HAS GFV TVIEW } - S.Read(GOptions, SizeOf(GOptions)); { Read new option masks } - S.Read(TabMask, SizeOf(TabMask)); { Read new tab masks } - S.Read(i, SizeOf(i)); RawOrigin.X:=i; { Read raw x origin point } - S.Read(i, SizeOf(i)); RawOrigin.Y:=i; { Read raw y origin point } - S.Read(i, SizeOf(i)); RawSize.X:=i; { Read raw x size } - S.Read(i, SizeOf(i)); RawSize.Y:=i; { Read raw y size } - S.Read(i, SizeOf(i)); ColourOfs:=i; { Read palette offset } - End Else Begin { STREAM HAS OLD TView } - RawOrigin.X := Origin.X * FontWidth; { Set x origin pt } - RawOrigin.Y := Origin.Y * FontHeight; { Set y origin pt } - RawSize.X := (Size.X * FontWidth) - 1; { Calc raw x size } - RawSize.Y := (Size.Y * FontHeight) - 1; { Calc raw y size } - End; END; {--TView--------------------------------------------------------------------} @@ -1198,7 +1199,7 @@ END; {---------------------------------------------------------------------------} FUNCTION TView.TextWidth (const Txt: String): Sw_Integer; BEGIN - TextWidth := Length(Txt) * SysFontWidth; { Calc text length } + TextWidth := Length(Txt); { Calc text length } END; FUNCTION TView.CTextWidth (const Txt: String): Sw_Integer; @@ -1209,7 +1210,7 @@ BEGIN I := Pos('~', S); { Check for tilde } If (I <> 0) Then System.Delete(S, I, 1); { Remove the tilde } Until (I = 0); { Remove all tildes } - CTextWidth := Length(S) * SysFontWidth; { Calc text length } + CTextWidth := Length(S); { Calc text length } END; {--TView--------------------------------------------------------------------} @@ -1218,10 +1219,10 @@ END; FUNCTION TView.MouseInView (Point: TPoint): Boolean; BEGIN MouseInView := False; { Preset false } - If (Point.X < RawOrigin.X) Then Exit; { Point to left } - If (Point.X > (RawOrigin.X+RawSize.X)) Then Exit; { Point to right } - If (Point.Y < RawOrigin.Y) Then Exit; { Point is above } - If (Point.Y > (RawOrigin.Y+RawSize.Y)) Then Exit; { Point is below } + If (Point.X < Origin.X) Then Exit; { Point to left } + If (Point.X > (Origin.X+Size.X)) Then Exit; { Point to right } + If (Point.Y < Origin.Y) Then Exit; { Point is above } + If (Point.Y > (Origin.Y+Size.Y)) Then Exit; { Point is below } MouseInView := True; { Return true } END; @@ -1240,17 +1241,10 @@ END; FUNCTION TView.OverlapsArea (X1, Y1, X2, Y2: Sw_Integer): Boolean; BEGIN OverLapsArea := False; { Preset false } - 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; + If (Origin.X > X2) Then Exit; { Area to the left } + If ((Origin.X + Size.X) < X1) Then Exit; { Area to the right } + If (Origin.Y > Y2) Then Exit; { Area is above } + If ((Origin.Y + Size.Y) < Y1) Then Exit; { Area is below } OverLapsArea := True; { Return true } END; @@ -1324,9 +1318,6 @@ var end; begin - if (not TextModeGFV) and not UseFixedFont then - exit; -{$ifdef USE_VIDEO_API} if ((state and sfV_CV_F) = sfV_CV_F) then begin p:=@Self; @@ -1344,33 +1335,11 @@ begin G:=p^.owner; if G=Nil then { top view } begin - if TextModeGFV then - Video.SetCursorPos(cur.x,cur.y) -{$IFDEF GRAPH_API} - else - GFVGraph.SetCursorPos(cur.x,cur.y) -{$ENDIF GRAPH_API} - ; + Video.SetCursorPos(cur.x,cur.y); if (state and sfCursorIns)<>0 then - begin - if TextModeGFV then - Video.SetCursorType(crBlock) -{$IFDEF GRAPH_API} - else - GFVGraph.SetCursorType(crBlock) -{$ENDIF GRAPH_API} - ; - end + Video.SetCursorType(crBlock) else - begin - if TextModeGFV then - Video.SetCursorType(crUnderline) -{$IFDEF GRAPH_API} - else - GFVGraph.SetCursorType(crUnderline) -{$ENDIF GRAPH_API} - ; - end; + Video.SetCursorType(crUnderline); exit; end; if (G^.state and sfVisible)=0 then @@ -1380,14 +1349,7 @@ begin break; end; { while } end; { if } - if TextModeGFV then - Video.SetCursorType(crHidden) -{$IFDEF GRAPH_API} - else - GFVGraph.SetCursorType(crHidden) -{$ENDIF GRAPH_API} - ; -{$endif USE_VIDEO_API} + Video.SetCursorType(crHidden); end; @@ -1420,7 +1382,7 @@ BEGIN (State AND sfExposed <> 0) AND { View is exposed } (State AND sfIconised = 0) Then Begin { View not iconised } SetViewLimits; { Set view limits } - GetViewSettings(ViewPort, TextModeGFV); { Get set viewport } + GetViewSettings(ViewPort); { Get set viewport } If OverlapsArea(ViewPort.X1, ViewPort.Y1, ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area } @@ -1435,9 +1397,7 @@ BEGIN End; Parent:=Parent^.Owner; End; -{$ifdef USE_VIDEO_API} LockScreenUpdate; { don't update the screen yet } -{$endif USE_VIDEO_API} HideMouseCursor; { Hide mouse cursor } If (DrawMask = 0) OR (DrawMask = vdNoChild) { No special masks set } { OR Assigned(LimitsLocked) } @@ -1446,17 +1406,12 @@ BEGIN Draw; { Draw interior } If (GOptions AND goDrawFocus <> 0) Then DrawFocus; { Draw focus } - if not TextModeGFV and - (State AND sfCursorVis <> 0) Then - DrawCursor; { Draw any cursor } If (Options AND ofFramed <> 0) OR (GOptions AND goThickFramed <> 0) { View has border } Then DrawBorder; { Draw border } -{$ifndef NoShadow} If ((State AND sfShadow) <> 0) AND (GOptions And goNoShadow = 0) Then DrawShadow; -{$endif ndef NoShadow} End Else Begin { Masked draws only } If (DrawMask AND vdBackGnd <> 0) Then { Chk background mask } Begin @@ -1474,20 +1429,11 @@ BEGIN DrawMask := DrawMask and Not vdFocus; DrawFocus; { Check focus mask } End; - if not TextModeGFV then - begin - If (DrawMask AND vdCursor <> 0) Then { Check cursor mask } - Begin - DrawMask := DrawMask and Not vdCursor; - DrawCursor; { Draw any cursor } - End; - end; If (DrawMask AND vdBorder <> 0) Then { Check border mask } Begin DrawMask := DrawMask and Not vdBorder; DrawBorder; { Draw border } End; -{$ifndef NoShadow} If ((State AND sfShadow) <> 0) AND (DrawMask AND vdShadow <> 0) AND (GOptions And goNoShadow = 0) AND @@ -1496,18 +1442,12 @@ BEGIN DrawMask := DrawMask and Not vdShadow; DrawShadow; End; -{$endif ndef NoShadow} End; + end; ShowMouseCursor; { Show mouse cursor } -{$ifdef USE_VIDEO_API} UnlockScreenUpdate; -{$endif USE_VIDEO_API} - if TextModeGFV or UseFixedFont then - begin - DrawScreenBuf; - TView.DrawCursor; - end; - End; + DrawScreenBuf; + TView.DrawCursor; ReleaseViewLimits; { Release the limits } End; DrawMask := 0; { Clear the draw mask } @@ -1530,6 +1470,13 @@ PROCEDURE TView.DrawFocus; BEGIN { Abstract method } END; +{--TView--------------------------------------------------------------------} +{ DrawBorder -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB } +{---------------------------------------------------------------------------} +PROCEDURE TView.DrawBorder; +BEGIN { Abstract method } +END; + {--TView--------------------------------------------------------------------} { DrawCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB } {---------------------------------------------------------------------------} @@ -1539,25 +1486,6 @@ BEGIN { Abstract method } ResetCursor; END; -{--TView--------------------------------------------------------------------} -{ DrawBorder -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17May98 LdB } -{---------------------------------------------------------------------------} -PROCEDURE TView.DrawBorder; -BEGIN - If (TextModeGFV = FALSE) Then Begin { GRAPHICS GFV MODE } - BiColorRectangle(0, 0, RawSize.X, RawSize.Y, - White, DarkGray, False); { Draw 3d effect } - If (GOptions AND goThickFramed <> 0) Then Begin { Thick frame at work } - GraphRectangle(1, 1, RawSize.X-1, RawSize.Y-1, - LightGray); { Draw frame part 1 } - GraphRectangle(2, 2, RawSize.X-2, RawSize.Y-2, - LightGray); { Fraw frame part 2 } - BiColorRectangle(3, 3, RawSize.X-3, RawSize.Y-3, - White, DarkGray, True); { Draw highlights } - End; - End; - { TView DrawBorder is empty for TextModeGFV } -END; PROCEDURE TView.DrawShadow; VAR X1, Y1, X2, Y2 : Sw_Integer; @@ -1570,25 +1498,21 @@ BEGIN Writeln(stderr,'DrawShadow'); End; {$endif DEBUG} - 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; + X1:=Origin.X+Size.X; + X2:=Origin.X+Size.X+ShadowSize.X; + Y1:=Origin.Y+ShadowSize.Y; + Y2:=Origin.Y+Size.Y+ShadowSize.Y; GOptions := GOptions OR goNoShadow; Owner^.GOptions := Owner^.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; + WriteShadow(X1,Y1,X2,Y2); + X1:=Origin.X+ShadowSize.X; + X2:=Origin.X+Size.X; + Y1:=Origin.Y+Size.Y; + Y2:=Origin.Y+Size.Y+ShadowSize.Y; Owner^.RedrawArea(X1,Y1,X2,Y2); - WriteShadow(X1 div SysFontWidth, Y1 div SysFontHeight, - X2 div SysFontWidth, Y2 div SysFontHeight); + WriteShadow(X1,Y1,X2,Y2); GOptions := GOptions AND not goNoShadow; Owner^.GOptions := Owner^.GOptions AND not goNoShadow; End; @@ -1649,35 +1573,29 @@ BEGIN {$endif} Begin { Check enough memory } GetMem(Ca, SizeOf(TComplexArea)); { Allocate memory } - GetViewSettings(ViewPort, TextModeGFV or UseFixedFont); { Fetch view port } + GetViewSettings(ViewPort); { Fetch view port } Ca^.X1 := ViewPort.X1; { Hold current X1 } Ca^.Y1 := ViewPort.Y1; { Hold current Y1 } Ca^.X2 := ViewPort.X2; { Hold current X2 } Ca^.Y2 := ViewPort.Y2; { Hold current Y2 } Ca^.NextArea := HoldLimit; { Pointer to next } HoldLimit := Ca; { Move down chain } - X1 := RawOrigin.X; { Xfer x raw origin } - Y1 := RawOrigin.Y; { Xfer y raw origin } - X2 := X1 + RawSize.X; { Calc right value } - Y2 := Y1 + RawSize.Y; { Calc lower value } + X1 := Origin.X; { Xfer x raw origin } + Y1 := Origin.Y; { Xfer y raw origin } + X2 := X1 + Size.X; { Calc right value } + Y2 := Y1 + Size.Y; { Calc lower value } P := Owner; { Start on owner } While (P <> Nil) Do Begin { While owner valid } - If (X1 < P^.RawOrigin.X) Then - X1 := P^.RawOrigin.X; { X minimum contain } - If (Y1 < P^.RawOrigin.Y) Then - Y1 := P^.RawOrigin.Y; { Y minimum contain } - If (X2 > P^.RawOrigin.X + P^.RawSize.X) - Then X2 := P^.RawOrigin.X + P^.RawSize.X; { X maximum contain } - If (Y2 > P^.RawOrigin.Y + P^.RawSize.Y) - Then Y2 := P^.RawOrigin.Y + P^.RawSize.Y; { Y maximum contain } + If (X1 < P^.Origin.X) Then + X1 := P^.Origin.X; { X minimum contain } + If (Y1 < P^.Origin.Y) Then + Y1 := P^.Origin.Y; { Y minimum contain } + If (X2 > P^.Origin.X + P^.Size.X) + Then X2 := P^.Origin.X + P^.Size.X; { X maximum contain } + If (Y2 > P^.Origin.Y + P^.Size.Y) + Then Y2 := P^.Origin.Y + P^.Size.Y; { Y maximum contain } P := P^.Owner; { Move to owners owner } End; - If TextModeGFV or UseFixedFont 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 } @@ -1690,7 +1608,7 @@ BEGIN If (Y2 > ViewPort.Y2) Then Y2 := ViewPort.Y2; { Adjust y2 to locked } End; - SetViewPort(X1, Y1, X2, Y2, ClipOn, TextModeGFV or UseFixedFont);{ Set new clip limits } + SetViewPort(X1, Y1, X2, Y2, true);{ Set new clip limits } End; END; @@ -1706,44 +1624,29 @@ BEGIN 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 or UseFixedFont); { Get view settings } - If not TextModeGFV and not UseFixedFont 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 X := X1 To X2 Do Begin - Buf[X-X1]:=(Bc shl 8) or ord(BackgroundChar){not a directive,was $20}; - End; - For Y := Y1 To Y2 Do Begin - WriteAbs(X1,Y, X2-X1, Buf); - End; - DrawScreenBuf; - End; + GetViewSettings(ViewPort); { Get view settings } + 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 X := X1 To X2 Do Begin + Buf[X-X1]:=(Bc shl 8) or ord(BackgroundChar){not a directive,was $20}; + End; + For Y := Y1 To Y2 Do Begin + WriteAbs(X1,Y, X2-X1, Buf); + End; + DrawScreenBuf; End; END; @@ -1756,8 +1659,7 @@ BEGIN P := HoldLimit; { Transfer pointer } If (P <> Nil) Then Begin { Valid complex area } HoldLimit := P^.NextArea; { Move to prior area } - SetViewPort(P^.X1, P^.Y1, P^.X2, P^.Y2, ClipOn, - TextModeGFV or UseFixedFont); { Restore clip limits } + SetViewPort(P^.X1, P^.Y1, P^.X2, P^.Y2, true); FreeMem(P, SizeOf(TComplexArea)); { Release memory } End; END; @@ -1817,16 +1719,7 @@ BEGIN Cursor.X := X; { New x position } Cursor.Y := Y; { New y position } If ((DrawMask and vdInSetCursor)=0) and (State AND sfCursorVis <> 0) Then - Begin { Cursor visible } - if TextModeGFV or UseFixedFont then - TView.DrawCursor - else - begin - SetDrawMask(vdCursor or vdInSetCursor); { Set draw mask } - DrawView; { Draw the cursor } - DrawMask:=DrawMask and not vdInSetCursor; - end; - End; + TView.DrawCursor END; {--TView--------------------------------------------------------------------} @@ -1852,8 +1745,8 @@ BEGIN State := State AND NOT sfVisible; { Temp stop drawing } If (LastView = Target) Then If (Owner <> Nil) Then Owner^.ReDrawArea( - RawOrigin.X, RawOrigin.Y, RawOrigin.X + RawSize.X, - RawOrigin.Y + RawSize.Y); { Redraw old area } + Origin.X, Origin.Y, Origin.X + Size.X, + Origin.Y + Size.Y); { Redraw old area } Owner^.Lock; Owner^.RemoveView(@Self); { Remove from list } Owner^.InsertView(@Self, Target); { Insert into list } @@ -1872,20 +1765,14 @@ BEGIN End; END; -{ ******************************* REMARK ****************************** } -{ The original TV origin data is only adjusted incase the user uses } -{ the values directly. New views should rely only on RawOrigin values. } -{ ****************************** END REMARK *** Leon de Boer, 15May98 * } {--TView--------------------------------------------------------------------} { DisplaceBy -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB } {---------------------------------------------------------------------------} PROCEDURE TView.DisplaceBy (Dx, Dy: Sw_Integer); BEGIN - RawOrigin.X := RawOrigin.X + Dx; { Displace raw x } - RawOrigin.Y := RawOrigin.Y + Dy; { Displace raw y } - Origin.X := RawOrigin.X DIV FontWidth; { Calc new x origin } - Origin.Y := RawOrigin.Y DIV FontHeight; { Calc new y origin } + Origin.X := Origin.X + Dx; { Displace raw x } + Origin.Y := Origin.Y + Dy; { Displace raw y } END; {--TView--------------------------------------------------------------------} @@ -1914,14 +1801,8 @@ BEGIN Writeln(stderr,'ReDrawArea(',X1,',',Y1,',',X2,',',Y2,')'); End; {$endif DEBUG} - 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 } + GetViewSettings(ViewPort); { Hold view port } + SetViewPort(X1, Y1, X2, Y2, true); { Set new clip limits } HLimit := LimitsLocked; { Hold lock limits } LimitsLocked := @Self; { We are the lock view } StoreDrawMask:=DrawMask; @@ -1930,7 +1811,7 @@ BEGIN DrawMask:=StoreDrawMask; LimitsLocked := HLimit; { Release our lock } SetViewPort(ViewPort.X1, ViewPort.Y1, - ViewPort.X2, ViewPort.Y2, ClipOn, TextModeGFV); { Reset old limits } + ViewPort.X2, ViewPort.Y2, true); { Reset old limits } END; {--TView--------------------------------------------------------------------} @@ -1975,9 +1856,9 @@ BEGIN Else If (Owner <> Nil) Then Owner^.ReDrawArea( { Owner valid } - RawOrigin.X, RawOrigin.Y, - RawOrigin.X + RawSize.X + 1 + ShadowSize.X*SysFontWidth, - RawOrigin.Y + RawSize.Y + 1 + ShadowSize.Y*SysFontHeight); { Owner redraws area } + Origin.X, Origin.Y, + Origin.X + Size.X + ShadowSize.X, + Origin.Y + Size.Y + ShadowSize.Y); { Owner redraws area } If (Options AND ofSelectable <> 0) Then { View is selectable } If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset selected } @@ -2001,23 +1882,10 @@ BEGIN If (AState AND (sfCursorVis + sfCursorIns) <> 0) and { Change cursor state } (OldState<>State) then ShouldDrawCursor:=true; - if (TextModeGFV or UseFixedFont) then - begin - If ShouldDraw then - DrawView; { Redraw the border } - if ShouldDrawCursor Then - DrawCursor; - end - else - Begin - if ShouldDrawCursor Then - begin - SetDrawMask(vdCursor); { Set cursor draw mask } - ShouldDraw:=true; - end; - If ShouldDraw then - DrawView; { Redraw the border } - End; + If ShouldDraw then + DrawView; { Redraw the border } + if ShouldDrawCursor Then + DrawCursor; END; {--TView--------------------------------------------------------------------} @@ -2046,10 +1914,6 @@ END; {--TView--------------------------------------------------------------------} { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB } {---------------------------------------------------------------------------} -{ You can save data to the stream compatable with the old original TV by } -{ temporarily turning off the ofGFVModeView making the call to this store } -{ routine and resetting the ofGFVModeView flag after the call. } -{---------------------------------------------------------------------------} PROCEDURE TView.Store (Var S: TStream); VAR SaveState: Word; i: integer; @@ -2069,15 +1933,6 @@ BEGIN S.Write(State, SizeOf(State)); { Write state masks } S.Write(Options, SizeOf(Options)); { Write options masks } S.Write(Eventmask, SizeOf(Eventmask)); { Write event masks } - If (Options AND ofGFVModeView <> 0) Then Begin { GFV GRAPHICAL TVIEW } - S.Write(GOptions, SizeOf(GOptions)); { Write new option masks } - S.Write(TabMask, SizeOf(TabMask)); { Write new tab masks } - i:=RawOrigin.X;S.Write(i, SizeOf(i)); { Write raw origin x point } - i:=RawOrigin.Y;S.Write(i, SizeOf(i)); { Write raw origin y point } - i:=RawSize.X;S.Write(i, SizeOf(i)); { Write raw x size } - i:=RawSize.Y;S.Write(i, SizeOf(i)); { Write raw y size } - i:=ColourOfs;S.Write(i, SizeOf(i)); { Write Palette offset } - End; State := SaveState; { Reset state masks } END; @@ -2097,10 +1952,10 @@ VAR END; BEGIN - X1 := RawOrigin.X; { Current x origin } - Y1 := RawOrigin.Y; { Current y origin } - X2 := RawOrigin.X + RawSize.X; { Current x size } - Y2 := RawOrigin.Y + RawSize.Y; { Current y size } + X1 := Origin.X; { Current x origin } + Y1 := Origin.Y; { Current y origin } + X2 := Origin.X + Size.X; { Current x size } + Y2 := Origin.Y + Size.Y; { Current y size } SizeLimits(Min, Max); { Get size limits } Bounds.B.X := Bounds.A.X + Range(Bounds.B.X - Bounds.A.X, Min.X, Max.X); { X bound limit } @@ -2177,47 +2032,37 @@ BEGIN assigned(Owner) then begin State:= State and not sfShadow; - Owner^.ReDrawArea(RawOrigin.X + RawSize.X + 1 , RawOrigin.Y, - RawOrigin.X + RawSize.X + 1 + ShadowSize.X*SysFontWidth, - RawOrigin.Y + RawSize.Y + 1 + ShadowSize.Y*SysFontHeight); { Owner redraws area } - Owner^.ReDrawArea(RawOrigin.X, RawOrigin.Y + RawSize.Y + 1 , - RawOrigin.X + RawSize.X + 1 + ShadowSize.X*SysFontWidth, - RawOrigin.Y + RawSize.Y + 1 + ShadowSize.Y*SysFontHeight); { Owner redraws area } + Owner^.ReDrawArea(Origin.X + Size.X, Origin.Y, + Origin.X + Size.X + ShadowSize.X, + Origin.Y + Size.Y + ShadowSize.Y); { Owner redraws area } + Owner^.ReDrawArea(Origin.X, Origin.Y + Size.Y, + Origin.X + Size.X + ShadowSize.X, + Origin.Y + Size.Y + ShadowSize.Y); { Owner redraws area } State:= State or sfShadow; end; - If (Bounds.B.X > 0) AND (Bounds.B.Y > 0) { Normal text co-ords } - AND (GOptions AND goGraphView = 0) Then Begin { Normal text view } + If (Bounds.B.X > 0) AND (Bounds.B.Y > 0) Then Begin { Normal text view } If (Owner <> Nil) Then Begin { Owner is valid } COrigin.X := Origin.X - Owner^.Origin.X; { Corrected x origin } COrigin.Y := Origin.Y - Owner^.Origin.Y; { Corrected y origin } D.X := Bounds.A.X - COrigin.X; { X origin disp } D.Y := Bounds.A.Y - COrigin.Y; { Y origin disp } If ((D.X <> 0) OR (D.Y <> 0)) Then - DisplaceBy(D.X*FontWidth, D.Y*FontHeight); { Offset the view } + DisplaceBy(D.X, D.Y); { Offset the view } End Else Origin := Bounds.A; { Hold as origin } Size.X := Bounds.B.X-Bounds.A.X; { Hold view x size } Size.Y := Bounds.B.Y-Bounds.A.Y; { Hold view y size } - RawOrigin.X := Origin.X * FontWidth; { Raw x origin } - RawOrigin.Y := Origin.Y * FontHeight; { Raw y origin } - RawSize.X := Size.X * FontWidth - 1; { Set raw x size } - RawSize.Y := Size.Y * FontHeight - 1; { Set raw y size } End Else Begin { Graphical co-ords } If (Owner <> Nil) Then Begin { Owner is valid } - COrigin.X := RawOrigin.X - Owner^.RawOrigin.X; { Corrected x origin } - COrigin.Y := RawOrigin.Y - Owner^.RawOrigin.Y; { Corrected y origin } + COrigin.X := Origin.X - Owner^.Origin.X; { Corrected x origin } + COrigin.Y := Origin.Y - Owner^.Origin.Y; { Corrected y origin } D.X := Bounds.A.X - COrigin.X; { X origin disp } D.Y := Bounds.A.Y - COrigin.Y; { Y origin disp } If ((D.X <> 0) OR (D.Y <> 0)) Then DisplaceBy(D.X, D.Y); { Offset the view } - End Else RawOrigin := Bounds.A; { Hold as origin } - RawSize.X := Abs(Bounds.B.X) - Bounds.A.X; { Set raw x size } - RawSize.Y := Abs(Bounds.B.Y) - Bounds.A.Y; { Set raw y size } - Origin.X := RawOrigin.X DIV FontWidth; { Rough x position } - Origin.Y := RawOrigin.Y DIV FontHeight; { Rough y position } - Size.X := RawSize.X DIV FontWidth; { Rough x size } - Size.Y := RawSize.Y DIV FontHeight; { Rough y size } + End Else Origin := Bounds.A; { Hold as origin } + Size.X := Abs(Bounds.B.X) - Bounds.A.X; { Set raw x size } + Size.Y := Abs(Bounds.B.Y) - Bounds.A.Y; { Set raw y size } End; - Options := Options OR ofGFVModeView; { Now in GFV mode } END; {--TView--------------------------------------------------------------------} @@ -2250,30 +2095,6 @@ BEGIN If (Focus = False) OR { Not view with focus } (Options AND ofFirstClick = 0) { Not 1st click select } Then ClearEvent(Event); { Handle the event } - If (Event.What = evKeyDown) AND { Key down event } - (Options OR ofGFVModeView <> 0) Then Begin { GFV mode view check } - If (Owner <> Nil) AND (TabMask <> 0) AND { Owner and tab masks } - (State AND sfFocused <> 0) Then Begin { View has focus } - Case Event.KeyCode Of - kbTab: If (TabMask AND tmTab <> 0) Then { Tab key mask set } - Owner^.FocusNext(False) Else Exit; { Focus next view } - kbEnter: If (TabMask AND tmEnter <> 0) Then { Enter key mask set } - Owner^.FocusNext(False) Else Exit; { Focus next view } - kbShiftTab: If (TabMask AND tmShiftTab <> 0) { Shit tab mask set } - Then Owner^.FocusNext(True) Else Exit; { Focus prior view } - kbLeft: If (TabMask AND tmLeft <> 0) Then { Left arrow mask set } - Owner^.FocusNext(True) Else Exit; { Focus prior view } - kbRight: If (TabMask AND tmRight <> 0) Then { Right arrow mask set } - Owner^.FocusNext(False) Else Exit; { Focus next view } - kbUp: If (TabMask AND tmUp <> 0) Then { Up arrow mask set } - Owner^.FocusNext(True) Else Exit; { Focus prior view } - kbDown: If (TabMask AND tmDown <> 0) Then { Down arrow mask set } - Owner^.FocusNext(False) Else Exit; { Focus next view } - Else Exit; { Not a tab key } - End; - ClearEvent(Event); { Clear handled events } - End; - End; END; {--TView--------------------------------------------------------------------} @@ -2630,21 +2451,11 @@ BEGIN { This should do the whole job now } If (DrawMask AND vdNoChild = 0) and (State AND (sfExposed or sfVisible) = (sfExposed or sfVisible)) and - (X1=RawOrigin.X) and { No need to parse childs for Shadows } - (Y2>=RawOrigin.Y) Then { No draw child clear } + (X1=Origin.X) and { No need to parse childs for Shadows } + (Y2>=Origin.Y) Then { No draw child clear } ReDrawVisibleArea(X1, Y1, X2, Y2,First); { Redraw each subview } -(* { redraw group members } - If (DrawMask AND vdNoChild = 0) and - (X1 Nil) Do Begin - P^.ReDrawVisibleArea(X1, Y1, X2, Y2,First,P); { Redraw each subview } - P := P^.PrevView; { Move to prior view } - End; - End; *) END; PROCEDURE TGroup.ReDrawVisibleArea (X1, Y1, X2, Y2: Sw_Integer;Cur : PView); @@ -2662,10 +2473,10 @@ BEGIN exit; End; - x3:=Cur^.RawOrigin.x; - x4:=x3+Cur^.RawSize.x; - y3:=Cur^.RawOrigin.Y; - y4:=y3+Cur^.RawSize.Y; + x3:=Cur^.Origin.x; + x4:=x3+Cur^.Size.x; + y3:=Cur^.Origin.Y; + y4:=y3+Cur^.Size.Y; { depending on relative positions of x1,x2,x3,x4 we should only draw subrectangles } if cur=last then @@ -2775,16 +2586,9 @@ END; PROCEDURE TGroup.Insert (P: PView); BEGIN If (P <> Nil) and assigned(P^.Owner) Then { View is valid and already inserted } - If (Options AND ofGFVModeView <> 0) Then { GFV mode view check } - P^.DisplaceBy(-P^.Owner^.RawOrigin.X, - -P^.Owner^.RawOrigin.Y) Else { We are in GFV mode } - P^.DisplaceBy(-P^.Owner^.Origin.X*FontWidth, - -P^.Owner^.Origin.Y*FontHeight); { Displace old view } + P^.DisplaceBy(-P^.Owner^.Origin.X,-P^.Owner^.Origin.Y); { Displace old view } If (P <> Nil) Then { View is valid } - If (Options AND ofGFVModeView <> 0) Then { GFV mode view check } - P^.DisplaceBy(RawOrigin.X, RawOrigin.Y) Else { We are in GFV mode } - P^.DisplaceBy(Origin.X*FontWidth, - Origin.Y*FontHeight); { Displace old view } + P^.DisplaceBy(Origin.X,Origin.Y); { Displace old view } InsertBefore(P, First); { Insert the view } END; @@ -2801,10 +2605,7 @@ BEGIN P^.Next := Nil; { Clear next ptr } { We need to recalculate correct position } If (P <> Nil) Then { View is valid } - If (Options AND ofGFVModeView <> 0) Then { GFV mode view check } - P^.DisplaceBy(-RawOrigin.X, -RawOrigin.Y) Else { We are in GFV mode } - P^.DisplaceBy(-Origin.X*FontWidth, - -Origin.Y*FontHeight); { Displace old view } + P^.DisplaceBy(-Origin.X, -Origin.Y); { Displace old view } If (SaveState AND sfVisible <> 0) Then P^.Show; { Show view } END; @@ -2885,35 +2686,15 @@ BEGIN ((Target = Nil) OR (Target^.Owner = @Self)) { Target valid } Then Begin If (P^.Options AND ofCenterX <> 0) Then Begin { Centre on x axis } - If (Options AND ofGFVModeView <> 0) Then { GFV mode view check } - I := RawSize.X Else I := Size.X * FontWidth; { Calc owner x size } - If (P^.Options AND ofGFVModeView <> 0) { GFV mode view check } - Then Begin - I := (I - P^.RawSize.X) DIV 2; { Calc view offset } - I := I - P^.RawOrigin.X; { Subtract x origin } - End Else Begin - I := (I - (P^.Size.X * FontWidth)) DIV 2; { Calc view offset } - I := I - (P^.Origin.X * FontWidth); { Subtract x origin } - End; - { make sure that I is a multiple of FontWidth } - if TextModeGFV or UseFixedFont then - I:= (I div FontWidth) * FontWidth; + I := Size.X; { Calc owner x size } + I := (I - P^.Size.X) DIV 2; { Calc view offset } + I := I - P^.Origin.X; { Subtract x origin } P^.DisplaceBy(I, 0); { Displace the view } End; If (P^.Options AND ofCenterY <> 0) Then Begin { Centre on y axis } - If (Options AND ofGFVModeView <> 0) Then { GFV mode view check } - I := RawSize.Y Else I := Size.Y * FontHeight;{ Calc owner y size } - If (P^.Options AND ofGFVModeView <> 0) { GFV mode view check } - Then Begin - I := (I - P^.RawSize.Y) DIV 2; { Calc view offset } - I := I - P^.RawOrigin.Y; { Subtract y origin } - End Else Begin - I := (I - (P^.Size.Y * FontHeight)) DIV 2; { Calc view offset } - I := I - (P^.Origin.Y * FontHeight); { Subtract y origin } - End; - { make sure that I is a multiple of FontHeight } - if TextModeGFV or UseFixedFont then - I:= (I div FontHeight) * FontHeight; + I := Size.Y;{ Calc owner y size } + I := (I - (P^.Size.Y)) DIV 2; { Calc view offset } + I := I - (P^.Origin.Y); { Subtract y origin } P^.DisplaceBy(0, I); { Displace the view } End; SaveState := P^.State; { Save view state } @@ -2954,8 +2735,6 @@ BEGIN sfFocused: Begin If (Current <> Nil) Then Current^.SetState(sfFocused, Enable); { Focus current view } - {If TextModeGFV then - SetDrawMask(vdBackGnd OR vdFocus OR vdInner OR vdBorder); Set redraw masks } End; sfExposed: Begin ForEach(@DoExpose); { Expose each subview } @@ -3323,10 +3102,6 @@ BEGIN S.Read(i, SizeOf(i)); PgStep:=i; { Read page step size } S.Read(i, SizeOf(i)); ArStep:=i; { Read arrow step size } S.Read(Chars, SizeOf(Chars)); { Read scroll chars } - If (Options AND ofGFVModeView <> 0) Then { GFV mode view check } - begin - S.Read(i, SizeOf(i)); Id:=i; { Read id } - end; END; {--TScrollBar---------------------------------------------------------------} @@ -3385,29 +3160,15 @@ BEGIN If (GOptions AND goNativeClass = 0) Then Begin { Non natives draw } Inherited DrawBackGround; { Call ancestor } Bc := GetColor(1) AND $F0 SHR 4; { Background colour } - If TextModeGFV {or UseFixedFont} then - Begin - WriteChar(0,0,Chars[0],Bc,1); - If (Size.X = 1) Then Begin { Vertical scrollbar } - For i:=1 to Size.Y-2 do - WriteChar(0,i,Chars[2],Bc,1); - WriteChar(0,Size.Y-1,Chars[1],Bc,1); - End Else Begin - WriteChar(1,0,Chars[2],Bc,Size.X-2); - WriteChar(Size.X-1,0,Chars[1],Bc,1); - End; - End - else - Begin - ClearArea(0, 0, FontWidth-1, FontHeight-1, Bc); { Clear top/left area } - BiColorRectangle(0, 0, FontWidth-1, FontHeight-1, - 15, 0, False); { Draw 3d effect } - ClearArea(RawSize.X-FontWidth+1, RawSize.Y- - FontHeight+1, RawSize.X, RawSize.Y, Bc); { Clr right/lower area } - BiColorRectangle(RawSize.X-FontWidth+1, - RawSize.Y-FontHeight+1,RawSize.X, RawSize.Y, - 15, 0, False); { Draw 3d effect } - End; + WriteChar(0,0,Chars[0],Bc,1); + If (Size.X = 1) Then Begin { Vertical scrollbar } + For i:=1 to Size.Y-2 do + WriteChar(0,i,Chars[2],Bc,1); + WriteChar(0,Size.Y-1,Chars[1],Bc,1); + End Else Begin + WriteChar(1,0,Chars[2],Bc,Size.X-2); + WriteChar(Size.X-1,0,Chars[1],Bc,1); + End; End; END; @@ -3491,10 +3252,6 @@ BEGIN i:=PgStep;S.Write(i, SizeOf(i)); { Write page step size } i:=ArStep;S.Write(i, SizeOf(i)); { Write arrow step size } S.Write(Chars, SizeOf(Chars)); { Write scroll chars } - If (Options AND ofGFVModeView <> 0) Then { GFV mode view check } - begin - i:=Id;S.Write(i, SizeOf(i)); { Write scrollbar id } - end; END; {--TScrollBar---------------------------------------------------------------} @@ -3505,18 +3262,16 @@ VAR Tracking: Boolean; I, P, S, ClickPart, Iv: Sw_Integer; Mouse: TPoint; Extent: TRect; FUNCTION GetPartCode: Sw_Integer; - VAR Mark, Part, J: Sw_Integer; + VAR Mark, Part : Sw_Integer; BEGIN Part := -1; { Preset failure } If Extent.Contains(Mouse) Then Begin { Contains mouse } If (Size.X = 1) Then Begin { Vertical scrollbar } - Mark := Mouse.Y - FontHeight; { Calc position } - J := FontHeight; { Font height } + Mark := Mouse.Y - 1; { Calc position } End Else Begin { Horizontal bar } - Mark := Mouse.X - FontWidth; { Calc position } - J := FontWidth; { Font width } + Mark := Mouse.X - 1; { Calc position } End; - If (Mark >= P) AND (Mark < P+J) Then { Within thumbnail } + If (Mark >= P) AND (Mark < P+1) Then { Within thumbnail } Part := sbIndicator; { Indicator part } If (Part <> sbIndicator) Then Begin { Not indicator part } If (Mark < 1) Then Part := sbLeftArrow Else { Left arrow part } @@ -3578,19 +3333,19 @@ BEGIN End; evMouseDown: Begin { Mouse press event } Clicked; { Scrollbar clicked } - Mouse.X := Event.Where.X - RawOrigin.X; { Localize x value } - Mouse.Y := Event.Where.Y - RawOrigin.Y; { Localize y value } + Mouse.X := Event.Where.X - Origin.X; { Localize x value } + Mouse.Y := Event.Where.Y - Origin.Y; { Localize y value } Extent.A.X := 0; { Zero x extent value } Extent.A.Y := 0; { Zero y extent value } - Extent.B.X := RawSize.X; { Set extent x value } - Extent.B.Y := RawSize.Y; { set extent y value } + Extent.B.X := Size.X; { Set extent x value } + Extent.B.Y := Size.Y; { set extent y value } P := GetPos; { Current position } S := GetSize; { Initial size } ClickPart := GetPartCode; { Get part code } If (ClickPart <> sbIndicator) Then Begin { Not thumb nail } Repeat - Mouse.X := Event.Where.X-RawOrigin.X; { Localize x value } - Mouse.Y := Event.Where.Y-RawOrigin.Y; { Localize y value } + Mouse.X := Event.Where.X-Origin.X; { Localize x value } + Mouse.Y := Event.Where.Y-Origin.Y; { Localize y value } If GetPartCode = ClickPart Then SetValue(Value+ScrollStep(ClickPart)); { Same part repeat } Until NOT MouseEvent(Event, evMouseAuto); { Until auto done } @@ -3598,13 +3353,13 @@ BEGIN End Else Begin { Thumb nail move } Iv := Value; { Initial value } Repeat - Mouse.X := Event.Where.X - RawOrigin.X; { Localize x value } - Mouse.Y := Event.Where.Y - RawOrigin.Y; { Localize y value } + Mouse.X := Event.Where.X - Origin.X; { Localize x value } + Mouse.Y := Event.Where.Y - Origin.Y; { Localize y value } Tracking := Extent.Contains(Mouse); { Check contains } If Tracking Then Begin { Tracking mouse } If (Size.X=1) Then - I := Mouse.Y-FontHeight Else { Calc vert position } - I := Mouse.X-FontWidth; { Calc horz position } + I := Mouse.Y-1 Else { Calc vert position } + I := Mouse.X-1; { Calc horz position } If (I < 0) Then I := 0; { Check underflow } If (I > S) Then I := S; { Check overflow } End Else I := GetPos; { Get position } @@ -3646,13 +3401,10 @@ END; FUNCTION TScrollBar.GetSize: Sw_Integer; VAR S: Sw_Integer; BEGIN - If TextModeGFV then Begin - If Size.X = 1 Then - S:= (Size.Y-3)*FontHeight - else - S:= (Size.X-3)*FontWidth; - end else If (Size.X = 1) Then S := RawSize.Y-3*FontHeight+1 { Vertical bar } - Else S := RawSize.X-3*FontWidth+1; { Horizontal bar } + If Size.X = 1 Then + S:= (Size.Y-3) + else + S:= (Size.X-3); If (S < 1) Then S := 1; { Fix minimum size } GetSize := S; { Return size } END; @@ -3671,41 +3423,25 @@ BEGIN (State AND sfExposed <> 0) AND { View is exposed } (Max <> Min) Then Begin { View has some size } SetViewLimits; { Set view limits } - GetViewSettings(ViewPort, TextModeGFV); { Get set viewport } + GetViewSettings(ViewPort); { Get set viewport } If OverlapsArea(ViewPort.X1, ViewPort.Y1, ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area } HideMouseCursor; { Hide the mouse } X1 := 0; { Initial x position } Y1 := 0; { Initial y position } - If TextModeGFV then Begin - If (Size.X = 1) Then Begin { Vertical scrollbar } - Pos:=Pos div FontHeight; - WriteChar(0,0,Chars[0],2,1); - For i:=1 to Size.Y-2 do - WriteChar(0,i,Chars[2],2,1); - WriteChar(0,Size.Y-1,Chars[1],2,1); - End Else Begin - Pos:=Pos div FontWidth; - WriteChar(0,0,Chars[0],2,1); - WriteChar(1,0,Chars[2],2,Size.X-2); - WriteChar(Size.X-1,0,Chars[1],2,1); - End; - If (Size.X=1) Then Y1 := Pos+1 { Vertical bar } - Else X1 := Pos+1; { Horizontal bar } - WriteChar(X1,Y1,Chars[3],2,1); + If (Size.X = 1) Then Begin { Vertical scrollbar } + WriteChar(0,0,Chars[0],2,1); + For i:=1 to Size.Y-2 do + WriteChar(0,i,Chars[2],2,1); + WriteChar(0,Size.Y-1,Chars[1],2,1); End Else Begin - If (Size.X=1) Then Y1 := Pos + FontHeight { Vertical bar } - Else X1 := Pos + FontWidth; { Horizontal bar } - X2 := X1 + FontWidth - 1; { Right side point } - Y2 := Y1 + FontHeight - 1; { Lower side point } - ClearArea(X1, Y1, X2, Y2, GetColor(2) AND $0F);{ Thumbnail back } - BiColorRectangle(X1, Y1, X2, Y2, 15, 8, False);{ Draw highlight } - Y1 := (Y2 + Y1) DIV 2; { Middle of thumb } - Y2 := Y1+1; { One line down } - Inc(X1, 1); { One in off left } - Dec(X2, 1); { One in off right } - BiColorRectangle(X1, Y1, X2, Y2, 15, 8, True); { Draw line marker } + WriteChar(0,0,Chars[0],2,1); + WriteChar(1,0,Chars[2],2,Size.X-2); + WriteChar(Size.X-1,0,Chars[1],2,1); End; + If (Size.X=1) Then Y1 := Pos+1 { Vertical bar } + Else X1 := Pos+1; { Horizontal bar } + WriteChar(X1,Y1,Chars[3],2,1); ShowMouseCursor; { Show the mouse } End; ReleaseViewLimits; { Release the limits } @@ -3725,16 +3461,15 @@ BEGIN If (State AND sfVisible <> 0) AND { View is visible } (State AND sfExposed <> 0) Then Begin { View is exposed } SetViewLimits; { Set view limits } - GetViewSettings(ViewPort, TextModeGFV); { Get set viewport } + GetViewSettings(ViewPort); { Get set viewport } If OverlapsArea(ViewPort.X1, ViewPort.Y1, ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area } HideMouseCursor; { Hide the mouse } X := 0; { Initial x position } Y := 0; { Initial y position } - If (Size.X=1) Then Y := Pos + FontHeight { Vertical bar } - Else X := Pos + FontWidth; { Horizontal bar } - ClearArea(X, Y, X+FontWidth-1, Y+FontHeight-1, - GetColor(1) AND $F0 SHR 4); { Clear the area } + If (Size.X=1) Then Y := Pos + 1 { Vertical bar } + Else X := Pos + 1; { Horizontal bar } + ClearArea(X, Y, X, Y, GetColor(1) AND $F0 SHR 4); { Clear the area } ShowMouseCursor; { Show the mouse } End; ReleaseViewLimits; { Release the limits } @@ -4005,8 +3740,7 @@ BEGIN SCOff := 2; { Colour offset=2 } End; If DrawIt Then Begin { We are drawing item } - ClearArea(CurCol*FontWidth, I*FontHeight, (CurCol+ColWidth-1)*FontWidth, - (I+1)*FontHeight-1, Color AND $F0 SHR 4); { Draw the bar } + ClearArea(CurCol, I, (CurCol+ColWidth-1), I, Color AND $F0 SHR 4); { Draw the bar } MoveChar(B[CurCol], ' ', Color, ColWidth); if Item < Range then begin Text := GetText(Item, ColWidth + Indent); @@ -4057,8 +3791,7 @@ BEGIN SCOff := 2; { Colour offset=2 } End; If DrawIt Then Begin { We are drawing item } - ClearArea(CurCol*FontWidth, I*FontHeight, (CurCol+ColWidth-1)*FontWidth, - (I+1)*FontHeight-1, Color AND $F0 SHR 4); { Draw the bar } + ClearArea(CurCol, I, (CurCol+ColWidth-1), I, Color AND $F0 SHR 4); { Draw the bar } MoveChar(B[CurCol], ' ', Color, ColWidth); if Item < Range then begin Text := GetText(Item, ColWidth + Indent); @@ -4572,23 +4305,18 @@ BEGIN End; evMouseDown: { MOUSE DOWN EVENT } If (GOptions AND goTitled <> 0) Then Begin { Must have title area } - If TextModeGFV then - I:=0 Else - If (GOptions AND goThickFramed <> 0) Then - I := 5 Else { Thick frame adjust } - If (Options AND ofFramed <> 0) Then I := 1 { Frame adjust } - Else I := 0; { No frame size } - If (Event.Where.Y >= (RawOrigin.Y + I)) AND - (Event.Where.Y < RawOrigin.Y+FontHeight+I) + I:=0; + If (Event.Where.Y >= (Origin.Y + I)) AND + (Event.Where.Y < Origin.Y+1+I) Then Begin { Within top line } If (Current <> Nil) AND (Current^.Options AND ofSelectable <> 0) Then Current^.FocusFromTop Else FocusFromTop; If (Flags AND wfClose <> 0) Then Begin { Has close icon } - J := I + 2*FontWidth; { Set X value } - If (Event.Where.X >= RawOrigin.X+J) AND - (Event.Where.X < RawOrigin.X+J+3*FontWidth) + J := I + 2; { Set X value } + If (Event.Where.X >= Origin.X+J) AND + (Event.Where.X < Origin.X+J+3) Then Begin { In close area } Event.What := evCommand; { Command event } Event.Command := cmClose; { Close command } @@ -4599,9 +4327,9 @@ BEGIN End; End; If (Flags AND wfZoom <> 0) Then Begin { Has Zoom icon } - J := (SIZE.X-5)*FontWidth; { Set X value } - If (Event.Where.X >= RawOrigin.X+J) AND - (Event.Where.X < RawOrigin.X+J+3*FontWidth) + J := (SIZE.X-5); { Set X value } + If (Event.Where.X >= Origin.X+J) AND + (Event.Where.X < Origin.X+J+3) Then Begin { In close area } Event.What := evCommand; { Command event } Event.Command := cmZoom; { Close command } @@ -4613,8 +4341,8 @@ BEGIN End; If (Owner <> Nil) AND (Flags AND wfMove <> 0) Then DragWindow(dmDragMove); { Drag the window } - End Else If (Event.Where.X >= RawOrigin.X + RawSize.X-2*FontWidth) AND - (Event.Where.Y >= RawOrigin.Y + RawSize.Y - FontHeight) + End Else If (Event.Where.X >= Origin.X + Size.X-2) AND + (Event.Where.Y >= Origin.Y + Size.Y - 1) Then If (Flags AND wfGrow <> 0) Then { Check grow flags } DragWindow(dmDragGrow); { Change window size } End; @@ -4644,7 +4372,7 @@ END; FUNCTION TView.Exposed: Boolean; VAR ViewPort: ViewPortType; BEGIN - GetViewSettings(ViewPort, TextModeGFV); { Fetch viewport } + GetViewSettings(ViewPort); { Fetch viewport } If (State AND sfVisible<>0) AND { View visible } (State AND sfExposed<>0) AND { View exposed } OverlapsArea(ViewPort.X1, ViewPort.Y1, @@ -4652,74 +4380,6 @@ BEGIN Else Exposed := False; { Is hidden } END; -{--TView--------------------------------------------------------------------} -{ GraphLine -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Sep99 LdB } -{---------------------------------------------------------------------------} -PROCEDURE TView.GraphLine (X1, Y1, X2, Y2: Sw_Integer; Colour: Byte); -VAR ViewPort: ViewPortType; - x,y,i,j : sw_integer; -BEGIN - GetViewSettings(ViewPort, TextModeGFV); { Get viewport settings } - If (TextModeGFV <> TRUE) Then Begin - SetColor(Colour); { Set line colour } - Line(RawOrigin.X + X1 - ViewPort.X1, - RawOrigin.Y + Y1 - ViewPort.Y1, RawOrigin.X + X2 - - ViewPort.X1, RawOrigin.Y + Y2-ViewPort.Y1); { Draw the line } - { mark the corresponding lines as without chars } -{$IFDEF GRAPH_API} - If UseFixedFont then - begin - if abs(x1-x2)=0) and (x<=Graph.GetMaxX) and (y>=0) and (y<=Graph.GetMaxY) then - SetExtraInfo(x div SysFontWidth,y div SysFontHeight, - x mod SysFontWidth,y mod SysFontHeight, Colour); - end; - end - else - begin - for j:=x1 to x2 do - begin - x:=(RawOrigin.x + j); - y:=(RawOrigin.y + y1 + ((j-x1)*(y2-y1)) div (x2-x1)); - if (x>=0) and (x<=Graph.GetMaxX) and (y>=0) and (y<=Graph.GetMaxY) then - SetExtraInfo(x div SysFontWidth,y div SysFontHeight, - x mod SysFontWidth,y mod SysFontHeight, Colour); - end; - end; - end; -{$ENDIF GRAPH_API} - End Else Begin { LEON???? } - End; -END; - -PROCEDURE TView.GraphRectangle (X1, Y1, X2, Y2: Sw_Integer; Colour: Byte); -VAR ViewPort: ViewPortType; -BEGIN - If (TextModeGFV <> TRUE) Then Begin { GRAPHICS MODE GFV } - If UseFixedFont then - begin - Graphline(x1,y1,x1,y2,colour); - Graphline(x1,y2,x2,y2,colour); - Graphline(x2,y2,x2,y1,colour); - Graphline(x2,y1,x1,y1,colour); - end - else - begin - SetColor(Colour); { Set line colour } - GetViewSettings(ViewPort, TextModeGFV); - Rectangle(RawOrigin.X + X1 - ViewPort.X1, RawOrigin.Y + Y1 - - ViewPort.Y1, RawOrigin.X + X2 - ViewPort.X1, - RawOrigin.Y+Y2-ViewPort.Y1); { Draw a rectangle } - end; - End Else Begin { LEON???? } - End; -END; - {--TView--------------------------------------------------------------------} { ClearArea -> Platforms DOS/DPMI/WIN/OS2 - Checked 19Sep97 LdB } {---------------------------------------------------------------------------} @@ -4728,158 +4388,20 @@ VAR X, Y: Sw_Integer; ViewPort: ViewPortType; Buf : TDrawBuffer; BEGIN - GetViewSettings(ViewPort, TextModeGFV); { Get viewport } - If not TextModeGFV {and not UseFixedFont} Then Begin { GRAPHICAL GFV MODE } - SetFillStyle(SolidFill, Colour); { Set colour up } - Bar(RawOrigin.X+X1-ViewPort.X1, RawOrigin.Y+Y1- - ViewPort.Y1, RawOrigin.X+X2-ViewPort.X1, - RawOrigin.Y+Y2-ViewPort.Y1); { Clear the area } - { Force redraw if something new is written after } - if UseFixedFont and assigned(OldVideoBuf) then - begin - X1 := (RawOrigin.X+X1) DIV SysFontWidth; - Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight; - X2 := (RawOrigin.X+X2-1) DIV SysFontWidth; - Y2 := (RawOrigin.Y+Y2-1) DIV SysFontHeight; - For Y := Y1 To Y2 Do - For X := X1 To X2 Do - begin - VideoBuf^[Y*TextScreenWidth+X]:=0; - OldVideoBuf^[Y*TextScreenWidth+X]:=0; - end; - end; - End Else Begin { TEXT MODE GFV } - X1 := (RawOrigin.X+X1) DIV SysFontWidth; - 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 - WriteAbs(X1,Y, X2-X1, Buf); - DrawScreenBuf; + GetViewSettings(ViewPort); { Get viewport } + X1 := Origin.X+X1; + Y1 := Origin.Y+Y1; + X2 := Origin.X+X2-1; + Y2 := Origin.Y+Y2-1; + For X := X1 To X2 Do Begin + Buf[X-X1]:=(Colour shl 12) or $20; End; + For Y := Y1 To Y2 Do + WriteAbs(X1,Y, X2-X1, Buf); + DrawScreenBuf; END; -PROCEDURE TView.GraphArc (Xc, Yc: Sw_Integer; Sa, Ea: Real; XRad, YRad: Sw_Integer; -Colour: Byte); -CONST RadConv = 57.2957795130823229; { Degrees per radian } -VAR X1, Y1, X2, Y2, X3, Y3: Sw_Integer; {$IFDEF OS_WINDOWS} ODc: hDc; {$ENDIF} -BEGIN - {$IFDEF NOT_IMPLEMENTED} - {$IFDEF OS_WINDOWS} - Xc := Xc - FrameSize; - Yc := Yc - CaptSize; - {$ENDIF} - While (Ea < -360) Do Ea := Ea + 360; { Max of a full circle } - While (Ea > 360) Do Ea := Ea - 360; { Max of a full circle } - Sa := Sa/RadConv; { Convert to radians } - Ea := Ea/RadConv; { Convert to radians } - X1 := Xc + Round(Sin(Sa)*XRad); { Calc 1st x value } - Y1 := Yc - Round(Cos(Sa)*YRad); { Calc 1st y value } - X2 := Xc + Round(Sin(Sa+Ea)*XRad); { Calc 2nd x value } - Y2 := Yc - Round(Cos(Sa+Ea)*YRad); { Calc 2nd y value } - X3 := X2; { Use X2 value } - Y3 := Y2; { Use Y2 value } - If (Abs(Ea) > Pi) Then Begin - X3 := Xc + Round(Sin(Sa+Pi)*XRad); { Calc 3rd x value } - Y3 := Yc - Round(Cos(Sa+Pi)*YRad); { Calc 3rd y value } - End; - {$IFDEF OS_WINDOWS} - If (HWindow <> 0) Then Begin { Valid window } - ODc := Dc; { Hold device context } - If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context } - SelectObject(Dc, ColPen[Colour]); { Pen colour } - If (Abs(X1-X3) > 1) OR (Abs(Y1-Y3) > 1) { Must exceed 2x2 arc } - Then Begin - If (Ea < 0) Then - Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad, - X1, Y1, X2, Y2) Else { Draw c/clkwise arc } - Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad, - X2, Y2, X1, Y1); { Draw clockwise arc } - End; - If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context } - Dc := ODc; { Reset held context } - End; - {$ENDIF} - {$ENDIF NOT_IMPLEMENTED} -END; - -PROCEDURE TView.FilletArc (Xc, Yc: Sw_Integer; Sa, Ea: Real; XRad, YRad, Ht: Sw_Integer; -Colour: Byte); -CONST RadConv = 57.2957795130823229; { Degrees per radian } -{$IFDEF OS_WINDOWS} VAR X1, Y1, X2, Y2, X3, Y3, X4, Y4: Sw_Integer; ODc: hDc; {$ENDIF} -BEGIN - {$IFDEF NOT_IMPLEMENTED} - {$IFDEF OS_WINDOWS} - If (HWindow <> 0) Then Begin { Valid window } - Xc := Xc - FrameSize; - Yc := Yc - CaptSize; - ODc := Dc; { Hold device context } - If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context } - Ea := (Ea-Sa); - While (Ea<-360) Do Ea := Ea+360; { One lap only } - While (Ea>360) Do Ea := Ea-360; { One lap only } - X1 := Round(Sin(Sa/RadConv)*XRad); - Y1 := -Round(Cos(Sa/RadConv)*YRad); { Calc 1st values } - X2 := Round(Sin((Sa+Ea)/RadConv)*XRad); - Y2 := -Round(Cos((Sa+Ea)/RadConv)*YRad); { Calc 2nd values } - X3 := Round(Sin(Sa/RadConv)*(XRad+Ht)); - Y3 := -Round(Cos(Sa/RadConv)*(YRad+Ht)); { Calc 3rd values } - X4 := Round(Sin((Sa+Ea)/RadConv)*(XRad+Ht)); - Y4 := -Round(Cos((Sa+Ea)/RadConv)*(YRad+Ht)); { Calc 4th values } - SelectObject(Dc, ColPen[Colour]); { Pen colour } - {$IFDEF WIN32} - MoveToEx(Dc, Xc+X1, Yc+Y1, Nil); { Move to first point } - {$ELSE} - WinProcs.MoveTo(Dc, Xc+X1, Yc+Y1); { Move to first point } - {$ENDIF} - LineTo(Dc, Xc+X3, Yc+Y3); - {$IFDEF WIN32} - MoveToEx(Dc, Xc+X2, Yc+Y2, Nil); - {$ELSE} - WinProcs.MoveTo(Dc, Xc+X2, Yc+Y2); - {$ENDIF} - LineTo(Dc, Xc+X4, Yc+Y4); - If (Ea < 0) Then - Arc(Dc, Xc-XRad-Ht, Yc-YRad-Ht, Xc+XRad+Ht, Yc+YRad+Ht, - Xc+X1, Yc+Y1, Xc+X2, Yc+Y2) Else - Arc(Dc, Xc-XRad-Ht, Yc-YRad-Ht, Xc+XRad+Ht, Yc+YRad+Ht, - Xc+X2, Yc+Y2, Xc+X1, Yc+Y1); { Draw arc } - If (Ea < 0) Then - Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad, - Xc+X3, Yc+Y3, Xc+X4, Yc+Y4) Else - Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad, - Xc+X4, Yc+Y4, Xc+X3, Yc+Y3); { Draw arc } - If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context } - Dc := ODc; { Reset held context } - End; - {$ENDIF} - {$ENDIF NOT_IMPLEMENTED} -END; - -{--TView--------------------------------------------------------------------} -{ BiColorRectangle -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB } -{---------------------------------------------------------------------------} -PROCEDURE TView.BicolorRectangle (X1, Y1, X2, Y2: Sw_Integer; Light, Dark: Byte; -Down: Boolean); -VAR UpperLeft, RightDown: Byte; -BEGIN - If Down Then Begin - UpperLeft := Dark; { Dark upper left } - RightDown := Light; { Light down } - End Else Begin - UpperLeft := Light; { Light upper left } - RightDown := Dark; { Dark down } - End; - GraphLine(X1, Y1, X1, Y2, UpperLeft); { Draw left side } - GraphLine(X1, Y1, X2, Y1, UpperLeft); { Draw top line } - GraphLine(X1, Y2, X2, Y2, RightDown); { Draw bottom line } - GraphLine(X2, Y1, X2, Y2, RightDown); { Draw right line } -END; - PROCEDURE TView.WriteBuf (X, Y, W, H: Sw_Integer; Var Buf); VAR I, J, K, L, CW: Sw_Integer; P: PDrawBuffer; Tix, Tiy: Sw_Integer; ViewPort: ViewPortType; @@ -4890,41 +4412,18 @@ BEGIN then begin P := @TDrawBuffer(Buf); { Set draw buffer ptr } L := 0; { Set buffer position } - If (X >= 0) AND (Y >= 0) AND ((GOptions and (goGraphical or goGraphView))=0) Then Begin - X := RawOrigin.X+X*FontWidth; { X position } - Y := RawOrigin.Y+Y*FontHeight; { Y position } + If (X >= 0) AND (Y >= 0) Then Begin + X := Origin.X+X; { X position } + Y := Origin.Y+Y; { Y position } End Else Begin - X := RawOrigin.X + Abs(X); - Y := RawOrigin.Y + Abs(Y); - End; - If TextModeGFV or UseFixedFont then Begin - X := X DIV SysFontWidth; - Y := Y DIV SysFontHeight; - End; - GetViewSettings(ViewPort, TextModeGFV); { Get current viewport } - If not TextModeGFV and not UseFixedFont then Begin - X := X - ViewPort.X1; { Calc x position } - Y := Y - ViewPort.Y1; { Calc y position } + X := Origin.X + Abs(X); + Y := Origin.Y + Abs(Y); End; + GetViewSettings(ViewPort); { Get current viewport } For J := 1 To H Do Begin { For each line } - If (TextModeGFV) or UseFixedFont 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 } - Inc(K,Cw); - Inc(L); { Next character } - End; - Y := Y + SysFontHeight; { Next line down } - end; + WriteAbs(X,Y,W,P^[L]); + Inc(Y); + Inc(L,W); DrawScreenBuf; End; end; @@ -4939,45 +4438,19 @@ BEGIN (State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed } then begin P := @TDrawBuffer(Buf); { Set draw buffer ptr } - If (X >= 0) AND (Y >= 0) AND ((GOptions and (goGraphical or goGraphView))=0) Then Begin - X := RawOrigin.X+X*FontWidth; { X position } - Y := RawOrigin.Y+Y*FontHeight; { Y position } + If (X >= 0) AND (Y >= 0) Then Begin + X := Origin.X+X; { X position } + Y := Origin.Y+Y; { Y position } End Else Begin - X := RawOrigin.X + Abs(X); - Y := RawOrigin.Y + Abs(Y); - End; - If TextModeGFV or UseFixedFont then Begin - X := X DIV SysFontWidth; - Y := Y DIV SysFontHeight; - End; - GetViewSettings(ViewPort, TextModeGFV); { Get current viewport } - If not TextModeGFV and not UseFixedFont then Begin - X := X - ViewPort.X1; { Calc x position } - Y := Y - ViewPort.Y1; { Calc y position } + X := Origin.X + Abs(X); + Y := Origin.Y + Abs(Y); End; + GetViewSettings(ViewPort); { Get current viewport } For J := 1 To H Do Begin { For each line } - If (TextModeGFV) or UseFixedFont 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 } -{$IFDEF GRAPH_API} - SetTextJustify(LeftText,TopText); -{$ENDIF GRAPH_API} - OutTextXY(K, Y+2, Chr(Lo(P^[I]))); { Write text char } - Inc(K,Cw); - End; - Y := Y + SysFontHeight; { Next line down } - End; + WriteAbs(X,Y,W,P^); + Inc(Y); end; - If TextModeGFV or UseFixedFont then - DrawScreenBuf; + DrawScreenBuf; End; END; @@ -4986,13 +4459,8 @@ END; {---------------------------------------------------------------------------} PROCEDURE TView.MakeLocal (Source: TPoint; Var Dest: TPoint); BEGIN - If (Options AND ofGFVModeView <> 0) Then Begin { GFV MODE TVIEW } - Dest.X := (Source.X-RawOrigin.X) DIV FontWidth; { Local x value } - Dest.Y := (Source.Y-RawOrigin.Y) DIV FontHeight; { Local y value } - End Else Begin { OLD MODE TVIEW } - Dest.X := Source.X - Origin.X; { Local x value } - Dest.Y := Source.Y - Origin.Y; { Local y value } - End; + Dest.X := Source.X - Origin.X; { Local x value } + Dest.Y := Source.Y - Origin.Y; { Local y value } END; {--TView--------------------------------------------------------------------} @@ -5000,13 +4468,8 @@ END; {---------------------------------------------------------------------------} PROCEDURE TView.MakeGlobal (Source: TPoint; Var Dest: TPoint); BEGIN - If (Options AND ofGFVModeView <> 0) Then Begin { GFV MODE TVIEW } - Dest.X := Source.X*FontWidth + RawOrigin.X; { Global x value } - Dest.Y := Source.Y*FontHeight + RawOrigin.Y; { Global y value } - End Else Begin { OLD MODE TVIEW } - Dest.X := Source.X + Origin.X; { Global x value } - Dest.Y := Source.Y + Origin.Y; { Global y value } - End; + Dest.X := Source.X + Origin.X; { Global x value } + Dest.Y := Source.Y + Origin.Y; { Global y value } END; PROCEDURE TView.WriteCStr (X, Y: Sw_Integer; Str: String; Color1, Color2 : Byte); @@ -5039,40 +4502,31 @@ BEGIN Fc := B; End; - If (X >= 0) AND (Y >= 0) AND ((GOptions and goGraphView)=0) Then Begin - Xw := RawOrigin.X+X*FontWidth; { X position } - Yw := RawOrigin.Y+Y*FontHeight; { Y position } + If (X >= 0) AND (Y >= 0) Then Begin + Xw := Origin.X+X; { X position } + Yw := Origin.Y+Y; { Y position } End Else Begin - Xw := RawOrigin.X + Abs(X); - Yw := RawOrigin.Y + Abs(Y); + Xw := Origin.X + Abs(X); + Yw := Origin.Y + Abs(Y); End; - GetViewSettings(ViewPort, TextModeGFV); + GetViewSettings(ViewPort); - If not TextModeGFV and not UseFixedFont Then Begin { GRAPHICAL MODE GFV } - SetFillStyle(SolidFill, Bc); { Set fill style } - Bar(Xw-ViewPort.X1, Yw-ViewPort.Y1, - Xw-ViewPort.X1+Length(Str)*FontWidth, - Yw-ViewPort.Y1+FontHeight-1); - SetColor(Fc); - OutTextXY(Xw-ViewPort.X1, Yw-ViewPort.Y1+2, Copy(Str,j,i-j));{ Write text char } - End Else Begin { TEXT MODE GFV } - Tix := Xw DIV SysFontWidth; - Tiy := Yw DIV SysFontHeight; - TiBuf := 0; - For Ti := j To i-1 Do Begin - Buf[TiBuf]:=((Fc or (Bc shl 4)) shl 8) or Ord(Str[Ti]); - inc(TiBuf); - end; - WriteAbs(Tix,TiY,i-j,Buf); - End; + Tix := Xw; + Tiy := Yw; + TiBuf := 0; + For Ti := j To i-1 Do Begin + Buf[TiBuf]:=((Fc or (Bc shl 4)) shl 8) or Ord(Str[Ti]); + inc(TiBuf); + end; + WriteAbs(Tix,TiY,i-j,Buf); { increase position on screen } - If (X >= 0) AND (Y >= 0) AND ((GOptions and goGraphView)=0) Then + If (X >= 0) AND (Y >= 0) Then inc(X,(i-j)) else if X>0 then - inc(X,(i-j)*FontWidth) + inc(X,(i-j)) else - dec(X,(i-j)*FontWidth); + dec(X,(i-j)); { Swap colors } if FoundSwap then begin @@ -5088,8 +4542,7 @@ BEGIN end; until not FoundSwap; - If TextModeGFV then - DrawScreenBuf; + DrawScreenBuf; End; END; @@ -5113,31 +4566,21 @@ BEGIN Fc := B; End; - 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 } + If (X >= 0) AND (Y >= 0) Then Begin + X := Origin.X+X; { X position } + Y := Origin.Y+Y; { Y position } End Else Begin - X := RawOrigin.X + Abs(X); - Y := RawOrigin.Y + Abs(Y); + X := Origin.X + Abs(X); + Y := Origin.Y + Abs(Y); End; - GetViewSettings(ViewPort, TextModeGFV); - If not TextModeGFV and not UseFixedFont Then Begin { GRAPHICAL MODE GFV } - SetFillStyle(SolidFill, Bc); { Set fill style } - Bar(X-ViewPort.X1, Y-ViewPort.Y1, - X-ViewPort.X1+Length(Str)*FontWidth, - Y-ViewPort.Y1+FontHeight-1); - SetColor(Fc); - OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1+2, Str);{ Write text char } - End Else Begin { TEXT MODE GFV } - Tix := X DIV SysFontWidth; - Tiy := Y DIV SysFontHeight; - For Ti := 1 To length(Str) Do Begin - Buf[Ti-1]:=(GetColor(Color) shl 8) or Ord(Str[Ti]); - end; - WriteAbs(Tix,TiY,Length(Str),Buf); - End; - If TextModeGFV or UseFixedFont then - DrawScreenBuf; + GetViewSettings(ViewPort); + Tix := X; + Tiy := Y; + For Ti := 1 To length(Str) Do Begin + Buf[Ti-1]:=(GetColor(Color) shl 8) or Ord(Str[Ti]); + end; + WriteAbs(Tix,TiY,Length(Str),Buf); + DrawScreenBuf; End; END; @@ -5148,7 +4591,7 @@ VAR Fc, Bc, B: Byte; I, Ti, Tix, Tiy: Sw_Integer; Col: Word; S: String; ViewPort BEGIN If (State AND sfVisible <> 0) AND { View visible } (State AND sfExposed <> 0) Then Begin { View exposed } - GetViewSettings(ViewPort, TextModeGFV); + GetViewSettings(ViewPort); Col := GetColor(Color); { Get view color } Fc := Col AND $0F; { Foreground colour } Bc := Col AND $F0 SHR 4; { Background colour } @@ -5159,40 +4602,27 @@ BEGIN Fc := B; End; - 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 } + If (X >= 0) AND (Y >= 0) Then Begin + X := Origin.X+X; { X position } + Y := Origin.Y+Y; { Y position } End Else Begin - X := RawOrigin.X + Abs(X); - Y := RawOrigin.Y + Abs(Y); + X := Origin.X + Abs(X); + Y := Origin.Y + Abs(Y); End; FillChar(S[1], 255, C); { Fill the string } While (Count>0) Do Begin If (Count>Size.X) Then I := Size.X Else I := Count; { Size to make } S[0] := Chr(I); { Set string length } - If not TextModeGFV and not UseFixedFont Then Begin { GRAPHICAL MODE GFV } - SetFillStyle(SolidFill, Bc); { Set fill style } - Bar(X-ViewPort.X1, Y-ViewPort.Y1, - X-ViewPort.X1+I*FontWidth, - Y-ViewPort.Y1+FontHeight-1); - SetColor(Fc); - OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1+2, S); { Write text char } - End Else Begin { TEXT MODE GFV } - Tix := X DIV SysFontWidth; - Tiy := Y DIV SysFontHeight; - 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); + Tix := X; + Tiy := Y; + 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); Count := Count - I; { Subtract count } - If TextModeGFV or UseFixedFont then - X := X + I { Move x position } - else - X := X + I*FontWidth; { Move x position } + X := X + I { Move x position } End; - If TextModeGFV or UseFixedFont then - DrawScreenBuf; + DrawScreenBuf; End; END; @@ -5216,7 +4646,7 @@ BEGIN End; {$endif DEBUG} { Direct wrong method } - GetViewSettings(ViewPort, TextModeGFV or UseFixedFont); { Get set viewport } + GetViewSettings(ViewPort); { Get set viewport } { Pedestrian character method } { Must be in area } If (X+L0) Then Begin If (Owner<>Nil) Then Begin Dec(Mouse.X, Owner^.Origin.X); { Sub owner x origin } @@ -5456,20 +4878,7 @@ BEGIN Mouse.Y := Mouse.Y+Q.Y-Origin.Y; End; HideMouseCursor; { Hide the mouse } - if not TextModeGFV then - begin - SetWriteMode(XORPut, TextModeGFV); - GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red); - SetWriteMode(NormalPut, TextModeGFV); - MoveGrow(R, Mouse); { Resize the view } - SetWriteMode(XORPut, TextModeGFV); - GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red); - SetWriteMode(NormalPut, TextModeGFV); - end - else - begin - MoveGrow(R, Mouse); { Resize the view } - end; + MoveGrow(R, Mouse); { Resize the view } ShowMouseCursor; { Show the mouse } Until NOT MouseEvent(Event, evMouseMove); { Finished moving } State := PState; { Restore view state } @@ -5507,17 +4916,6 @@ BEGIN SetState(sfDragging, False); { Clr dragging flag } END; -FUNCTION TView.FontWidth: Sw_Integer; -BEGIN - FontWidth := SysFontWidth; -END; - -FUNCTION TView.FontHeight: Sw_Integer; -BEGIN - FontHeight := SysFontHeight; -END; - - {***************************************************************************} { TScroller OBJECT METHODS } @@ -5633,19 +5031,8 @@ VAR Fc, Bc: Byte; X, Y: Sw_Integer; S: String; BEGIN Fc := GetColor(2) AND $0F; { Foreground colour } Bc := (GetColor(2) AND $70) SHR 4; { Background colour } - If TextModeGFV then - Y:=0 else - begin - Y:=0; - (* If (Options AND ofFramed<>0) Then Y := 1 - Else Y := 0; { Initial value } - If (GOptions AND goThickFramed<>0) Then Inc(Y, 3); { Adjust position } - *) - end; - ClearArea(0, Y, RawSize.X, Y+FontHeight-1, Bc); { Clear background } - If not TextModeGFV then - Inherited DrawBorder - Else Begin { TEXT GFV MODE } + Y:=0; + ClearArea(0, Y, Size.X, Y, Bc); { Clear background } {Focused:=(State AND (sfSelected + sfModal)<>0); if Assigned(Owner) then Focused := Focused AND (@Self = Owner^.Current); } @@ -5685,23 +5072,12 @@ BEGIN 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; - If not TextModeGFV then - GOptions := GOptions OR goGraphView; { Graphics co-ords mode } If (Title<>Nil) AND (GOptions AND goTitled<>0) Then Begin { View has a title } - GetViewSettings(ViewPort, TextModeGFV); - X := (RawSize.X DIV 2); { Half way point } - X := X - ((Length(Title^)+2)*FontWidth) DIV 2; { Calc start point } - If (TextModeGFV <> TRUE) Then Begin { GRAPHICS MODE GFV } - (* SetColor(Fc); - OutTextXY(RawOrigin.X+X-ViewPort.X1, - RawOrigin.Y+Y+1-ViewPort.Y1+2, ' '+Title^+' '); { Write the title }*) - WriteStr(X,Y+1,' '+Title^+' ',Color); - - End Else Begin { LEON??? } - WriteStr(X div SysFontWidth,0,' '+Title^+' ',Color); - End; + GetViewSettings(ViewPort); + X := (Size.X DIV 2); { Half way point } + X := X - ((Length(Title^)+2)) DIV 2; { Calc start point } + WriteStr(X ,0,' '+Title^+' ',Color); End; If (Number>0) AND (Number<10) Then Begin { Valid number } Str(Number, S); { Make number string } @@ -5709,24 +5085,10 @@ BEGIN I:=7 else I:=3; - If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV } - (* SetColor(GetColor(2) AND $0F); - OutTextXY(RawOrigin.X+RawSize.X-I*FontWidth-ViewPort.X1, - RawOrigin.Y+Y+1-ViewPort.Y1+2, S); { Write number } *) - WriteCStr(RawSize.X-I*FontWidth,Y+1,S,1,Color); - End Else Begin { LEON ????? } - WriteCStr(Size.X-I,0,S,1,Color); - End; + WriteCStr(Size.X-I,0,S,1,Color); End; If Focused and (Flags AND wfClose<>0) Then Begin { Close icon request } - If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV } - (*SetColor(Fc); - OutTextXY(RawOrigin.X+Y+FontWidth-ViewPort.X1, - RawOrigin.Y+Y+1-ViewPort.Y1+2, '[*]'); { Write close icon } *) - WriteCStr(2*FontWidth,Y+1,'[~'+ClickC[LowAscii]+'~]', 2, 3); - End Else Begin { LEON??? } - WriteCStr(2,0,'[~'+ClickC[LowAscii]+'~]', 2, 3); - End; + WriteCStr(2,0,'[~'+ClickC[LowAscii]+'~]', 2, 3); End; If Focused and (Flags AND wfZoom<>0) Then Begin if assigned(Owner) and @@ -5734,25 +5096,9 @@ BEGIN C:=RestoreC[LowAscii] else C:=LargeC[LowAscii]; - If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV } - (* SetColor(GetColor(2) AND $0F); - OutTextXY(RawOrigin.X+RawSize.X-4*FontWidth-Y-ViewPort.X1, - RawOrigin.Y+Y+1-ViewPort.Y1+2, '['+C+']'); { Write zoom icon } *) - WriteCStr(RawSize.X-5*FontWidth,Y+1,'[~'+C+'~]', 2, 3); - WriteCStr(RawSize.X-2*FontWidth,RawSize.Y-FontHeight+Y+1,'~ÄÙ~',2, 3); - End Else Begin { LEON??? } - WriteCStr(Size.X-5,0,'[~'+C+'~]', 2, 3); - WriteCStr(Size.X-2,Size.Y-1,'~ÄÙ~',2, 3); - End; + WriteCStr(Size.X-5,0,'[~'+C+'~]', 2, 3); + WriteCStr(Size.X-2,Size.Y-1,'~ÄÙ~',2, 3); End; - If not TextModeGFV then - begin - BiColorRectangle(Y+1, Y+1, RawSize.X-Y-1, Y+FontHeight, - White, DarkGray, False); { Draw 3d effect } - BiColorRectangle(Y+1, Y+1, RawSize.X-Y-2, Y+FontHeight-1, - White, DarkGray, False); { Draw 3d effect } - GOptions := GOptions AND NOT goGraphView; { Return to normal mode } - end; { Ensure that the scrollers are repainted } NP:=Last; while assigned(NP) do @@ -5762,14 +5108,14 @@ BEGIN (NP^.Origin.X>=Origin.X+Size.X) or (NP^.Origin.Y>=Origin.Y+Size.Y) then begin - NP^.ReDrawArea(RawOrigin.X,RawOrigin.Y, - RawOrigin.X+FontWidth*Size.X,RawOrigin.Y+FontHeight); - NP^.ReDrawArea(RawOrigin.X,RawOrigin.Y+FontHeight*(Size.Y-1), - RawOrigin.X+FontWidth*Size.X,RawOrigin.Y+FontHeight*Size.Y); - NP^.ReDrawArea(RawOrigin.X,RawOrigin.Y+FontHeight, - RawOrigin.X+FontWidth,RawOrigin.Y+FontHeight*(Size.Y-1)); - NP^.ReDrawArea(RawOrigin.X+FontWidth*(Size.X-1),RawOrigin.Y+FontHeight, - RawOrigin.X+FontWidth*Size.X,RawOrigin.Y+FontHeight*(Size.Y-1)); + NP^.ReDrawArea(Origin.X,Origin.Y, + Origin.X+Size.X,Origin.Y+1); + NP^.ReDrawArea(Origin.X,Origin.Y+(Size.Y-1), + Origin.X+Size.X,Origin.Y+Size.Y); + NP^.ReDrawArea(Origin.X,Origin.Y+1, + Origin.X+1,Origin.Y+(Size.Y-1)); + NP^.ReDrawArea(Origin.X+(Size.X-1),Origin.Y+1, + Origin.X+Size.X,Origin.Y+(Size.Y-1)); end; NP:=NP^.Prevview; end; @@ -5866,7 +5212,10 @@ END. { $Log$ - Revision 1.43 2004-11-03 12:09:08 peter + Revision 1.44 2004-11-03 20:33:05 peter + * removed unnecesasry graphfv stuff + + Revision 1.43 2004/11/03 12:09:08 peter * textwidth doesn't support ~ anymore, added CTextWidth with ~ support Revision 1.42 2004/11/03 10:37:24 peter diff --git a/fv/win32gr.pas b/fv/win32gr.pas deleted file mode 100644 index 54b70dbec5..0000000000 --- a/fv/win32gr.pas +++ /dev/null @@ -1,836 +0,0 @@ -{ - $Id$ - Copyright (c) 2002 by Pierre Muller - - This unit implements an the hooks needed for the win32 graph unit. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit win32gr; - -interface - -procedure SetGraphHooks; - -procedure UnsetGraphHooks; - -implementation - -uses - windows, - drivers, - graph; - - -var - InputHandle : Handle; - StoredControlKeyState : longint; - lastir : INPUT_RECORD; - -const - StoredChar : boolean = false; - - -const - KeyToAsciiCode : array [0..255] of char = - ( - { 00 } #0, - { 01 VK_LBUTTON } #0, - { 02 VK_RBUTTON } #0, - { 03 VK_CANCEL } #0, - { 04 VK_MBUTTON } #0, - { 05 unassigned } #0, - { 06 unassigned } #0, - { 07 unassigned } #0, - { 08 VK_BACK } #8, - { 09 VK_TAB } #9, - { 0A unassigned } #0, - { 0B unassigned } #0, - { 0C VK_CLEAR ?? } #0, - { 0D VK_RETURN } #13, - { 0E unassigned } #0, - { 0F unassigned } #0, - { 10 VK_SHIFT } #0, - { 11 VK_CONTROL } #0, - { 12 VK_MENU (Alt key) } #0, - { 13 VK_PAUSE } #0, - { 14 VK_CAPITAL (Caps Lock) } #0, - { 15 Reserved for Kanji systems} #0, - { 16 Reserved for Kanji systems} #0, - { 17 Reserved for Kanji systems} #0, - { 18 Reserved for Kanji systems} #0, - { 19 Reserved for Kanji systems} #0, - { 1A unassigned } #0, - { 1B VK_ESCAPE } #27, - { 1C Reserved for Kanji systems} #0, - { 1D Reserved for Kanji systems} #0, - { 1E Reserved for Kanji systems} #0, - { 1F Reserved for Kanji systems} #0, - { 20 VK_SPACE} ' ', - { 21 VK_PRIOR (PgUp) } #0, - { 22 VK_NEXT (PgDown) } #0, - { 23 VK_END } #0, - { 24 VK_HOME } #0, - { 25 VK_LEFT } #0, - { 26 VK_UP } #0, - { 27 VK_RIGHT } #0, - { 28 VK_DOWN } #0, - { 29 VK_SELECT ??? } #0, - { 2A OEM specific !! } #0, - { 2B VK_EXECUTE } #0, - { 2C VK_SNAPSHOT } #0, - { 2D VK_INSERT } #0, - { 2E VK_DELETE } #0, - { 2F VK_HELP } #0, - { 30 VK_0 '0' } '0', - { 31 VK_1 '1' } '1', - { 32 VK_2 '2' } '2', - { 33 VK_3 '3' } '3', - { 34 VK_4 '4' } '4', - { 35 VK_5 '5' } '5', - { 36 VK_6 '6' } '6', - { 37 VK_7 '7' } '7', - { 38 VK_8 '8' } '8', - { 39 VK_9 '9' } '9', - { 3A unassigned } #0, - { 3B unassigned } #0, - { 3C unassigned } #0, - { 3D unassigned } #0, - { 3E unassigned } #0, - { 3F unassigned } #0, - { 40 unassigned } #0, - { 41 VK_A 'A' } 'A', - { 42 VK_B 'B' } 'B', - { 43 VK_C 'C' } 'C', - { 44 VK_D 'D' } 'D', - { 45 VK_E 'E' } 'E', - { 46 VK_F 'F' } 'F', - { 47 VK_G 'G' } 'G', - { 48 VK_H 'H' } 'H', - { 49 VK_I 'I' } 'I', - { 4A VK_J 'J' } 'J', - { 4B VK_K 'K' } 'K', - { 4C VK_L 'L' } 'L', - { 4D VK_M 'M' } 'M', - { 4E VK_N 'N' } 'N', - { 4F VK_O 'O' } 'O', - { 50 VK_P 'P' } 'P', - { 51 VK_Q 'Q' } 'Q', - { 52 VK_R 'R' } 'R', - { 53 VK_S 'S' } 'S', - { 54 VK_T 'T' } 'T', - { 55 VK_U 'U' } 'U', - { 56 VK_V 'V' } 'V', - { 57 VK_W 'W' } 'W', - { 58 VK_X 'X' } 'X', - { 59 VK_Y 'Y' } 'Y', - { 5A VK_Z 'Z' } 'Z', - { 5B unassigned } #0, - { 5C unassigned } #0, - { 5D unassigned } #0, - { 5E unassigned } #0, - { 5F unassigned } #0, - { 60 VK_NUMPAD0 NumKeyPad '0' } '0', - { 61 VK_NUMPAD1 NumKeyPad '1' } '1', - { 62 VK_NUMPAD2 NumKeyPad '2' } '2', - { 63 VK_NUMPAD3 NumKeyPad '3' } '3', - { 64 VK_NUMPAD4 NumKeyPad '4' } '4', - { 65 VK_NUMPAD5 NumKeyPad '5' } '5', - { 66 VK_NUMPAD6 NumKeyPad '6' } '6', - { 67 VK_NUMPAD7 NumKeyPad '7' } '7', - { 68 VK_NUMPAD8 NumKeyPad '8' } '8', - { 69 VK_NUMPAD9 NumKeyPad '9' } '9', - { 6A VK_MULTIPLY } #0, - { 6B VK_ADD } #0, - { 6C VK_SEPARATOR } #0, - { 6D VK_SUBSTRACT } #0, - { 6E VK_DECIMAL } #0, - { 6F VK_DIVIDE } #0, - { 70 VK_F1 'F1' } #0, - { 71 VK_F2 'F2' } #0, - { 72 VK_F3 'F3' } #0, - { 73 VK_F4 'F4' } #0, - { 74 VK_F5 'F5' } #0, - { 75 VK_F6 'F6' } #0, - { 76 VK_F7 'F7' } #0, - { 77 VK_F8 'F8' } #0, - { 78 VK_F9 'F9' } #0, - { 79 VK_F10 'F10' } #0, - { 7A VK_F11 'F11' } #0, - { 7B VK_F12 'F12' } #0, - { 7C VK_F13 } #0, - { 7D VK_F14 } #0, - { 7E VK_F15 } #0, - { 7F VK_F16 } #0, - { 80 VK_F17 } #0, - { 81 VK_F18 } #0, - { 82 VK_F19 } #0, - { 83 VK_F20 } #0, - { 84 VK_F21 } #0, - { 85 VK_F22 } #0, - { 86 VK_F23 } #0, - { 87 VK_F24 } #0, - { 88 unassigned } #0, - { 89 VK_NUMLOCK } #0, - { 8A VK_SCROLL } #0, - { 8B unassigned } #0, - { 8C unassigned } #0, - { 8D unassigned } #0, - { 8E unassigned } #0, - { 8F unassigned } #0, - { 90 unassigned } #0, - { 91 unassigned } #0, - { 92 unassigned } #0, - { 93 unassigned } #0, - { 94 unassigned } #0, - { 95 unassigned } #0, - { 96 unassigned } #0, - { 97 unassigned } #0, - { 98 unassigned } #0, - { 99 unassigned } #0, - { 9A unassigned } #0, - { 9B unassigned } #0, - { 9C unassigned } #0, - { 9D unassigned } #0, - { 9E unassigned } #0, - { 9F unassigned } #0, - { A0 unassigned } #0, - { A1 unassigned } #0, - { A2 unassigned } #0, - { A3 unassigned } #0, - { A4 unassigned } #0, - { A5 unassigned } #0, - { A6 unassigned } #0, - { A7 unassigned } #0, - { A8 unassigned } #0, - { A9 unassigned } #0, - { AA unassigned } #0, - { AB unassigned } #0, - { AC unassigned } #0, - { AD unassigned } #0, - { AE unassigned } #0, - { AF unassigned } #0, - { B0 unassigned } #0, - { B1 unassigned } #0, - { B2 unassigned } #0, - { B3 unassigned } #0, - { B4 unassigned } #0, - { B5 unassigned } #0, - { B6 unassigned } #0, - { B7 unassigned } #0, - { B8 unassigned } #0, - { B9 unassigned } #0, - { BA OEM specific } #0, - { BB OEM specific } #0, - { BC OEM specific } #0, - { BD OEM specific } #0, - { BE OEM specific } #0, - { BF OEM specific } #0, - { C0 OEM specific } #0, - { C1 unassigned } #0, - { C2 unassigned } #0, - { C3 unassigned } #0, - { C4 unassigned } #0, - { C5 unassigned } #0, - { C6 unassigned } #0, - { C7 unassigned } #0, - { C8 unassigned } #0, - { C9 unassigned } #0, - { CA unassigned } #0, - { CB unassigned } #0, - { CC unassigned } #0, - { CD unassigned } #0, - { CE unassigned } #0, - { CF unassigned } #0, - { D0 unassigned } #0, - { D1 unassigned } #0, - { D2 unassigned } #0, - { D3 unassigned } #0, - { D4 unassigned } #0, - { D5 unassigned } #0, - { D6 unassigned } #0, - { D7 unassigned } #0, - { D8 unassigned } #0, - { D9 unassigned } #0, - { DA unassigned } #0, - { DB OEM specific } #0, - { DC OEM specific } #0, - { DD OEM specific } #0, - { DE OEM specific } #0, - { DF OEM specific } #0, - { E0 OEM specific } #0, - { E1 OEM specific } #0, - { E2 OEM specific } #0, - { E3 OEM specific } #0, - { E4 OEM specific } #0, - { E5 unassigned } #0, - { E6 OEM specific } #0, - { E7 unassigned } #0, - { E8 unassigned } #0, - { E9 OEM specific } #0, - { EA OEM specific } #0, - { EB OEM specific } #0, - { EC OEM specific } #0, - { ED OEM specific } #0, - { EE OEM specific } #0, - { EF OEM specific } #0, - { F0 OEM specific } #0, - { F1 OEM specific } #0, - { F2 OEM specific } #0, - { F3 OEM specific } #0, - { F4 OEM specific } #0, - { F5 OEM specific } #0, - { F6 unassigned } #0, - { F7 unassigned } #0, - { F8 unassigned } #0, - { F9 unassigned } #0, - { FA unassigned } #0, - { FB unassigned } #0, - { FC unassigned } #0, - { FD unassigned } #0, - { FE unassigned } #0, - { FF unassigned } #0 - ); - KeyToQwertyScan : array [0..255] of byte = - ( - { 00 } 0, - { 01 VK_LBUTTON } 0, - { 02 VK_RBUTTON } 0, - { 03 VK_CANCEL } 0, - { 04 VK_MBUTTON } 0, - { 05 unassigned } 0, - { 06 unassigned } 0, - { 07 unassigned } 0, - { 08 VK_BACK } $E, - { 09 VK_TAB } $F, - { 0A unassigned } 0, - { 0B unassigned } 0, - { 0C VK_CLEAR ?? } 0, - { 0D VK_RETURN } $1C, - { 0E unassigned } 0, - { 0F unassigned } 0, - { 10 VK_SHIFT } 0, - { 11 VK_CONTROL } 0, - { 12 VK_MENU (Alt key) } 0, - { 13 VK_PAUSE } 0, - { 14 VK_CAPITAL (Caps Lock) } 0, - { 15 Reserved for Kanji systems} 0, - { 16 Reserved for Kanji systems} 0, - { 17 Reserved for Kanji systems} 0, - { 18 Reserved for Kanji systems} 0, - { 19 Reserved for Kanji systems} 0, - { 1A unassigned } 0, - { 1B VK_ESCAPE } $1, - { 1C Reserved for Kanji systems} 0, - { 1D Reserved for Kanji systems} 0, - { 1E Reserved for Kanji systems} 0, - { 1F Reserved for Kanji systems} 0, - { 20 VK_SPACE} $39, - { 21 VK_PRIOR (PgUp) } $49, - { 22 VK_NEXT (PgDown) } $51, - { 23 VK_END } $4F, - { 24 VK_HOME } $47, - { 25 VK_LEFT } $4B, - { 26 VK_UP } $48, - { 27 VK_RIGHT } $4D, - { 28 VK_DOWN } $50, - { 29 VK_SELECT ??? } 0, - { 2A OEM specific !! } 0, - { 2B VK_EXECUTE } 0, - { 2C VK_SNAPSHOT } 0, - { 2D VK_INSERT } $52, - { 2E VK_DELETE } $53, - { 2F VK_HELP } 0, - { 30 VK_0 '0' } 11, - { 31 VK_1 '1' } 2, - { 32 VK_2 '2' } 3, - { 33 VK_3 '3' } 4, - { 34 VK_4 '4' } 5, - { 35 VK_5 '5' } 6, - { 36 VK_6 '6' } 7, - { 37 VK_7 '7' } 8, - { 38 VK_8 '8' } 9, - { 39 VK_9 '9' } 10, - { 3A unassigned } 0, - { 3B unassigned } 0, - { 3C unassigned } 0, - { 3D unassigned } 0, - { 3E unassigned } 0, - { 3F unassigned } 0, - { 40 unassigned } 0, - { 41 VK_A 'A' } $1E, - { 42 VK_B 'B' } $30, - { 43 VK_C 'C' } $2E, - { 44 VK_D 'D' } $20, - { 45 VK_E 'E' } $12, - { 46 VK_F 'F' } $21, - { 47 VK_G 'G' } $22, - { 48 VK_H 'H' } $23, - { 49 VK_I 'I' } $17, - { 4A VK_J 'J' } $24, - { 4B VK_K 'K' } $25, - { 4C VK_L 'L' } $26, - { 4D VK_M 'M' } $32, - { 4E VK_N 'N' } $31, - { 4F VK_O 'O' } $18, - { 50 VK_P 'P' } $19, - { 51 VK_Q 'Q' } $10, - { 52 VK_R 'R' } $13, - { 53 VK_S 'S' } $1F, - { 54 VK_T 'T' } $14, - { 55 VK_U 'U' } $16, - { 56 VK_V 'V' } $2F, - { 57 VK_W 'W' } $11, - { 58 VK_X 'X' } $2D, - { 59 VK_Y 'Y' } $15, - { 5A VK_Z 'Z' } $2C, - { 5B unassigned } 0, - { 5C unassigned } 0, - { 5D unassigned } 0, - { 5E unassigned } 0, - { 5F unassigned } 0, - { 60 VK_NUMPAD0 NumKeyPad '0' } 11, - { 61 VK_NUMPAD1 NumKeyPad '1' } 2, - { 62 VK_NUMPAD2 NumKeyPad '2' } 3, - { 63 VK_NUMPAD3 NumKeyPad '3' } 4, - { 64 VK_NUMPAD4 NumKeyPad '4' } 5, - { 65 VK_NUMPAD5 NumKeyPad '5' } 6, - { 66 VK_NUMPAD6 NumKeyPad '6' } 7, - { 67 VK_NUMPAD7 NumKeyPad '7' } 8, - { 68 VK_NUMPAD8 NumKeyPad '8' } 9, - { 69 VK_NUMPAD9 NumKeyPad '9' } 10, - { 6A VK_MULTIPLY } 0, - { 6B VK_ADD } 0, - { 6C VK_SEPARATOR } 0, - { 6D VK_SUBSTRACT } 0, - { 6E VK_DECIMAL } 0, - { 6F VK_DIVIDE } 0, - { 70 VK_F1 'F1' } $3B, - { 71 VK_F2 'F2' } $3C, - { 72 VK_F3 'F3' } $3D, - { 73 VK_F4 'F4' } $3E, - { 74 VK_F5 'F5' } $3F, - { 75 VK_F6 'F6' } $40, - { 76 VK_F7 'F7' } $41, - { 77 VK_F8 'F8' } $42, - { 78 VK_F9 'F9' } $43, - { 79 VK_F10 'F10' } $44, - { 7A VK_F11 'F11' } $57, - { 7B VK_F12 'F12' } $58, - { 7C VK_F13 } 0, - { 7D VK_F14 } 0, - { 7E VK_F15 } 0, - { 7F VK_F16 } 0, - { 80 VK_F17 } 0, - { 81 VK_F18 } 0, - { 82 VK_F19 } 0, - { 83 VK_F20 } 0, - { 84 VK_F21 } 0, - { 85 VK_F22 } 0, - { 86 VK_F23 } 0, - { 87 VK_F24 } 0, - { 88 unassigned } 0, - { 89 VK_NUMLOCK } 0, - { 8A VK_SCROLL } 0, - { 8B unassigned } 0, - { 8C unassigned } 0, - { 8D unassigned } 0, - { 8E unassigned } 0, - { 8F unassigned } 0, - { 90 unassigned } 0, - { 91 unassigned } 0, - { 92 unassigned } 0, - { 93 unassigned } 0, - { 94 unassigned } 0, - { 95 unassigned } 0, - { 96 unassigned } 0, - { 97 unassigned } 0, - { 98 unassigned } 0, - { 99 unassigned } 0, - { 9A unassigned } 0, - { 9B unassigned } 0, - { 9C unassigned } 0, - { 9D unassigned } 0, - { 9E unassigned } 0, - { 9F unassigned } 0, - { A0 unassigned } 0, - { A1 unassigned } 0, - { A2 unassigned } 0, - { A3 unassigned } 0, - { A4 unassigned } 0, - { A5 unassigned } 0, - { A6 unassigned } 0, - { A7 unassigned } 0, - { A8 unassigned } 0, - { A9 unassigned } 0, - { AA unassigned } 0, - { AB unassigned } 0, - { AC unassigned } 0, - { AD unassigned } 0, - { AE unassigned } 0, - { AF unassigned } 0, - { B0 unassigned } 0, - { B1 unassigned } 0, - { B2 unassigned } 0, - { B3 unassigned } 0, - { B4 unassigned } 0, - { B5 unassigned } 0, - { B6 unassigned } 0, - { B7 unassigned } 0, - { B8 unassigned } 0, - { B9 unassigned } 0, - { BA OEM specific } 0, - { BB OEM specific } 0, - { BC OEM specific } 0, - { BD OEM specific } 0, - { BE OEM specific } 0, - { BF OEM specific } 0, - { C0 OEM specific } 0, - { C1 unassigned } 0, - { C2 unassigned } 0, - { C3 unassigned } 0, - { C4 unassigned } 0, - { C5 unassigned } 0, - { C6 unassigned } 0, - { C7 unassigned } 0, - { C8 unassigned } 0, - { C9 unassigned } 0, - { CA unassigned } 0, - { CB unassigned } 0, - { CC unassigned } 0, - { CD unassigned } 0, - { CE unassigned } 0, - { CF unassigned } 0, - { D0 unassigned } 0, - { D1 unassigned } 0, - { D2 unassigned } 0, - { D3 unassigned } 0, - { D4 unassigned } 0, - { D5 unassigned } 0, - { D6 unassigned } 0, - { D7 unassigned } 0, - { D8 unassigned } 0, - { D9 unassigned } 0, - { DA unassigned } 0, - { DB OEM specific } 0, - { DC OEM specific } 0, - { DD OEM specific } 0, - { DE OEM specific } 0, - { DF OEM specific } 0, - { E0 OEM specific } 0, - { E1 OEM specific } 0, - { E2 OEM specific } 0, - { E3 OEM specific } 0, - { E4 OEM specific } 0, - { E5 unassigned } 0, - { E6 OEM specific } 0, - { E7 unassigned } 0, - { E8 unassigned } 0, - { E9 OEM specific } 0, - { EA OEM specific } 0, - { EB OEM specific } 0, - { EC OEM specific } 0, - { ED OEM specific } 0, - { EE OEM specific } 0, - { EF OEM specific } 0, - { F0 OEM specific } 0, - { F1 OEM specific } 0, - { F2 OEM specific } 0, - { F3 OEM specific } 0, - { F4 OEM specific } 0, - { F5 OEM specific } 0, - { F6 unassigned } 0, - { F7 unassigned } 0, - { F8 unassigned } 0, - { F9 unassigned } 0, - { FA unassigned } 0, - { FB unassigned } 0, - { FC unassigned } 0, - { FD unassigned } 0, - { FE unassigned } 0, - { FF unassigned } 0 - ); - -{ this procedure allows to hook keyboard messages } -function fvisioncharmessagehandler (Window: hwnd; AMessage, WParam, - LParam: Longint): Longint; -var - ir : INPUT_RECORD; - NumWritten : dword; - vKey : byte; - scancode : integer; - ach, ch : array[0..1] of char; - IsExtended : boolean; -begin - fvisioncharmessagehandler:=0; - if (AMessage = WM_CHAR) or (AMessage = WM_SYSCHAR) then - begin - if StoredChar then - begin - ach[0]:=chr(wparam and $ff); - ach[1]:=#0; - CharToOem(@ach,@ch); -{$ifdef DEBUG} - Write('key ',hexstr(lastir.Event.KeyEvent.wVirtualKeyCode,2)); - Write(' scan ',hexstr(lastir.Event.KeyEvent.wVirtualScanCode,2)); - if lastir.Event.KeyEvent.bKeyDown then - writeln(' pressed') - else - writeln(' released'); - Writeln('char ',ach[0],'(',ch[0],')',' $',hexstr(wparam,2)); -{$endif DEBUG} - Lastir.Event.KeyEvent.AsciiChar:=ch[0]; - WriteConsoleInput(InputHandle,lastir,1,NumWritten); - StoredChar:=false; - end - else - begin -{$ifdef DEBUG} - Writeln('char ',chr(wparam and $ff),' $',hexstr(wparam,2),' ignored'); -{$endif DEBUG} - ach[0]:=chr(wparam and $ff); - ach[1]:=#0; - CharToOem(@ach,@ch); -{$ifdef DEBUG} - Write('key ',hexstr(lastir.Event.KeyEvent.wVirtualKeyCode,2)); - Write(' scan ',hexstr(lastir.Event.KeyEvent.wVirtualScanCode,2)); - if lastir.Event.KeyEvent.bKeyDown then - writeln(' pressed') - else - writeln(' released'); - Writeln('char ',ach[0],'(',ch[0],')',' $',hexstr(wparam,2)); -{$endif DEBUG} - Lastir.Event.KeyEvent.AsciiChar:=ch[0]; - WriteConsoleInput(InputHandle,lastir,1,NumWritten); - StoredChar:=false; - end; - exit; - end; - if StoredChar then - begin -{$ifdef DEBUG} - Write('key ',hexstr(lastir.Event.KeyEvent.wVirtualKeyCode,2)); - Write(' scan ',hexstr(lastir.Event.KeyEvent.wVirtualScanCode,2)); - if lastir.Event.KeyEvent.bKeyDown then - writeln(' pressed') - else - writeln(' released'); - Writeln('char ',ach[0],'(',ch[0],')',' $',hexstr(wparam,2)); -{$endif DEBUG} - WriteConsoleInput(InputHandle,lastir,1,NumWritten); - StoredChar:=false; - end; - fillchar(ir,sizeof(ir),#0); - ir.EventType:=KEY_EVENT; - with ir.Event.KeyEvent do - begin - vKey:=WParam and $ff; - wRepeatCount:=lparam and $ffff; - IsExtended:=(lParam and (1 shl 24))<>0; - if (AMessage = WM_KEYDOWN) or (AMessage = WM_SYSKEYDOWN) then - bKeyDown:=true; - wVirtualKeyCode:=vKey; - AsciiChar:=KeyToAsciiCode[vKey]; - if AsciiChar<>#0 then - begin - { Use lower chars } - if ((StoredControlKeyState and SHIFT_PRESSED)=0) and - ((wVirtualKeyCode>=VK_A) and (wVirtualKeyCode<=VK_Z)) then - AsciiChar:=chr(ord(AsciiChar) + ord('a')-ord('A')); - if bKeyDown then - StoredChar:=true; - end; - scancode:=KeyToQwertyScan[vKey]; - if scancode>0 then - wVirtualScanCode:=scancode; - case vKey of - VK_SHIFT : - if bKeyDown then - StoredControlKeyState:= StoredControlKeyState or SHIFT_PRESSED - else - StoredControlKeyState:= StoredControlKeyState and not SHIFT_PRESSED; - VK_CONTROL : - begin - if IsExtended then - begin - if bKeyDown then - StoredControlKeyState:= StoredControlKeyState or RIGHT_CTRL_PRESSED - else - StoredControlKeyState:= StoredControlKeyState and not RIGHT_CTRL_PRESSED; - end - else if bKeyDown then - StoredControlKeyState:= StoredControlKeyState or LEFT_CTRL_PRESSED - else - StoredControlKeyState:= StoredControlKeyState and not LEFT_CTRL_PRESSED; - end; - VK_MENU : - begin - if IsExtended then - begin - if bKeyDown then - StoredControlKeyState:= StoredControlKeyState or RIGHT_ALT_PRESSED - else - StoredControlKeyState:= StoredControlKeyState and not RIGHT_ALT_PRESSED; - end - else if bKeyDown then - StoredControlKeyState:= StoredControlKeyState or LEFT_ALT_PRESSED - else - StoredControlKeyState:= StoredControlKeyState and not LEFT_ALT_PRESSED; - end; - end; - dwControlKeyState:=StoredControlKeyState; - end; - if not StoredChar then - begin -{$ifdef DEBUG} - Write('key ',hexstr(ir.Event.KeyEvent.wVirtualKeyCode,2)); - Write(' scan ',hexstr(ir.Event.KeyEvent.wVirtualScanCode,2)); - if ir.Event.KeyEvent.bKeyDown then - writeln(' pressed') - else - writeln(' released'); -{$endif DEBUG} - WriteConsoleInput(InputHandle,ir,1,NumWritten); - { still copy for use for special keys not registered } - Lastir:=ir; - end - else - Lastir:=ir; -end; - -{ this procedure allows to hook mouse messages } -function fvisionmousemessagehandler (Window: hwnd; AMessage, WParam, - LParam: Longint): Longint; - -var - ir : INPUT_RECORD; - NumWritten : dword; -begin - fvisionmousemessagehandler:=0; - ir.EventType:=_MOUSE_EVENT; - with ir.Event.MouseEvent do - begin - dwMousePosition.x:=loword(LParam) div SysFontWidth; - dwMousePosition.y:=hiword(LParam) div SysFontHeight; - dwButtonState:=0; - if (wParam and MK_LBUTTON)<>0 then - dwButtonState:=dwButtonState or FROM_LEFT_1ST_BUTTON_PRESSED; - if (wParam and MK_MBUTTON)<>0 then - dwButtonState:=dwButtonState or FROM_LEFT_2ND_BUTTON_PRESSED; - if (wParam and MK_RBUTTON)<>0 then - dwButtonState:=dwButtonState or RIGHTMOST_BUTTON_PRESSED; - end; - WriteConsoleInput(InputHandle,ir,1,NumWritten); -end; - -{$ifdef USE_NEW_WNDPROC} -Const - PreviousWindowProc: WndProc = nil; - -function FvisionWindowProc(Window: HWnd; AMessage, WParam, - LParam: Longint): Longint; stdcall; export; - -begin - case AMessage of - wm_lbuttondown, - wm_rbuttondown, - wm_mbuttondown, - wm_lbuttonup, - wm_rbuttonup, - wm_mbuttonup, - wm_lbuttondblclk, - wm_rbuttondblclk, - wm_mbuttondblclk: - { - This leads to problem, i.e. the menu etc doesn't work any longer - wm_nclbuttondown, - wm_ncrbuttondown, - wm_ncmbuttondown, - wm_nclbuttonup, - wm_ncrbuttonup, - wm_ncmbuttonup, - wm_nclbuttondblclk, - wm_ncrbuttondblclk, - wm_ncmbuttondblclk: - } - { if assigned(mousemessagehandler) then } - FvisionWindowProc:=mousemessagehandler(window,amessage,wparam,lparam); - wm_keydown, - wm_keyup, - wm_syskeydown, - wm_syskeyup, - wm_syschar, - wm_char: - { if assigned(charmessagehandler) then } - FvisionWindowProc:=charmessagehandler(window,amessage,wparam,lparam); - else - FvisionWindowProc:= CallWindowProc(PreviousWindowProc,Window,AMessage,WParam,LParam); - end; -end; -{$endif USE_NEW_WNDPROC} - - -procedure SetGraphHooks; - -begin -{$ifdef USE_NEW_WNDPROC} - If not assigned (PreviousWindowProc) then - PreviousWindowProc:=WndProc(SetWindowLong(MainWindow,GWL_WNDPROC, longint(@fvisionWindowProc))); -{$else not USE_NEW_WNDPROC} - mousemessagehandler:=@fvisionmousemessagehandler; - charmessagehandler:=@fvisioncharmessagehandler; -{$endif USE_NEW_WNDPROC} - InputHandle:=GetStdHandle(STD_INPUT_HANDLE); -end; - -procedure UnsetGraphHooks; - -begin - mousemessagehandler:=nil; - charmessagehandler:=nil; -{$ifdef USE_NEW_WNDPROC} - SetWindowLong(MainWindow,GWL_WNDPROC, longint(PreviousWindowProc)); - PreviousWindowProc:=nil; -{$endif USE_NEW_WNDPROC} - InputHandle:=UnusedHandle; - StoredControlKeyState:=0; -end; - -end. - -{ - $Log$ - Revision 1.6 2003-01-12 23:25:51 pierre - * fix win32 graph version compilation failure - - Revision 1.5 2002/05/31 13:35:33 pierre - * recognize Enter key with kbEnter - - Revision 1.4 2002/05/29 21:20:49 pierre - * better key translations - - Revision 1.3 2002/05/29 19:34:27 pierre - * fix other keys - - Revision 1.2 2002/05/28 19:12:26 pierre - * fix fvisioncharmessage - - Revision 1.1 2002/05/24 09:35:20 pierre - first commit, not fully functional yet - - -}