frxdesgnctrls.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

  var
    i:Integer;
    Found:Boolean;
    Empty:Integer;
  begin
    Found:= False;
    Empty:= 0;
    for i:= 0 to 39 do
    begin
      if Colors[i] = FColor then
        Found:= True;
      if (i > 30) and (Colors[i] = clBtnFace) and (Empty = 0) then
        Empty:= i;
    end;

    if Found then exit;

    if Empty = 0 then
    begin
      for i:= 31 to 38 do
        Colors[i]:= Colors[i+1];
      Empty:= 39;
    end;
    Colors[Empty]:= FColor
  end;

begin
  X:= (X-5) div 18;
  if X >= 8 then
    X:= 7;
  Y:= (Y-5) div 18;

  if Y < 5 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 4 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, 98, Width-9, Height-9);
    s:= 'Other...';
    Font:= Self.Font;
    TextOut((Width-TextWidth(s)) div 2, 100, 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, clBtnHighlight, 1) else
    Frame3D(Canvas, r, clBtnHighlight, 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
  FUndo:= TList.Create;
  FRedo:= TList.Create;
end;

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

procedure TfrxUndoBuffer.AddUndo(Report:TfrxReport);
var
  m:TMemoryStream;
begin
  m:= TMemoryStream.Create;
  FUndo.Add(m);
  Report.SaveToStream(m);
end;

procedure TfrxUndoBuffer.AddRedo(Report:TfrxReport);
var
  m:TMemoryStream;
begin
  m:= TMemoryStream.Create;
  FRedo.Add(m);
  Report.SaveToStream(m);
end;

procedure TfrxUndoBuffer.GetUndo(Report:TfrxReport);
var
  m:TMemoryStream;
begin
  m:= FUndo[FUndo.Count-2];
  m.Position:= 0;
  Report.LoadFromStream(m);
  m:= FUndo[FUndo.Count-1];
  m.Free;
  FUndo.Delete(FUndo.Count-1);
end;

procedure TfrxUndoBuffer.GetRedo(Report:TfrxReport);
var
  m:TMemoryStream;
begin
  m:= FRedo[FRedo.Count-1];
  m.Position:= 0;
  Report.LoadFromStream(m);
  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;

{ 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;
    s:TStringStream;
    Writer:TfrxXMLSerializer;
  begin
    c1:= TfrxComponent(c.NewInstance);
    c1.Create(FDesigner.Page);
    c1.Assign(c);
    c1.Left:= c1.Left-minX;
    c1.Top:= c.AbsTop-minY;

    s:= TStringStream.Create('');
    Writer:= TfrxXMLSerializer.Create(s);
    Writer.Owner:= c1.Report;
    Writer.WriteComponent(c1);
    Writer.Free;

    text:= text+s.DataString;

    s.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;

  function ReadComponent:TfrxComponent;
  var
    Reader:TfrxXMLSerializer;
  begin
    Reader:= TfrxXMLSerializer.Create(s);
    Result:= Reader.ReadComponent(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)) and
      not (FDesigner.Page is TfrxDMPPage) then
      Result:= False;
    if not ((c is TfrxBand) or (c is TfrxDMPMemoView) or (c is TfrxDMPLineView)) and
      (FDesigner.Page is TfrxDMPPage) 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
      List.Add(c);
      FindParent(c);
      c.CreateUniqueName;
      c.GroupIndex:= 0;
      FDesigner.Objects.Add(c);
      if c.Parent = FDesigner.Page then
        FDesigner.SelectedObjects.Add(c);
    end;
  end;

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

  List.Free;
  s.Free;
end;

end.