mweditstrings.pas

来自「本人买的<<VC++项目开发实例>>源代码配套光盘.」· PAS 代码 · 共 749 行 · 第 1/2 页

{+-----------------------------------------------------------------------------+
 | Unit:        mwEditStrings
 | Created:     05.1999
 | Author:      Martin Waldenburg
 | Description: a alternative string list
 |
 | Version:     0.503
 | Copyright (c) 1999 Martin Waldenburg
 | No rights reserved.
 | Portions Copyright Inprise Corporation.
 | Thanks to: Michael Hieke
 +--------------------------------------------------------------------------+}
unit mwEditStrings;

{$R-}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TIndexEvent = procedure(Index: Integer) of object;

  PmwEditItem = ^TmwEditItem;
  TmwEditItem = record
    FString: string;
    Finfo: TObject;
    FObject: TObject;
  end;

  PEditItemArray = ^TEditItemArray;
  TEditItemArray = array[0..0] of PmwEditItem;

  TmwEditFileBuffer = class(TObject)
  private
    fBuffFile: File;
    fFileName: String;
    fLineStart: LongInt;
    fMaxMemorySize: Longint;
    fMemorySize: LongInt;
    fMemory: PChar;
    fMemoryPos: LongInt;
    fEof: Boolean;
    fSize: Longint;
    fUnixStyle: Boolean;
    function GetMemoryFull: Boolean;
    procedure SetMaxMemorySize(NewValue: Longint);
    function GetFileEof: Boolean;
    function GetPosition: Longint;
    procedure SetPosition(NewPos: Longint);
  protected
  public
    constructor create(FileName: string; ClearFile: Boolean);
    destructor destroy; override;
    procedure FillMemory;
    function ReadLine: PChar;
    procedure WriteLine(NewLine: String);
    procedure FlushMemory;
    procedure ResetBuff;
    property MaxMemorySize: Longint read fMaxMemorySize write SetMaxMemorySize;
    property Memory: PChar read fMemory;
    property MemoryFull: Boolean read GetMemoryFull;
    property Position: Longint read GetPosition write SetPosition;
    property FileEof: Boolean read GetFileEof;
    property Eof: Boolean read fEof;
    property Size: Longint read fSize;
    property UnixStyle: Boolean read fUnixStyle write fUnixStyle;
  published
  end;

  TmwEditItemList = class(TObject)
  private
    FCapacity: Integer;
    FCount: Integer;
    FList: PEditItemArray;
  protected
    function GetItems(Index: Integer): PmwEditItem;
    procedure SetCapacity(NewCapacity: Integer);
    procedure SetItems(Index: Integer; Item: PmwEditItem);
  public
    constructor Create;
    destructor Destroy; override;
    function Add(Item: PmwEditItem): Integer;
    procedure Clear;
    procedure Delete(Index: Integer);
    procedure Expand(NewDelta: Integer);
    procedure Insert(Index: Integer; Item: PmwEditItem);
    procedure MultiDelete(Index, Number: Integer);
    procedure PrepareMultiInsert(Index, Number: Integer);
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property Items[Index: Integer]: PmwEditItem read GetItems write SetItems; default;
  end;

  TmwEditStrings = class(TStrings)
  private
    FList: TmwEditItemList;
    FOnChange: TNotifyEvent;
    FOnChanging: TNotifyEvent;
    FOnDeleted: TIndexEvent;
    FOnPutted: TIndexEvent;
    FOnInserted: TIndexEvent;
    FOnLoaded: TNotifyEvent;
    FOnAdded: TNotifyEvent;
    FUpdateCount: Integer;
    fWriteUnixStyle: Boolean;
    fHandle: THandle;
    procedure PutNewItem(Index: Integer; const S: string);
    procedure WndProc(var Message: TMessage);
  protected
    procedure Changed; virtual;
    procedure Changing; virtual;
    function Get(Index: Integer): string; override;
    function GetCapacity: Integer; override;
    function GetCount: Integer; override;
    function GetInfo(Index: Integer): TObject;
    function GetObject(Index: Integer): TObject; override;
    procedure InsertItem(Index: Integer; const S: string);
    procedure Put(Index: Integer; const S: string); override;
    procedure PutInfo(Index: Integer; AInfo: TObject);
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure SetCapacity(NewCapacity: Integer); override;
    procedure SetUpdateState(Updating: Boolean); override;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function Add(const S: string): Integer; override;
    procedure BeginUpdate;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure DeleteBetween(Index1, Pos1, Index2, Pos2: Integer);
    procedure EndUpdate;
    procedure Exchange(Index1, Index2: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure InsertAt(Index, aPos: Integer; S: string);
    procedure InsertStrings(Index: Integer; StringsToInsert: TStrings);
    procedure InsertStringsBetween(Index1, Pos1, Index2, Pos2: Integer; StringsToInsert: TStrings);
    procedure LoadFromFile(const FileName: string); override;
    procedure MultiDelete(Index, Number: Integer);
    procedure SaveToFile(const FileName: string); override;
    procedure SetTextStr(const Value: string); override;
    property Handle: THandle read fHandle;
    property Infos[Index: Integer]: TObject read GetInfo write PutInfo;
    property WriteUnixStyle: Boolean read fWriteUnixStyle write fWriteUnixStyle;
    property OnAdded: TNotifyEvent read FOnAdded write FOnAdded;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
    property OnDeleted: TIndexEvent read FOnDeleted write FOnDeleted;
    property OnInserted: TIndexEvent read FOnInserted write FOnInserted;
    property OnLoaded: TNotifyEvent read FOnLoaded write FOnLoaded;
    property OnPutted: TIndexEvent read FOnPutted write FOnPutted;
  end;

implementation

{ TmwEditFileBuffer }

constructor TmwEditFileBuffer.create(FileName: string; ClearFile: Boolean);
var
  fHandle: Integer;
begin
  fFileName := FileName;
  if not ClearFile then
  if not FileExists(FileName) then
  begin
    fHandle := FileCreate(FileName);
    FileClose(fHandle);
  end;
  inherited create;
  AssignFile(fBuffFile, FileName);
  if ClearFile then Rewrite(fBuffFile, 1) else Reset(fBuffFile, 1);
  fSize := FileSize(fBuffFile);
  fEof := fSize = 0;
  MaxMemorySize := 4096;
  fMemorySize := 0;
  fMemoryPos := 0;
  fUnixStyle := False;
end;

destructor TmwEditFileBuffer.destroy;
begin
  ReallocMem(fMemory, 0);
  CloseFile(fBuffFile);
  inherited destroy;
end;

function TmwEditFileBuffer.GetFileEof: Boolean;
begin
  Result := Position = Size;
end;

procedure TmwEditFileBuffer.SetMaxMemorySize(NewValue: Longint);
begin
  if fMaxMemorySize <> NewValue then begin
    fMaxMemorySize := NewValue;
    ReallocMem(fMemory, fMaxMemorySize + 1);
  end;
end;

procedure TmwEditFileBuffer.FillMemory;
var
  Readed: LongInt;
begin
  BlockRead(fBuffFile, fMemory^, fMaxMemorySize, Readed);
  fMemorySize := Readed;
  if not FileEof then
  begin
    while (fMemory[fMemorySize - 1] in [#10, #13]) and (fMemorySize > 1) do dec(fMemorySize);
    while (not (fMemory[fMemorySize - 1] in [#10, #13])) and (fMemorySize > 1) do dec(fMemorySize);
  end;
  fMemory[fMemorySize] := #0;
  Position := Position - Readed + fMemorySize;
  fLineStart := 0;
end;

function TmwEditFileBuffer.GetMemoryFull: Boolean;
begin
  Result := fMemorySize > 0;
end;

function TmwEditFileBuffer.ReadLine: PChar;
var
  LineEnd: LongInt;
begin
  if fMemoryPos = fMemorySize then FillMemory;
  fMemoryPos := fLineStart;
  while fMemoryPos < fMemorySize do
    Case fMemory[fMemoryPos] of
      #13:
        begin
          LineEnd := fMemoryPos;
          Inc(fMemoryPos);
          if fMemory[fMemoryPos] = #10 then Inc(fMemoryPos);
          fMemory[LineEnd] := #0;
          break;
        end;
      #10:
        begin
          LineEnd := fMemoryPos;
          inc(fMemoryPos);
          fMemory[LineEnd] := #0;
          break;
        end;
    else inc(fMemoryPos);
    end;
  Result := (fMemory + fLineStart);
  fLineStart := fMemoryPos;
  if (fMemoryPos = fMemorySize) and FileEof then fEof := True;
end;

procedure TmwEditFileBuffer.WriteLine(NewLine: String);
var
  Count, Pos: Longint;
begin
  if fUnixStyle then NewLine := NewLine + #10 else
    NewLine := NewLine + #13#10;
  Count := Length(NewLine);
  if (fMemoryPos >= 0) and (Count > 0) then
  begin
    Pos := fMemoryPos + Count;
    if Pos > 0 then
    begin
      if Pos > FMaxMemorySize then
      begin
        FlushMemory;
      end;
      StrECopy((fMemory + fMemoryPos), PChar(NewLine));
      fMemoryPos := fMemoryPos + Count;
      fMemory[fMemoryPos] := #0;
    end;
  end;
end;

procedure TmwEditFileBuffer.FlushMemory;
var
  Written: LongInt;
begin
  BlockWrite(fBuffFile, fMemory^, fMemoryPos, Written);
  fMemoryPos := 0;
end;

procedure TmwEditFileBuffer.ResetBuff;
begin
  fEof := False;
  fMemorySize := 0;
  fMemoryPos := 0;
  Position := 0;
end;

function TmwEditFileBuffer.GetPosition: Longint;
begin
  Result := FilePos(fBuffFile);
end;

procedure TmwEditFileBuffer.SetPosition(NewPos: Longint);
begin
  Seek(fBuffFile, NewPos);
end;

{ TmwEditItemList }

constructor TmwEditItemList.Create;
begin
  inherited Create;
  FCapacity := 0;
  FCount := 0;
end;

destructor TmwEditItemList.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TmwEditItemList.Add(Item: PmwEditItem): Integer;
begin
  Result := FCount;
  if Result = FCapacity then Expand(0);
  fList[Result] := Item;
  Inc(FCount);
end;

procedure TmwEditItemList.Clear;
begin
  SetCapacity(0);
end;

procedure TmwEditItemList.Delete(Index: Integer);
begin
  Dec(FCount);
  if Index < FCount then
    System.Move(fList[Index + 1], fList[Index],
      (FCount - Index) * SizeOf(PmwEditItem));
end;

procedure TmwEditItemList.Expand(NewDelta: Integer);
var
  Delta: Integer;
begin
  if FCapacity > 64 then Delta := FCapacity div 4 else
    if FCapacity > 8 then Delta := 16 else Delta := 4;
  if Delta < NewDelta then Delta := NewDelta;
  SetCapacity(FCapacity + Delta);
end;

function TmwEditItemList.GetItems(Index: Integer): PmwEditItem;
begin
  Result := fList[Index];
end;

procedure TmwEditItemList.Insert(Index: Integer; Item: PmwEditItem);
begin
  if FCount = FCapacity then Expand(0);
  if Index < FCount then
    System.Move(fList[Index], fList[Index + 1],
      (FCount - Index) * SizeOf(PmwEditItem));
  fList[Index] := Item;
  Inc(FCount);
end;

procedure TmwEditItemList.SetCapacity(NewCapacity: Integer);
begin
  if NewCapacity < FCount then FCount := NewCapacity;
  if NewCapacity <> FCapacity then
  begin
    ReallocMem(fList, NewCapacity * SizeOf(PmwEditItem));
    FCapacity := NewCapacity;
  end;
end;

procedure TmwEditItemList.SetItems(Index: Integer; Item: PmwEditItem);
begin
  fList[Index] := Item;
end;