diff --git a/install/fpinst/install.pas b/install/fpinst/install.pas index e74e067f7f..372bccb26f 100644 --- a/install/fpinst/install.pas +++ b/install/fpinst/install.pas @@ -63,6 +63,9 @@ program install; {$ENDIF VirtualPascal} {$ENDIF FPC} {$ENDIF OS2} +{$IFDEF GO32V2} + emu387, +{$ENDIF} {$ifdef HEAPTRC} heaptrc, {$endif HEAPTRC} @@ -74,12 +77,15 @@ program install; {$IFDEF DLL} unzipdll, {$ENDIF} - app,dialogs,views,menus,msgbox,colortxt,tabs,inststr; + app,dialogs,views,menus,msgbox,colortxt,tabs,inststr,scroll; const installerversion='1.02'; + + {$ifdef TP}lfnsupport=false;{$endif} + maxpacks=10; maxpackages=20; maxdefcfgs=1024; @@ -149,6 +155,7 @@ program install; punzipdialog=^tunzipdialog; tunzipdialog=object(tdialog) filetext : pstatictext; + extractfiletext : pstatictext; constructor Init(var Bounds: TRect; ATitle: TTitleStr); procedure do_unzip(s,topath:string); end; @@ -466,17 +473,33 @@ program install; begin inherited init(bounds,atitle); (* 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: ')); insert(filetext); + R.Assign (1, 7,bounds.B.X-Bounds.A.X-2, 9); + extractfiletext:=new(pstatictext,init(r,#3' ')); + insert(extractfiletext); end; {$IFNDEF DLL} procedure UnzipCheckFn (Retcode: longint; Rec: pReportRec );{$ifdef Delphi32}STDCALL;{$endif} {$IFNDEF BIT32} FAR;{$ENDIF BIT32} + var + name : string; begin 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_unzipping: begin @@ -730,6 +753,9 @@ program install; titletext : pcoloredtext; labcfg : plabel; cfgcb : pcheckboxes; + scrollbox: pscrollbox; + sbr,sbsbr: trect; + sbsb: pscrollbar; begin f:=nil; { walk packages reverse and insert a newsitem for each, and set the mask } @@ -822,18 +848,39 @@ program install; {-------- Pack Sheets ----------} for j:=1 to cfg.packs do 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])); if data.packmask[j]=$ffff then 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]); end; {--------- Main ---------} 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 - packtd:=NewTabDef(cfg.pack[j].name,packcbs[j],NewTabItem(packcbs[j],nil),packtd); + begin + if (sbr.b.y-sbr.a.y) 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 - -} \ No newline at end of file +} diff --git a/install/fpinst/scroll.pas b/install/fpinst/scroll.pas new file mode 100644 index 0000000000..ec84c11bbd --- /dev/null +++ b/install/fpinst/scroll.pas @@ -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 + +} \ No newline at end of file