jvmrulist.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvMru.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is S閎astien Buysse [sbuysse att buypin dott com]
Portions created by S閎astien Buysse are Copyright (C) 2001 S閎astien Buysse.
All Rights Reserved.

Contributor(s):
Michael Beck [mbeck att bigfoot dott com].
Arioch [the_Arioch att nm dott ru]

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
   This unit is an interface to the MRU List (comctl32)
   Informations from :
      http://www.geocities.com/SiliconValley/4942

the_Arioch att nm dott ru

Changes are:
 0) Memory leaks in GetItem and EnumerateItems been fixed in JVCL 1.32
 1) fixed bug 2 Microsoft bugs. Read article at URL above.
 2) added ItemData property that allows to read data w|o using event
 3) EnumerateItems now relies upon GetItem to remove duplication of code.
     Now, if any bug - You may fix it one time, not 2 times :)
 4) one more thing - i cannot get the reason that almost all of the methods
    of the component are published rather than public. I think it is also a bug
 5) added MoveToTop(index) method; Warning! it changes ItemData property
 6) added DelayedWrite property
 7) renamed DeleteString to DeleteItem - cause it is the same for both String and Data
 8) added UseUnicode property - if List is of string type then it will use WideString methods
 9) added WantUnicode property - it will set UseUnicode respecting to used platform
10) some storage modifiers added for published property
xx) why keep UnicodeAvailable in every component? I wish Delphi could map
    property to a global variable :(

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvMRUList.pas,v 1.26 2005/03/09 14:57:27 marquardt Exp $

unit JvMRUList;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  SysUtils, Classes,
  JvComponent, JvTypes;

type
  TJvDataType = (dtString, dtBinary);
  TOnEnumData = procedure(Sender: TObject; Data: Pointer; Size: Integer; Index: Integer) of object;
  TOnEnumText = procedure(Sender: TObject; Value: string; Index: Integer) of object;
  TOnEnumUnicodeText = procedure(Sender: TObject; Value: WideString; Index: Integer) of object;

  TJvMruReturnData = record
    case Byte of
      0: (P: Pointer; );
      1: (S: PChar; );
      2: (Ws: PWideChar; );
  end;
  PJvMruReturnData = ^TJvMruReturnData;
  TMruCount = 0..29;

  TJvMruList = class(TJvComponent)
  private
    FUnicodeAvailable: Boolean;
    FUseUnicode: Boolean;
    FDelayedWrite: Boolean;
    FWantUnicode: Boolean;
    FMax: TMruCount;
    FSubKey: WideString;
    FKey: TJvRegKey;
    FList: THandle;
    FType: TJvDataType;
    FOnEnumData: TOnEnumData;
    FOnEnumText: TOnEnumText;
    FOnEnumUnicodeText: TOnEnumUnicodeText;
    FItemIndex: Integer;
    FItemData: TJvMruReturnData;
    procedure SetKey(const Value: TJvRegKey);
    procedure SetMax(const Value: TMruCount);
    function GetSubKey: string;
    procedure SetSubKeyUnicode(const Value: WideString);
    procedure SetSubKey(const Value: string);
    procedure SetType(const Value: TJvDataType);
    procedure SetUseUnicode(const Value: Boolean);
    procedure SetWantUnicode(const Value: Boolean);
    procedure SetItemData(const P: Pointer);
    function GetActive: Boolean;
    procedure SetActive(const Value: Boolean);
    function GetItemDataAsPChar: PChar;
    function GetItemDataAsPWideChar: PWideChar;
  protected
    function InternalGetItem(Index: Integer; FireEvent: Boolean = True): Boolean;
    procedure ReCreateList;
    procedure NeedUnicode;
    procedure DoEnumText; virtual;
    procedure DoUnicodeEnumText; virtual;
    // Arioch: even DataSize can be retained later from properties - but let 'em be.
    procedure DoEnumData(DataSize: Integer); virtual;
  public
    procedure Close;
    procedure Open;
    function ItemDataSize: Integer;
    property ItemDataAsPointer: Pointer read FItemData.P;
    property ItemDataAsPChar: PChar read GetItemDataAsPChar;
    property ItemDataAsPWideChar: PWideChar read GetItemDataAsPWideChar;
    property ItemIndex: Integer read FItemIndex;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MoveToTop(const Index: Integer);

    property UnicodeAvailable: Boolean read FUnicodeAvailable;
    property UseUnicode: Boolean read FUseUnicode write SetUseUnicode;

    // Arioch: the methods below are not public but published in original code
    function AddString(Value: string): Boolean;
    function AddPChar(Value: string): Boolean;
    function AddData(Value: Pointer; Size: Integer): Boolean;
    function GetItemsCount: Integer;
    function EnumItems: Boolean;
    function GetMostRecentItem: Boolean;
    function GetItem(Index: Integer = 0): Boolean;
    function FindString(Value: string): Integer;
    function FindData(Value: Pointer; Size: Integer): Integer;

    function DeleteItem(Index: Integer = 0): Boolean;
    function DeleteKey: Boolean;

    // Arioch: the following are function for Unicode Enabling
    function AddUnicodeString(Value: WideString): Boolean;
    function AddUnicodePChar(Value: PWideChar): Boolean;
    function FindUnicodeString(Value: WideString): Integer;
  published
    property DelayedWrite: Boolean read FDelayedWrite write FDelayedWrite default False;
    property WantUnicode: Boolean read FWantUnicode write SetWantUnicode default False;
    property RootKey: TJvRegKey read FKey write SetKey default hkCurrentUser;
    property SubKey: string read GetSubKey write SetSubKey stored False;
    // Arioch: it will be read from RCDATA for compatiblility, but unicode value should be stored!
    property SubKeyUnicode: WideString read FSubKey write SetSubKeyUnicode stored True;

    property MaxItems: TMruCount read FMax write SetMax default 10;
    property DataType: TJvDataType read FType write SetType default dtString;

    property OnEnumText: TOnEnumText read FOnEnumText write FOnEnumText;
    property OnEnumUnicodeText: TOnEnumUnicodeText read FOnEnumUnicodeText write FOnEnumUnicodeText;
    property OnEnumData: TOnEnumData read FOnEnumData write FOnEnumData;
    property Active: Boolean read GetActive write SetActive;
  end;

  EMruException = class(EJVCLException);

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvMRUList.pas,v $';
    Revision: '$Revision: 1.26 $';
    Date: '$Date: 2005/03/09 14:57:27 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Registry,
  JvJCLUtils, JvResources;

var
  hComCtlDll: HMODULE = 0;

const
  DllComCtlName = 'COMCTL32.DLL';

type
  MruCompareString = function(lpszString1, lpszString2: PChar): Integer;
  MruCompareData = function(lpData1, lpData2: Pointer; cbData: DWORD): Integer;
  MruCompareStringW = function(lpszString1, lpszString2: PWideChar): Integer;

  PMruRec = ^TMruRec;
  TMruRec = packed record
    cbSize: DWORD;
    nMaxItems: DWORD;
    dwFlags: DWORD;
    hKey: HKEY;
    case Boolean of
      False: (
        lpszSubKey: PChar;
        case Boolean of
          False:
            (lpfnCompareString: MruCompareString; );
          True:
            (lpfnCompareData: MruCompareData; );
          );
      True: (
        lpszSubKeyW: PWideChar;
        lpfnCompareStringW: MruCompareStringW; );
  end;

const
  MRUF_STRING_LIST = 0;
  MRUF_BINARY_LIST = 1;
  MRUF_DELAYED_SAVE = 2;

type
  TCreateMruList = function(lpCreateInfo: PMruRec): THandle; stdcall;
  TFreeMruList = procedure(hList: THandle); stdcall;

  TAddMruString = function(hList: THandle; lpszString: PChar): Integer; stdcall;
  TAddMruStringW = function(hList: THandle; lpszString: PWideChar): Integer; stdcall;
  TAddMruData = function(hList: THandle; lpData: Pointer; cbData: DWORD): Integer; stdcall;

  TDelMruString = function(hList: THandle; nItemPos: Integer): Boolean; stdcall;

  TEnumMruList = function(hList: THandle; nItemPos: Integer; lpBuffer: Pointer; nBufferSize: DWORD): Integer; stdcall;

  TFindMruString = function(hList: THandle; lpszString: PChar; lpRegNum: PInteger): Integer; stdcall;
  TFindMruStringW = function(hList: THandle; lpszString: PWideChar; lpRegNum: PInteger): Integer; stdcall;
  TFindMruData = function(hList: THandle; lpData: Pointer; cbData: DWORD; lpRegNum: PInteger): Integer; stdcall;

var
  CreateMruList: TCreateMruList;
  FreeMruList: TFreeMruList;
  AddMruString: TAddMruString;
  AddMruData: TAddMruData;
  DelMruString: TDelMruString;
  EnumMruList: TEnumMruList;
  FindMruString: TFindMruString;
  FindMruData: TFindMruData;

  //Arioch:  Unicode functions for WinNT
  CreateMruListW: TCreateMruList;
  AddMruStringW: TAddMruStringW;
  FindMruStringW: TFindMruStringW;
  EnumMruListW: TEnumMruList;

procedure InitializeDLL; forward;

constructor TJvMruList.Create(AOwner: TComponent);
begin
  InitializeDLL;

  inherited Create(AOwner);
  FList := 0;
  FMax := 10;
  FType := dtString;
  FKey := hkCurrentUser;
  FUnicodeAvailable := Win32Platform = VER_PLATFORM_WIN32_NT;
  FDelayedWrite := False;
  SetWantUnicode(False);
  FItemData.P := nil;

  // ReCreateList;
  Close; // since there is PUBLISHED .Active property - let it control how it will be.
end;

destructor TJvMruList.Destroy;
begin
  if FList <> 0 then
    FreeMruList(FList);
  inherited Destroy;
end;

function TJvMruList.AddData(Value: Pointer; Size: Integer): Boolean;
begin
  Result := False;
  if FList <> 0 then
    Result := AddMruData(FList, Value, Size) <> -1;
end;

function TJvMruList.AddPChar(Value: string): Boolean;
begin
  Result := False;
  if FList <> 0 then
  begin
    Result := AddMruString(FList, PChar(Value)) <> -1;
    // (p3) call EnumText here ?
    //  Arioch: Why? What for?
    //  Whether You want them - make a special separate set of events
    //  And there's danger that eventHandler tries to get a list of items,
    //  thus, killing current section!
  end;
end;

function TJvMruList.AddUnicodePChar(Value: PWideChar): Boolean;
begin
  NeedUnicode;
  Result := False;
  if FList <> 0 then
  begin
    Result := AddMruStringW(FList, PWideChar(Value)) <> -1;
    // (p3) call EnumText here?
    // See above
  end;
end;

function TJvMruList.AddString(Value: string): Boolean;
begin
  Result := AddPChar(PChar(Value));
end;

function TJvMruList.AddUnicodeString(Value: WideString): Boolean;
begin
  Result := AddUnicodePChar(PWideChar(Value));
end;

function TJvMruList.DeleteItem(Index: Integer): Boolean;
begin
  Result := False;
  if FList <> 0 then
  begin
    Result := DelMruString(FList, Index);
    ReCreateList; // Arioch: fixes MS's bug
  end;
end;

function TJvMruList.EnumItems: Boolean;
var
  Index: Integer;
begin
  Result := False;
  if FList = 0 then
    Exit;

  Index := 0;
  while GetItem(Index) do
    Inc(Index);
  if Index > 0 then
    Result := True;
end;

function TJvMruList.FindData(Value: Pointer; Size: Integer): Integer;
begin
  Result := -1;
  if FList <> 0 then
    Result := FindMruData(FList, Value, Size, nil);
end;

function TJvMruList.FindString(Value: string): Integer;
begin
  Result := -1;
  if FList <> 0 then
    Result := FindMruString(FList, PChar(Value), nil);
end;

function TJvMruList.FindUnicodeString(Value: WideString): Integer;
begin
  NeedUnicode;
  Result := -1;
  if FList <> 0 then
    Result := FindMruStringW(FList, PWideChar(Value), nil);
end;

function TJvMruList.GetItem(Index: Integer): Boolean;
begin
  Result := InternalGetItem(Index);
end;

function TJvMruList.InternalGetItem(Index: Integer; FireEvent: Boolean): Boolean;
var
  I: Integer;
  P: Pointer;
  EnP: TEnumMruList;
begin
  Result := False;
  if FList = 0 then