mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 07:46:00 +02:00
* add emulation for go32v2 and display currently extraced file
and changes by Gabor for scrolling support (merged)
This commit is contained in:
pierre
parent
83d20f9b14
commit
9edea136d0
@ -63,6 +63,9 @@ program install;
|
|||||||
{$ENDIF VirtualPascal}
|
{$ENDIF VirtualPascal}
|
||||||
{$ENDIF FPC}
|
{$ENDIF FPC}
|
||||||
{$ENDIF OS2}
|
{$ENDIF OS2}
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
emu387,
|
||||||
|
{$ENDIF}
|
||||||
{$ifdef HEAPTRC}
|
{$ifdef HEAPTRC}
|
||||||
heaptrc,
|
heaptrc,
|
||||||
{$endif HEAPTRC}
|
{$endif HEAPTRC}
|
||||||
@ -74,12 +77,15 @@ program install;
|
|||||||
{$IFDEF DLL}
|
{$IFDEF DLL}
|
||||||
unzipdll,
|
unzipdll,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
app,dialogs,views,menus,msgbox,colortxt,tabs,inststr;
|
app,dialogs,views,menus,msgbox,colortxt,tabs,inststr,scroll;
|
||||||
|
|
||||||
|
|
||||||
const
|
const
|
||||||
installerversion='1.02';
|
installerversion='1.02';
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef TP}lfnsupport=false;{$endif}
|
||||||
|
|
||||||
maxpacks=10;
|
maxpacks=10;
|
||||||
maxpackages=20;
|
maxpackages=20;
|
||||||
maxdefcfgs=1024;
|
maxdefcfgs=1024;
|
||||||
@ -149,6 +155,7 @@ program install;
|
|||||||
punzipdialog=^tunzipdialog;
|
punzipdialog=^tunzipdialog;
|
||||||
tunzipdialog=object(tdialog)
|
tunzipdialog=object(tdialog)
|
||||||
filetext : pstatictext;
|
filetext : pstatictext;
|
||||||
|
extractfiletext : pstatictext;
|
||||||
constructor Init(var Bounds: TRect; ATitle: TTitleStr);
|
constructor Init(var Bounds: TRect; ATitle: TTitleStr);
|
||||||
procedure do_unzip(s,topath:string);
|
procedure do_unzip(s,topath:string);
|
||||||
end;
|
end;
|
||||||
@ -466,17 +473,33 @@ program install;
|
|||||||
begin
|
begin
|
||||||
inherited init(bounds,atitle);
|
inherited init(bounds,atitle);
|
||||||
(* R.Assign (11, 4, 38, 6);*)
|
(* R.Assign (11, 4, 38, 6);*)
|
||||||
R.Assign (1, 4, 39, 6);
|
R.Assign (1, 4,bounds.B.X-Bounds.A.X-2, 6);
|
||||||
filetext:=new(pstatictext,init(r,#3'File: '));
|
filetext:=new(pstatictext,init(r,#3'File: '));
|
||||||
insert(filetext);
|
insert(filetext);
|
||||||
|
R.Assign (1, 7,bounds.B.X-Bounds.A.X-2, 9);
|
||||||
|
extractfiletext:=new(pstatictext,init(r,#3' '));
|
||||||
|
insert(extractfiletext);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$IFNDEF DLL}
|
{$IFNDEF DLL}
|
||||||
procedure UnzipCheckFn (Retcode: longint; Rec: pReportRec );{$ifdef Delphi32}STDCALL;{$endif}
|
procedure UnzipCheckFn (Retcode: longint; Rec: pReportRec );{$ifdef Delphi32}STDCALL;{$endif}
|
||||||
{$IFNDEF BIT32} FAR;{$ENDIF BIT32}
|
{$IFNDEF BIT32} FAR;{$ENDIF BIT32}
|
||||||
|
var
|
||||||
|
name : string;
|
||||||
begin
|
begin
|
||||||
case Rec^.Status of
|
case Rec^.Status of
|
||||||
unzip_starting: UnzipErr := 0;
|
unzip_starting:
|
||||||
|
UnzipErr := 0;
|
||||||
|
file_starting:
|
||||||
|
begin
|
||||||
|
with UnzDlg^.extractfiletext^ do
|
||||||
|
begin
|
||||||
|
Disposestr(text);
|
||||||
|
name:=Strpas(Rec^.FileName);
|
||||||
|
Text:=NewStr(#3+name);
|
||||||
|
DrawView;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
file_failure: UnzipErr := RetCode;
|
file_failure: UnzipErr := RetCode;
|
||||||
file_unzipping:
|
file_unzipping:
|
||||||
begin
|
begin
|
||||||
@ -730,6 +753,9 @@ program install;
|
|||||||
titletext : pcoloredtext;
|
titletext : pcoloredtext;
|
||||||
labcfg : plabel;
|
labcfg : plabel;
|
||||||
cfgcb : pcheckboxes;
|
cfgcb : pcheckboxes;
|
||||||
|
scrollbox: pscrollbox;
|
||||||
|
sbr,sbsbr: trect;
|
||||||
|
sbsb: pscrollbar;
|
||||||
begin
|
begin
|
||||||
f:=nil;
|
f:=nil;
|
||||||
{ walk packages reverse and insert a newsitem for each, and set the mask }
|
{ walk packages reverse and insert a newsitem for each, and set the mask }
|
||||||
@ -822,18 +848,39 @@ program install;
|
|||||||
{-------- Pack Sheets ----------}
|
{-------- Pack Sheets ----------}
|
||||||
for j:=1 to cfg.packs do
|
for j:=1 to cfg.packs do
|
||||||
begin
|
begin
|
||||||
R.Copy (TabIR);
|
R.Copy(TabIR);
|
||||||
|
if R.A.Y+cfg.pack[j].packages>R.B.Y then
|
||||||
|
R.B.Y:=R.A.Y+cfg.pack[j].packages;
|
||||||
new(packcbs[j],init(r,items[j]));
|
new(packcbs[j],init(r,items[j]));
|
||||||
if data.packmask[j]=$ffff then
|
if data.packmask[j]=$ffff then
|
||||||
data.packmask[j]:=packmask[j];
|
data.packmask[j]:=packmask[j];
|
||||||
packcbs[j]^.enablemask:=packmask[j];
|
packcbs[j]^.enablemask:={$ifdef DEV}$7fffffff{$else}packmask[j]{$endif};
|
||||||
packcbs[j]^.movedto(firstitem[j]);
|
packcbs[j]^.movedto(firstitem[j]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{--------- Main ---------}
|
{--------- Main ---------}
|
||||||
packtd:=nil;
|
packtd:=nil;
|
||||||
|
sbr.assign(1,3,tabr.b.x-tabr.a.x-3,tabr.b.y-tabr.a.y-1);
|
||||||
for j:=cfg.packs downto 1 do
|
for j:=cfg.packs downto 1 do
|
||||||
packtd:=NewTabDef(cfg.pack[j].name,packcbs[j],NewTabItem(packcbs[j],nil),packtd);
|
begin
|
||||||
|
if (sbr.b.y-sbr.a.y)<cfg.pack[j].packages then
|
||||||
|
begin
|
||||||
|
sbsbr.assign(sbr.b.x,sbr.a.y,sbr.b.x+1,sbr.b.y);
|
||||||
|
New(sbsb, init(sbsbr));
|
||||||
|
end
|
||||||
|
else
|
||||||
|
sbsb:=nil;
|
||||||
|
New(ScrollBox, Init(sbr, nil, sbsb));
|
||||||
|
PackCbs[j]^.MoveTo(0,0);
|
||||||
|
ScrollBox^.Insert(PackCbs[j]);
|
||||||
|
|
||||||
|
packtd:=NewTabDef(
|
||||||
|
cfg.pack[j].name,ScrollBox,
|
||||||
|
NewTabItem(sbsb,
|
||||||
|
NewTabItem(ScrollBox,
|
||||||
|
nil)),
|
||||||
|
packtd);
|
||||||
|
end;
|
||||||
|
|
||||||
New(Tab, Init(TabR,
|
New(Tab, Init(TabR,
|
||||||
NewTabDef(dialog_install_general,IlPath,
|
NewTabDef(dialog_install_general,IlPath,
|
||||||
@ -846,6 +893,7 @@ program install;
|
|||||||
packtd)
|
packtd)
|
||||||
));
|
));
|
||||||
Tab^.GrowMode:=0;
|
Tab^.GrowMode:=0;
|
||||||
|
|
||||||
Insert(Tab);
|
Insert(Tab);
|
||||||
|
|
||||||
line:=tabr.b.y;
|
line:=tabr.b.y;
|
||||||
@ -1038,7 +1086,7 @@ program install;
|
|||||||
for j:=1 to cfg.packs do
|
for j:=1 to cfg.packs do
|
||||||
with cfg.pack[j] do
|
with cfg.pack[j] do
|
||||||
begin
|
begin
|
||||||
r.assign(20,7,60,16);
|
r.assign(10,7,70,18);
|
||||||
UnzDlg:=new(punzipdialog,init(r,dialog_unzipdialog_title));
|
UnzDlg:=new(punzipdialog,init(r,dialog_unzipdialog_title));
|
||||||
desktop^.insert(UnzDlg);
|
desktop^.insert(UnzDlg);
|
||||||
for i:=1 to packages do
|
for i:=1 to packages do
|
||||||
@ -1442,7 +1490,11 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.6 2000-09-22 12:15:49 florian
|
Revision 1.7 2000-09-22 23:13:37 pierre
|
||||||
|
* add emulation for go32v2 and display currently extraced file
|
||||||
|
and changes by Gabor for scrolling support (merged)
|
||||||
|
|
||||||
|
Revision 1.6 2000/09/22 12:15:49 florian
|
||||||
+ support of Russian (Windows)
|
+ support of Russian (Windows)
|
||||||
|
|
||||||
Revision 1.5 2000/09/22 11:07:51 florian
|
Revision 1.5 2000/09/22 11:07:51 florian
|
||||||
@ -1461,112 +1513,4 @@ end.
|
|||||||
Revision 1.1 2000/07/13 06:30:21 michael
|
Revision 1.1 2000/07/13 06:30:21 michael
|
||||||
+ Initial import
|
+ Initial import
|
||||||
|
|
||||||
Revision 1.20 2000/07/09 12:55:45 hajny
|
}
|
||||||
* updated for version 1.0
|
|
||||||
|
|
||||||
Revision 1.19 2000/06/18 18:27:32 hajny
|
|
||||||
+ archive validity checking, progress indicator, better error checking
|
|
||||||
|
|
||||||
Revision 1.18 2000/02/24 17:47:47 peter
|
|
||||||
* last fixes for 0.99.14a release
|
|
||||||
|
|
||||||
Revision 1.17 2000/02/23 17:17:56 peter
|
|
||||||
* write ppc386.cfg for all found targets
|
|
||||||
|
|
||||||
Revision 1.16 2000/02/06 12:59:39 peter
|
|
||||||
* change upper -> upcase
|
|
||||||
* fixed stupid debugging leftover with diskspace check
|
|
||||||
|
|
||||||
Revision 1.15 2000/02/02 17:19:10 pierre
|
|
||||||
* avoid diskfree problem and get mouse visible
|
|
||||||
|
|
||||||
Revision 1.14 2000/02/02 15:21:31 peter
|
|
||||||
* show errorcode in message when error in unzipping
|
|
||||||
|
|
||||||
Revision 1.13 2000/01/26 21:49:33 peter
|
|
||||||
* install.pas compilable by FPC again
|
|
||||||
* removed some notes from unzip.pas
|
|
||||||
* support installer creation under linux (install has name conflict)
|
|
||||||
|
|
||||||
Revision 1.12 2000/01/26 21:15:59 hajny
|
|
||||||
* compilable with TP again (lines < 127install.pas, ifdef around findclose)
|
|
||||||
|
|
||||||
Revision 1.11 2000/01/24 22:21:48 peter
|
|
||||||
* new install version (keys not wrong correct yet)
|
|
||||||
|
|
||||||
Revision 1.10 2000/01/18 00:22:48 peter
|
|
||||||
* fixed uninited local var
|
|
||||||
|
|
||||||
Revision 1.9 1999/08/03 20:21:53 peter
|
|
||||||
* fixed sources mask which was not set correctly
|
|
||||||
|
|
||||||
Revision 1.7 1999/07/01 07:56:58 hajny
|
|
||||||
* installation to root fixed
|
|
||||||
|
|
||||||
Revision 1.6 1999/06/29 22:20:19 peter
|
|
||||||
* updated to use tab pages
|
|
||||||
|
|
||||||
Revision 1.5 1999/06/25 07:06:30 hajny
|
|
||||||
+ searching for installation script updated
|
|
||||||
|
|
||||||
Revision 1.4 1999/06/10 20:01:23 peter
|
|
||||||
+ fcl,fv,gtk support
|
|
||||||
|
|
||||||
Revision 1.3 1999/06/10 15:00:14 peter
|
|
||||||
* fixed to compile for not os2
|
|
||||||
* update install.dat
|
|
||||||
|
|
||||||
Revision 1.2 1999/06/10 07:28:27 hajny
|
|
||||||
* compilable with TP again
|
|
||||||
|
|
||||||
Revision 1.1 1999/02/19 16:45:26 peter
|
|
||||||
* moved to fpinst/ directory
|
|
||||||
+ makefile
|
|
||||||
|
|
||||||
Revision 1.15 1999/02/17 22:34:08 peter
|
|
||||||
* updates from TH for OS2
|
|
||||||
|
|
||||||
Revision 1.14 1998/12/22 22:47:34 peter
|
|
||||||
* updates for OS2
|
|
||||||
* small fixes
|
|
||||||
|
|
||||||
Revision 1.13 1998/12/21 13:11:39 peter
|
|
||||||
* updates for 0.99.10
|
|
||||||
|
|
||||||
Revision 1.12 1998/12/16 00:25:34 peter
|
|
||||||
* updated for 0.99.10
|
|
||||||
* new end dialogbox
|
|
||||||
|
|
||||||
Revision 1.11 1998/11/01 20:32:25 peter
|
|
||||||
* packed record
|
|
||||||
|
|
||||||
Revision 1.10 1998/10/25 23:38:35 peter
|
|
||||||
* removed warnings
|
|
||||||
|
|
||||||
Revision 1.9 1998/10/23 16:57:40 pierre
|
|
||||||
* compiles without -So option
|
|
||||||
* the main dialog init was buggy !!
|
|
||||||
|
|
||||||
Revision 1.8 1998/09/22 21:10:31 jonas
|
|
||||||
* initialize cfg and data with 0 at startup
|
|
||||||
|
|
||||||
Revision 1.7 1998/09/16 16:46:37 peter
|
|
||||||
+ updates
|
|
||||||
|
|
||||||
Revision 1.6 1998/09/15 13:11:14 pierre
|
|
||||||
small fix to cleanup if no package
|
|
||||||
|
|
||||||
Revision 1.5 1998/09/15 12:06:06 peter
|
|
||||||
* install updated to support w32 and dos and config file
|
|
||||||
|
|
||||||
Revision 1.4 1998/09/10 10:50:49 florian
|
|
||||||
* DOS install program updated
|
|
||||||
|
|
||||||
Revision 1.3 1998/09/09 13:39:58 peter
|
|
||||||
+ internal unzip
|
|
||||||
* dialog is showed automaticly
|
|
||||||
|
|
||||||
Revision 1.2 1998/04/07 22:47:57 florian
|
|
||||||
+ version/release/patch numbers as string added
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|||||||
260
install/fpinst/scroll.pas
Normal file
260
install/fpinst/scroll.pas
Normal file
@ -0,0 +1,260 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 2000 by B‚rczi, G bor
|
||||||
|
member of the Free Pascal development team
|
||||||
|
|
||||||
|
Support objects for the install program
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
unit Scroll;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses Objects,Commands,Drivers,Views,App;
|
||||||
|
|
||||||
|
const
|
||||||
|
CScrollBoxBackground = #6;
|
||||||
|
|
||||||
|
type
|
||||||
|
PScrollBoxBackground = ^TScrollBoxBackground;
|
||||||
|
TScrollBoxBackground = object(TBackground)
|
||||||
|
function GetPalette: PPalette; virtual;
|
||||||
|
end;
|
||||||
|
|
||||||
|
PScrollBox = ^TScrollBox;
|
||||||
|
TScrollBox = object(TGroup)
|
||||||
|
Delta,Limit: TPoint;
|
||||||
|
HScrollBar,VScrollBar: PScrollBar;
|
||||||
|
Background: PScrollBoxBackground;
|
||||||
|
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
||||||
|
procedure InitBackground; virtual;
|
||||||
|
procedure HandleEvent(var Event: TEvent); virtual;
|
||||||
|
procedure ChangeBounds(var Bounds: TRect); virtual;
|
||||||
|
procedure ScrollDraw; virtual;
|
||||||
|
procedure ScrollTo(X, Y: Sw_Integer);
|
||||||
|
procedure SetLimit(X, Y: Sw_Integer);
|
||||||
|
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
||||||
|
procedure TrackCursor;
|
||||||
|
procedure Draw; virtual;
|
||||||
|
function ClipChilds: boolean; virtual;
|
||||||
|
procedure BeforeInsert(P: PView); virtual;
|
||||||
|
procedure AfterInsert(P: PView); virtual;
|
||||||
|
procedure AfterDelete(P: PView); virtual;
|
||||||
|
private
|
||||||
|
DrawLock: Byte;
|
||||||
|
DrawFlag: Boolean;
|
||||||
|
procedure CheckDraw;
|
||||||
|
procedure UpdateLimits;
|
||||||
|
procedure ShiftViews(DX,DY: sw_integer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function TScrollBoxBackground.GetPalette: PPalette;
|
||||||
|
const P: string[length(CScrollBoxBackground)] = CScrollBoxBackground;
|
||||||
|
begin
|
||||||
|
GetPalette:=@P;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TScrollBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
||||||
|
begin
|
||||||
|
inherited Init(Bounds);
|
||||||
|
EventMask:=EventMask or evBroadcast;
|
||||||
|
HScrollBar:=AHScrollBar; VScrollBar:=AVScrollBar;
|
||||||
|
InitBackground;
|
||||||
|
if Assigned(Background) then Insert(Background);
|
||||||
|
ReDraw;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.InitBackground;
|
||||||
|
var R: TRect;
|
||||||
|
begin
|
||||||
|
GetExtent(R);
|
||||||
|
New(Background, Init(R,' '));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.HandleEvent(var Event: TEvent);
|
||||||
|
begin
|
||||||
|
if (Event.What=evBroadcast) and (Event.Command=cmCursorChanged) then
|
||||||
|
TrackCursor;
|
||||||
|
inherited HandleEvent(Event);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.ChangeBounds(var Bounds: TRect);
|
||||||
|
begin
|
||||||
|
SetBounds(Bounds);
|
||||||
|
Inc(DrawLock);
|
||||||
|
SetLimit(Limit.X, Limit.Y);
|
||||||
|
Dec(DrawLock);
|
||||||
|
DrawFlag := False;
|
||||||
|
DrawView;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.CheckDraw;
|
||||||
|
begin
|
||||||
|
if (DrawLock = 0) and DrawFlag then
|
||||||
|
begin
|
||||||
|
DrawFlag := False;
|
||||||
|
ReDraw; DrawView;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.ScrollDraw;
|
||||||
|
var
|
||||||
|
D: TPoint;
|
||||||
|
begin
|
||||||
|
if HScrollBar <> nil then
|
||||||
|
D.X := HScrollBar^.Value
|
||||||
|
else
|
||||||
|
D.X := 0;
|
||||||
|
if VScrollBar <> nil then
|
||||||
|
D.Y := VScrollBar^.Value
|
||||||
|
else
|
||||||
|
D.Y := 0;
|
||||||
|
if (D.X <> Delta.X) or (D.Y <> Delta.Y) then
|
||||||
|
begin
|
||||||
|
SetCursor(Cursor.X + Delta.X - D.X, Cursor.Y + Delta.Y - D.Y);
|
||||||
|
Delta := D;
|
||||||
|
if DrawLock <> 0 then
|
||||||
|
DrawFlag := True
|
||||||
|
else
|
||||||
|
DrawView;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TScrollBox.ScrollTo(X, Y: Sw_Integer);
|
||||||
|
var DX,DY: sw_integer;
|
||||||
|
begin
|
||||||
|
Inc(DrawLock);
|
||||||
|
DX:=Delta.X-X; DY:=Delta.Y-Y;
|
||||||
|
if HScrollBar <> nil then
|
||||||
|
HScrollBar^.SetValue(X);
|
||||||
|
if VScrollBar <> nil then
|
||||||
|
VScrollBar^.SetValue(Y);
|
||||||
|
ShiftViews(DX,DY);
|
||||||
|
Dec(DrawLock);
|
||||||
|
CheckDraw;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.ShiftViews(DX,DY: sw_integer);
|
||||||
|
procedure DoShift(P: PView); {$ifndef FPC}far;{$endif}
|
||||||
|
begin
|
||||||
|
P^.MoveTo(P^.Origin.X+DX,P^.Origin.Y+DY);
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
ForEach(@DoShift);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.SetLimit(X, Y: Sw_Integer);
|
||||||
|
begin
|
||||||
|
Limit.X := X;
|
||||||
|
Limit.Y := Y;
|
||||||
|
Inc(DrawLock);
|
||||||
|
if HScrollBar <> nil then
|
||||||
|
HScrollBar^.SetParams(HScrollBar^.Value, 0, X - Size.X, Size.X - 1, HScrollBar^.ArStep);
|
||||||
|
if VScrollBar <> nil then
|
||||||
|
VScrollBar^.SetParams(VScrollBar^.Value, 0, Y - Size.Y, Size.Y - 1, VScrollBar^.ArStep);
|
||||||
|
Dec(DrawLock);
|
||||||
|
CheckDraw;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.SetState(AState: Word; Enable: Boolean);
|
||||||
|
procedure ShowSBar(SBar: PScrollBar);
|
||||||
|
begin
|
||||||
|
if (SBar <> nil) then
|
||||||
|
if GetState(sfActive + sfSelected) then
|
||||||
|
SBar^.Show
|
||||||
|
else
|
||||||
|
SBar^.Hide;
|
||||||
|
end;
|
||||||
|
var OState: word;
|
||||||
|
begin
|
||||||
|
OState:=State;
|
||||||
|
inherited SetState(AState, Enable);
|
||||||
|
if AState and (sfActive + sfSelected) <> 0 then
|
||||||
|
begin
|
||||||
|
ShowSBar(HScrollBar);
|
||||||
|
ShowSBar(VScrollBar);
|
||||||
|
end;
|
||||||
|
if ((OState xor State) and (sfFocused))<>0 then
|
||||||
|
TrackCursor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.TrackCursor;
|
||||||
|
var V: PView;
|
||||||
|
P,ND: TPoint;
|
||||||
|
begin
|
||||||
|
V:=Current;
|
||||||
|
if (not Assigned(V)) then Exit;
|
||||||
|
P.X:=V^.Origin.X+V^.Cursor.X; P.Y:=V^.Origin.Y+V^.Cursor.Y;
|
||||||
|
ND:=Delta;
|
||||||
|
if (P.X<0) then Dec(ND.X,-P.X) else
|
||||||
|
if (P.X>=Size.X) then Inc(ND.X,P.X-(Size.X-1));
|
||||||
|
if (P.Y<0) then Dec(ND.Y,-P.Y) else
|
||||||
|
if (P.Y>=Size.Y) then Inc(ND.Y,P.Y-(Size.Y-1));
|
||||||
|
if (ND.X<>Delta.X) or (ND.Y<>Delta.Y) then
|
||||||
|
ScrollTo(ND.X,ND.Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TScrollBox.ClipChilds: boolean;
|
||||||
|
begin
|
||||||
|
ClipChilds:=false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.BeforeInsert(P: PView);
|
||||||
|
begin
|
||||||
|
if Assigned(P) then
|
||||||
|
P^.MoveTo(P^.Origin.X-Delta.X,P^.Origin.Y-Delta.Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.AfterInsert(P: PView);
|
||||||
|
begin
|
||||||
|
UpdateLimits;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.AfterDelete(P: PView);
|
||||||
|
begin
|
||||||
|
UpdateLimits;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.Draw;
|
||||||
|
begin
|
||||||
|
inherited Draw;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TScrollBox.UpdateLimits;
|
||||||
|
var Max: TPoint;
|
||||||
|
procedure Check(P: PView); {$ifndef FPC}far;{$endif}
|
||||||
|
var O: TPoint;
|
||||||
|
begin
|
||||||
|
O.X:=P^.Origin.X+P^.Size.X+Delta.X; O.Y:=P^.Origin.Y+P^.Size.Y+Delta.Y;
|
||||||
|
if O.X>Max.X then Max.X:=O.X;
|
||||||
|
if O.Y>Max.Y then Max.Y:=O.Y;
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
Max.X:=0; Max.Y:=0;
|
||||||
|
ForEach(@Check);
|
||||||
|
if (Max.X<>Limit.X) or (Max.Y<>Limit.Y) then
|
||||||
|
SetLimit(Max.X,Max.Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
END.
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.2 2000-09-22 23:13:37 pierre
|
||||||
|
* add emulation for go32v2 and display currently extraced file
|
||||||
|
and changes by Gabor for scrolling support (merged)
|
||||||
|
|
||||||
|
Revision 1.1.2.1 2000/09/21 10:51:33 pierre
|
||||||
|
new file from Gabor
|
||||||
|
|
||||||
|
}
|
||||||
Loading…
Reference in New Issue
Block a user