frxdesgnctrls.pas

这个是功能强大的报表软件

  if Y < 6 then
    FColor := Colors[X + Y * 8]
  else
  begin
    TForm(Parent).AutoSize := False;
    Parent.Height := 0;
    cd := TColorDialog.Create(Self);
    cd.Options := [cdFullOpen];
    cd.Color := FColor;
    if cd.Execute then
      FColor := cd.Color else
      Exit;

    AddCustomColor;
  end;

  Repaint;
  if Assigned(FOnColorChanged) then
    FOnColorChanged(Self);
  Parent.Hide;
end;

procedure TfrxColorSelector.Paint;
var
  i, j: Integer;
  s: String;
begin
  inherited;

  with Canvas do
  begin
    for j := 0 to 5 do
      for i := 0 to 7 do
      begin
        if (i = 0) and (j = 0) then
          Brush.Color := clWhite else
          Brush.Color := Colors[i + j * 8];
        Pen.Color := clGray;
        Rectangle(i * 18 + 8, j * 18 + 8, i * 18 + 20, j * 18 + 20);
        if (i = 0) and (j = 0) then
        begin
          MoveTo(i * 18 + 10, j * 18 + 10);
          LineTo(i * 18 + 18, j * 18 + 18);
          MoveTo(i * 18 + 17, j * 18 + 10);
          LineTo(i * 18 + 9, j * 18 + 18);
        end;
      end;

    Pen.Color := clGray;
    Brush.Color := clBtnFace;
    Rectangle(8, 116, Width - 9, Height - 9);
    s := 'Other...';
    Font := Self.Font;
    TextOut((Width - TextWidth(s)) div 2, 118, s);
  end;
end;


{ TfrxLineSelector }

constructor TfrxLineSelector.Create(AOwner: TComponent);
begin
  inherited;
  Width := 98;
  Height := 106;
end;

procedure TfrxLineSelector.DrawEdge(X, Y: Integer; IsDown: Boolean);
var
  r: TRect;
begin
  Y := (Y - 5) div 16;
  if Y > 5 then
    Y := 5;

  Repaint;

  r := Rect(5, Y * 16 + 5, Width - 5, Y * 16 + 21);
  if IsDown then
    Frame3D(Canvas, r, clBtnShadow, clBtnShadow, 2) else
    Frame3D(Canvas, r, clBtnShadow, clBtnShadow, 1);
end;

procedure TfrxLineSelector.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  Y := (Y - 5) div 16;
  if Y > 5 then
    Y := 5;

  FStyle := Y;

  Repaint;
  if Assigned(FOnStyleChanged) then
    FOnStyleChanged(Self);
  Parent.Hide;
end;

procedure TfrxLineSelector.Paint;
var
  i: Integer;

  procedure DrawLine(Y, Style: Integer);
  begin
    if Style = 5 then
    begin
      Style := 0;
      DrawLine(Y - 2, Style);
      Inc(Y, 2);
    end;

    with Canvas do
    begin
      Pen.Color := clBlack;
      Pen.Style := TPenStyle(Style);
      MoveTo(7, Y);
      LineTo(Width - 8, Y);
      MoveTo(7, Y + 1);
      LineTo(Width - 8, Y + 1);
    end;
  end;

begin
  inherited;

  for i := 0 to 5 do
    DrawLine(12 + i * 16, i);
end;


{ TfrxUndoBuffer }

constructor TfrxUndoBuffer.Create;
begin
  FRedo := TList.Create;
  FUndo := TList.Create;
end;

destructor TfrxUndoBuffer.Destroy;
begin
  ClearUndo;
  ClearRedo;
  FUndo.Free;
  FRedo.Free;
  inherited;
end;

procedure TfrxUndoBuffer.AddUndo(ReportComponent: TfrxComponent);
var
  m: TMemoryStream;
begin
  m := TMemoryStream.Create;
  FUndo.Add(m);
  SetPictureFlag(ReportComponent, False);
  try
    ReportComponent.SaveToStream(m);
  finally
    SetPictureFlag(ReportComponent, True);
  end;
end;

procedure TfrxUndoBuffer.AddRedo(ReportComponent: TfrxComponent);
var
  m: TMemoryStream;
begin
  m := TMemoryStream.Create;
  FRedo.Add(m);
  SetPictureFlag(ReportComponent, False);
  try
    ReportComponent.SaveToStream(m);
  finally
    SetPictureFlag(ReportComponent, True);
  end;
end;

procedure TfrxUndoBuffer.GetUndo(ReportComponent: TfrxComponent);
var
  m: TMemoryStream;
  IsReport: Boolean;
begin
  IsReport := False;
  if ReportComponent is TfrxReport then
    isReport := True;
  m := FUndo[FUndo.Count - 2];
  m.Position := 0;
  if IsReport then
    TfrxReport(ReportComponent).Reloading := True;
  try
    ReportComponent.LoadFromStream(m);
  finally
  if IsReport then
    TfrxReport(ReportComponent).Reloading := False;
  end;
  SetPictures(ReportComponent);

  m := FUndo[FUndo.Count - 1];
  m.Free;
  FUndo.Delete(FUndo.Count - 1);
end;

procedure TfrxUndoBuffer.GetRedo(ReportComponent: TfrxComponent);
var
  m: TMemoryStream;
  IsReport: Boolean;
begin
  IsReport := False;
  if ReportComponent is TfrxReport then
    isReport := True;
  m := FRedo[FRedo.Count - 1];
  m.Position := 0;
  if IsReport then
    TfrxReport(ReportComponent).Reloading := True;
  try
    ReportComponent.LoadFromStream(m);
  finally
    if IsReport then
      TfrxReport(ReportComponent).Reloading := False;
  end;
  SetPictures(ReportComponent);

  m.Free;
  FRedo.Delete(FRedo.Count - 1);
end;

procedure TfrxUndoBuffer.ClearUndo;
begin
  while FUndo.Count > 0 do
  begin
    TMemoryStream(FUndo[0]).Free;
    FUndo.Delete(0);
  end;
end;

procedure TfrxUndoBuffer.ClearRedo;
begin
  while FRedo.Count > 0 do
  begin
    TMemoryStream(FRedo[0]).Free;
    FRedo.Delete(0);
  end;
end;

function TfrxUndoBuffer.GetRedoCount: Integer;
begin
  Result := FRedo.Count;
end;

function TfrxUndoBuffer.GetUndoCount: Integer;
begin
  Result := FUndo.Count;
end;

procedure TfrxUndoBuffer.SetPictureFlag(ReportComponent: TfrxComponent; Flag: Boolean);
var
  i: Integer;
  l: TList;
  c: TfrxComponent;
begin
  l := ReportComponent.AllObjects;
  for i := 0 to l.Count - 1 do
  begin
    c := l[i];
    if c is TfrxPictureView then
    begin
      TfrxPictureView(c).IsPictureStored := Flag;
      TfrxPictureView(c).IsImageIndexStored := not Flag;
    end;
  end;
end;

procedure TfrxUndoBuffer.SetPictures(ReportComponent: TfrxComponent);
var
  i: Integer;
  l: TList;
  c: TfrxComponent;
begin
  l := ReportComponent.AllObjects;
  for i := 0 to l.Count - 1 do
  begin
    c := l[i];
    if c is TfrxPictureView then
      FPictureCache.GetPicture(TfrxPictureView(c));
  end;
end;


{ TfrxClipboard }

constructor TfrxClipboard.Create(ADesigner: TfrxCustomDesigner);
begin
  FDesigner := ADesigner;
end;

procedure TfrxClipboard.Copy;
var
  c, c1: TfrxComponent;
  i, j: Integer;
  text: String;
  minX, minY: Extended;
  List: TList;
  Flag: Boolean;

  procedure Write(c: TfrxComponent);
  var
    c1: TfrxComponent;
    Writer: TfrxXMLSerializer;
  begin
    c1 := TfrxComponent(c.NewInstance);
    c1.Create(FDesigner.Page);

    if c is TfrxPictureView then
    begin
      TfrxPictureView(c).IsPictureStored := False;
      TfrxPictureView(c).IsImageIndexStored := True;
    end;

    try
      c1.Assign(c);
    finally
      if c is TfrxPictureView then
      begin
        TfrxPictureView(c).IsPictureStored := True;
        TfrxPictureView(c).IsImageIndexStored := False;
        TfrxPictureView(c1).IsImageIndexStored := True;
      end;
    end;

    c1.Left := c1.Left - minX;
    c1.Top := c.AbsTop - minY;

    Writer := TfrxXMLSerializer.Create(nil);
    Writer.Owner := c1.Report;
    text := text + '<' + c1.ClassName + ' Name="' + c.Name + '"' + Writer.ObjToXML(c1) + '/>';
    Writer.Free;

    c1.Free;
  end;

begin
  text := '#FR3 clipboard#' + #10#13;

  minX := 100000;
  minY := 100000;
  for i := 0 to FDesigner.SelectedObjects.Count - 1 do
  begin
    c := FDesigner.SelectedObjects[i];
    if c.AbsLeft < minX then
      minX := c.AbsLeft;
    if c.AbsTop < minY then
      minY := c.AbsTop;
  end;

  List := FDesigner.Page.AllObjects;
  for i := 0 to List.Count - 1 do
  begin
    c := List[i];
    if FDesigner.SelectedObjects.IndexOf(c) <> -1 then
    begin
      Write(c);
      if c is TfrxBand then
      begin
        Flag := False;
        for j := 0 to c.Objects.Count - 1 do
        begin
          c1 := c.Objects[j];
          if FDesigner.SelectedObjects.IndexOf(c1) <> -1 then
            Flag := True;
        end;

        if not Flag then
          for j := 0 to c.Objects.Count - 1 do
            Write(c.Objects[j]);
      end;
    end;
  end;

  Clipboard.AsText := text;
end;

function TfrxClipboard.GetPasteAvailable: Boolean;
begin
  try
    Result := Clipboard.HasFormat(CF_TEXT) and
      (Pos('#FR3 clipboard#', Clipboard.AsText) = 1);
  except
    Result := False;
  end;
end;

procedure TfrxClipboard.Paste;
var
  c: TfrxComponent;
  sl: TStrings;
  s: TStream;
  List: TList;
  NewCompName: string;
  NewComp: TfrxComponent;

  function ReadComponent_(AReader: TfrxXMLSerializer; Root: TfrxComponent): TfrxComponent;
  var
    rd: TfrxXMLReader;
    RootItem: TfrxXMLItem;
  begin
    rd := TfrxXMLReader.Create(AReader.Stream);
    RootItem := TfrxXMLItem.Create;

    try
      rd.ReadRootItem(RootItem, False);
      Result := AReader.ReadComponentStr(Root, RootItem.Name + ' ' + RootItem.Text);

      NewCompName := RootItem.Prop['Name'];
    finally
      rd.Free;
      RootItem.Free;
    end;
  end;

  function ReadComponent: TfrxComponent;
  var
    Reader: TfrxXMLSerializer;
  begin
    Reader := TfrxXMLSerializer.Create(s);
    Result := ReadComponent_(Reader, FDesigner.Report);
    Reader.Free;
  end;

  function FindBand(Band: TfrxComponent): Boolean;
  var
    i: Integer;
  begin
    Result := False;
    for i := 0 to FDesigner.Page.Objects.Count - 1 do
      if (FDesigner.Page.Objects[i] <> Band) and
        (TObject(FDesigner.Page.Objects[i]) is Band.ClassType) then
        Result := True;
  end;

  function CanInsert(c: TfrxComponent): Boolean;
  begin
    Result := True;
    if (c is TfrxDialogControl) and (FDesigner.Page is TfrxReportPage) then
      Result := False;
    if not (c is TfrxDialogComponent) and not (c is TfrxDialogControl) and
      (FDesigner.Page is TfrxDialogPage) then
      Result := False;
    if ((c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or (c is TfrxDMPCommand)) and
      not (FDesigner.Page is TfrxDMPPage) then
      Result := False;
    if not ((c is TfrxBand) or (c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or
      (c is TfrxDMPCommand)) and (FDesigner.Page is TfrxDMPPage) then
      Result := False;
    if not ((c is TfrxCustomLineView) or (c is TfrxCustomMemoView) or
      (c is TfrxShapeView) or (c is TfrxDialogComponent)) and
      (FDesigner.Page is TfrxDataPage) then
      Result := False;
  end;

  procedure FindParent(c: TfrxComponent);
  var
    i: Integer;
    Found: Boolean;
    c1: TfrxComponent;
  begin
    Found := False;
    if not (c is TfrxBand) then
      for i := List.Count - 1 downto 0 do
      begin
        c1 := List[i];
        if c1 is TfrxBand then
          if (c.Top >= c1.Top) and (c.Top < c1.Top + c1.Height) then
          begin
            c.Parent := c1;
            c.Top := c.Top - c1.Top;
            Found := True;
            break;
          end;
      end;
    if not Found then
      c.Parent := FDesigner.Page;
  end;

begin
  FDesigner.SelectedObjects.Clear;

  sl := TStringList.Create;
  sl.Text := Clipboard.AsText;
  sl.Delete(0);

  s := TMemoryStream.Create;
  sl.SaveToStream(s);
  sl.Free;
  s.Position := 0;

  List := TList.Create;

  while s.Position < s.Size do
  begin
    c := ReadComponent;
    if c = nil then break;

    if (((c is TfrxReportTitle) or (c is TfrxReportSummary) or
       (c is TfrxPageHeader) or (c is TfrxPageFooter) or
       (c is TfrxColumnHeader) or (c is TfrxColumnFooter)) and FindBand(c)) or
       not CanInsert(c) then
      c.Free
    else
    begin
      if c is TfrxPictureView then
        FPictureCache.GetPicture(TfrxPictureView(c));
      List.Add(c);
      FindParent(c);
      if FDesigner.IsPreviewDesigner then
        NewComp := FDesigner.Report.FindObject(NewCompName) as TfrxComponent
      else
        NewComp := FDesigner.Report.FindComponent(NewCompName) as TfrxComponent;
      if ((NewComp <> nil) and (NewComp <> c)) or (NewCompName = '') then
        c.CreateUniqueName
      else
        c.Name := NewCompName;
      c.GroupIndex := 0;
      FDesigner.Objects.Add(c);
      if c.Parent = FDesigner.Page then
        FDesigner.SelectedObjects.Add(c);
      c.OnPaste;
    end;
  end;

  if FDesigner.SelectedObjects.Count = 0 then
    FDesigner.SelectedObjects.Add(FDesigner.Page);

  List.Free;
  s.Free;
end;


end.




//