frxcrosseditor.pas

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

procedure TfrxCrossEditorForm.FormHide(Sender:TObject);
begin
  if ModalResult = mrCancel then
    FCross.Assign(FTempCross);
end;

procedure TfrxCrossEditorForm.DrawCross;

  procedure FillMatrix;
  var
    i:Integer;
    RowValues, ColumnValues, CellValues:array of Variant;
  begin
    FCross.BeginMatrix;
    SetLength(RowValues, FCross.RowLevels);
    SetLength(ColumnValues, FCross.ColumnLevels);
    SetLength(CellValues, FCross.CellLevels);

    for i:= 0 to FCross.RowLevels-1 do
      RowValues[i]:= FCross.RowFields[i];
    for i:= 0 to FCross.ColumnLevels-1 do
      ColumnValues[i]:= FCross.ColumnFields[i];
    for i:= 0 to FCross.CellLevels-1 do
      CellValues[i]:= 0;
    FCross.AddValue(RowValues, ColumnValues, CellValues);

    RowValues:= nil;
    ColumnValues:= nil;
    CellValues:= nil;
    FCross.EndMatrix;
  end;

  procedure DrawSelection(Canvas:TCanvas; m:TfrxCustomMemoView);
  begin
    if m<>nil then
    with Canvas do
    begin
      Brush.Style:= bsClear;
      Pen.Color:= $00A9F9;
      Pen.Width:= 2;
      Rectangle(Round(m.Left+2), Round(m.Top+2),
        Round(m.Left+m.Width-0), Round(m.Top+m.Height-0));
    end;
  end;

  procedure CorrectDMPBounds(Memo:TfrxCustomMemoView);
  begin
    if Memo is TfrxDMPMemoView then
    begin
      Memo.Left:= Memo.Left+fr1CharX;
      Memo.Top:= Memo.Top+fr1CharY;
      Memo.Width:= Memo.Width-fr1CharX;
      Memo.Height:= Memo.Height-fr1CharY;
    end;
  end;

  procedure DrawHeader(Canvas:TCanvas; Header:TfrxCrossHeader; p:TfrxPoint);
  var
    i:Integer;
    Items:TList;
    Item:TfrxCrossHeader;
    r:TfrxRect;
    m:TfrxCustomMemoView;
    s:String;
    fr:TfrxFrame;
  begin
    if not Header.Visible then Exit;
    Items:= Header.AllItems;
    fr:= TfrxFrame.Create;

    for i:= 0 to Items.Count-1 do
    begin
      Item:= Items[i];
      m:= Item.Memo;
      r:= Item.Bounds;
      s:= m.Text;
      m.Text:= VarToStr(Item.Value);
      fr.Assign(m.Frame);
      if m.Frame.Typ = [] then
      begin
        m.Frame.Typ:= [ftLeft, ftRight, ftTop, ftBottom];
        m.Frame.Color:= $E8E8E8;
      end;

      m.SetBounds(r.Left+p.X, r.Top+p.Y, r.Right, r.Bottom);
      CorrectDMPBounds(m);
      if m.Visible then
      begin
        m.Draw(Canvas, 1, 1, 0, 0);
        if PtInRect(Rect(Round(r.Left+p.X), Round(r.Top+p.Y),
          Round(r.Left+p.X+r.Right), Round(r.Top+p.Y+r.Bottom)), FSelectedPoint) then
        begin
          FSelectedObject:= m;
          FSelectedPoint:= Point(0, 0);
          DrawSelection(Canvas, m);
        end;
      end;

      m.Text:= s;
      m.Frame:= fr;
    end;

    fr.Free;
    Items.Free;
  end;

  procedure DrawCell(Canvas:TCanvas; p:TfrxPoint);
  var
    i:Integer;
    h, CellOffs, CellWidth:Extended;
    Cell:Variant;
    ColumnItems, RowItems:TList;
    ColumnItem, RowItem:TfrxCrossHeader;
    m:TfrxCustomMemoView;
    CellRect:TRect;
  begin
    ColumnItems:= FCross.Matrix.ColumnHeader.TerminalItems;
    RowItems:= FCross.Matrix.RowHeader.TerminalItems;

    RowItem:= RowItems[0];
    ColumnItem:= ColumnItems[0];
    h:= RowItem.Bounds.Bottom / FCross.CellLevels;
    CellOffs:= 0;

    for i:= 0 to FCross.CellLevels-1 do
    begin
      Cell:= FCross.Matrix.GetValue(0, 0, i);
      m:= FCross.CellMemos[i];
      m.Text:= m.FormatData(Cell);
      if FCross.PlainCells then
      begin
        CellWidth:= ColumnItem.CellSizes[i];
        m.SetBounds(p.X+CellOffs, p.Y, CellWidth, RowItem.Bounds.Bottom);
        CellRect:= Rect(Round(p.X+CellOffs), Round(p.Y),
          Round(p.X+CellOffs+CellWidth), Round(p.Y+RowItem.Bounds.Bottom));
        CellOffs:= CellOffs+CellWidth;
      end
      else
      begin
        m.SetBounds(p.X, p.Y+i * h, ColumnItem.Bounds.Right, h);
        CellRect:= Rect(Round(p.X), Round(p.Y+i * h),
          Round(p.X+ColumnItem.Bounds.Right), Round(p.Y+i * h+h));
      end;
      CorrectDMPBounds(m);
      m.Draw(Canvas, 1, 1, 0, 0);

      if PtInRect(CellRect, FSelectedPoint) then
      begin
        FSelectedObject:= m;
        FSelectedPoint:= Point(0, 0);
        DrawSelection(Canvas, m);
      end;
    end;

    ColumnItems.Free;
    RowItems.Free;
  end;

begin
  with PaintBox.Canvas do
  begin
    Brush.Color:= clWindow;
    FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));
  end;

  if FCross.IsCrossValid then
  begin
    FillMatrix;
    if not FCross.Matrix.NoColumns then
      DrawHeader(PaintBox.Canvas, FCross.Matrix.ColumnHeader,
        frxPoint(FCross.RowHeaderWidth+10, 10));
    if not FCross.Matrix.NoRows then
      DrawHeader(PaintBox.Canvas, FCross.Matrix.RowHeader,
        frxPoint(10, FCross.ColumnHeaderHeight+10));
    DrawCell(PaintBox.Canvas, frxPoint(FCross.RowHeaderWidth+10,
      FCross.ColumnHeaderHeight+10));
    DrawSelection(PaintBox.Canvas, FSelectedObject);
  end;
end;

procedure TfrxCrossEditorForm.PaintBoxPaint(Sender:TObject);
begin
  DrawCross;
end;

procedure TfrxCrossEditorForm.DatasetCBDrawItem(Control:TWinControl;
  Index:Integer; ARect:TRect; State:TOwnerDrawState);
begin
  DatasetCB.Canvas.FillRect(ARect);
  FImageList.Draw(DatasetCB.Canvas, ARect.Left, ARect.Top, 53);
  DatasetCB.Canvas.TextOut(ARect.Left+20, ARect.Top+1, DatasetCB.Items[Index]);
end;

procedure TfrxCrossEditorForm.DatasetCBClick(Sender:TObject);
var
  ds:TfrxCustomDBDataSet;
begin
  if DatasetCB.ItemIndex =-1 then Exit;
  ds:= TfrxCustomDBDataSet(DatasetCB.Items.Objects[DatasetCB.ItemIndex]);
  ds.GetFieldList(FieldsLB.Items);
  RowsLB.Clear;
  ColumnsLB.Clear;
  CellsLB.Clear;
  if Sender<>nil then
    ReflectChanges;
end;

procedure TfrxCrossEditorForm.FieldsLBDrawItem(Control:TWinControl;
  Index:Integer; ARect:TRect; State:TOwnerDrawState);
begin
  FieldsLB.Canvas.FillRect(ARect);
  FImageList.Draw(FieldsLB.Canvas, ARect.Left, ARect.Top, 54);
  FieldsLB.Canvas.TextOut(ARect.Left+20, ARect.Top+1, FieldsLB.Items[Index]);
end;

procedure TfrxCrossEditorForm.ReflectChanges;
begin
  if DatasetCB.ItemIndex =-1 then
    FCross.DataSet:= nil else
    FCross.DataSet:= TfrxCustomDBDataSet(DatasetCB.Items.Objects[DatasetCB.ItemIndex]);
  if FCross is TfrxDBCrossView then
  begin
    FCross.RowFields:= RowsLB.Items;
    FCross.ColumnFields:= ColumnsLB.Items;
    FCross.CellFields:= CellsLB.Items;
  end;
  FCross.RowLevels:= FCross.RowFields.Count;
  FCross.ColumnLevels:= FCross.ColumnFields.Count;
  FCross.CellLevels:= FCross.CellFields.Count;
  FSelectedObject:= nil;
  DrawCross;
  UpdateControls;
end;

procedure TfrxCrossEditorForm.LBDragOver(Sender, Source:TObject; X,
  Y:Integer; State:TDragState; var Accept:Boolean);
begin
  Accept:= (Source is TListBox) and (TListBox(Source).Items.Count > 0);
end;

procedure TfrxCrossEditorForm.LBDragDrop(Sender, Source:TObject; X,
  Y:Integer);
var
  s:String;
  i:Integer;
  CellExist:Boolean;
  SourceLB, SenderLB:TListBox;
begin
  SourceLB:= TListBox(Source);
  SenderLB:= TListBox(Sender);
  if (Source = Sender) and (Source<>FieldsLB) then
  begin
    i:= SourceLB.ItemAtPos(Point(X, Y), True);
    if i =-1 then
      i:= SourceLB.Items.Count-1;
    SourceLB.Items.Exchange(SourceLB.ItemIndex, i);
  end
  else if Source<>Sender then
  begin
    if SourceLB.ItemIndex =-1 then Exit;
    s:= SourceLB.Items[SourceLB.ItemIndex];

    CellExist:= CellsLB.Items.IndexOf(s) >= 0;

    if not (((Source = CellsLB) and (Sender = FieldsLB)) or
      ((Source = FieldsLB) and (Sender<>CellsLB) and CellExist)) then
      SenderLB.Items.Add(s);
    i:= FieldsLB.Items.IndexOf(s);
    if (Source = CellsLB) and (Sender<>FieldsLB) and (i<>-1) then
    begin
      FieldsLB.Items.Delete(i);
      repeat
        i:= CellsLB.Items.IndexOf(s);
        if i<>-1 then
          CellsLB.Items.Delete(i);
      until i =-1;
    end;
    if (Source<>FieldsLB) and (Sender = CellsLB) then
      FieldsLB.Items.Add(s);

    if not (((Source = FieldsLB) and (Sender = CellsLB)) or
      ((Source = FieldsLB) and CellExist)) then
    begin
      i:= SourceLB.ItemIndex;
      if (i<>-1) and (SourceLB.Items[i] = s) then
        SourceLB.Items.Delete(i);
    end;
  end;

  ReflectChanges;
end;

procedure TfrxCrossEditorForm.LBDrawItem(Control:TWinControl;
  Index:Integer; ARect:TRect; State:TOwnerDrawState);
var
  HasSubtotal:Boolean;
  sort:String;
begin
  with TListBox(Control), TListBox(Control).Canvas do
  begin
    FillRect(ARect);
    TextOut(ARect.Left+2, ARect.Top+1, Items[Index]);

    if Control = RowsLB then
      sort:= FSortNames[FCross.RowSort[Index]] else
      sort:= FSortNames[FCross.ColumnSort[Index]];
    TextOut(ARect.Left+200, ARect.Top+1, sort);

    if Index<>Items.Count-1 then
    begin
      TextOut(ARect.Left+135, ARect.Top+1, frxResources.Get('crSubtotal'));
      Pen.Color:= clGray;
      Brush.Color:= clWindow;
      Rectangle(ARect.Left+120, ARect.Top+3, ARect.Left+131, ARect.Top+14);

      if Control = RowsLB then
        HasSubtotal:= FCross.RowTotalMemos[Index+1].Visible else
        HasSubtotal:= FCross.ColumnTotalMemos[Index+1].Visible;

      if HasSubtotal then
      begin
        Pen.Color:= clBlack;
        with ARect do
        begin
          PolyLine([Point(Left+122, Top+7), Point(Left+124, Top+9), Point(Left+129, Top+4)]);
          PolyLine([Point(Left+122, Top+8), Point(Left+124, Top+10), Point(Left+129, Top+5)]);
          PolyLine([Point(Left+122, Top+9), Point(Left+124, Top+11), Point(Left+129, Top+6)]);
        end;
      end;
    end;

    Pen.Color:= clGray;
    Brush.Color:= clWindow;
    Rectangle(ARect.Left+185, ARect.Top+3, ARect.Left+196, ARect.Top+14);

    Pen.Color:= clBlack;
    with ARect do
    begin
      MoveTo(Left+187, Top+7); LineTo(Left+194, Top+7);
      MoveTo(Left+188, Top+8); LineTo(Left+193, Top+8);
      MoveTo(Left+189, Top+9); LineTo(Left+192, Top+9);
      MoveTo(Left+190, Top+10); LineTo(Left+191, Top+10);
    end;
  end;
end;

procedure TfrxCrossEditorForm.LBClick(Sender:TObject);
begin
  if Sender<>FieldsLB then
    FieldsLB.ItemIndex:=-1;
  if Sender<>RowsLB then
    RowsLB.ItemIndex:=-1;
  if Sender<>ColumnsLB then
    ColumnsLB.ItemIndex:=-1;
  if Sender<>CellsLB then
    CellsLB.ItemIndex:=-1;
end;

procedure TfrxCrossEditorForm.LBDblClick(Sender:TObject);
var
  lb:TListBox;
  s:String;
begin
  lb:= TListBox(Sender);

  s:= Cross.Report.Designer.InsertExpression(lb.Items[lb.ItemIndex]);
  if s<>'' then
  begin
    lb.Items[lb.ItemIndex]:= s;
    ReflectChanges;
  end;
end;

procedure TfrxCrossEditorForm.CancelBClick(Sender:TObject);
begin
  ModalResult:= mrCancel;
end;

procedure TfrxCrossEditorForm.OkBClick(Sender:TObject);
begin
  ModalResult:= mrOk;
end;

procedure TfrxCrossEditorForm.LBMouseDown(Sender:TObject;
  Button:TMouseButton; Shift:TShiftState; X, Y:Integer);
var
  Memo:TfrxCustomMemoView;
  sort:TfrxCrossSortOrder;
  i:Integer;
  pt:TPoint;
begin
  FCurList:= TListBox(Sender);
  if (X > 118) and (X < 133) then
  begin
    if FCurList = RowsLB then
      Memo:= FCross.RowTotalMemos[FCurList.ItemIndex+1] else
      Memo:= FCross.ColumnTotalMemos[FCurList.ItemIndex+1];
    Memo.Visible:= not Memo.Visible;
  end;