home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
VISIMP.ZIP
/
OMRULIST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-07-09
|
9KB
|
309 lines
{ *************************************************************************** }
{ V I S U A L I M P L E M E N T A T I O N }
{ Part One }
{ Most Recently Used File List }
{ Pascal Version (C)1993 Bobby R. Wallen }
{ All Rights Reserved }
{ Please do not remove my Credits from this file. }
{ *************************************************************************** }
unit OMRUList;
interface
uses WinTypes, Objects;
const
{ Allow for up to nine (9) Remembered Files }
CM_File1 = 5000;
CM_File2 = 5001;
CM_File3 = 5002;
CM_File4 = 5003;
CM_File5 = 5004;
CM_File6 = 5005;
CM_File7 = 5006;
CM_File8 = 5007;
CM_File9 = 5008;
{ Initialized ( Static ) variable/Constants }
nMaxItems : Integer = 5; { Default Number if Items in List }
hMDIWnd : HWND = 0; { MDI Client Window Handle }
DefIni : PChar = 'WIN.INI';
DefKey : PChar = 'files';
cFile : Integer = 0; { Number of remembered files }
cFileList : Integer = 0; { Number of files in FileMenu List }
type
TItemFmt = record
ID : Integer;
Name : PChar;
end;
PMRUItem = ^TMRUItem;
TMRUItem = object( TObject )
ItemName : PChar;
constructor Init( AName: PChar );
destructor Done; virtual;
end;
PMRUList = ^TMRUList;
TMRUList = object( TCollection )
constructor Init(CWnd: HWND; ALimit, ADelta: Integer );
destructor Done; virtual;
procedure AddMRUItem( AWnd: HWND; AName: PChar ); virtual;
procedure DeleteMRUItem( AWnd: HWND; AName: PChar ); virtual;
function GetMRUItem( AnID: Integer; AName: PChar ): Boolean; virtual;
procedure AppendMRUList( AWnd: HWND ); virtual;
procedure UpdateMRUList( AWnd: HWND ); virtual;
procedure LoadMRUList( AWnd: HWND; IniFile, KeyName: PChar ); virtual;
procedure SaveMRUList( IniFile, KeyName: PChar ); virtual;
end;
implementation
uses WinProcs, Strings;
function Min( I, J: Integer ): Integer;
begin
if I < J then Min := I else Min := J;
end;
constructor TMRUItem.Init( AName: PChar );
begin
ItemName := StrNew( AName );
end;
destructor TMRUItem.Done;
begin
StrDispose( ItemName );
end;
constructor TMRUList.Init( CWnd: HWND; ALimit, ADelta: Integer );
begin
if CWnd <> 0 then hMDIWnd := CWnd;
if ALimit > 9 then nMaxItems := 9;
if ALimit < 1 then nMaxItems := 1;
if ( ALimit >= 1 ) and ( ALimit <= 9 ) then nMaxItems := ALimit;
if ADelta <> 0 then ADelta := 0;
inherited Init( ALimit, ADelta );
end;
destructor TMRUList.Done;
begin
inherited Done;
end;
function Check( C: PMRUList; AName: PChar ): Boolean;
function Match( I : PMRUItem ): Boolean; far;
begin
Match := StrPos( I^.ItemName, AName ) <> nil;
end;
var
F : PMRUItem;
begin
F := C^.FirstThat( @Match );
if F = nil then Check := False
else
begin
Check := True;
C^.Delete( F );
end;
end;
procedure TMRUList.AddMRUItem( AWnd: HWND; AName: PChar );
var
P : PMRUItem;
F : Boolean;
begin
F := Check( @Self, AName );
P := new( PMRUItem, Init( AName ) );
if not F then { Not in List }
begin
if Count < nMaxItems then AtInsert( 0, P )
else
begin
AtDelete( Count - 1 );
dec( cFile );
AtInsert( 0, P );
end;
end
else
begin
dec( cFile );
AtInsert( 0, P );
end;
inc( cFile );
UpdateMRUList( AWnd );
end;
procedure TMRUList.UpdateMRUList( AWnd: HWND );
var
C : Integer;
sz : array[0..160] of Char;
MMenu : HMenu;
FMenu : HMenu;
cCount : Integer;
nFile : Integer;
Fmt : TItemFmt;
begin
nFile := 0;
if hMDIWnd <> 0 then
if HIWORD( SendMessage( hMDIWnd, WM_MDIGETACTIVE, 0, LongInt(0))) = 1
then
inc( nFile );
MMenu := GetMenu( AWnd );
FMenu := GetSubMenu( MMenu, nFile );
cCount := GetMenuItemCount( FMenu );
dec( cCount );
for C := 0 to Min( cFile, cFileList ) - 1 do
begin
Fmt.ID := C + 1;
Fmt.Name := PMRUItem( At(C) )^.ItemName;
wvsprintf( sz, '&%d %s', Fmt );
ModifyMenu( FMenu, CM_File1 + C, MF_STRING, CM_File1 + C, sz );
end;
if cFileList < cFile then
begin
if cFileList = 0 then
InsertMenu( FMenu, cCount, MF_SEPARATOR or MF_BYPOSITION, 0, nil )
else
dec( cCount );
for C := cFileList to cFile - 1 do
begin
Fmt.ID := C + 1;
Fmt.Name := PMRUItem( At( C ) )^.ItemName;
wvsprintf( sz, '&%d %s', Fmt );
InsertMenu( FMenu, cCount, MF_STRING or MF_BYPOSITION,
CM_File1 + C, sz );
inc( cCount );
end;
end
else
for C := cFile to cFileList - 1 do
DeleteMenu( FMenu, CM_File1 + C, MF_BYCOMMAND );
if (cFileList > 0) and (cFile = 0) then
begin
cCount := GetMenuItemCount( FMenu );
dec( cCount, 2 );
DeleteMenu( FMenu, cCount, MF_BYPOSITION );
end;
cFileList := cFile;
DrawMenuBar( AWnd );
end;
function FindItem( C: PMRUList; AName: PChar ): Integer;
function FoundIt( P: PMRUItem ): Boolean; far;
begin
FoundIt := StrPos( P^.ItemName, AName ) <> nil;
end;
var
F : PMRUItem;
begin
F := C^.FirstThat( @FoundIt );
if F = nil then FindItem := -1
else
begin
C^.Delete(F);
FindItem := 0;
end;
end;
procedure TMRUList.DeleteMRUItem( AWnd: HWND; AName: PChar );
var
X : Integer;
begin
X := FindItem( @Self, AName );
if X = -1 then Exit
else dec( cFile );
UpdateMRUList( AWnd );
end;
function TMRUList.GetMRUItem( AnID: Integer; AName: PChar ): Boolean;
begin
if ( AnID - CM_File1 ) < cFile then
StrCopy( AName, PMRUItem( At(AnID - CM_File1) )^.ItemName )
else
AName[0] := #0;
GetMRUItem := ( AName[0] <> #0 );
end;
procedure TMRUList.AppendMRUList( AWnd: HWND );
var
C : Integer;
nFile : Integer;
cCount : Integer;
MMenu : HMenu;
FMenu : HMenu;
sz : array[0..160] of Char;
Fmt : TItemFmt;
begin
nFile := 0;
if hMDIWnd <> 0 then
if HIWORD( SendMessage( hMDIWnd, WM_MDIGETACTIVE, 0, LongInt(0))) = 1
then
inc( nFile );
MMenu := GetMenu( AWnd );
FMenu := GetSubMenu( MMenu, nFile );
cCount := GetMenuItemCount( FMenu );
dec( cCount );
for C := 0 to cFile -1 do
begin
Fmt.ID := C + 1;
Fmt.Name := PMRUItem( At(C) )^.ItemName;
wvsprintf( sz, '&%d %s', Fmt );
InsertMenu( FMenu, cCount, MF_STRING or MF_BYPOSITION,
CM_File1 + C, sz );
inc( cCount );
end;
InsertMenu( FMenu, cCount, MF_SEPARATOR or MF_BYPOSITION, 0, nil );
cFileList := cFile;
end;
procedure TMRUList.LoadMRUList( AWnd: HWND; IniFile, KeyName: PChar );
var
C : Integer;
sz : array[0..144] of Char;
sz2 : array[0..6] of Char;
szIniFile : array[0..144] of Char;
szKey : array[0..144] of Char;
TheID : Integer;
begin
if IniFile[0] = #0 then StrCopy( szIniFile, DefIni )
else StrCopy(szIniFile, IniFile );
if KeyName[0] = #0 then StrCopy( szKey,DefKey)
else StrCopy( szKey, KeyName);
for C := nMaxItems - 1 downto 0 do
begin
TheID := C + 1;
wvsprintf( sz2, 'File%d', TheID );
GetPrivateProfileString( szKey, sz2, '', sz, 144, szIniFile );
if sz[0] <> #0 then
begin
AddMRUItem( AWnd, sz );
end;
end;
end;
procedure TMRUList.SaveMRUList( IniFile, KeyName: PChar );
var
C : Integer;
sz : array[0..144] of Char;
sz2 : array[0..6] of Char;
szIniFile : PChar;
szKey : PChar;
TheID : Integer;
begin
if IniFile[0] = #0 then szIniFile := DefIni else szIniFile := IniFile;
if KeyName[0] = #0 then szKey := DefKey else szKey := KeyName;
for C := 0 to nMaxItems - 1 do
begin
TheID := C + 1;
wvsprintf( sz2, 'File%d', TheID );
if( GetMRUItem( C + CM_File1, sz ) ) then
WritePrivateProfileString( szKey, sz2, sz, szIniFile )
else
WritePrivateProfileString( szKey, sz2, '', szIniFile );
end;
end;
end.