rvproj.pas

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

end;  { SaveToStreamHelper }

procedure TRaveReport.LoadFromStreamHelper(StreamHelper: TStreamHelper);
var
  I1: integer;
  I2: integer;
  NameFound: boolean;
  TestChild: TRaveComponent;
  Items: integer;
  Item: TRaveProjectItem;
begin { LoadFromStreamHelper }
  with StreamHelper do begin
    if TRaveProjectManager(Project).Version >= 30004 then begin {!!! Remove check before release }
      LastActivePage := ReadString;
    end; { if }

    FixUpList := TStringList.Create;
  { Read in list of owned pages }
    Items := ReadIndex;
    for I1 := 1 to Items do begin
      case ReadByte of
        0: Item := TRavePage.Create(self);
        else Raise EClassNotFound.Create(Trans('TRaveProjectItem class not found'));
      end; { case }
      Item.Parent := self;
      Item.Name := ReadString;
    end; { for }

  { Read in list of loaded pages }
    Items := ReadIndex;
    for I1 := 1 to Items do begin
      FixupList.Add(ReadString);
    end; { for }

  { Add all owned pages if not already in FixupList to fix 3.0D bug }
    for I1 := 0 to ChildCount - 1 do begin
      TestChild := TRaveComponent(Child[I1]);
      NameFound := false;
      for I2 := 0 to FixupList.Count - 1 do begin
        if AnsiCompareText(TestChild.Name,FixupList[I2]) = 0 then begin
          NameFound := true;
          Break;
        end; { if }
      end; { for }
      if not NameFound then begin
        FixupList.Add(TestChild.Name);
      end; { if }
    end; { for }

  { Read in report properties }
    with TRaveReader.Create(StreamHelper) do try
      MasterProject := TRaveProjectManager(Project).MasterProject;
      ReadIntoComponent(self);
    finally
      Free;
    end; { with }

  { Read in pages }
    for I1 := 0 to (ChildCount - 1) do begin
      StreamHelper.StartReadBlock;
      TRavePage(Child[I1]).LoadFromStreamHelper(StreamHelper);
      StreamHelper.FinishReadBlock;
    end; { for }
  end; { with }
end;  { LoadFromStreamHelper }

procedure TRaveReport.ProcessLoaded;
var
  I1: integer;
  Item: TRaveComponent;
begin { ProcessLoaded }
  if not Assigned(FixUpList) then Exit;
  for I1 := 0 to FixUpList.Count - 1 do begin
    Item := TRaveProjectManager(Project).FindRaveComponent(FixUpList[I1],self);
    if Assigned(Item) and (Item is TRavePage) then begin
      LoadedList.Add(TRavePage(Item));
    end else begin
    //!!! Error, editor not found
    end; { else }
  end; { for }
  FixUpList.Free;
  FixUpList := nil;
end;  { ProcessLoaded }

function TRaveReport.GetLoadedCount: integer;
begin { GetLoadedCount }
  Result := LoadedList.Count;
end;  { GetLoadedCount }

function TRaveReport.GetLoaded(Index: integer): TRavePage;
begin { GetLoaded }
  if (Index >= 0) and (Index <= LoadedList.Count) then begin
    Result := LoadedList[Index];
  end else begin
    Result := nil;
  end; { else }
end;  { GetLoaded }

procedure TRaveReport.SetPageList(Value: TRaveComponentList);
begin { SetPageList }
  if Assigned(Value) and (Value.Count > 0) then begin
    if not Assigned(FPageList) then begin
      FPageList := TRaveComponentList.Create;
    end; { if }
    CopyList(Value,FPageList);
  end else begin
    if Assigned(FPageList) then begin
      FPageList.Free;
      FPageList := nil;
    end; { if }
  end; { else }
end;  { SetPageList }

procedure TRaveReport.LoadPage(Page: TRavePage);
begin { LoadPage }
  LoadedList.Add(Page);
  Page.Open;
  if SaveEnvOnly then begin
    TRaveProjectManager(Project).DataChanged := true;
  end; { if }
end;  { LoadPage }

procedure TRaveReport.UnloadPage(Page: TRavePage);
begin { UnloadPage }
  Page.Close;
  LoadedList.Remove(Page);
  if SaveEnvOnly then begin
    TRaveProjectManager(Project).DataChanged := true;
  end; { if }
end;  { UnloadPage }

procedure TRaveReport.Open;
var
  I1: integer;
  Page: TRavePage;
begin { Open }
  if not Active then begin
    inherited Open;
    for I1 := 0 to ChildCount - 1 do begin
      TRaveProjectItem(Child[I1]).Open;
    end; { for }
    for I1 := 0 to LoadedList.Count - 1 do begin
      Page := TRavePage(LoadedList[I1]);
      if Page.Global then begin
        Page.Open;
      end; { if }
    end; { for }
  end; { if }
  TRaveProjectManager(Project).FreeForwardRefs;
end;  { Open }

procedure TRaveReport.Close;
var
  I1: integer;
begin { Close }
  if not Active then Exit;
  inherited Close;
  for I1 := 0 to LoadedList.Count - 1 do begin
    TRaveProjectItem(LoadedList[I1]).Close;
  end; { for }
end;  { Close }

procedure TRaveReport.Compile;
var
  I1: integer;
begin { Compile }
  inherited Compile;
  for I1 := 0 to ChildCount - 1 do begin
    if Child[I1] is TRaveProjectItem then begin
      TRaveProjectItem(Child[I1]).Compile;
    end; { if }
  end; { for }
end;  { Compile }

function TRaveReport.NewPage: TRavePage;
begin { NewPage }
  Result := TRavePage.Create(self);
  Result.Parent := self;
  Result.Name := TRaveProjectManager(Project).GetUniqueName({Trans-}'Page',self,false);
  LoadPage(Result);
  TRaveProjectManager(Project).DataChanged := true;
end;  { NewPage }

procedure TRaveReport.RSPrint(Sender: TObject);
var
  CurrPage: TRavePage;
  Beginning: boolean;
  PageStack: TRaveStackList;
  PageIdx: integer;
  DonePrint: boolean;
  I1: integer;
  Pages: integer;
begin { RSPrint }
{ BaseReport is initialized to printing engine }
  (Sender as TBaseReport).NoBufferLine := true;

  Pages := MaxPages;
  PageIdx := 0;
  if Assigned(PageList) and (PageList.Count > 0) then begin
    CurrPage := nil;
  end else begin
    CurrPage := FirstPage;
  end; { else }
  Beginning := true;
  PageStack := TRaveStackList.Create;
  try
    repeat
      if not Assigned(CurrPage) then begin { Get new page }
        if PageStack.Empty then begin
          Inc(PageIdx);
          if Assigned(PageList) and (PageList.Count >= PageIdx) then begin
            CurrPage := TRavePage(PageList[PageIdx - 1]);
          end else begin
            Break; { Done printing pages }
          end; { else }
        end else begin
          CurrPage := TRavePage(PageStack.Pop);
        end; { else }
      end; { if }

      if not Beginning then begin
      { Set up new page }
        if CurrPage.Orientation <> poDefault then begin
          (Sender as TBaseReport).Orientation := CurrPage.Orientation;
        end; { if }
        if CurrPage.BinCustom <> '' then begin
          (Sender as TBaseReport).SelectBin(CurrPage.BinCustom);
        end else if CurrPage.Bin <> -1 then begin
          if RPDev <> nil then begin
            for I1 := 0 to RPDev.Bins.Count - 1 do begin
              if longint(RPDev.Bins.Objects[I1]) = CurrPage.Bin then begin
                (Sender as TBaseReport).SelectBin(RPDev.Bins[I1]);
              end; { if }
            end; { for }
          end; { if }
        end; { else }
      { Go to new page }
        (Sender as TBaseReport).NewPage;
      end else begin
        Beginning := false;
      end; { else }
      CurrPage.PrintAll((Sender as TBaseReport));
      DonePrint := CurrPage.DonePrinting;
      case CurrPage.GotoMode of
        gmGotoDone: begin
          if DonePrint then begin
            CurrPage := CurrPage.GotoPage;
          end; { if }
        end;
        gmGotoNotDone: begin
          if not DonePrint then begin
            CurrPage := CurrPage.GotoPage;
          end else begin
            CurrPage := nil;
          end; { else }
        end;
        gmCallEach: begin
          if Assigned(CurrPage.GotoPage) then begin
            if not DonePrint then begin
              PageStack.Push(CurrPage);
            end; { if }
            CurrPage := CurrPage.GotoPage;
          {!!! Init CurrPage }
          end else begin
            if DonePrint then begin
              CurrPage := nil;
            end; { if }
          end; { else }
        end;
      end; { case }
      if Pages > 0 then begin
        Dec(Pages);
        if Pages = 0 then Break;
      end; { if }
    until false;
  finally
    PageStack.Free;
  end; { tryf }
end;  { RSPrint }

procedure TRaveReport.RSBeforePrint(Sender: TObject);
var
  Page: TRavePage;
  I1: integer;
begin { RSBeforePrint }
  TRaveProjectManager(Project).BaseReport := (Sender as TBaseReport);

{ Configure BaseReport }
  if Printer <> '' then begin
    (Sender as TBaseReport).SelectPrinter(Printer);
  end; { if }
  if Collate <> pcDefault then begin
    (Sender as TBaseReport).Collate := boolean(Ord(Collate));
  end; { if }
  if Duplex <> pdDefault then begin
    (Sender as TBaseReport).Duplex := TDuplex(Ord(Duplex));
  end; { if }
  if (Resolution <> prDefault) and Assigned((Sender as TBaseReport).DevMode) then begin
    (Sender as TBaseReport).DevMode^.dmPrintQuality := RavePrinterResolution[Resolution];
  end; { if }
  if Copies > 0 then begin
    (Sender as TBaseReport).Copies := Copies;
  end; { if }

{ Get first page to be printed }
  if Assigned(PageList) and (PageList.Count > 0) then begin
    Page := TRavePage(PageList[0]);
  end else begin
    Page := FirstPage;
  end; { else }

  if Assigned(Page) then begin { Configure first page - PaperSize, Orientation, Bin }
    if Page.PaperSize = DMPAPER_USER then begin
      (Sender as TBaseReport).SetPaperSize(0,Page.PageWidth,Page.PageHeight);
    end else if Page.PaperSize <> -1 then begin
      (Sender as TBaseReport).SetPaperSize(Page.PaperSize,0,0);
    end; { else }
    if Page.Orientation <> poDefault then begin
      (Sender as TBaseReport).Orientation := Page.Orientation;
    end; { if }

    if Page.BinCustom <> '' then begin
      (Sender as TBaseReport).SelectBin(Page.BinCustom);
    end else if Page.Bin <> -1 then begin
      if RPDev <> nil then begin
        for I1 := 0 to RPDev.Bins.Count - 1 do begin
          if longint(RPDev.Bins.Objects[I1]) = Page.Bin then begin
            (Sender as TBaseReport).SelectBin(RPDev.Bins[I1]);
          end; { if }
        end; { for }
      end; { if }
    end; { else }
  end; { if }

  if Assigned(SaveBeforePrint) then begin
    SaveBeforePrint(Sender);
  end; { if }
end;  { RSBeforePrint }

procedure TRaveReport.RSAfterPrint(Sender: TObject);
begin { RSAfterPrint }
  TRaveProjectManager(Project).BaseReport := GBaseReport;

  if Assigned(SaveAfterPrint) then begin
    SaveAfterPrint(Sender);
  end; { if }
end;  { RSAfterPrint }

procedure TRaveReport.InternalExecute(Engine: TRPComponent);
var
  I1: integer;
  LHaveControl: boolean;
  SavedUnitsFactor: TRaveFloat;
begin { InternalExecute }
  TRaveProjectManager(Project).PrepareModule;

  if Assigned(CurrentDesigner) then begin
    CurrentDesigner.ClearSelection;
  end; { if }

{ Save designed state for report and all global pages }
  SaveDesigned;
  for I1 := 0 to TRaveProjectManager(Project).GlobalPageList.Count - 1 do begin
    TRaveReport(TRaveProjectManager(Project).GlobalPageList[I1]).SaveDesigned;
  end; { for }
  if RaveDataSystem <> nil then begin
    RaveDataSystem.AutoUpdate := true;
  end;
  TRaveProjectManager(Project).BeforeReport; { Initialize all components }
  TRaveProjectManager(Project).FPrinting := true;

  LHaveControl := true;
  if RaveDataSystem <> nil then begin
    LHaveControl := RaveDataSystem.GainControl;
  end;
  if LHaveControl then try
    if Assigned(Engine) then begin
      if Engine is TRvSystem then begin
        with Engine as TRvSystem do begin
          SavedUnitsFactor := SystemPrinter.UnitsFactor;
          SystemPrinter.UnitsFactor := 1;
          if BaseReport <> nil then begin
            try
              TRaveProjectManager(Project).BaseReport := BaseReport;
              RSPrint(BaseReport);
            finally
              SystemPrinter.UnitsFactor := SavedUnitsFactor;
            end; { tryf }
          end else begin
            SaveOnPrint := OnPrint;
            OnPrint := RSPrint;
            SaveBeforePrint := OnBeforePrint;
            OnBeforePrint := RSBeforePrint;
            SaveAfterPrint := OnAfterPrint;
            OnAfterPrint := RSAfterPrint;
            if AlwaysGenerate then begin
              SystemOptions := SystemOptions + [soUseFiler];
            end; { if }
            try
              Execute;