paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-05 19:10:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revisions 3315-3317,3371,3397-3398,3430,3435,3437,3444,3450,3452,3455,3574,3594,3676-3678,3693,3710,3714,3717,3722-3723,3730-3732,3777-3778,3838-3840,3843 via svnmerge from

Browse Source 
http://peter@svn.freepascal.org/svn/fpc/trunk

........
r3315 | daniel | 2006-04-22 21:53:02 +0200 (Sat, 22 Apr 2006) | 2 lines

  * Editor fixes by Wayne Sherman.

........
r3316 | daniel | 2006-04-22 23:56:38 +0200 (Sat, 22 Apr 2006) | 2 lines

  * Lazarus IDE config file

........
r3317 | daniel | 2006-04-23 09:32:51 +0200 (Sun, 23 Apr 2006) | 2 lines

  * Fix by Wayne Sherman

........
r3371 | daniel | 2006-04-29 22:18:44 +0200 (Sat, 29 Apr 2006) | 2 lines

  * Fix buttons that didn't show.

........
r3397 | daniel | 2006-05-01 13:53:36 +0200 (Mon, 01 May 2006) | 2 lines

  * New test program by Wayne Sherman

........
r3398 | daniel | 2006-05-01 13:57:46 +0200 (Mon, 01 May 2006) | 2 lines

  * Add hotkeys to test menu

........
r3430 | daniel | 2006-05-06 13:02:46 +0200 (Sat, 06 May 2006) | 2 lines

  * Removal of memory unit by Wayne Sherman

........
r3435 | daniel | 2006-05-06 20:40:21 +0200 (Sat, 06 May 2006) | 2 lines

  * Make Tframe codepage aware

........
r3437 | tom_at_work | 2006-05-06 22:03:43 +0200 (Sat, 06 May 2006) | 1 line

* re-added memory to buildfv.pas so that it gets built and a make install works.
........
r3444 | daniel | 2006-05-07 01:10:02 +0200 (Sun, 07 May 2006) | 2 lines

  * Newline for dos/unix shell

........
r3450 | daniel | 2006-05-07 16:02:06 +0200 (Sun, 07 May 2006) | 2 lines

  * it's May, not November :)

........
r3452 | daniel | 2006-05-07 17:56:11 +0200 (Sun, 07 May 2006) | 2 lines

  * Make dosshell work under Unix

........
r3455 | daniel | 2006-05-08 08:39:01 +0200 (Mon, 08 May 2006) | 2 lines

  * Fix by Wayne Sherman to make restore from dosshell work under Win32

........
r3574 | daniel | 2006-05-19 00:10:02 +0200 (Fri, 19 May 2006) | 2 lines

  * Some fixes by Onur Sayman

........
r3594 | florian | 2006-05-20 18:44:59 +0200 (Sat, 20 May 2006) | 2 lines

* removed tfileio from makefile

........
r3676 | daniel | 2006-05-25 23:06:00 +0200 (Thu, 25 May 2006) | 3 lines

  + New implementation of outline.pas.
    Contains some code contrinuted by Onur Sayman.

........
r3677 | daniel | 2006-05-25 23:22:04 +0200 (Thu, 25 May 2006) | 2 lines

  * Fix expandall

........
r3678 | daniel | 2006-05-26 12:13:14 +0200 (Fri, 26 May 2006) | 2 lines

  * Further development.

........
r3693 | daniel | 2006-05-27 15:54:28 +0200 (Sat, 27 May 2006) | 2 lines

  * Further development

........
r3710 | daniel | 2006-05-27 23:43:14 +0200 (Sat, 27 May 2006) | 2 lines

  * Further development

........
r3714 | daniel | 2006-05-28 11:28:32 +0200 (Sun, 28 May 2006) | 2 lines

  * Further development

........
r3717 | daniel | 2006-05-28 17:53:28 +0200 (Sun, 28 May 2006) | 2 lines

  * Further development

........
r3722 | daniel | 2006-05-28 22:34:19 +0200 (Sun, 28 May 2006) | 2 lines

  * Further development

........
r3723 | daniel | 2006-05-28 22:43:21 +0200 (Sun, 28 May 2006) | 2 lines

  + More assertions

........
r3730 | daniel | 2006-05-29 02:02:01 +0200 (Mon, 29 May 2006) | 3 lines

  * Fix color of highlighted item
  * Expand nodes by default

........
r3731 | daniel | 2006-05-29 02:05:59 +0200 (Mon, 29 May 2006) | 2 lines

  - Remove unnecessary drawview

........
r3732 | daniel | 2006-05-29 02:08:11 +0200 (Mon, 29 May 2006) | 2 lines

  * Fix mouse expand/retract

........
r3777 | daniel | 2006-06-03 20:53:00 +0200 (Sat, 03 Jun 2006) | 2 lines

  * Remove useless Unix specific hack.

........
r3778 | daniel | 2006-06-03 22:57:55 +0200 (Sat, 03 Jun 2006) | 2 lines

  * Do not redraw entire screen when Tgroup.draw is called.

........
r3838 | daniel | 2006-06-11 08:24:01 +0200 (Sun, 11 Jun 2006) | 2 lines

  * Fix disposenode bug.

........
r3839 | daniel | 2006-06-11 08:38:45 +0200 (Sun, 11 Jun 2006) | 2 lines

  * Add codepage directive to files.

........
r3840 | daniel | 2006-06-11 10:44:54 +0200 (Sun, 11 Jun 2006) | 2 lines

  * Typo

........
r3843 | daniel | 2006-06-11 12:11:34 +0200 (Sun, 11 Jun 2006) | 2 lines

  * Handle video initialization failure.

........

git-svn-id: branches/fixes_2_0@3956 -
This commit is contained in:
peter 2006-06-26 06:30:01 +00:00
parent 0b12257021
commit ec3c805097
14 changed files with 840 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -992,6 +992,7 @@ fv/inplong.pas svneol=native#text/plain
fv/memory.pas svneol=native#text/plain
fv/menus.pas svneol=native#text/plain
fv/msgbox.pas svneol=native#text/plain
fv/outline.pas -text
fv/platform.inc svneol=native#text/plain
fv/resource.pas svneol=native#text/plain
fv/statuses.pas svneol=native#text/plain

25
fv/app.pas
View File

@ -885,11 +885,12 @@ procedure TProgram.SetScreenVideoMode(const Mode: TVideoMode);
var
R: TRect;
begin
DoneMouse;
{ DoneMemory;}
hidemouse;
{ DoneMouse;
DoneMemory;}
ScreenMode:=Mode;
InitMouse;
{ InitMemory;}
{ InitMouse;
InitMemory;}
InitScreen;
Video.SetVideoMode(Mode);
ScreenWidth:=Video.ScreenWidth;
@ -970,16 +971,24 @@ END;
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
{---------------------------------------------------------------------------}
CONSTRUCTOR TApplication.Init;
BEGIN
{ InitMemory;} { Start memory up }
InitResource;
initkeyboard;
Drivers.InitVideo; { Start video up }
if not Drivers.InitVideo then { Start video up }
begin
donekeyboard;
{Initresource might have failed.}
if strings<>nil then
writeln(strings^.get(sVideoFailed));
halt(1);
end;
Drivers.InitEvents; { Start event drive }
Drivers.InitSysError; { Start system error }
InitHistory; { Start history up }
InitResource;
InitMsgBox;
Inherited Init; { Call ancestor }
InitMsgBox;
{ init mouse and cursor }
Video.SetCursorType(crHidden);
Mouse.SetMouseXY(1,1);
@ -992,12 +1001,12 @@ DESTRUCTOR TApplication.Done;
BEGIN
Inherited Done; { Call ancestor }
DoneHistory; { Close history }
DoneResource;
Drivers.DoneSysError; { Close system error }
Drivers.DoneEvents; { Close event drive }
drivers.donevideo;
{ DoneMemory;} { Close memory }
donekeyboard;
DoneResource;
END;
{--TApplication-------------------------------------------------------------}

2
fv/dialogs.pas
View File

@ -27,6 +27,8 @@
UNIT Dialogs;
{$CODEPAGE cp437}
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

23
fv/drivers.pas
View File

@ -488,7 +488,7 @@ Initializes the video manager, Saves the current screen mode in
StartupMode, and switches to the mode indicated by ScreenMode.
19May98 LdB
---------------------------------------------------------------------}
PROCEDURE InitVideo;
function InitVideo:boolean;
{-DoneVideo---------------------------------------------------------
Terminates the video manager by restoring the initial screen mode
@ -828,12 +828,12 @@ VAR
{ PRIVATE INTERNAL ROUTINES }
{***************************************************************************}
PROCEDURE ShowMouseCursor;
PROCEDURE ShowMouseCursor;inline;
BEGIN
ShowMouse;
END;
PROCEDURE HideMouseCursor;
PROCEDURE HideMouseCursor;inline;
BEGIN
HideMouse;
END;
@ -870,7 +870,7 @@ end;
{---------------------------------------------------------------------------}
{ DetectMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }
FUNCTION DetectMouse: Byte;
FUNCTION DetectMouse: Byte;inline;
begin
DetectMouse:=Mouse.DetectMouse;
end;
@ -1304,10 +1304,12 @@ end;
{---------------------------------------------------------------------------}
{ InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE InitVideo;
VAR
StoreScreenMode : TVideoMode;
BEGIN
function InitVideo:boolean;
var StoreScreenMode : TVideoMode;
begin
initvideo:=false;
if VideoInitialized then
begin
StoreScreenMode:=ScreenMode;
@ -1317,6 +1319,8 @@ BEGIN
StoreScreenMode.Col:=0;
Video.InitVideo;
if video.errorcode<>viook then
exit;
GetVideoMode(StartupScreenMode);
GetVideoMode(ScreenMode);
{$ifdef win32}
@ -1338,7 +1342,8 @@ BEGIN
ScreenWidth:=Video.ScreenWidth;
ScreenHeight:=Video.ScreenHeight;
VideoInitialized:=true;
END;
initvideo:=true;
end;
{---------------------------------------------------------------------------}
{ DoneVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }

31
fv/editors.pas
View File

@ -403,7 +403,7 @@ procedure RegisterEditors;
implementation
uses
Memory, Dos, App, StdDlg, MsgBox, Resource;
Dos, App, StdDlg, MsgBox, Resource;
type
pword = ^word;
@ -1222,6 +1222,7 @@ end;
destructor TLineInfo.Done;
begin
FreeMem(Info,MaxPos*sizeof(TLineInfoRec));
Info := nil;
end;
@ -1598,11 +1599,7 @@ end; { TEditor.DeleteSelect }
procedure TEditor.DoneBuffer;
begin
if assigned(Buffer) then
begin
FreeMem (Buffer, BufSize);
Buffer := nil;
end;
ReAllocMem(Buffer, 0);
end; { TEditor.DoneBuffer }
@ -2156,7 +2153,8 @@ end; { TEditor.HideSelect }
procedure TEditor.InitBuffer;
begin
Buffer := MemAlloc (BufSize);
Assert(Buffer = nil, 'TEditor.InitBuffer: Buffer is not nil');
ReAllocMem(Buffer, BufSize);
end; { TEditor.InitBuffer }
@ -2951,8 +2949,9 @@ end; { TEditor.SetBufLen }
function TEditor.SetBufSize (NewSize : Sw_Word) : Boolean;
begin
// SetBufSize := NewSize <= BufSize;
SetBufSize := SetBufferSize(Buffer, NewSize);
ReAllocMem(Buffer, NewSize);
BufSize := NewSize;
SetBufSize := True;
end; { TEditor.SetBufSize }
@ -3441,8 +3440,7 @@ end; { TFileEditor.Load }
procedure TFileEditor.DoneBuffer;
begin
if assigned(Buffer) then
DisposeBuffer (Buffer);
ReAllocMem(Buffer, 0);
end; { TFileEditor.DoneBuffer }
@ -3468,7 +3466,9 @@ end; { TFileEditor.HandleEvent }
procedure TFileEditor.InitBuffer;
begin
NewBuffer(Pointer(Buffer), MinBufLength);
Assert(Buffer = nil, 'TFileEditor.InitBuffer: Buffer is not nil');
ReAllocMem(Buffer, MinBufLength);
BufSize := MinBufLength;
end; { TFileEditor.InitBuffer }
@ -3584,13 +3584,10 @@ begin
NewSize := (NewSize + (MinBufLength-1)) and (MaxBufLength and (not (MinBufLength-1)));
if NewSize <> BufSize then
begin
if NewSize > BufSize then
if not SetBufferSize(pointer(Buffer), NewSize) then
Exit;
if NewSize > BufSize then ReAllocMem(Buffer, NewSize);
N := BufLen - CurPtr + DelCount;
Move(Buffer^[BufSize - N], Buffer^[NewSize - N], N);
if NewSize < BufSize then
SetBufferSize(pointer(Buffer), NewSize);
if NewSize < BufSize then ReAllocMem(Buffer, NewSize);
BufSize := NewSize;
GapLen := BufSize - BufLen;
end;

2
fv/menus.pas
View File

@ -27,6 +27,8 @@
UNIT Menus;
{$CODEPAGE cp437}
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

685
fv/outline.pas Normal file
View File

@ -0,0 +1,685 @@
unit outline;
{$CODEPAGE cp437}
{***************************************************************************}
interface
{***************************************************************************}
uses drivers,objects,views;
type Pnode=^Tnode;
Tnode=record
next:Pnode;
text:Pstring;
childlist:Pnode;
expanded:boolean;
end;
Poutlineviewer=^Toutlineviewer;
Toutlineviewer=object(Tscroller)
foc:sw_integer;
constructor init(var bounds:Trect;
AHscrollbar,AVscrollbar:Pscrollbar);
procedure adjust(node:pointer;expand:boolean);virtual;
function creategraph(level:integer;lines:longint;
flags:word;levwidth,endwidth:integer;
const chars:string):string;
procedure draw;virtual;
procedure expandall(node:pointer);
function firstthat(test:pointer):pointer;
procedure focused(i:sw_integer);virtual;
procedure foreach(action:pointer);
function getchild(node:pointer;i:sw_integer):pointer;virtual;
function getgraph(level:integer;lines:longint;flags:word):string;
function getnode(i:sw_integer):pointer;virtual;
function getnumchildren(node:pointer):sw_integer;virtual;
function getpalette:Ppalette;virtual;
function getroot:pointer;virtual;
function gettext(node:pointer):string;virtual;
procedure handleevent(var event:Tevent);virtual;
function haschildren(node:pointer):boolean;virtual;
function isexpanded(node:pointer):boolean;virtual;
function isselected(i:sw_integer):boolean;virtual;
procedure selected(i:sw_integer);virtual;
procedure setstate(Astate:word;enable:boolean);virtual;
procedure update;
private
procedure set_focus(Afocus:sw_integer);
function do_recurse(action,callerframe:pointer;
stop_if_found:boolean):pointer;
end;
Poutline=^Toutline;
Toutline=object(Toutlineviewer)
root:Pnode;
constructor init(var bounds:Trect;
AHscrollbar,AVscrollbar:Pscrollbar;
Aroot:Pnode);
procedure adjust(node:pointer;expand:boolean);virtual;
function getchild(node:pointer;i:sw_integer):pointer;virtual;
function getnumchildren(node:pointer):sw_integer;virtual;
function getroot:pointer;virtual;
function gettext(node:pointer):string;virtual;
function haschildren(node:pointer):boolean;virtual;
function isexpanded(node:pointer):boolean;virtual;
destructor done;virtual;
end;
const ovExpanded = $1;
ovChildren = $2;
ovLast = $4;
Coutlineviewer=Cscroller+#8#8;
function newnode(const Atext:string;Achildren,Anext:Pnode):Pnode;
procedure disposenode(node:Pnode);
{***************************************************************************}
implementation
{***************************************************************************}
type TMyFunc = function(_EBP: Pointer; Cur: Pointer;
Level, Position: sw_integer; Lines: LongInt;
Flags: Word): Boolean;
function newnode(const Atext:string;Achildren,Anext:Pnode):Pnode;
begin
newnode:=new(Pnode);
with newnode^ do
begin
next:=Anext;
text:=newstr(Atext);
childlist:=Achildren;
expanded:=true;
end;
end;
procedure disposenode(node:Pnode);
var next:Pnode;
begin
while node<>nil do
begin
disposenode(node^.childlist);
disposestr(node^.text);
next:=node^.next;
dispose(node);
node:=next;
end;
end;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ Toutlineviewer object methods }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
constructor Toutlineviewer.init(var bounds:Trect;
AHscrollbar,AVscrollbar:Pscrollbar);
begin
inherited init(bounds,AHscrollbar,AVscrollbar);
foc:=0;
growmode:=gfGrowHiX+gfGrowHiY;
end;
procedure Toutlineviewer.adjust(node:pointer;expand:boolean);
begin
abstract;
end;
function TOutlineViewer.CreateGraph(Level: Integer; Lines: LongInt;
Flags: Word; LevWidth, EndWidth: Integer;
const Chars: String): String;
const
FillerOrBar = 0;
YorL = 2;
StraightOrTee= 4;
Retracted = 6;
var
Last, Children, Expanded: Boolean;
I , J : Byte;
Graph : String;
begin
{ Load registers }
graph:=space(Level*LevWidth+EndWidth+1);
{ Write bar characters }
J := 1;
while (Level > 0) do
begin
Inc(J);
if (Lines and 1) <> 0 then
Graph[J] := Chars[FillerOrBar+2]
else
Graph[J] := Chars[FillerOrBar+1];
for I := 1 to LevWidth - 1 do
Graph[I]:= Chars[FillerOrBar+1];
J := J + LevWidth - 1;
Dec(Level);
Lines := Lines shr 1;
end;
{ Write end characters }
Dec(EndWidth);
if EndWidth > 0 then
begin
Inc(J);
if Flags and ovLast <> 0 then
Graph[J] := Chars[YorL+2]
else
Graph[J] := Chars[YorL+1];
Dec(EndWidth);
if EndWidth > 0 then
begin
Dec(EndWidth);
for I := 1 to EndWidth do
Graph[I]:= Chars[StraightOrTee+1];
J := J + EndWidth;
Inc(J);
if (Flags and ovChildren) <> 0 then
Graph[J] := Chars[StraightOrTee+2]
else
Graph[J] := Chars[StraightOrTee+1];
end;
Inc(J);
if Flags and ovExpanded <> 0 then
Graph[J] := Chars[Retracted+2]
else
Graph[J] := Chars[Retracted+1];
end;
Graph[0] := Char(J);
CreateGraph := Graph;
end;
function Toutlineviewer.do_recurse(action,callerframe:pointer;
stop_if_found:boolean):pointer;
var position:sw_integer;
r:pointer;
function recurse(cur:pointer;level:integer;lines:longint;lastchild:boolean):pointer;
var i,childcount:sw_integer;
child:pointer;
flags:word;
children,expanded,found:boolean;
begin
inc(position);
recurse:=nil;
children:=haschildren(cur);
expanded:=isexpanded(cur);
{Determine flags.}
flags:=0;
if not children or expanded then
inc(flags,ovExpanded);
if children and expanded then
inc(flags,ovChildren);
if lastchild then
inc(flags,ovLast);
{Call the function.}
found:=TMyFunc(action)(callerframe,cur,level,position,lines,flags);
if stop_if_found and found then
recurse:=cur
else if children and expanded then {Recurse children?}
begin
if not lastchild then
lines:=lines or (1 shl level);
{Iterate all childs.}
childcount:=getnumchildren(cur);
for i:=0 to childcount-1 do
begin
child:=getchild(cur,i);
if (child<>nil) and (level<31) then
recurse:=recurse(child,level+1,lines,i=childcount-1);
{Did we find a node?}
if recurse<>nil then
break;
end;
end;
end;
begin
position:=-1;
r:=getroot;
if r<>nil then
do_recurse:=recurse(r,0,0,true)
else
do_recurse:=nil;
end;
procedure Toutlineviewer.draw;
var c_normal,c_normal_x,c_select,c_focus:byte;
maxpos:sw_integer;
b:Tdrawbuffer;
function draw_item(cur:pointer;level,position:sw_integer;
lines:longint;flags:word):boolean;
var c,i:byte;
s,t:string;
begin
draw_item:=position>=delta.y+size.y;
if (position<delta.y) or draw_item then
exit;
maxpos:=position;
s:=getgraph(level,lines,flags);
t:=gettext(cur);
{Determine text colour.}
if (foc=position) and (state and sffocused<>0) then
c:=c_focus
else if isselected(position) then
c:=c_select
else if flags and ovexpanded<>0 then
c:=c_normal_x
else
c:=c_normal;
{Fill drawbuffer with graph and text to draw.}
for i:=0 to size.x-1 do
begin
wordrec(b[i]).hi:=c;
if i+delta.x<length(s) then
wordrec(b[i]).lo:=byte(s[1+i+delta.x])
else if 1+i+delta.x-length(s)<=length(t) then
wordrec(b[i]).lo:=byte(t[1+i+delta.x-length(s)])
else
wordrec(b[i]).lo:=byte(' ');
end;
{Draw!}
writeline(0,position-delta.y,size.x,1,b);
end;
begin
c_normal:=getcolor(4);
c_normal_x:=getcolor(1);
c_focus:=getcolor(2);
c_select:=getcolor(3);
maxpos:=-1;
foreach(@draw_item);
movechar(b,' ',c_normal,size.x);
writeline(0,maxpos+1,size.x,size.y-(maxpos-delta.y),b);
end;
procedure Toutlineviewer.expandall(node:pointer);
var i:sw_integer;
begin
if haschildren(node) then
begin
for i:=0 to getnumchildren(node)-1 do
expandall(getchild(node,i));
adjust(node,true);
end;
end;
function Toutlineviewer.firstthat(test:pointer):pointer;
begin
firstthat:=do_recurse(test,get_caller_frame(get_frame),true);
end;
procedure Toutlineviewer.focused(i:sw_integer);
begin
foc:=i;
end;
procedure Toutlineviewer.foreach(action:pointer);
begin
do_recurse(action,get_caller_frame(get_frame),false);
end;
function Toutlineviewer.getchild(node:pointer;i:sw_integer):pointer;
begin
abstract;
end;
function Toutlineviewer.getgraph(level:integer;lines:longint;
flags:word):string;
begin
getgraph:=creategraph(level,lines,flags,3,3,' ³ÃÀÄÄ+Ä');
end;
function Toutlineviewer.getnode(i:sw_integer):pointer;
function test_position(node:pointer;level,position:sw_integer;lines:longInt;
flags:word):boolean;
begin
test_position:=position=i;
end;
begin
getnode:=firstthat(@test_position);
end;
function Toutlineviewer.getnumchildren(node:pointer):sw_integer;
begin
abstract;
end;
function Toutlineviewer.getpalette:Ppalette;
const p:string[length(Coutlineviewer)]=Coutlineviewer;
begin
getpalette:=@p;
end;
function Toutlineviewer.getroot:pointer;
begin
abstract;
end;
function Toutlineviewer.gettext(node:pointer):string;
begin
abstract;
end;
procedure Toutlineviewer.handleevent(var event:Tevent);
var mouse:Tpoint;
cur:pointer;
new_focus:sw_integer;
count:byte;
handled,m,mouse_drag:boolean;
graph:string;
function graph_of_focus(var graph:string):pointer;
var _level:sw_integer;
_lines:longInt;
_flags:word;
function find_focused(cur:pointer;level,position:sw_integer;
lines:longint;flags:word):boolean;
begin
find_focused:=position=foc;
if find_focused then
begin
_level:=level;
_lines:=lines;
_flags:=flags;
end;
end;
begin
graph_of_focus:=firstthat(@find_focused);
graph:=getgraph(_level,_lines,_flags);
end;
const skip_mouse_events=3;
begin
inherited handleevent(event);
case event.what of
evKeyboard:
begin
new_focus:=foc;
handled:=true;
case ctrltoarrow(event.keycode) of
kbUp,kbLeft:
dec(new_focus);
kbDown,kbRight:
inc(new_focus);
kbPgDn:
inc(new_focus,size.y-1);
kbPgUp:
dec(new_focus,size.y-1);
kbCtrlPgUp:
new_focus:=0;
kbCtrlPgDn:
new_focus:=limit.y-1;
kbHome:
new_focus:=delta.y;
kbEnd:
new_focus:=delta.y+size.y-1;
kbCtrlEnter,kbEnter:
selected(new_focus);
else
case event.charcode of
'-','+':
begin
adjust(getnode(new_focus),event.charcode='+');
update;
end;
'*':
begin
expandall(getnode(new_focus));
update;
end;
else
handled:=false;
end;
end;
if new_focus<0 then
new_focus:=0;
if new_focus>=limit.y then
new_focus:=limit.y-1;
if foc<>new_focus then
set_focus(new_focus);
if handled then
clearevent(event);
end;
evMouseDown:
begin
count:=1;
mouse_drag:=false;
repeat
makelocal(event.where,mouse);
if mouseinview(event.where) then
new_focus:=delta.y+mouse.y
else
begin
inc(count,byte(event.what=evMouseAuto));
if count and skip_mouse_events=0 then
begin
if mouse.y<0 then
dec(new_focus);
if mouse.y>=size.y then
inc(new_focus);
end;
end;
if new_focus<0 then
new_focus:=0;
if new_focus>=limit.y then
new_focus:=limit.y-1;
if foc<>new_focus then
set_focus(new_focus);
m:=mouseevent(event,evMouseMove+evMouseAuto);
if m then
mouse_drag:=true;
until not m;
if event.double then
selected(foc)
else if not mouse_drag then
begin
cur:=graph_of_focus(graph);
if mouse.x<length(graph) then
begin
adjust(cur,not isexpanded(cur));
update;
end;
end;
end;
end;
end;
function Toutlineviewer.haschildren(node:pointer):boolean;
begin
abstract;
end;
function Toutlineviewer.isexpanded(node:pointer):boolean;
begin
abstract;
end;
function Toutlineviewer.isselected(i:sw_integer):boolean;
begin
isselected:=foc=i;
end;
procedure Toutlineviewer.selected(i:sw_integer);
begin
{Does nothing by default.}
end;
procedure Toutlineviewer.set_focus(Afocus:sw_integer);
begin
assert((Afocus>=0) and (Afocus<limit.y));
focused(Afocus);
if Afocus<delta.y then
scrollto(delta.x,Afocus)
else if Afocus-size.y>=delta.y then
scrollto(delta.x,Afocus-size.y+1);
drawview;
end;
procedure Toutlineviewer.setstate(Astate:word;enable:boolean);
begin
if Astate and sffocused<>0 then
drawview;
inherited setstate(Astate,enable);
end;
procedure Toutlineviewer.update;
var count:sw_integer;
maxwidth:byte;
procedure check_item(cur:pointer;level,position:sw_integer;
lines:longint;flags:word);
var width:word;
begin
inc(count);
width:=length(gettext(cur))+length(getgraph(level,lines,flags));
if width>maxwidth then
maxwidth:=width;
end;
begin
count:=0;
maxwidth:=0;
foreach(@check_item);
setlimit(maxwidth,count);
set_focus(foc);
end;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ Toutline object methods }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
constructor Toutline.init(var bounds:Trect;
AHscrollbar,AVscrollbar:Pscrollbar;
Aroot:Pnode);
begin
inherited init(bounds,AHscrollbar,AVscrollbar);
root:=Aroot;
update;
end;
procedure Toutline.adjust(node:pointer;expand:boolean);
begin
assert(node<>nil);
Pnode(node)^.expanded:=expand;
end;
function Toutline.getnumchildren(node:pointer):sw_integer;
var p:Pnode;
begin
assert(node<>nil);
p:=Pnode(node)^.childlist;
getnumchildren:=0;
while p<>nil do
begin
inc(getnumchildren);
p:=p^.next;
end;
end;
function Toutline.getchild(node:pointer;i:sw_integer):pointer;
begin
assert(node<>nil);
getchild:=Pnode(node)^.childlist;
while i<>0 do
begin
dec(i);
getchild:=Pnode(getchild)^.next;
end;
end;
function Toutline.getroot:pointer;
begin
getroot:=root;
end;
function Toutline.gettext(node:pointer):string;
begin
assert(node<>nil);
gettext:=Pnode(node)^.text^;
end;
function Toutline.haschildren(node:pointer):boolean;
begin
assert(node<>nil);
haschildren:=Pnode(node)^.childlist<>nil;
end;
function Toutline.isexpanded(node:pointer):boolean;
begin
assert(node<>nil);
isexpanded:=Pnode(node)^.expanded;
end;
destructor Toutline.done;
begin
disposenode(root);
inherited done;
end;
end.

2
fv/statuses.pas
View File

@ -1,6 +1,8 @@
{$V-}
unit Statuses;
{$CODEPAGE cp437}
{#Z+}
{ Free Vision Status Objects Unit
Free VIsion

1
fv/str.inc
View File

@ -1,4 +1,5 @@
{ Strings }
sVideoFailed = 0; {Video initialization failed.}
sButtonDefault = 1; { Button default }
sButtonDisabled = 2; { Button disabled }
sButtonNormal = 3; { Button normal }

3
fv/strtxt.inc
View File

@ -3,8 +3,9 @@ type standard_string=record
text:Pchar;
end;
const standard_string_count=106;
const standard_string_count=107;
standard_strings:array[0..standard_string_count-1] of standard_string=(
(nr:sVideoFailed;text:'Video initialization failed.'),
(nr:sButtonDefault;text:'Button default'),
(nr:sButtonDisabled;text:'Button disabled'),
(nr:sButtonNormal;text:'Button normal'),

3
fv/tabs.pas
View File

@ -20,6 +20,9 @@
****************************************************************************}
unit tabs;
{$CODEPAGE cp437}
interface
uses

130
fv/test/Makefile
View File

@ -1,8 +1,8 @@
#
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/02/06]
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/06/12]
#
default: all
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-palmos arm-wince powerpc64-linux
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-palmos arm-wince arm-gba powerpc64-linux
BSDs = freebsd netbsd openbsd darwin
UNIXs = linux $(BSDs) solaris qnx
LIMIT83fs = go32v2 os2 emx watcom
@ -231,118 +231,124 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
endif
PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
ifeq ($(FULL_TARGET),i386-linux)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-go32v2)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-win32)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-os2)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-freebsd)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-beos)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-netbsd)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-solaris)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-qnx)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-netware)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-openbsd)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-wdosx)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-darwin)
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-emx)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-watcom)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-netwlibc)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),i386-wince)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),m68k-linux)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),m68k-freebsd)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),m68k-netbsd)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),m68k-amiga)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),m68k-atari)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),m68k-openbsd)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),m68k-palmos)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),powerpc-linux)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),powerpc-netbsd)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),powerpc-macos)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),powerpc-darwin)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),powerpc-morphos)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),sparc-linux)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),sparc-netbsd)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),sparc-solaris)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),x86_64-linux)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),x86_64-freebsd)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),x86_64-win64)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),arm-linux)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),arm-palmos)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),arm-wince)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),arm-gba)
override TARGET_PROGRAMS+=testapp
endif
ifeq ($(FULL_TARGET),powerpc64-linux)
override TARGET_PROGRAMS+=tfileio testapp
override TARGET_PROGRAMS+=testapp
endif
ifdef REQUIRE_UNITSDIR
override UNITSDIR+=$(REQUIRE_UNITSDIR)
@ -552,6 +558,7 @@ STATICLIBEXT=.a
SHAREDLIBEXT=.so
SHAREDLIBPREFIX=libfp
STATICLIBPREFIX=libp
IMPORTLIBPREFIX=libimp
RSTEXT=.rst
ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
ifeq ($(OS_TARGET),go32v1)
@ -664,6 +671,11 @@ EXEEXT=
HASSHAREDLIB=1
SHORTSUFFIX=dwn
endif
ifeq ($(OS_TARGET),gba)
EXEEXT=.gba
SHAREDLIBEXT=.so
SHORTSUFFIX=gba
endif
else
ifeq ($(OS_TARGET),go32v1)
PPUEXT=.pp1
@ -984,12 +996,17 @@ endif
endif
export ZIPPROG
ifndef TARPROG
TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(TARPROG),)
TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(TARPROG),)
TARPROG= __missing_command_TARPROG
else
TARPROG:=$(firstword $(TARPROG))
endif
else
TARPROG:=$(firstword $(TARPROG))
endif
endif
export TARPROG
ASNAME=$(BINUTILSPREFIX)as
@ -1125,6 +1142,10 @@ ifeq ($(FULL_TARGET),i386-wdosx)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_FV=1
endif
ifeq ($(FULL_TARGET),i386-darwin)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_FV=1
endif
ifeq ($(FULL_TARGET),i386-emx)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_FV=1
@ -1225,6 +1246,10 @@ ifeq ($(FULL_TARGET),arm-wince)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_FV=1
endif
ifeq ($(FULL_TARGET),arm-gba)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_FV=1
endif
ifeq ($(FULL_TARGET),powerpc64-linux)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_FV=1
@ -1287,6 +1312,9 @@ endif
ifneq ($(OS_TARGET),$(OS_SOURCE))
override FPCOPT+=-T$(OS_TARGET)
endif
ifneq ($(CPU_TARGET),$(CPU_SOURCE))
override FPCOPT+=-P$(CPU_TARGET)
endif
ifeq ($(OS_SOURCE),openbsd)
override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
endif
@ -1321,14 +1349,15 @@ override FPCOPT+=-gl
override FPCOPTDEF+=DEBUG
endif
ifdef RELEASE
ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
ifeq ($(CPU_TARGET),i386)
FPCCPUOPT:=-OG2p3
else
endif
ifeq ($(CPU_TARGET),powerpc)
FPCCPUOPT:=-O1r
else
FPCCPUOPT:=
endif
else
FPCCPUOPT:=-O2
endif
override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
override FPCOPTDEF+=RELEASE
@ -1337,9 +1366,7 @@ ifdef STRIP
override FPCOPT+=-Xs
endif
ifdef OPTIMIZE
ifeq ($(CPU_TARGET),i386)
override FPCOPT+=-OG2p3
endif
override FPCOPT+=-O2
endif
ifdef VERBOSE
override FPCOPT+=-vwni
@ -1383,11 +1410,6 @@ override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
endif
endif
ifeq ($(OS_TARGET),linux)
ifeq ($(FPC_VERSION),1.0.6)
override FPCOPTDEF+=HASUNIX
endif
endif
ifdef CREATESHARED
override FPCOPT+=-Cg
ifeq ($(CPU_TARGET),i386)
@ -1430,7 +1452,7 @@ endif
ifndef CROSSINSTALL
ifneq ($(TARGET_PROGRAMS),)
override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))
override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
override ALLTARGET+=fpc_exes
override INSTALLEXEFILES+=$(EXEFILES)
override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
@ -1528,7 +1550,7 @@ ifdef INSTALL_BUILDUNIT
override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
endif
ifdef INSTALLPPUFILES
override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
ifneq ($(UNITTARGETDIRPREFIX),)
override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
@ -1598,7 +1620,7 @@ ifdef CLEAN_UNITS
override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
endif
ifdef CLEANPPUFILES
override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
ifdef DEBUGSYMEXT
override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
endif

2
fv/test/Makefile.fpc
View File

@ -3,7 +3,7 @@
#
[target]
programs=tfileio testapp
programs=testapp
[require]
packages=fv

33
fv/views.pas
View File

@ -27,6 +27,8 @@
UNIT Views;
{$CODEPAGE cp437}
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
@ -855,11 +857,11 @@ const
MouseUsesVideoBuf = false;
{$endif not UNIX}
procedure DrawScreenBuf;
procedure DrawScreenBuf(force:boolean);
begin
if (GetLockScreenCount=0) then
begin
If MouseUsesVideoBuf then
{ If MouseUsesVideoBuf then
begin
LockScreenUpdate;
HideMouse;
@ -867,10 +869,10 @@ begin
UnlockScreenUpdate;
end
else
HideMouse;
UpdateScreen(false);
If not MouseUsesVideoBuf then
ShowMouse;
HideMouse;}
UpdateScreen(force);
{ If not MouseUsesVideoBuf then
ShowMouse;}
end;
end;
@ -1430,7 +1432,7 @@ begin
LockScreenUpdate; { don't update the screen yet }
Draw;
UnLockScreenUpdate;
DrawScreenBuf;
DrawScreenBuf(false);
TView.DrawCursor;
end;
end;
@ -2164,11 +2166,16 @@ end;
{--TGroup-------------------------------------------------------------------}
{ ReDraw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
{ ReDraw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 2Jun06 DM }
{---------------------------------------------------------------------------}
procedure TGroup.Redraw;
begin
{Lock to prevent screen update.}
lockscreenupdate;
DrawSubViews(First, nil);
unlockscreenupdate;
{Draw all views at once, forced update.}
drawscreenbuf(true);
end;
@ -2199,7 +2206,7 @@ END;
PROCEDURE TGroup.Draw;
BEGIN
If Buffer=Nil then
ReDraw
DrawSubViews(First, nil)
else
WriteBuf(0,0,Size.X,Size.Y,Buffer);
END;
@ -4341,7 +4348,7 @@ begin
B[i]:=myChar;
do_writeView(X,X+Count,Y,B);
end;
DrawScreenBuf;
DrawScreenBuf(false);
end;
@ -4352,7 +4359,7 @@ begin
if h>0 then
for i:=0 to h-1 do
do_writeView(x,x+w,y+i,buf);
DrawScreenBuf;
DrawScreenBuf(false);
end;
@ -4370,10 +4377,10 @@ begin
MyColor:=MapColor(Color);
MyColor:=MyColor shl 8;
for i:=0 to l-1 do
B[i]:=MyColor+ord(Str[i+1]);
B[i]:=MyColor+ord(Str[i+1]);
do_writeView(x,x+l,y,b);
end;
DrawScreenBuf;
DrawScreenBuf(false);
end;