rvproj.pas

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

    end; { if }
  end else begin
    if Assigned(DefRoot) then begin
      Root := DefRoot;
    end else begin
      Root := TRaveProjectManager(Project);
    end; { else }
    ObjectName := Name;
  end; { else }

  if not Assigned(Root) then begin
    Result := nil;
  end else begin
    Result := TRaveComponent(Root.FindComponent(ObjectName));
    if not Assigned(Result) then begin
      Result := TRaveComponent(TRaveProjectManager(Project).FindComponent(ObjectName));
    end; { if }
  end; { else }
end;  { FindRaveComponent }

function TRaveProjectManager.GetUniqueName(BaseName: string;
                                           NameOwner: TRaveComponent;
                                           UseCurrent: boolean): string;
var
  I1: integer;
  OrigName: string;
  SepCh: char;
begin { GetUniqueName }
  if UseCurrent then begin { BaseName='OrigName|BaseName' }
  { Try to use OrigName first, then switch to BaseName }
    OrigName := CutWord(BaseName,SepCh,'|');
    Result := OrigName;
    if not Assigned(NameOwner.FindComponent(Result)) then Exit;
  end; { if }
  for I1 := 1 to 9999 do begin
    Result := BaseName + IntToStr(I1);
    if not Assigned(NameOwner.FindComponent(Result)) then Exit;
  end; { for }
end;  { GetUniqueName }

procedure TRaveProjectManager.DeactivateReport;
begin { DeactivateReport }
  if Assigned(FActiveReport) then begin
    ActiveReport.Close;
    FActiveReport := nil;
    CurrentDesigner := nil;
  end; { if }
end;  { DeactivateReport }

procedure TRaveProjectManager.ActivateReport(Report: TRaveReport);
begin { ActivateReport }
  DeactivateReport;
  FActiveReport := Report;
  ActiveReport.Open;
  LastActiveReport := ActiveReport.Name;
  if SaveEnvOnly then begin
    DataChanged := true;
  end; { if }
end;  { ActivateReport }

procedure TRaveProjectManager.ExportProject(ExportFileName: string;
                                            Items: TList);
var
  Stream: TStream;
begin { ExportProject }
  Stream := TFileStream.Create(ExportFileName,fmCreate);
  try
    ExportList := Items;
    SaveToStream(Stream);
    ExportList := nil;
  finally
    Stream.Free;
  end; { tryf }
end;  { ExportProject }

function TRaveProjectManager.ImportProject(ImportFileName: string;
                                           AutoReplace: boolean): boolean;
var
  Stream: TStream;
begin { ImportProject }
  Result := false;
  if FileExists(ImportFileName) then begin
    Stream := TFileStream.Create(ImportFileName,fmOpenRead);
    if Stream.Size > 0 then begin
      try
        Importing := true;
        ImportReplace := AutoReplace;
        LoadFromStream(Stream);
        Importing := false;
      finally
        Stream.Free;
      end; { tryf }
      DataChanged := true;
      Result := true;
    end; { if }
  end; { if }
end;  { ImportProject }

procedure TRaveProjectManager.Save;
var
  Stream: TStream;
begin { Save }
  Stream := TFileStream.Create(ChangeFileExt(FileName,{Trans-}'.$$$'),fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end; { tryf }

{ Rename file from FileName.$$$ to FileName.rav and save backup *.~ra }
  DeleteFile(ChangeFileExt(FileName,{Trans-}'.~ra'));
  RenameFile(FileName,ChangeFileExt(FileName,{Trans-}'.~ra'));
  RenameFile(ChangeFileExt(FileName,{Trans-}'.$$$'),FileName);
end;  { Save }

procedure TRaveProjectManager.Load;
var
  Stream: TStream;
begin { Load }
  IsLoading := true;
  try
    if FileExists(FileName) then begin
      Stream := TFileStream.Create(FileName,fmOpenRead);
      if Stream.Size > 0 then begin
        try
          LoadFromStream(Stream);
        finally
          Stream.Free;
        end; { tryf }
      end else begin
        Stream.Free;
        New;
      end; { else }
    end else begin
      New;
    end; { else }
  finally
    IsLoading := false;
  end; { tryf }
end;  { Load }

procedure TRaveProjectManager.New;
begin { New }
  try
    IsLoading := true;
    FileName := {Trans-}'Project1.rav';
    NewReport;
    ClearChanged;
    Saved := false;
  finally
    IsLoading := false;
  end; { tryf }
end;  { New }

procedure TRaveProjectManager.Unload;
begin { Unload }
  DeactivateReport;
  Clear;
end;  { Unload }

{ File methods }

function TRaveProjectManager.NewReport: TRaveReport;
begin { NewReport }
  Result := TRaveReport.Create(self);
  Result.Parent := self;
  Result.Name := GetUniqueName({Trans-}'Report', TRaveProjectManager(Project), false);
  AddComponent(Result);
  ReportList.Add(Result);
  ActivateReport(Result);
  Result.NewPage;
  Result.FirstPage := Result.Child[0] as TRavePage;
  DataChanged := true;
end;  { NewReport }

function TRaveProjectManager.NewGlobalPage: TRavePage;
begin { NewGlobalPage }
  Result := TRavePage.Create(self);
  Result.Parent := self;
  Result.Name := GetUniqueName({Trans-}'GlobalPage', TRaveProjectManager(Project), false);
  GlobalPageList.Add(Result);
  AddComponent(Result);
  ActiveReport.LoadPage(Result);
  DataChanged := true;
end;  { NewGlobalPage }

function TRaveProjectManager.NewDataObject(DataObjectClass: TRaveDataObjectClass): TRaveDataObject;
var
  NewName: string;
begin { NewDataObject }
  Result := DataObjectClass.Create(self);
  Result.Parent := self;
  NewName := DataObjectClass.ClassName;
  if NewName[1] = 'T' then begin
    Delete(NewName,1,1);
  end; { if }
  if Pos({Trans-}'RAVE',UpperCase(NewName)) = 1 then begin
    Delete(NewName,1,4);
  end; { if }
  Result.Name := TRaveProjectManager(Project).GetUniqueName(NewName,Result.Owner as TRaveComponent,false);
  DataObjectList.Add(Result);
  AddComponent(Result);
  DataChanged := true;
end;  { NewDataObject }

procedure TRaveProjectManager.DeleteItem(Item: TRaveProjectItem;
                                         Notify: boolean);
var
  I1: integer;
  CheckReportPage: boolean;
begin { DeleteItem }
  CheckReportPage := false;
  if Item is TRaveReport then begin
    if ReportList.Count = 1 then begin
      NewReport;
    end else if ActiveReport = Item then begin
      I1 := ReportList.IndexOf(Item);
      if I1 = 0 then begin
        I1 := 1;
      end else begin
        Dec(I1);
      end; { else }
      ActivateReport(TRaveReport(ReportList[I1]));
    end; { else }
    ReportList.Remove(Item);
  end else if Item is TRavePage then begin
    ActiveReport.UnloadPage(TRavePage(Item));
    if TRavePage(Item).Global then begin
      GlobalPageList.Remove(Item);
    end else begin
      CheckReportPage := true;
    end; { else }
  end else if Item is TRaveDataObject then begin
    DataObjectList.Remove(Item);
  end; { else }
  DeleteComponent(Item);
  Item.Free;
  if CheckReportPage and (ActiveReport.ChildCount = 0) then begin
    ActiveReport.NewPage;
  end; { if }
end;  { DeleteItem }

procedure TRaveProjectManager.SetParam(Param: string; Value: string);
begin { SetParam }
  Params.Values[Param] := Value;
end;  { SetParam }

function TRaveProjectManager.GetParam(Param: string): string;
begin { GetParam }
  Result := Params.Values[Param];
end;  { GetParam }

procedure TRaveProjectManager.ClearParams;
begin { ClearParams }
  Params.Clear;
end;  { ClearParams }

procedure TRaveProjectManager.SetUnits(Value: TPrintUnits);
begin { SetUnits }
  FUnits := Value;
  case FUnits of
    unInch: FUnitsFactor := 1.0;
    unMM: FUnitsFactor := 25.4;
    unCM: FUnitsFactor := 2.54;
    unPoint: FUnitsFactor := 72.0;
    unUser: begin
    { Don't change FUnitsFactor }
    end;
  end; { case }
  if Assigned(CurrentDesigner) then begin
    CurrentDesigner.Modified;
  end; { if }
end;  { SetUnits }

procedure TRaveProjectManager.SetUnitsFactor(Value: double);
begin { SetUnitsFactor }
  if Value > 0.0 then begin
    FUnitsFactor := Value;
    if FEQ(FUnitsFactor,1.0) then begin
      FUnits := unInch;
    end else if FEQ(FUnitsFactor,25.4) then begin
      FUnits := unMM;
    end else if FEQ(FUnitsFactor,2.54) then begin
      FUnits := unCM;
    end else if FEQ(FUnitsFactor,72.0) then begin
      FUnits := unPoint;
    end else begin
      FUnits := unUser;
    end; { else }
  end; { if }
  if Assigned(CurrentDesigner) then begin
    CurrentDesigner.Modified;
  end; { if }
end;  { SetUnitsFactor }

procedure TRaveProjectManager.SetDataChanged(Value: boolean);
var
{$IFNDEF LEVEL6}
  FileProps: integer;
{$ENDIF}
  ReadOnly: boolean;
begin { SetDataChanged }
{ DataChanged will only change value when set to true, to clear call ClearChanged }
  if Value then begin
    if not FDataChanged and not IsLoading and Saved then begin
      if not FileExists(FileName) then begin
        ReadOnly := false;
      end else begin
      {$IFDEF Level6}
        ReadOnly := FileIsReadOnly(FileName);
      {$ELSE}
        FileProps := FileGetAttr(FileName);
        ReadOnly := (FileProps >= 0) and ((FileProps and faReadOnly) = faReadOnly);
      {$ENDIF}
      end; { else }
      if ReadOnly then begin
        ShowMessage(Trans('The report project file you are modifying is marked read only.  ' +
         'You will be prompted for another file name when saving.'));
      end; { if }
    end; { if }
    FDataChanged := true;
  end; { if }
end;  { SetDataChanged }

procedure TRaveProjectManager.ClearChanged;
begin { ClearChanged }
  FDataChanged := false;
end;  { ClearChanged }

procedure TRaveProjectManager.Compile;
var
  I1: integer;
  I2: integer;
begin { Compile }
  DefineCompiles := true;
  for I2 := 1 to 2 do begin
    inherited Compile;
    for I1 := 0 to TRaveProjectManager(Project).DataObjectList.Count - 1 do begin
      TRaveDataObject(TRaveProjectManager(Project).DataObjectList[I1]).Compile;
    end; { for }
    for I1 := 0 to TRaveProjectManager(Project).GlobalPageList.Count - 1 do begin
      TRavePage(TRaveProjectManager(Project).GlobalPageList[I1]).Compile;
    end; { for }
    for I1 := 0 to TRaveProjectManager(Project).ReportList.Count - 1 do begin
      TRaveReport(TRaveProjectManager(Project).ReportList[I1]).Compile;
    end; { for }
    DefineCompiles := false;
  end; { for }
end;  { Compile }

function TRaveProjectManager.FindReport(const AName: string;
 const AIsFullName: boolean): TRaveReport;
var
  i: integer;
  LReport: TRaveReport;
begin
  Result := nil;
  for i := 0 to ReportList.Count - 1 do begin
    LReport := TRaveReport(ReportList.Items[i]);
    if (AIsFullName and (AnsiCompareText(LReport.FullName, AName) = 0))
     or (AnsiCompareText(LReport.Name, AName) = 0) then begin
      Result := LReport;
      Break;
    end;
  end;
end;

procedure TRaveProjectManager.FreeForwardRefs;
var
  I1: integer;
  Index: integer;
  Target: TRaveComponent;
begin { FreeForwardRefs }
  if Assigned(ForwardRefList) then begin
    for I1 := 0 to ForwardRefList.Count - 1 do begin
      with TRaveForwardRef(ForwardRefList.Objects[I1]) do begin
      { Figure out Target component }
        if Assigned(RenameRefList) and
         RenameRefList.Find(ForwardRefList[I1],Index) then begin
        { Target was renamed }
          Target := TRaveComponent(RenameRefList.Objects[Index]);
        end else begin
        { Target was not renamed }
          Target := FindRaveComponent(ForwardRefList[I1],
           TRaveComponent(TRaveForwardRef(ForwardRefList.Objects[I1]).
           Instance).Parent);
          if not Assigned(Target) then begin
            Continue; {!!! Unresolved forward reference }
          end; { if }
        end; { else }

      { Assign Target to forward reference }
        if not Assigned(PropInfo) then begin
          TRaveComponentList(Instance).Items[Param] := Target;
        end else begin
          SetOrdProp(Instance,PropInfo,integer(Target));
        end; { else