Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
Delphi 10.4 Sydney
|
AW: Liste ohne dahinterliegende Items
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;
|
|
Zitat
|