mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 16:39:24 +01:00
439 lines
21 KiB
ObjectPascal
439 lines
21 KiB
ObjectPascal
{ $Id$ }
|
|
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
|
|
{ }
|
|
{ System independent GRAPHICAL clone of HISTLIST.PAS }
|
|
{ }
|
|
{ Interface Copyright (c) 1992 Borland International }
|
|
{ }
|
|
{ Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer }
|
|
{ ldeboer@attglobal.net - primary e-mail address }
|
|
{ ldeboer@starwon.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) }
|
|
{ }
|
|
{******************[ REVISION HISTORY ]********************}
|
|
{ Version Date Fix }
|
|
{ ------- --------- --------------------------------- }
|
|
{ 1.00 11 Nov 96 First DOS/DPMI platform release. }
|
|
{ 1.10 13 Jul 97 Windows platform code added. }
|
|
{ 1.20 29 Aug 97 Platform.inc sort added. }
|
|
{ 1.30 13 Oct 97 Delphi 2 32 bit code added. }
|
|
{ 1.40 05 May 98 Virtual pascal 2.0 code added. }
|
|
{ 1.50 30 Sep 99 Complete recheck preformed }
|
|
{ 1.51 03 Nov 99 FPC windows support added }
|
|
{**********************************************************}
|
|
|
|
UNIT HistList;
|
|
|
|
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
|
|
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 }
|
|
{$N-} { No 80x87 code generation }
|
|
{$E+} { Emulation is on }
|
|
{$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 }
|
|
{====================================================================}
|
|
|
|
USES FVCommon, Objects; { Standard GFV units }
|
|
|
|
{***************************************************************************}
|
|
{ INTERFACE ROUTINES }
|
|
{***************************************************************************}
|
|
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
{ HISTORY SYSTEM CONTROL ROUTINES }
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
|
|
{-InitHistory--------------------------------------------------------
|
|
Initializes the history system usually called from Application.Init
|
|
30Sep99 LdB
|
|
---------------------------------------------------------------------}
|
|
PROCEDURE InitHistory;
|
|
|
|
{-DoneHistory--------------------------------------------------------
|
|
Destroys the history system usually called from Application.Done
|
|
30Sep99 LdB
|
|
---------------------------------------------------------------------}
|
|
PROCEDURE DoneHistory;
|
|
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
{ HISTORY ITEM ROUTINES }
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
|
|
{-HistoryCount-------------------------------------------------------
|
|
Returns the number of strings in the history list with ID number Id.
|
|
30Sep99 LdB
|
|
---------------------------------------------------------------------}
|
|
FUNCTION HistoryCount (Id: Byte): Word;
|
|
|
|
{-HistoryStr---------------------------------------------------------
|
|
Returns the Index'th string in the history list with ID number Id.
|
|
30Sep99 LdB
|
|
---------------------------------------------------------------------}
|
|
FUNCTION HistoryStr (Id: Byte; Index: Sw_Integer): String;
|
|
|
|
{-ClearHistory-------------------------------------------------------
|
|
Removes all strings from all history lists.
|
|
30Sep99 LdB
|
|
---------------------------------------------------------------------}
|
|
PROCEDURE ClearHistory;
|
|
|
|
{-HistoryAdd---------------------------------------------------------
|
|
Adds the string Str to the history list indicated by Id.
|
|
30Sep99 LdB
|
|
---------------------------------------------------------------------}
|
|
PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
|
|
|
|
function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
|
|
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
{ HISTORY STREAM STORAGE AND RETREIVAL ROUTINES }
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
|
|
{-LoadHistory--------------------------------------------------------
|
|
Reads the application's history block from the stream S by reading the
|
|
size of the block, then the block itself. Sets HistoryUsed to the end
|
|
of the block read. Use LoadHistory to restore a history block saved
|
|
with StoreHistory
|
|
30Sep99 LdB
|
|
---------------------------------------------------------------------}
|
|
PROCEDURE LoadHistory (Var S: TStream);
|
|
|
|
{-StoreHistory--------------------------------------------------------
|
|
Writes the currently used portion of the history block to the stream
|
|
S, first writing the length of the block then the block itself. Use
|
|
the LoadHistory procedure to restore the history block.
|
|
30Sep99 LdB
|
|
---------------------------------------------------------------------}
|
|
PROCEDURE StoreHistory (Var S: TStream);
|
|
|
|
{***************************************************************************}
|
|
{ INITIALIZED PUBLIC VARIABLES }
|
|
{***************************************************************************}
|
|
{---------------------------------------------------------------------------}
|
|
{ INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
|
|
{---------------------------------------------------------------------------}
|
|
CONST
|
|
HistorySize: Word = 1024; { Maximum history size }
|
|
HistoryUsed: LongInt = 0; { History used }
|
|
HistoryBlock: Pointer = Nil; { Storage block }
|
|
|
|
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
|
|
IMPLEMENTATION
|
|
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
|
|
|
|
{***************************************************************************}
|
|
{ PRIVATE RECORD DEFINITIONS }
|
|
{***************************************************************************}
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ THistRec RECORD DEFINITION }
|
|
{---------------------------------------------------------------------------}
|
|
TYPE
|
|
THistRec = PACKED RECORD
|
|
Zero: byte; { Start marker }
|
|
Id : byte; { History id }
|
|
Str : String; { History string }
|
|
END;
|
|
PHistRec = ^THistRec; { History record ptr }
|
|
|
|
{***************************************************************************}
|
|
{ UNINITIALIZED PRIVATE VARIABLES }
|
|
{***************************************************************************}
|
|
{---------------------------------------------------------------------------}
|
|
{ UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
|
|
{---------------------------------------------------------------------------}
|
|
VAR
|
|
CurId: Byte; { Current history id }
|
|
CurString: PString; { Current string }
|
|
|
|
{***************************************************************************}
|
|
{ PRIVATE UNIT ROUTINES }
|
|
{***************************************************************************}
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ StartId -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
PROCEDURE StartId (Id: Byte);
|
|
BEGIN
|
|
CurId := Id; { Set current id }
|
|
CurString := HistoryBlock; { Set current string }
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
PROCEDURE DeleteString;
|
|
VAR Len: Sw_Integer; P, P2: PChar;
|
|
BEGIN
|
|
P := PChar(CurString); { Current string }
|
|
P2 := PChar(CurString); { Current string }
|
|
Len := PByte(P2)^+3; { Length of data }
|
|
Dec(P, 2); { Correct position }
|
|
Inc(P2, PByte(P2)^+1); { Next hist record }
|
|
{ Shuffle history }
|
|
Move(P2^, P^, cardinal(HistoryBlock) + HistoryUsed - cardinal(P2) );
|
|
Dec(HistoryUsed, Len); { Adjust history used }
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ AdvanceStringPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
PROCEDURE AdvanceStringPtr;
|
|
VAR P: PHistRec;
|
|
BEGIN
|
|
While (CurString <> Nil) Do Begin
|
|
If (cardinal(CurString) >= cardinal(HistoryBlock) + HistoryUsed) Then Begin{ Last string check }
|
|
CurString := Nil; { Clear current string }
|
|
Exit; { Now exit }
|
|
End;
|
|
Inc(PChar(CurString), PByte(CurString)^+1); { Move to next string }
|
|
If (cardinal(CurString) >= cardinal(HistoryBlock) + HistoryUsed) Then Begin{ Last string check }
|
|
CurString := Nil; { Clear current string }
|
|
Exit; { Now exit }
|
|
End;
|
|
P := PHistRec(CurString); { Transfer record ptr }
|
|
Inc(PChar(CurString), 2); { Move to string }
|
|
if (P^.Zero<>0) then
|
|
RunError(215);
|
|
If (P^.Id = CurId) Then Exit; { Found the string }
|
|
End;
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ InsertString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
PROCEDURE InsertString (Id: Byte; Const Str: String);
|
|
VAR P1, P2: PChar;
|
|
P : PHistRec;
|
|
BEGIN
|
|
while (HistoryUsed+Length(Str)+3>HistorySize) do
|
|
begin
|
|
P:=PHistRec(HistoryBlock);
|
|
while Pointer(P)<Pointer(HistoryBlock)+HistorySize do
|
|
begin
|
|
if Pointer(P)+Length(P^.Str)+6+Length(Str) >
|
|
Pointer(HistoryBlock)+HistorySize then
|
|
begin
|
|
HistoryUsed:=HistoryUsed-(Length(P^.Str)+3);
|
|
FillChar(P^,Pointer(HistoryBlock)+HistorySize-Pointer(P),#0);
|
|
break;
|
|
end;
|
|
P:=PHistRec(Pointer(P)+Length(P^.Str)+3);
|
|
end;
|
|
end;
|
|
P1 := PChar(HistoryBlock)+1; { First history record }
|
|
P2 := P1+Length(Str)+3; { History record after }
|
|
Move(P1^, P2^, HistoryUsed - 1); { Shuffle history data }
|
|
PHistRec(P1)^.Zero := 0; { Set marker byte }
|
|
PHistRec(P1)^.Id := Id; { Set history id }
|
|
{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
|
|
Move(Str[1], PHistRec(P1)^.Str[1], Length(Str)); { Set history string }
|
|
SetLength(PHistRec(P1)^.Str, Length(Str)); { Set string length }
|
|
{$ELSE} { OTHER COMPILERS }
|
|
Move(Str[0], PHistRec(P1)^.Str, Length(Str)+1); { Set history string }
|
|
{$ENDIF}
|
|
Inc(HistoryUsed, Length(Str)+3); { Inc history used }
|
|
END;
|
|
|
|
{***************************************************************************}
|
|
{ INTERFACE ROUTINES }
|
|
{***************************************************************************}
|
|
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
{ HISTORY SYSTEM CONTROL ROUTINES }
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ InitHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
PROCEDURE InitHistory;
|
|
BEGIN
|
|
GetMem(HistoryBlock, HistorySize); { Allocate block }
|
|
ClearHistory; { Clear the history }
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ DoneHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
PROCEDURE DoneHistory;
|
|
BEGIN
|
|
If (HistoryBlock <> Nil) Then { History block valid }
|
|
FreeMem(HistoryBlock, HistorySize); { Release history block }
|
|
END;
|
|
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
{ HISTORY ITEM ROUTINES }
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ HistoryCount -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
FUNCTION HistoryCount(Id: Byte): Word;
|
|
VAR Count: Word;
|
|
BEGIN
|
|
StartId(Id); { Set to first record }
|
|
Count := 0; { Clear count }
|
|
If (HistoryBlock <> Nil) Then Begin { History initalized }
|
|
AdvanceStringPtr; { Move to first string }
|
|
While (CurString <> Nil) Do Begin
|
|
Inc(Count); { Add one to count }
|
|
AdvanceStringPtr; { Move to next string }
|
|
End;
|
|
End;
|
|
HistoryCount := Count; { Return history count }
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
FUNCTION HistoryStr(Id: Byte; Index: Sw_Integer): String;
|
|
VAR I: Sw_Integer;
|
|
BEGIN
|
|
StartId(Id); { Set to first record }
|
|
If (HistoryBlock <> Nil) Then Begin { History initalized }
|
|
For I := 0 To Index Do AdvanceStringPtr; { Find indexed string }
|
|
If (CurString <> Nil) Then
|
|
HistoryStr := CurString^ Else { Return string }
|
|
HistoryStr := ''; { Index not found }
|
|
End Else HistoryStr := ''; { History uninitialized }
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ ClearHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
PROCEDURE ClearHistory;
|
|
BEGIN
|
|
If (HistoryBlock <> Nil) Then Begin { History initiated }
|
|
PChar(HistoryBlock)^ := #0; { Clear first byte }
|
|
HistoryUsed := 1; { Set position }
|
|
End;
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ HistoryAdd -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
|
|
BEGIN
|
|
If (Str = '') Then Exit; { Empty string exit }
|
|
If (HistoryBlock = Nil) Then Exit; { History uninitialized }
|
|
StartId(Id); { Set current data }
|
|
AdvanceStringPtr; { Find the string }
|
|
While (CurString <> nil) Do Begin
|
|
If (Str = CurString^) Then DeleteString; { Delete duplicates }
|
|
AdvanceStringPtr; { Find next string }
|
|
End;
|
|
InsertString(Id, Str); { Add new history item }
|
|
END;
|
|
|
|
function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
|
|
var
|
|
I: Sw_Integer;
|
|
begin
|
|
StartId(Id);
|
|
for I := 0 to Index do
|
|
AdvanceStringPtr; { Find the string }
|
|
if CurString <> nil then
|
|
begin
|
|
DeleteString;
|
|
HistoryRemove:=true;
|
|
end
|
|
else
|
|
HistoryRemove:=false;
|
|
end;
|
|
|
|
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
{ HISTORY STREAM STORAGE AND RETREIVAL ROUTINES }
|
|
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ LoadHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
PROCEDURE LoadHistory (Var S: TStream);
|
|
VAR Size: sw_Word;
|
|
BEGIN
|
|
S.Read(Size, sizeof(Size)); { Read history size }
|
|
If (HistoryBlock <> Nil) Then Begin { History initialized }
|
|
If (Size <= HistorySize) Then Begin
|
|
S.Read(HistoryBlock^, Size); { Read the history }
|
|
HistoryUsed := Size; { History used }
|
|
End Else S.Seek(S.GetPos + Size); { Move stream position }
|
|
End Else S.Seek(S.GetPos + Size); { Move stream position }
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{ StoreHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
|
|
{---------------------------------------------------------------------------}
|
|
PROCEDURE StoreHistory (Var S: TStream);
|
|
VAR Size: sw_Word;
|
|
BEGIN
|
|
If (HistoryBlock = Nil) Then Size := 0 Else { No history data }
|
|
Size := HistoryUsed; { Size of history data }
|
|
S.Write(Size, sizeof(Size)); { Write history size }
|
|
If (Size > 0) Then S.Write(HistoryBlock^, Size); { Write history data }
|
|
END;
|
|
|
|
END.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.10 2002-10-17 11:24:16 pierre
|
|
* Clean up the Load/Store routines so they are endian independent
|
|
|
|
Revision 1.9 2002/09/07 15:06:37 peter
|
|
* old logs removed and tabs fixed
|
|
|
|
Revision 1.8 2002/06/10 11:51:08 pierre
|
|
* render history load/store compatible with older fvnew lib
|
|
|
|
Revision 1.7 2002/06/03 20:07:44 pierre
|
|
* DeleteString was moving to much memory
|
|
|
|
Revision 1.6 2002/05/24 09:30:33 pierre
|
|
* fix bug with HistoryUsed, now is really a used size
|
|
|
|
}
|