Einzelnen Beitrag anzeigen

Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#6

AW: Liste ohne dahinterliegende Items

  Alt 23. Jan 2014, 00:48
Oje, ob das so stimmt?

Delphi-Quellcode:
type
  TGraphicHistoryStatusChanged = procedure(CanUndo, CanRedo: boolean) of object;

  TGraphicHistory = class
  private
    FCurrent: integer;
    FList: TGraphicList;
    FEnterValue: TGraphicList;
    FExitValue: TGraphicList;
    FEnabled: boolean;
    FOnHistoryStatusChanged: TGraphicHistoryStatusChanged;
    FItem: TGraphicList;
    FPath: string;
    FFileNames: TStringList;
    procedure SetCurrent(const Value: integer);
    procedure AddExitValue;
    function Changed: boolean;
    function GetItems(Index: integer): TGraphicList;
    property FItems[Index: integer]: TGraphicList read GetItems;
    property Current: integer read FCurrent write SetCurrent;
    function CanUndo: boolean;
    function CanRedo: boolean;
    function Count: integer;
  public
    property OnHistoryStatusChanged: TGraphicHistoryStatusChanged
      read FOnHistoryStatusChanged write FOnHistoryStatusChanged;
    property Enabled: boolean read FEnabled write FEnabled;
    procedure Enter;
    procedure Exit;
    procedure UnDo;
    procedure ReDo;
    procedure Clear;
    procedure Refresh(List: TGraphicList);
    constructor Create(Path: string; List: TGraphicList);
    destructor Destroy; override;
  end;

implementation

{ TGraphicHistory }

constructor TGraphicHistory.Create(Path: string; List: TGraphicList);
begin
  inherited Create;
  FEnterValue := TGraphicList.Create;
  FExitValue := TGraphicList.Create;
  FList := List;
  FEnabled := true;
  FCurrent := -1;
  FItem := TGraphicList.Create;
  FPath := Path;
  FFileNames := TStringList.Create;
end;

destructor TGraphicHistory.Destroy;
begin
  FEnterValue.Free;
  FExitValue.Free;
  FFileNames.Free;
  FItem.Free;
  inherited Destroy;
end;

function TGraphicHistory.GetItems(Index: integer): TGraphicList;
begin
  FItem.LoadFromFile(FFileNames[Index]);
  Result := FItem;
end;

procedure TGraphicHistory.Clear;
begin
  Current := -1;
  FEnterValue.Clear;
  FFileNames.Clear;
  Tui.RecycleFile(FPath, FOF_NOCONFIRMATION or FOF_SILENT);
end;

function TGraphicHistory.Count: integer;
begin
  Result := FFileNames.Count;
end;

procedure TGraphicHistory.AddExitValue;
begin
  FFileNames.Add(FPath + IntToStr(Count));
  FExitValue.SaveToFile(FFileNames[Count - 1]);
  FItem.Assign(FExitValue); // Last;
  Current := Count - 1;
end;

function TGraphicHistory.Changed: boolean;
begin
  Result := not FEnterValue.Compare(FExitValue);
end;

function TGraphicHistory.CanUndo: boolean;
begin
  Result := FEnabled and (Count > 1) and (FCurrent > 0);
end;

function TGraphicHistory.CanRedo: boolean;
begin
  Result := FEnabled and (Count > 1) and (FCurrent < Count - 1);
end;

procedure TGraphicHistory.UnDo;
begin
  if CanUnDo then
  begin
    Current := Current - 1;
    FList.Assign(FItems[FCurrent]);
  end;
end;

procedure TGraphicHistory.ReDo;
begin
  if CanReDo then
  begin
    Current := Current + 1;
    FList.Assign(FItems[FCurrent]);
  end;
end;

procedure TGraphicHistory.Refresh(List: TGraphicList);
begin
  Clear;
  FFileNames.Add(FPath + IntToStr(Count));
  List.SaveToFile(FFileNames[Count - 1]);
  FItem.Assign(List); // Last;
end;

procedure TGraphicHistory.Enter;
begin
  FEnterValue.Assign(FList);
end;

procedure TGraphicHistory.Exit;
begin
  FExitValue.Assign(FList);
  if Changed then
    AddExitValue;
end;

procedure TGraphicHistory.SetCurrent(const Value: integer);
begin
  FCurrent := Value;
  if Assigned(FOnHistoryStatusChanged) then
    FOnHistoryStatusChanged(CanUndo, CanRedo);
end;
  Mit Zitat antworten Zitat