/packages/fv/src/histlist.pas
Pascal | 416 lines | 178 code | 45 blank | 193 comment | 7 complexity | 771b2afda4811b055309b995f9eef168 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
1{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********} 2{ } 3{ System independent GRAPHICAL clone of HISTLIST.PAS } 4{ } 5{ Interface Copyright (c) 1992 Borland International } 6{ } 7{ Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer } 8{ ldeboer@attglobal.net - primary e-mail address } 9{ ldeboer@starwon.com.au - backup e-mail address } 10{ } 11{****************[ THIS CODE IS FREEWARE ]*****************} 12{ } 13{ This sourcecode is released for the purpose to } 14{ promote the pascal language on all platforms. You may } 15{ redistribute it and/or modify with the following } 16{ DISCLAIMER. } 17{ } 18{ This SOURCE CODE is distributed "AS IS" WITHOUT } 19{ WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR } 20{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. } 21{ } 22{*****************[ SUPPORTED PLATFORMS ]******************} 23{ 16 and 32 Bit compilers } 24{ DOS - Turbo Pascal 7.0 + (16 Bit) } 25{ DPMI - Turbo Pascal 7.0 + (16 Bit) } 26{ - FPC 0.9912+ (GO32V2) (32 Bit) } 27{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) } 28{ - Delphi 1.0+ (16 Bit) } 29{ WIN95/NT - Delphi 2.0+ (32 Bit) } 30{ - Virtual Pascal 2.0+ (32 Bit) } 31{ - Speedsoft Sybil 2.0+ (32 Bit) } 32{ - FPC 0.9912+ (32 Bit) } 33{ OS2 - Virtual Pascal 1.0+ (32 Bit) } 34{ } 35{******************[ REVISION HISTORY ]********************} 36{ Version Date Fix } 37{ ------- --------- --------------------------------- } 38{ 1.00 11 Nov 96 First DOS/DPMI platform release. } 39{ 1.10 13 Jul 97 Windows platform code added. } 40{ 1.20 29 Aug 97 Platform.inc sort added. } 41{ 1.30 13 Oct 97 Delphi 2 32 bit code added. } 42{ 1.40 05 May 98 Virtual pascal 2.0 code added. } 43{ 1.50 30 Sep 99 Complete recheck preformed } 44{ 1.51 03 Nov 99 FPC windows support added } 45{**********************************************************} 46 47UNIT HistList; 48 49{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} 50 INTERFACE 51{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} 52 53{====Include file to sort compiler platform out =====================} 54{$I platform.inc} 55{====================================================================} 56 57{==== Compiler directives ===========================================} 58 59{$IFNDEF PPC_FPC}{ FPC doesn't support these switches } 60 {$F-} { Short calls are okay } 61 {$A+} { Word Align Data } 62 {$B-} { Allow short circuit boolean evaluations } 63 {$O+} { This unit may be overlaid } 64 {$G+} { 286 Code optimization - if you're on an 8088 get a real computer } 65 {$P-} { Normal string variables } 66 {$N-} { No 80x87 code generation } 67 {$E+} { Emulation is on } 68{$ENDIF} 69 70{$X+} { Extended syntax is ok } 71{$R-} { Disable range checking } 72{$S-} { Disable Stack Checking } 73{$I-} { Disable IO Checking } 74{$Q-} { Disable Overflow Checking } 75{$V-} { Turn off strict VAR strings } 76{====================================================================} 77 78USES FVCommon, Objects; { Standard GFV units } 79 80{***************************************************************************} 81{ INTERFACE ROUTINES } 82{***************************************************************************} 83 84{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 85{ HISTORY SYSTEM CONTROL ROUTINES } 86{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 87 88{-InitHistory-------------------------------------------------------- 89Initializes the history system usually called from Application.Init 9030Sep99 LdB 91---------------------------------------------------------------------} 92PROCEDURE InitHistory; 93 94{-DoneHistory-------------------------------------------------------- 95Destroys the history system usually called from Application.Done 9630Sep99 LdB 97---------------------------------------------------------------------} 98PROCEDURE DoneHistory; 99 100{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 101{ HISTORY ITEM ROUTINES } 102{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 103 104{-HistoryCount------------------------------------------------------- 105Returns the number of strings in the history list with ID number Id. 10630Sep99 LdB 107---------------------------------------------------------------------} 108FUNCTION HistoryCount (Id: Byte): Word; 109 110{-HistoryStr--------------------------------------------------------- 111Returns the Index'th string in the history list with ID number Id. 11230Sep99 LdB 113---------------------------------------------------------------------} 114FUNCTION HistoryStr (Id: Byte; Index: Sw_Integer): String; 115 116{-ClearHistory------------------------------------------------------- 117Removes all strings from all history lists. 11830Sep99 LdB 119---------------------------------------------------------------------} 120PROCEDURE ClearHistory; 121 122{-HistoryAdd--------------------------------------------------------- 123Adds the string Str to the history list indicated by Id. 12430Sep99 LdB 125---------------------------------------------------------------------} 126PROCEDURE HistoryAdd (Id: Byte; Const Str: String); 127 128function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean; 129 130{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 131{ HISTORY STREAM STORAGE AND RETREIVAL ROUTINES } 132{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 133 134{-LoadHistory-------------------------------------------------------- 135Reads the application's history block from the stream S by reading the 136size of the block, then the block itself. Sets HistoryUsed to the end 137of the block read. Use LoadHistory to restore a history block saved 138with StoreHistory 13930Sep99 LdB 140---------------------------------------------------------------------} 141PROCEDURE LoadHistory (Var S: TStream); 142 143{-StoreHistory-------------------------------------------------------- 144Writes the currently used portion of the history block to the stream 145S, first writing the length of the block then the block itself. Use 146the LoadHistory procedure to restore the history block. 14730Sep99 LdB 148---------------------------------------------------------------------} 149PROCEDURE StoreHistory (Var S: TStream); 150 151{***************************************************************************} 152{ INITIALIZED PUBLIC VARIABLES } 153{***************************************************************************} 154{---------------------------------------------------------------------------} 155{ INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES } 156{---------------------------------------------------------------------------} 157CONST 158 HistorySize: sw_integer = 64*1024; { Maximum history size } 159 HistoryUsed: sw_integer = 0; { History used } 160 HistoryBlock: Pointer = Nil; { Storage block } 161 162{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} 163 IMPLEMENTATION 164{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} 165 166{***************************************************************************} 167{ PRIVATE RECORD DEFINITIONS } 168{***************************************************************************} 169 170{---------------------------------------------------------------------------} 171{ THistRec RECORD DEFINITION 172 173 Zero 1 byte, start marker 174 Id 1 byte, History id 175 <shortstring> 1 byte length+string data, Contents 176} 177 178{***************************************************************************} 179{ UNINITIALIZED PRIVATE VARIABLES } 180{***************************************************************************} 181{---------------------------------------------------------------------------} 182{ UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES } 183{---------------------------------------------------------------------------} 184VAR 185 CurId: Byte; { Current history id } 186 CurString: PString; { Current string } 187 188{***************************************************************************} 189{ PRIVATE UNIT ROUTINES } 190{***************************************************************************} 191 192{---------------------------------------------------------------------------} 193{ StartId -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 194{---------------------------------------------------------------------------} 195PROCEDURE StartId (Id: Byte); 196BEGIN 197 CurId := Id; { Set current id } 198 CurString := HistoryBlock; { Set current string } 199END; 200 201{---------------------------------------------------------------------------} 202{ DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 203{---------------------------------------------------------------------------} 204PROCEDURE DeleteString; 205VAR Len: Sw_Integer; P, P2: PChar; 206BEGIN 207 P := PChar(CurString); { Current string } 208 P2 := PChar(CurString); { Current string } 209 Len := PByte(P2)^+3; { Length of data } 210 Dec(P, 2); { Correct position } 211 Inc(P2, PByte(P2)^+1); { Next hist record } 212 { Shuffle history } 213 Move(P2^, P^, Pointer(HistoryBlock) + HistoryUsed - Pointer(P2) ); 214 Dec(HistoryUsed, Len); { Adjust history used } 215END; 216 217{---------------------------------------------------------------------------} 218{ AdvanceStringPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 219{---------------------------------------------------------------------------} 220PROCEDURE AdvanceStringPtr; 221VAR P: PChar; 222BEGIN 223 While (CurString <> Nil) Do Begin 224 If (Pointer(CurString) >= Pointer(HistoryBlock) + HistoryUsed) Then Begin{ Last string check } 225 CurString := Nil; { Clear current string } 226 Exit; { Now exit } 227 End; 228 Inc(PChar(CurString), PByte(CurString)^+1); { Move to next string } 229 If (Pointer(CurString) >= Pointer(HistoryBlock) + HistoryUsed) Then Begin{ Last string check } 230 CurString := Nil; { Clear current string } 231 Exit; { Now exit } 232 End; 233 P := PChar(CurString); { Transfer record ptr } 234 Inc(PChar(CurString), 2); { Move to string } 235 if (P^<>#0) then 236 RunError(215); 237 Inc(P); 238 If (P^ = Chr(CurId)) Then Exit; { Found the string } 239 End; 240END; 241 242{---------------------------------------------------------------------------} 243{ InsertString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 244{---------------------------------------------------------------------------} 245PROCEDURE InsertString (Id: Byte; Const Str: String); 246VAR P, P1, P2: PChar; 247BEGIN 248 while (HistoryUsed+Length(Str)+3>HistorySize) do 249 begin 250 P:=PChar(HistoryBlock); 251 while Pointer(P)<Pointer(HistoryBlock)+HistorySize do 252 begin 253 if Pointer(P)+Length(PShortString(P+2)^)+6+Length(Str) > 254 Pointer(HistoryBlock)+HistorySize then 255 begin 256 Dec(HistoryUsed,Length(PShortString(P+2)^)+3); 257 FillChar(P^,Pointer(HistoryBlock)+HistorySize-Pointer(P),#0); 258 break; 259 end; 260 Inc(P,Length(PShortString(P+2)^)+3); 261 end; 262 end; 263 P1 := PChar(HistoryBlock)+1; { First history record } 264 P2 := P1+Length(Str)+3; { History record after } 265 Move(P1^, P2^, HistoryUsed - 1); { Shuffle history data } 266 P1^:=#0; { Set marker byte } 267 Inc(P1); 268 P1^:=Chr(Id); { Set history id } 269 Inc(P1); 270 Move(Str[0], P1^, Length(Str)+1); { Set history string } 271 Inc(HistoryUsed, Length(Str)+3); { Inc history used } 272END; 273 274{***************************************************************************} 275{ INTERFACE ROUTINES } 276{***************************************************************************} 277 278{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 279{ HISTORY SYSTEM CONTROL ROUTINES } 280{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 281 282{---------------------------------------------------------------------------} 283{ InitHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 284{---------------------------------------------------------------------------} 285PROCEDURE InitHistory; 286BEGIN 287 if HistorySize>0 then 288 GetMem(HistoryBlock, HistorySize); { Allocate block } 289 ClearHistory; { Clear the history } 290END; 291 292{---------------------------------------------------------------------------} 293{ DoneHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 294{---------------------------------------------------------------------------} 295PROCEDURE DoneHistory; 296BEGIN 297 If (HistoryBlock <> Nil) Then { History block valid } 298 begin 299 FreeMem(HistoryBlock); { Release history block } 300 HistoryBlock:=nil; 301 end; 302END; 303 304{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 305{ HISTORY ITEM ROUTINES } 306{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 307 308{---------------------------------------------------------------------------} 309{ HistoryCount -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 310{---------------------------------------------------------------------------} 311FUNCTION HistoryCount(Id: Byte): Word; 312VAR Count: Word; 313BEGIN 314 StartId(Id); { Set to first record } 315 Count := 0; { Clear count } 316 If (HistoryBlock <> Nil) Then Begin { History initalized } 317 AdvanceStringPtr; { Move to first string } 318 While (CurString <> Nil) Do Begin 319 Inc(Count); { Add one to count } 320 AdvanceStringPtr; { Move to next string } 321 End; 322 End; 323 HistoryCount := Count; { Return history count } 324END; 325 326{---------------------------------------------------------------------------} 327{ HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 328{---------------------------------------------------------------------------} 329FUNCTION HistoryStr(Id: Byte; Index: Sw_Integer): String; 330VAR I: Sw_Integer; 331BEGIN 332 StartId(Id); { Set to first record } 333 If (HistoryBlock <> Nil) Then Begin { History initalized } 334 For I := 0 To Index Do AdvanceStringPtr; { Find indexed string } 335 If (CurString <> Nil) Then 336 HistoryStr := CurString^ Else { Return string } 337 HistoryStr := ''; { Index not found } 338 End Else HistoryStr := ''; { History uninitialized } 339END; 340 341{---------------------------------------------------------------------------} 342{ ClearHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 343{---------------------------------------------------------------------------} 344PROCEDURE ClearHistory; 345BEGIN 346 If (HistoryBlock <> Nil) Then Begin { History initiated } 347 PChar(HistoryBlock)^ := #0; { Clear first byte } 348 HistoryUsed := 1; { Set position } 349 End; 350END; 351 352{---------------------------------------------------------------------------} 353{ HistoryAdd -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 354{---------------------------------------------------------------------------} 355PROCEDURE HistoryAdd (Id: Byte; Const Str: String); 356BEGIN 357 If (Str = '') Then Exit; { Empty string exit } 358 If (HistoryBlock = Nil) Then Exit; { History uninitialized } 359 StartId(Id); { Set current data } 360 AdvanceStringPtr; { Find the string } 361 While (CurString <> nil) Do Begin 362 If (Str = CurString^) Then DeleteString; { Delete duplicates } 363 AdvanceStringPtr; { Find next string } 364 End; 365 InsertString(Id, Str); { Add new history item } 366END; 367 368function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean; 369var 370 I: Sw_Integer; 371begin 372 StartId(Id); 373 for I := 0 to Index do 374 AdvanceStringPtr; { Find the string } 375 if CurString <> nil then 376 begin 377 DeleteString; 378 HistoryRemove:=true; 379 end 380 else 381 HistoryRemove:=false; 382end; 383 384 385{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 386{ HISTORY STREAM STORAGE AND RETREIVAL ROUTINES } 387{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} 388 389{---------------------------------------------------------------------------} 390{ LoadHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 391{---------------------------------------------------------------------------} 392PROCEDURE LoadHistory (Var S: TStream); 393VAR Size: sw_integer; 394BEGIN 395 S.Read(Size, sizeof(Size)); { Read history size } 396 If (HistoryBlock <> Nil) Then Begin { History initialized } 397 If (Size <= HistorySize) Then Begin 398 S.Read(HistoryBlock^, Size); { Read the history } 399 HistoryUsed := Size; { History used } 400 End Else S.Seek(S.GetPos + Size); { Move stream position } 401 End Else S.Seek(S.GetPos + Size); { Move stream position } 402END; 403 404{---------------------------------------------------------------------------} 405{ StoreHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB } 406{---------------------------------------------------------------------------} 407PROCEDURE StoreHistory (Var S: TStream); 408VAR Size: sw_integer; 409BEGIN 410 If (HistoryBlock = Nil) Then Size := 0 Else { No history data } 411 Size := HistoryUsed; { Size of history data } 412 S.Write(Size, sizeof(Size)); { Write history size } 413 If (Size > 0) Then S.Write(HistoryBlock^, Size); { Write history data } 414END; 415 416END.