⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 preximclasses.pas

📁 一个很好的学习例子,有需要的请下载研究,
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        TTransaction(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

{ TTransaction }

function TTransaction.Add(ADocument: TDocument): Integer;
begin
  ADocument.Parent := Self;
  Result := FDocuments.Add(ADocument);
end;

procedure TTransaction.Clear;
begin
  FDocuments.Clear;
end;

constructor TTransaction.Create;
begin
  inherited;
  FObjectLevel := solTransaction;
  FDocuments := TObjectList.Create(true);
  FNotes := TNotes.Create(Self);
  FHistorys := THistorys.Create(Self);
end;

destructor TTransaction.Destroy;
begin
  FreeAndNil(FHistorys);
  FreeAndNil(FNotes);
  FreeAndNil(FDocuments);
  inherited;
end;

function TTransaction.DocumentsCount: integer;
begin
  Result := FDocuments.Count;
end;

function TTransaction.Extract(Item: TDocument): TDocument;
begin
  Result := TDocument(FDocuments.Extract(Item));
  Result.Parent := nil;
end;

function TTransaction.GetItem(Index: Integer): TDocument;
begin
  Result := TDocument(FDocuments.Items[Index]);
end;

function TTransaction.GetParent: TFolder;
begin
  if assigned(FParent) then
    Result := TFolder(FParent)
  else Result := nil;
end;

function TTransaction.IndexOf(ADocument: TDocument): Integer;
begin
  Result := FDocuments.IndexOf(ADocument);
end;

procedure TTransaction.Insert(Index: Integer; ADocument: TDocument);
begin
  FDocuments.Insert(Index, ADocument);
end;

function TTransaction.Modified: boolean;
var
  Idx: integer;
begin
  Result := inherited Modified;
  if Result then exit;

  for Idx:=0 to DocumentsCount-1 do
  begin
    Result := Items[Idx].Modified;
    if Result then break;
  end;
end;

function TTransaction.New: TDocument;
begin
  Result := TDocument.Create;
  Result.PageStoredPath := PageStoredPath;
  Result.OperateStatus := opInsert;
  Add(Result);
end;

procedure TTransaction.ReadData(Reader: TReader);
var
  ADoc: TDocument;
  cName: string;
  DocsCount: integer;
begin
  // read TTransaction signature
  Reader.ReadSignature;
  inherited;

  // clear all old items
  Clear;

  FNotes.ReadData(Reader);
  FHistorys.ReadData(Reader);

  with Reader do
  begin
    // read beginning of file and beginning of object list markers
    DocsCount := ReadInteger;
    //loop through file list of objects
    while DocsCount > 0 do
    begin
      //Load ClassName and use it to get ClassType
      cName := ReadString;

      // If a ClassType was found create an instance and
      // add object to this list
      if cName = TDocument.ClassName  then
      begin
        ADoc := New;
        ADoc.ReadData(Reader);
      end;
      Dec(DocsCount);

      //ProcessWindowsMessageQueue;
    end;
  end;
end;


function TTransaction.Remove(ADocument: TDocument): Integer;
begin
  Result := FDocuments.Remove(ADocument);
end;

procedure TTransaction.ResetOperateStatus;
var
  Idx: integer;
begin
  inherited;
  for Idx:=0 to DocumentsCount-1 do
  begin
    Items[Idx].ResetOperateStatus;

    //ProcessWindowsMessageQueue;
  end;

  FNotes.ResetOperateStatus;
end;

procedure TTransaction.SetHistorys(const Value: THistorys);
begin
  FHistorys.Assign(Value);
end;

procedure TTransaction.SetItem(Index: Integer; const Value: TDocument);
begin
  FDocuments.Items[Index] := Value;
end;

procedure TTransaction.SetKeepPageInStream(const Value: boolean);
var
  Idx: integer;
begin
  if KeepPageInStream <> Value then
  begin
    for Idx:=0 to FDocuments.Count-1 do
    begin
      with Items[Idx] do
       if (OperateStatus<>opMove) or (OperateStatus<>opMoveFax) or
          (OperateStatus<> opInsert) then
          KeepPageInStream := Value;

       //ProcessWindowsMessageQueue;
    end;
  end;
end;

procedure TTransaction.SetNotes(const Value: TNotes);
begin
  FNotes.Assign(Value);
end;

procedure TTransaction.SetParent(const Value: TFolder);
begin
  if (FParent <> Value) and (Value is TFolder) then
    FParent := Value;
end;

procedure TTransaction.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  // write TTransaction signature;
  Writer.WriteSignature;
  inherited;

  FNotes.WriteData(Writer);
  FHistorys.WriteData(Writer);

  with Writer do
  begin
    // mark beginning of file and beginning of object list
    WriteInteger(FDocuments.Count);

    for Idx := 0 to FDocuments.Count - 1 do
    begin
      //Store any TDocument objects
      if TObject(Items[Idx]) is TDocument then
      begin
        WriteString(TDocument(Items[Idx]).ClassName);
        //Call WriteData() for TDocument objects}
        TDocument(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

{ TDocument }

function TDocument.Add(APage: TPage): Integer;
begin
  APage.Parent := Self;
  Result := FPages.Add(APage);
end;

procedure TDocument.Clear;
begin
  FPages.Clear;
end;

constructor TDocument.Create;
begin
  inherited;
  FObjectLevel := solDocument;
  FPages := TObjectList.Create(true);  //Owner object is true, for auto free object
end;

destructor TDocument.Destroy;
begin
  FreeAndNil(FPages);
  inherited;
end;

function TDocument.Extract(Item: TPage): TPage;
begin
  Result := TPage(FPages.Extract(Item));
  Result.Parent := nil;
end;

function TDocument.GetItem(Index: Integer): TPage;
begin
  Result := TPage(FPages.Items[Index]);
end;

function TDocument.GetParent: TTransaction;
begin
  if assigned(FParent) then
    Result := TTransaction(FParent)
  else Result := nil;
end;

function TDocument.IndexOf(APage: TPage): Integer;
begin
  Result := FPages.IndexOf(APage);
end;

procedure TDocument.Insert(Index: Integer; APage: TPage);
begin
  FPages.Insert(Index, APage);
end;

function TDocument.Modified: boolean;
var
  Idx: integer;
begin
  Result := inherited Modified;
  if Result then exit;

  for Idx:=0 to PagesCount-1 do
  begin
    Result := Items[Idx].Modified;
    if Result then break;
  end;
end;

function TDocument.New: TPage;
begin
  Result := TPage.Create;
  Result.StoredPath := PageStoredPath;
  Result.OperateStatus := opInsert;
  Add(Result);
end;

function TDocument.PagesCount: integer;
begin
  Result := FPages.Count;
end;

procedure TDocument.ReadData(Reader: TReader);
var
  APage: TPage;
  cName: string;
  Pages: integer;
begin
  // read TDocument signature
  Reader.ReadSignature;
  inherited;

  // clear all old items
  Clear;

  with Reader do
  begin
    // read beginning of file and beginning of object list markers
    Pages := ReadInteger;
    //loop through file list of objects
    while Pages > 0 do //not EndOfList
    begin
      //Load ClassName and use it to get ClassType
      cName := ReadString;

      // If a ClassType was found create an instance and
      // add object to this list
      if cName = TPage.ClassName  then
      begin
        APage := New;
        APage.ReadData(Reader);
      end;
      Dec(Pages);

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

function TDocument.Remove(APage: TPage): Integer;
begin
  Result := FPages.Remove(APage);
end;

procedure TDocument.ResetOperateStatus;
var
  Idx: integer;
begin
  inherited;
  for Idx:=0 to PagesCount-1 do
  begin
    Items[Idx].ResetOperateStatus;

    //ProcessWindowsMessageQueue;
  end;
end;

procedure TDocument.SetItem(Index: Integer; const Value: TPage);
begin
  FPages.Items[Index] := Value;
end;

procedure TDocument.SetKeepPageInStream(const Value: boolean);
var
  Idx: integer;
begin
  if KeepPageInStream <> Value then
  begin
    for Idx:=0 to FPages.Count-1 do
    begin
      with Items[Idx] do
       if (OperateStatus<>opMove) or (OperateStatus<>opMoveFax) or
          (OperateStatus<> opInsert) then
          KeepPageInStream := Value;

       //ProcessWindowsMessageQueue;
    end;
  end;
end;

procedure TDocument.SetParent(const Value: TTransaction);
begin
  if (FParent <> Value) and (Value is TTransaction) then
    FParent := Value;
end;

procedure TDocument.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  // write TDocument signature;
  Writer.WriteSignature;
  inherited;

  with Writer do
  begin
    // mark beginning of file and beginning of object list
    WriteInteger(FPages.Count);

    for Idx := 0 to FPages.Count - 1 do
    begin
      //Store any TPage objects
      if TObject(Items[Idx]) is TPage then
      begin
        WriteString(TPage(Items[Idx]).ClassName);
        //Call WriteData() for TPage objects}
        TPage(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

{ TPage }

constructor TPage.Create;
begin
  inherited;
  FObjectLevel := solPage;
  FKeepPageInStream := true;
  FParent := nil;
end;

function TPage.GetExisted: boolean;
begin
  Result := FileExists(FStoredPath+FFilename);
end;

function TPage.GetParent: TDocument;
begin
  if assigned(FParent) then
    Result := TDocument(FParent)
  else Result := nil;
end;

{-------------------------------------------------------------------------------
  ProceName:  TPage.LoadFromStream
  Purpose:    Create a file named associated wite FFilename, and read file data
              from a stream
  Author:     Licwing
  Date:       08-15-2003
-------------------------------------------------------------------------------}
procedure TPage.LoadFromStream(Stream: TStream);
var
  Reader: TReader;
begin
  Reader := TReader.Create(Stream, $FF);
  try
    ReadData(Reader);
  finally
    FreeAndNil(Reader);
  end;
end;

{-------------------------------------------------------------------------------
  ProceName:  TPage.ReadData
  Purpose:    Read page's filename from a stream
  Author:     Licwing
  Date:       08-15-2003
-------------------------------------------------------------------------------}
function TPage.Modified: boolean;
begin
  Result := inherited Modified;
  if Result then exit;

 { for Idx:=0 to FPages.Count-1 do
  begin
    Result := Items[Idx].Modified;
    if Result then break;
  end;   }
end;

procedure TPage.ReadData(Reader: TReader);
var
  //ABufStream: TMemoryStream;
  AFileStream: TFileStream;
  buf: array[0..511] of byte;
  ASize: Int64;
  NeedCompare: boolean;
  OldFileName: TFilename;
begin
  // write TPage's signature
  Reader.ReadSignature;
//  inherited;

  with Reader do
  begin
    FFilename := ReadString;
    FCaption := ReadString;
    FKeepPageInStream := ReadBoolean;

    // The page is stored in stream and save it as a local file
    if FKeepPageInStream then
    begin
      {ABufStream := TMemoryStream.Create;
      try
        // read file size and allocate memory for storing data
        ASize := Reader.ReadInt64;
        ABufStream.SetSize(ASize);
        Reader.Read(ABufStream.Memory^, ASize);
        // save to a file
        ABufStream.SaveToFile(FStoredPath+FFilename);
      finally
        FreeAndNil(ABufStream);
      end;     }
      OldFileName := FStoredPath+FFilename;
      NeedCompare := FileExists(OldFileName);
      if NeedCompare then
      begin
        FileName := ChangeFileExt(GetExclusiveFileName(FStoredPath),
                            ExtractFileExt(FFilename));
      end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -