bkmkmgr.pas

MiniHex 1.1 源程序说明 “MiniHex11SrcSource”目录中的所有文件是MiniHex 1.1的主程序； “MiniHex11SrcControls”目录中的是该软件

unit BkmkMgr;

interface

uses
  Windows, Messages, SysUtils, Classes, Forms, IniFiles;

type
  PBkmkItem = ^TBkmkItem;
  TBkmkItem = record
    Offset: Integer;
    Description: string;
  end;

  TBkmkItems = array of TBkmkItem;

  PBkmkGroup = ^TBkmkGroup;
  TBkmkGroup = record
    GroupName: string;
    Items: TBkmkItems;
  end;

  TBkmkGroups = array of TBkmkGroup;

  { TBkmkMgr }

  TBkmkMgr = class
  private
    FIniFileName: string;
    FGroups: TBkmkGroups;

    procedure ClearItems(GroupIdx: Integer);
    procedure ClearGroups;

    procedure ReadGroups(var Groups: TBkmkGroups);
    procedure ReadItems(GroupIdx: Integer; var Items: TBkmkItems);
    procedure WriteItems(GroupIdx: Integer; var Items: TBkmkItems);
    procedure EraseGroup(GroupName: string);
    procedure WriteGroup(GroupIdx: Integer);

  public
    constructor Create(IniFileName: string);
    destructor Destroy; override;

    property Groups: TBkmkGroups read FGroups;

    procedure AddGroup(GroupName: string);
    procedure DeleteGroup(GroupIdx: Integer);
    procedure ModifyGroup(GroupIdx: Integer; GroupName: string);

    procedure AddItem(GroupIdx: Integer; Item: TBkmkItem);
    procedure DeleteItem(GroupIdx: Integer; Index: Integer);
    procedure ModifyItem(GroupIdx: Integer; Index: Integer; Item: TBkmkItem);
    procedure MoveUp(GroupIdx: Integer; Index: Integer);
    procedure MoveDown(GroupIdx: Integer; Index: Integer);

    procedure LoadAllGroups;
  end;

var
  BkmkManager: TBkmkMgr;

implementation

uses
  Misc;

constructor TBkmkMgr.Create(IniFileName: string);
begin
  FIniFileName := IniFileName;
end;

destructor TBkmkMgr.Destroy;
begin
  ClearGroups;
end;

procedure TBkmkMgr.AddGroup(GroupName: string);
begin
  SetLength(FGroups, Length(FGroups) + 1);
  FGroups[High(FGroups)].GroupName := GroupName;
end;

procedure TBkmkMgr.DeleteGroup(GroupIdx: Integer);
var
  i: Integer;
begin
  EraseGroup(FGroups[GroupIdx].GroupName);
  for i := GroupIdx to High(FGroups) - 1 do
  begin
    FGroups[i].GroupName := FGroups[i+1].GroupName;
    FGroups[i].Items := FGroups[i+1].Items;
  end;
  SetLength(FGroups, Length(FGroups) - 1);
end;

procedure TBkmkMgr.ModifyGroup(GroupIdx: Integer; GroupName: string);
begin
  EraseGroup(FGroups[GroupIdx].GroupName);
  FGroups[GroupIdx].GroupName := GroupName;
  WriteGroup(GroupIdx);
end;

procedure TBkmkMgr.ClearGroups;
var
  i: Integer;
begin
  for i := 0 to High(FGroups) do
    SetLength(FGroups[i].Items, 0);
  SetLength(FGroups, 0);
end;

procedure TBkmkMgr.AddItem(GroupIdx: Integer; Item: TBkmkItem);
begin
  SetLength(FGroups[GroupIdx].Items, Length(FGroups[GroupIdx].Items) + 1);
  FGroups[GroupIdx].Items[High(FGroups[GroupIdx].Items)] := Item;
  WriteGroup(GroupIdx);
end;

procedure TBkmkMgr.DeleteItem(GroupIdx: Integer; Index: Integer);
var
  i: Integer;
begin
  for i := Index to High(FGroups[GroupIdx].Items) - 1 do
    FGroups[GroupIdx].Items[i] := FGroups[GroupIdx].Items[i + 1];
  SetLength(FGroups[GroupIdx].Items, Length(FGroups[GroupIdx].Items) - 1);
  WriteGroup(GroupIdx);
end;

procedure TBkmkMgr.ModifyItem(GroupIdx: Integer; Index: Integer; Item: TBkmkItem);
begin
  FGroups[GroupIdx].Items[Index] := Item;
  WriteGroup(GroupIdx);
end;

procedure TBkmkMgr.ClearItems(GroupIdx: Integer);
begin
  SetLength(FGroups[GroupIdx].Items, 0);
end;

procedure TBkmkMgr.MoveUp(GroupIdx: Integer; Index: Integer);
var
  Temp: TBkmkItem;
begin
  if (Index <= 0) or (Index > High(FGroups[GroupIdx].Items)) then Exit;
  Temp := FGroups[GroupIdx].Items[Index - 1];
  FGroups[GroupIdx].Items[Index - 1] := FGroups[GroupIdx].Items[Index];
  FGroups[GroupIdx].Items[Index] := Temp;
  WriteGroup(GroupIdx);
end;

procedure TBkmkMgr.MoveDown(GroupIdx: Integer; Index: Integer);
var
  Temp: TBkmkItem;
begin
  if (Index < 0) or (Index >= High(FGroups[GroupIdx].Items)) then Exit;
  Temp := FGroups[GroupIdx].Items[Index + 1];
  FGroups[GroupIdx].Items[Index + 1] := FGroups[GroupIdx].Items[Index];
  FGroups[GroupIdx].Items[Index] := Temp;
  WriteGroup(GroupIdx);
end;

procedure TBkmkMgr.ReadGroups(var Groups: TBkmkGroups);
var
  i: Integer;
  Sections: TStrings;
  Ini: TIniFile;
begin
  Ini := TIniFile.Create(FIniFileName);
  Sections := TStringList.Create;
  Ini.ReadSections(Sections);
  Ini.Free;
  ClearGroups;
  SetLength(FGroups, Sections.Count);
  for i := 0 to Sections.Count - 1 do
  begin
    FGroups[i].GroupName := Sections[i];
    ReadItems(i, FGroups[i].Items);
  end;
  Sections.Free;
end;

procedure TBkmkMgr.ReadItems(GroupIdx: Integer; var Items: TBkmkItems);
var
  Ini: TIniFile;
  Section: string;
  Names: TStrings;
  i: Integer;
begin
  Ini := TIniFile.Create(FIniFileName);
  Names := TStringList.Create;
  Section := FGroups[GroupIdx].GroupName;
  Ini.ReadSection(Section, Names);
  SetLength(Items, Names.Count);
  for i := 0 to Names.Count - 1 do
  begin
    Items[i].Offset := StrToIntDef(Names[i], 0);
    Items[i].Description := Ini.ReadString(Section, Names[i], '');
  end;
  Names.Free;
  Ini.Free;
end;

procedure TBkmkMgr.WriteItems(GroupIdx: Integer; var Items: TBkmkItems);
var
  Ini: TIniFile;
  Section: string;
  i: Integer;
begin
  Ini := TIniFile.Create(FIniFileName);
  Section := FGroups[GroupIdx].GroupName;
  Ini.EraseSection(Section);
  for i := 0 to High(Items) do
  begin
    Ini.WriteString(Section, IntToStr(Items[i].Offset), Items[i].Description);
  end;
  Ini.Free;
end;

procedure TBkmkMgr.EraseGroup(GroupName: string);
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create(FIniFileName);
  Ini.EraseSection(GroupName);
  Ini.Free;
end;

procedure TBkmkMgr.LoadAllGroups;
begin
  ReadGroups(FGroups);
end;

procedure TBkmkMgr.WriteGroup(GroupIdx: Integer);
begin
  WriteItems(GroupIdx, FGroups[GroupIdx].Items);
end;

end.