frd_mngr.pas

FASTREPORT报表工具,可以迅速制作报表.

  procedure WriteString(s: String);
  begin
    sl.Text := s;
    frWriteMemo(Stream, sl);
  end;

  procedure WriteFields(ds: TDataSet);
  var
    i: Integer;
    b: Byte;
    w: Word;
    s: String;
  begin
    w := ds.FieldCount;
    Stream.Write(w, 2);
    for i := 0 to ds.FieldCount - 1 do
    with ds.Fields[i] do
    begin
      if Lookup then
      begin
        b := 1;
        Stream.Write(b, 1);
        WriteString(FieldName);
        for b := 0 to FieldNum - 1 do
          if ClassName = FieldClasses[b].ClassName then
            break;
        Stream.Write(b, 1);
        w := Size;
        Stream.Write(w, 2);
        WriteString(KeyFields);
        if LookupDataset <> nil then
        begin
          s := LookupDataset.Name;
          if LookupDataset.Owner <> frDataModule then
            s := LookupDataset.Owner.Name + '.' + s;
        end
        else
          s := '';
        WriteString(s);
        WriteString(LookupKeyFields);
        WriteString(LookupResultField);
      end
      else
      begin
        b := 0;
        Stream.Write(b, 1);
        WriteString(FieldName);
      end;
    end;
  end;

  procedure WriteParams(q: TfrQuery);
  var
    i: Integer;
    w: Word;
  begin
    w := q.frParams.Count;
    Stream.Write(w, 2);
    for i := 0 to q.frParams.Count - 1 do
    with q.frParams do
    begin
      for w := 0 to 10 do
        if ParamType[i] = ParamTypes[w] then
          break;
      Stream.Write(w, 2);
      case ParamKind[i] of
        pkAssignFromMaster: w := 0;
        pkValue:            w := 1;
        pkAsk, pkVariable:  w := $101;
      end;
      Stream.Write(w, 2);
      WriteString(ParamText[i]);
    end;
  end;

  procedure WriteDataset1(ds: TDataSet);
  var
    t: TfrTable;
    q: TfrQuery;
  begin
    if ds is TfrTable then
    begin
      t := ds as TfrTable;
      b := 0;
      Stream.Write(b, 1);
      WriteString(t.Name);
      WriteString(t.frDatabaseName);
      WriteString(t.TableName);
      WriteString(t.IndexName);
      WriteString(t.Filter);
    end
    else if ds is TfrQuery then
    begin
      q := ds as TfrQuery;
      b := 1;
      Stream.Write(b, 1);
      WriteString(q.Name);
      WriteString(q.frDatabaseName);
      frWriteMemo(Stream, q.SQL);
    end;
  end;

  procedure WriteDataset2(ds: TDataSet);
  var
    t: TfrTable;
    q: TfrQuery;
    s: String;
  begin
    if ds is TfrTable then
    begin
      t := ds as TfrTable;
      b := 0;
      Stream.Write(b, 1);
      WriteString(t.Name);
      if (t.MasterSource <> nil) and (t.MasterSource.DataSet <> nil) then
        s := t.MasterSource.DataSet.Owner.Name + '.' + t.MasterSource.DataSet.Name else
        s := '';
      WriteString(s);
      WriteString(t.MasterFields);
      WriteFields(t);
    end
    else
    begin
      q := ds as TfrQuery;
      b := 1;
      Stream.Write(b, 1);
      WriteString(q.Name);
      if (q.DataSource <> nil) and (q.DataSource.DataSet <> nil) then
        s := q.DataSource.DataSet.Owner.Name + '.' + q.DataSource.DataSet.Name else
        s := '';
      WriteString(s);
      WriteParams(q);
      WriteFields(q);
    end;
  end;

  procedure WriteDialogControls;
  var
    i: Integer;
    w: Word;
    p: PfrParamInfo;
    procedure WriteControlInfo(p: PfrControlInfo);
    begin
      with p^ do
      begin
        Stream.Write(Bounds, SizeOf(Bounds));
        WriteString(Caption);
        WriteString(FontName);
        Stream.Write(FontSize, 4);
        Stream.Write(FontStyle, 2);
        Stream.Write(FontCharset, 2);
        Stream.Write(FontColor, 4);
      end;
    end;
  begin
    w := frParamList.Count;
    Stream.Write(w, 2);
    Stream.Write(ParamFormWidth, 4);
    Stream.Write(ParamFormHeight, 4);
    for i := 0 to frParamList.Count - 1 do
    begin
      p := frParamList[i];
      WriteString(p^.QueryRef.Owner.Name + '.' + p^.QueryRef.Name);
      WriteString(p^.ParamName);
      WriteControlInfo(@p^.LabelControl);
      WriteControlInfo(@p^.EditControl);
      Stream.Write(p^.Typ, 1);
      if p.Typ = ptLookup then
      begin
        WriteString(p^.LookupDS);
        WriteString(p^.LookupKF);
        WriteString(p^.LookupLF);
      end
      else if p^.Typ = ptCombo then
        frWriteMemo(Stream, p^.ComboStrings);
    end;
  end;

  procedure WriteSpecialParams;
  var
    i: Integer;
    w: Word;
  begin
    w := frSpecialParams.Count;
    Stream.Write(w, 2);
    for i := 0 to frSpecialParams.Count - 1 do
      WriteString(frSpecialParams.Name[i] + '=' + frSpecialParams.Value[i]);
  end;

  procedure WriteDatabase(d: TfrDatabase);
  var
    b: Byte;
  begin
    WriteString(d.Name);
    WriteString(d.frDriver);
    b := Byte(d.LoginPrompt);
    Stream.Write(b, 1);
    if d.Params <> nil then
      sl.Assign(d.Params);
    frWriteMemo(Stream, sl);
    WriteString(d.frDatabaseName);
  end;

begin
  sl := TStringList.Create;
  w := $01FF;                 // new version signature
  Stream.Write(w, 2);
  w := 0;
  with frDataModule do
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TfrDatabase then
      Inc(w);
  Stream.Write(w, 2);

  with frDataModule do
    for i := 0 to ComponentCount - 1 do
      if Components[i] is TfrDatabase then
        WriteDatabase(Components[i] as TfrDatabase);

  w := 0;
  with frDataModule do
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TDataSet then
      Inc(w);
  Stream.Write(w, 2);

  with frDataModule do
  begin
    for i := 0 to ComponentCount - 1 do
      if Components[i] is TDataSet then
        WriteDataset1(Components[i] as TDataSet);
    for i := 0 to ComponentCount - 1 do
      if Components[i] is TDataSet then
        WriteDataset2(Components[i] as TDataSet);
  end;

  if w > 0 then
  begin
    CurReport.FillQueryParams;
    AfterPreparing;
    WriteDialogControls;
    WriteSpecialParams;
  end;
  sl.Free;
end;

procedure TfrReportDataManager.BeforePreparing;
var
  i: Integer;
begin
  FEnabled := True;
  for i := 0 to frParamList.Count - 1 do
    PfrParamInfo(frParamList[i])^.Actual := False;
end;

procedure TfrReportDataManager.AfterPreparing;
var
  i, j: Integer;
  p: PfrParamInfo;
begin
  FEnabled := False;
  i := 0;
  while i < frParamList.Count do
  begin
    p := frParamList[i];
    if not p^.Actual then
    begin
      p^.ComboStrings.Free;
      FreeMem(p, SizeOf(TfrParamInfo));
      frParamList.Delete(i);
    end
    else
    begin
      j := p^.QueryRef.frParams.ParamIndex(p^.ParamName);
      p^.QueryRef.frParams.ParamKind[j] := pkAsk;
      Inc(i);
    end;
  end;
end;

procedure TfrReportDataManager.PrepareDataSet(ds: TfrTDataSet);
var
  q: TfrQuery;
  i, j, b, ofsx, ofsy: Integer;
  p: PfrParamInfo;
  f: Boolean;
begin
{$IFDEF BDE}
  if not (TDataSet(ds) is TQuery) or not FEnabled then Exit;
{$ENDIF}
{$IFDEF ADO}
  if not (TDataSet(ds) is TADOQuery) or not FEnabled then Exit;
{$ENDIF}
{$IFDEF IBX}
  if not (TDataSet(ds) is TIBQuery) or not FEnabled then Exit;
{$ENDIF}
  q := TfrQuery(ds);
  if (DocMode = dmPrinting) and (frDataStorage <> nil) then
    if Assigned(frDataStorage.OnQueryParams) then
      frDataStorage.OnQueryParams(CurReport, q);
  ofsx := 8; ofsy := 8;
  if TDataSet(ds) is TfrQuery then
    for i := 0 to q.frParams.Count - 1 do
    begin
      if q.frParams.ParamKind[i] <> pkAsk then
        continue;
      f := True;
      for j := 0 to frParamList.Count - 1 do
      begin
        p := frParamList[j];
        b := p^.EditControl.Bounds.Top + p^.EditControl.Bounds.Bottom - 1;
        if ofsx = 8 then
          if b + 4 > ofsy then
            ofsy := b + 4;
        if (q = p^.QueryRef) and (q.frParams.ParamName[i] = p^.ParamName) then
        begin
          p^.Actual := True;
          f := False;
        end;
      end;
      if f then
      begin
        GetMem(p, SizeOf(TfrParamInfo));
        FillChar(p^, SizeOf(TfrParamInfo), #0);
        p^.ComboStrings := TStringList.Create;
        if ofsx > 8 then
          Inc(ofsy, 25);
        if ofsy + 70 > ParamFormHeight then
        begin
          ParamFormHeight := ofsy + 70;
          if ParamFormHeight > 480 then
          begin
            ParamFormHeight := 480;
            ofsy := 8;
            Inc(ofsx, 210);
          end;
        end;
        p^.Actual := True;
        p^.QueryRef := q;
        p^.ParamName := q.frParams.ParamName[i];
        with p^.LabelControl do
        begin
          Bounds := Rect(ofsx, ofsy + 4, 101, 13);
          Caption := q.frParams.ParamName[i];
          FontName := 'MS Sans Serif';
          FontSize := 8;
          FontStyle := 0;
          FontCharset := frCharset;
          FontColor := clWindowText;
        end;
        with p^.EditControl do
        begin
          Bounds := Rect(ofsx + 104, ofsy, 89, 21);
          Caption := '';
          FontName := 'MS Sans Serif';
          FontSize := 8;
          FontStyle := 0;
          FontCharset := frCharset;
          FontColor := clWindowText;
        end;
        frParamList.Add(p);
        if ofsx + 200 > ParamFormWidth then
          ParamFormWidth := ofsx + 200;
      end;
    end;
end;

function TfrReportDataManager.ShowParamsDialog: Boolean;
var
  i, n: Integer;
  s, qname, pname: String;
  p: PfrParamInfo;
  ds: TDataSource;
  q: TfrQuery;
begin
  Result := True;
  for i := 0 to frSpecialParams.Count - 1 do
  begin
    s := frSpecialParams.Name[i];
    n := Pos('.', s);
    qname := Copy(s, 1, n - 1);
    pname := Copy(s, n + 1, 255);
    q := frDataModule.FindComponent(qname) as TfrQuery;
    if (q <> nil) and (q.frParams.ParamIndex(pname) <> -1) then
    begin
      q.Close;
      n := q.frParams.ParamIndex(pname);
      q.frParams.ParamText[n] := frParser.Calc(frSpecialParams.Value[i]);
    end;
  end;

  if frParamList.Count = 0 then Exit;
  for i := 0 to frParamList.Count - 1 do
  begin
    p := frParamList[i];
    p^.QueryRef.Close;
    if p.Typ = ptLookup then
    begin
      ds := frFindComponent(nil, p^.LookupDS) as TDataSource;
      if ds <> nil then
      begin
        p^.LookupActive := ds.DataSet.Active;
        ds.DataSet.Open;
      end;
    end;
  end;
  frParamsDialogForm.BorderStyle := bsDialog;
  frParamsDialogForm.Designing := False;
  frParamsDialogForm.ShowModal;
  for i := 0 to frParamList.Count - 1 do
  begin
    p := frParamList[i];
    try
      n := p^.QueryRef.frParams.ParamIndex(p^.ParamName);
      p^.QueryRef.frParams.ParamText[n] := p^.EditControl.Caption;
    except
      MessageBox(0, PChar(frLoadStr(SInvalidParamValue)), PChar(frLoadStr(SError)),
        mb_Ok + mb_IconError);
      Result := False;
      Exit;
    end;
    if p.Typ = ptLookup then
    begin
      ds := frFindComponent(nil, p^.LookupDS) as TDataSource;
      if ds <> nil then
        ds.DataSet.Active := p^.LookupActive;
    end;
  end;
  for i := 0 to frParamList.Count - 1 do
  begin
    p := frParamList[i];
    p^.QueryRef.Open;
  end;
end;

procedure TfrReportDataManager.AfterParamsDialog;
var
  i, n: Integer;
  s, qname, pname: String;
  p: PfrParamInfo;
  q: TfrQuery;
begin
  for i := 0 to frSpecialParams.Count - 1 do
  begin
    s := frSpecialParams.Name[i];
    n := Pos('.', s);
    qname := Copy(s, 1, n - 1);
    pname := Copy(s, n + 1, 255);
    q := frDataModule.FindComponent(qname) as TfrQuery;
    if (q <> nil) and (q.frParams.ParamIndex(pname) <> -1) then
    begin
      n := q.frParams.ParamIndex(pname);
      s := frSpecialParams.Value[i];
      q.frParams.ParamKind[n] := pkVariable;
      q.frParams.ParamVariable[n] := s;
    end;
  end;

  for i := 0 to frParamList.Count - 1 do
  begin
    p := frParamList[i];
    q := p^.QueryRef;
    n := q.frParams.ParamIndex(p^.ParamName);
    q.frParams.ParamKind[n] := pkAsk;
  end;
end;

procedure TfrReportDataManager.OnMngrClick(Sender:TObject);
var
  DatasetsForm: TfrDatasetsForm;
begin
  DatasetsForm := TfrDatasetsForm.Create(nil);
  with DatasetsForm do
  begin
    ShowModal;
    Free;
  end;
end;

procedure TfrReportDataManager.OnParmClick(Sender: TObject);
begin
  CurReport.FillQueryParams;
  AfterPreparing;
  if frParamList.Count = 0 then Exit;
  frParamsDialogForm.BorderStyle := bsSizeable;
  frParamsDialogForm.Designing := True;
  frParamsDialogForm.ShowModal;
end;


initialization
  frDataManager := TfrReportDataManager.Create;
  Bmp1 := TBitmap.Create;
  Bmp1.Handle := LoadBitmap(hInstance, 'DATAMGRBMP');
  Bmp2 := TBitmap.Create;
  Bmp2.Handle := LoadBitmap(hInstance, 'PARAMDLGBMP');
  frRegisterTool(frLoadStr(SDataManager), Bmp1,
    TfrReportDataManager(frDataManager).OnMngrClick);
  frRegisterTool(frLoadStr(SParamDialog), Bmp2,
    TfrReportDataManager(frDataManager).OnParmClick);
  frDataModule := TDataModule.Create(nil);
  frDataModule.Name := 'ReportData';
  frParamList := TList.Create;

finalization
  Bmp1.Free;
  Bmp2.Free;
  frDataManager.Free;
  frDataManager := nil;
  ClearParamList;
  frDataModule.Free;
  frParamList.Free;

end.