rvproj.pas

医院病历管理简易版,完全用DELPHI实现.

                  SetIncluded(TPersistent(O1),false);
                end else if O1 is TRaveComponentList then begin
                  for I2 := 0 to TRaveComponentList(O1).Count - 1 do begin
                    CheckComponent(TComponent(TRaveComponentList(O1)[I2]).Owner);
                    CheckComponent(TComponent(TRaveComponentList(O1)[I2]));
                  end; { for }
                end else if O1 is TRavePersistentList then begin
                  for I2 := 0 to TRavePersistentList(O1).Count - 1 do begin
                    SetIncluded(TPersistent(TRavePersistentList(O1)[I2]),false);
                  end; { for }
                end; { else }
              end; { if }
            end; { if }
          end; { for }
        finally
          FreeMem(PropList,Count * SizeOf(pointer));
        end; { tryf }
      end; { if }

      if DoOwned and (Item is TComponent) then begin
        for I1 := 0 to TComponent(Item).ComponentCount - 1 do begin
          SetIncluded(TComponent(Item).Components[I1],true);
        end; { for }
      end; { if }
    end; { if }
  end;  { SetIncluded }

begin { ReportToStream }
// Include all other project items that it references
  ClearProjectItems(ReportList);
  ClearProjectItems(GlobalPageList);
  ClearProjectItems(DataObjectList);
  Included := true;
  AReport.Included := true;
  SetIncluded(AReport,false);

// Create ExportList
  ExportList := TList.Create;
  ExportList.Add(AReport);
  AddProjectItems(GlobalPageList);
  AddProjectItems(DataObjectList);

// Write out items to stream
  StreamHelper := TStreamHelper.Create(AStream);
  with StreamHelper do try
    CompressMethod := NoCompression;
    SaveToStreamHelper(StreamHelper);
  finally
    Free;
  end; { with }
  FreeAndNil(ExportList);
end;  { ReportToStream }

procedure TRaveProjectManager.Clear;
begin { Clear }
  ClearObjectList(ReportList);
  ClearObjectList(GlobalPageList);
  ClearObjectList(DataObjectList);
end;  { Clear }

procedure TRaveProjectManager.DefineProperties(Filer: TFiler);
begin { DefineProperties }
  inherited DefineProperties(Filer);
  Filer.DefineProperty({Trans-}'Params', ReadParamValues, WriteParamValues,
   StreamParamValues and (Params.Count > 0));
end;  { DefineProperties }

procedure TRaveProjectManager.ReadParamValues(Reader: TReader);
var
  ParamBuf: string;
  ParamPtr: PChar;
  ParamName: string;
  ParamData: string;
begin { ReadParamValues }
  ParamBuf := Reader.ReadString;
  if ParamBuf <> '' then begin
    ParamPtr := @ParamBuf[1];
    while ParamPtr^ <> #0 do begin
      ParamName := AnsiExtractQuotedStr(ParamPtr,'"');
      Inc(ParamPtr); { Skip comma }
      ParamData := AnsiExtractQuotedStr(ParamPtr,'"');
      SetParam(ParamName, ParamData);
      Inc(ParamPtr); { Skip semicolon }
    end; { while }
  end; { else }
end;  { ReadParamValues }

procedure TRaveProjectManager.WriteParamValues(Writer: TWriter);
var
  ParamBuf: string;
  I1: integer;
begin { WriteParamValues }
  ParamBuf := '';
  for I1 := 0 to (Params.Count - 1) do begin
    ParamBuf := ParamBuf + AnsiQuotedStr(Params.Names[I1], '"') + ',' +
     AnsiQuotedStr(Params.Values[Params.Names[I1]] ,'"') + ';';
  end; { for }
  Writer.WriteString(ParamBuf);
end;  { WriteParamValues }

procedure TRaveProjectManager.LoadFromStreamHelper(StreamHelper: TStreamHelper);
var
  TagKind: TTagKind;
  Item: TRaveProjectItem;
  ItemName: string;
  I1: integer;
  RaveReport: TRaveReport;
  TestSig: string;
begin { LoadFromStreamHelper }
  with StreamHelper do begin
    SetLength(TestSig,4);
    Stream.Read(TestSig[1],4);
    if TestSig <> Signature then begin
      RaveError(Trans('Invalid Project Format'));
      Exit;
    end; { if }
    Stream.Read(FVersion,SizeOf(FVersion));

  { Read project header information }
    TagKind := TTagKind(ReadByte); { Should be tkProject }
    if TagKind <> tkProject then begin
      RaveError(Trans('Invalid Project Header Code'));
      Exit;
    end; { if }

  { Read in library modules }
    if Version >= 40005 then begin
      ModuleManager.LoadModules(StreamHelper);
    end; { if }

    if Importing then begin
    { Absorb and ignore project header }
      ReadString; { Absorb LastActivePage }
      with TRaveReader.Create(StreamHelper) do try
        MasterProject := self.FMasterProject;
        ReadComponent(self,self).Free;
      finally
        Free;
      end; { with }
    end else begin
    { Read in project header }
      LastActiveReport := ReadString;
      with TRaveReader.Create(StreamHelper) do try
        MasterProject := self.FMasterProject;
        ReadIntoComponent(self);
      finally
        Free;
      end; { with }
    end; { else }

  { Read in ProjectItem blocks }
    repeat
      TagKind := TTagKind(ReadByte);
      ItemName := ReadString;
      if Importing then begin
        Item := FindRaveComponent(ItemName, TRaveProjectManager(Project)) as TRaveProjectItem;
        if Assigned(Item) then begin
          if Assigned(FOnImportConflict) then begin
            FOnImportConflict(Item,ItemName);
          end else begin
            if ImportReplace then begin { Delete and replace old item }
              DeleteItem(Item,false);
            //!!! Need to make it so that links to this item or components on
            //!!! this item are preserved.
            end else begin { Get new name }
              ItemName := GetUniqueName(ItemName, TRaveProjectManager(Project), false);
            end; { else }
          end; { else }
        end; { if }
      end; { if }

      case TagKind of
        tkDataView: begin // Only used to load pre 4.0 projects
          Item := TRaveDataView.Create(self);
          DataObjectList.Add(Item);
        end;
        tkDataObject: begin
          Item := TRaveDataObjectClass(FindClass(ReadString)).Create(self);
          DataObjectList.Add(Item);
        end;
        tkPage: begin
          Item := TRavePage.Create(self);
          GlobalPageList.Add(Item);
        end;
        else begin { tkReport }
          Item := TRaveReport.Create(self);
          ReportList.Add(Item);
          FActiveReport := Item as TRaveReport;
        end;
      end; { case }
      Item.Parent := self;
      if ItemName <> '' then begin
        Item.Name := ItemName;
        AddComponent(Item);
      end; { if }
      StartReadBlock;
      Item.LoadFromStreamHelper(StreamHelper);
      FinishReadBlock;
      FActiveReport := nil;
      if ItemName = '' then begin
        case TagKind of
          tkDataView,tkDataObject: DataObjectList.Remove(Item);
          tkPage: GlobalPageList.Remove(Item);
          else ReportList.Remove(Item);
        end; { case }
        Item.Free;
      end; { if }
    until Empty;
  end; { with }
  FreeForwardRefs;

{ Activate report }
  RaveReport := nil;
  for I1 := 0 to ReportList.Count - 1 do begin
    TRaveReport(ReportList[I1]).ProcessLoaded;
    if (LastActiveReport <> '') and
     (TRaveReport(ReportList[I1]).Name = LastActiveReport) then begin
      RaveReport := TRaveReport(ReportList[I1]);
    { Break; Don't break since we need to call ProcessLoaded for each report }
    end; { if }
  end; { for }

  if Assigned(RaveReport) then begin
    ActivateReport(RaveReport);
  end else if ReportList.Count > 0 then begin
    ActivateReport(TRaveReport(ReportList[0]));
  end; { else }
  FreeForwardRefs;
  PostLoad;
  ClearChanged;
  Saved := true;
end;  { LoadFromStreamHelper }

procedure TRaveProjectManager.SaveToStreamHelper(StreamHelper: TStreamHelper);

  procedure WriteListNames(List: TList;
                           TagKind: TTagKind);

  var
    I1: longint;

  begin { WriteListNames }
    with StreamHelper do begin
      for I1 := 0 to (List.Count - 1) do begin
        if Assigned(ExportList) then begin { Look for item in list }
          if ExportList.IndexOf(List[I1]) < 0 then Continue; { Don't export item }
        end; { if }
        WriteByte(Ord(TagKind));
        WriteString(TRaveProjectItem(List[I1]).Name);
        if TagKind = tkDataObject then begin
          WriteString(TRaveDataObject(List[I1]).ClassName);
        end; { if }
        StartWriteBlock;
        TRaveProjectItem(List[I1]).SaveToStreamHelper(StreamHelper);
        FinishWriteBlock;
      end; { for }
    end; { with }
  end;  { WriteListNames }

begin { SaveToStreamHelper }
  StreamHelper.WriteBuf(Signature[1],4);
  FVersion := RaveVersion;
  StreamHelper.WriteBuf(FVersion,SizeOf(FVersion));

  StreamHelper.WriteByte(Ord(tkProject));
  ModuleManager.SaveModules(StreamHelper);
  StreamHelper.WriteString(LastActiveReport);
  with TRaveWriter.Create(StreamHelper) do try
    WriteComponent(self,false);
  finally
    Free;
  end; { with }
  WriteListNames(DataObjectList,tkDataObject);
  WriteListNames(GlobalPageList,tkPage);
  WriteListNames(ReportList,tkReport);
  if not Assigned(ExportList) then begin
    ClearChanged;
    Saved := true;
  end; { if }
end;  { SaveToStreamHelper }

procedure TRaveProjectManager.LoadFromStream(Stream: TStream);
var
  StreamHelper: TStreamHelper;
begin { LoadFromStream }
  StreamHelper := TStreamHelper.Create(Stream);
  with StreamHelper do try
    LoadFromStreamHelper(StreamHelper);
  finally
    Free;
  end; { with }
end;  { LoadFromStream }

procedure TRaveProjectManager.SaveToStream(Stream: TStream);
var
  StreamHelper: TStreamHelper;
begin { SaveToStream }
  StreamHelper := TStreamHelper.Create(Stream);
  with StreamHelper do try
    SaveToStreamHelper(StreamHelper);
  finally
    Free;
  end; { with }
end;  { SaveToStream }

procedure TRaveProjectManager.SetCategories(Value: TStrings);
begin { SetCategories }
  FCategories.Assign(Value);
end;  { SetCategories }

procedure TRaveProjectManager.Changing(OldItem: TRaveComponent;
                                       NewItem: TRaveComponent);
begin { Changing }
  inherited Changing(OldItem,NewItem);
  if Assigned(SecurityControl) and (OldItem = SecurityControl) then begin
    SecurityControl := NewItem as TRaveBaseSecurity;
  end; { if }
end;  { Changing }

procedure TRaveProjectManager.SetDepth(Control: TRaveComponent;
                                       Adjustment: integer);
var
  I1: integer;
  I2: integer;
  ChildList: TList;
begin { SetDepth }
  if Control is TRaveReport then begin
    ChildList := ReportList;
  end else if Control is TRavePage then begin
    ChildList := GlobalPageList;
  end else if Control is TRaveDataObject then begin
    ChildList := DataObjectList;
  end else begin
    Exit;
  end; { else }

  with ChildList do begin
    I1 := IndexOf(Control);
    case Adjustment of
      1: I2 := 0;           { 1: Send to back }
      2: I2 := I1 - 1;      { 2: Move behind }
      3: I2 := I1 + 1;      { 3: Move forward }
      else I2 := Count - 1; { 4: Bring to front }
    end; { case }
    if (I1 >= 0) and (I2 >= 0) and (I2 < Count) and (I1 <> I2) then begin
      Delete(I1);
      Insert(I2,Control);
      if Control is TRaveControl then begin
        TRaveControl(Control).Invalidate;
      end; { if }
    end; { if }
  end; { with }
end;  { SetDepth }

function TRaveProjectManager.FindRaveComponent(Name: string;
                                               DefRoot: TRaveComponent): TRaveComponent;
var
  I1: integer;
  I2: integer;
  P1: TRavePage;
  Item: TRaveProjectItem;
  ObjectName: string;
  Root: TRaveComponent;
begin { FindRaveComponent }
//TODO: Add capability to process Owner.Owner.Component strings
  I1 := AnsiPos('.',Name);
  if I1 > 0 then begin
  { Find owner }
    ObjectName := MBCSCopy(Name,1,I1 - 1); { Owner portion }

  { Look for owner in ActiveReport pages }
    Root := nil;
    if Assigned(ActiveReport) then begin
      with ActiveReport do begin
        for I2 := 0 to ChildCount - 1 do begin
          if Child[I2] is TRavePage then begin
            P1 := TRavePage(Child[I2]);
            if AnsiCompareText(P1.Name,ObjectName) = 0 then begin
              Root := P1;
              Break;
            end; { if }
          end; { if }
        end; { for }
      end; { with }
    end; { if }

  { Look for owner in ProjectItems (Reports/Global Pages/Data Views) }
    if not Assigned(Root) then begin
      for I2 := 0 to ChildCount - 1 do begin
        Item := TRaveProjectItem(Child[I2]);
        if AnsiCompareText(Item.Name,ObjectName) = 0 then begin
          Root := Item;
          Break;
        end; { if }
      end; { for }
    end; { if }

  { Second half is object's name on Root }
    if Assigned(Root) then begin
      ObjectName := MBCSCopy(Name,I1 + 1,Length(Name) - I1);