⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frxcrosseditor.pas

📁 这个是功能强大的报表软件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  begin
    s := SourceLB.Items[SourceLB.ItemIndex];
    if Source <> FieldsLB then
      SourceLB.Items.Delete(SourceLB.Items.IndexOf(s));
    if Sender <> FieldsLB then
      SenderLB.Items.Add(s);
  end;

  ReflectChanges(Source);
  ReflectChanges(Sender);
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);
  if lb.ItemIndex = -1 then
    exit;
  s := Cross.Report.Designer.InsertExpression(lb.Items[lb.ItemIndex]);
  if s <> '' then
  begin
    lb.Items[lb.ItemIndex] := s;
    ReflectChanges(Sender);
  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;

  if (X > 183) and (X < 198) then
  begin
    if FCurList = RowsLB then
      sort := FCross.RowSort[FCurList.ItemIndex] else
      sort := FCross.ColumnSort[FCurList.ItemIndex];

    for i := 0 to SortPopup.Items.Count - 1 do
      if SortPopup.Items[i].Tag = Integer(sort) then
         SortPopup.Items[i].Checked := True;
    pt := FCurList.ClientToScreen(Point(X, Y));
    SortPopup.Popup(pt.X, pt.Y);
  end;

  FCurList.Invalidate;
  ReflectChanges(Sender, False);
end;

procedure TfrxCrossEditorForm.CBClick(Sender: TObject);
begin
  if FUpdating then Exit;

  FCross.ShowTitle := TitleCB.Checked;
  FCross.ShowCorner := CornerCB.Checked;
  FCross.ShowColumnHeader := ColumnHeaderCB.Checked;
  FCross.ShowRowHeader := RowHeaderCB.Checked;
  FCross.ShowColumnTotal := ColumnTotalCB.Checked;
  FCross.ShowRowTotal := RowTotalCB.Checked;

  FCross.AutoSize := AutoSizeCB.Checked;
  FCross.Border := BorderCB.Checked;
  FCross.DownThenAcross := DownAcrossCB.Checked;
  FCross.RepeatHeaders := RepeatCB.Checked;
  FCross.PlainCells := PlainCB.Checked;
  FCross.JoinEqualCells := JoinCB.Checked;
  ReflectChanges(Sender, False);
end;

procedure TfrxCrossEditorForm.DimensionsChange(Sender: TObject);
begin
  if FUpdating then Exit;

  case TControl(Sender).Tag of
    0: FCross.RowLevels := StrToInt(RowsE.Text);
    1: FCross.ColumnLevels := StrToInt(ColumnsE.Text);
    2: FCross.CellLevels := StrToInt(CellsE.Text);
  end;

  RowsLB.Items := FCross.RowFields;
  ColumnsLB.Items := FCross.ColumnFields;
  CellsLB.Items := FCross.CellFields;

  ReflectChanges(Sender);
end;

procedure TfrxCrossEditorForm.FuncMIClick(Sender: TObject);
begin
  if CellsLB.ItemIndex = -1 then Exit;
  FCross.CellFunctions[CellsLB.ItemIndex] := TfrxCrossFunction(TControl(Sender).Tag);
  CellsLB.Invalidate;
  CellsLB.EndDrag(False);
end;

procedure TfrxCrossEditorForm.CellsLBMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  f: TfrxCrossFunction;
  pt: TPoint;
begin
  if CellsLB.ItemIndex = -1 then Exit;
  if (X > 183) and (X < 198) then
  begin
    f := FCross.CellFunctions[CellsLB.ItemIndex];
    for i := 0 to FuncPopup.Items.Count - 1 do
      if FuncPopup.Items[i].Tag = Integer(f) then
         FuncPopup.Items[i].Checked := True;
    pt := CellsLB.ClientToScreen(Point(X, Y));
    FuncPopup.Popup(pt.X, pt.Y);
  end;
end;

procedure TfrxCrossEditorForm.SortMIClick(Sender: TObject);
begin
  if FCurList.ItemIndex = -1 then Exit;
  if FCurList = ColumnsLB then
    FCross.ColumnSort[FCurList.ItemIndex] := TfrxCrossSortOrder(TControl(Sender).Tag) else
    FCross.RowSort[FCurList.ItemIndex] := TfrxCrossSortOrder(TControl(Sender).Tag);
  FCurList.Invalidate;
  FCurList.EndDrag(False);
end;

procedure TfrxCrossEditorForm.SwapBClick(Sender: TObject);
var
  sl: TStrings;
begin
  sl := TStringList.Create;
  sl.Assign(RowsLB.Items);
  FUpdating := True;
  RowsLB.Items := ColumnsLB.Items;
  ColumnsLB.Items := sl;
  sl.Free;
  FUpdating := False;
  ReflectChanges(nil);
  RowsLB.Repaint;
  ColumnsLB.Repaint;
end;

procedure TfrxCrossEditorForm.StyleClick(Sender: TObject);
var
  Style: TfrxStyles;
begin
  Style := FStyleSheet.Find(TMenuItem(Sender).Caption);
  if Style <> nil then
    FCross.ApplyStyle(Style);
  PaintBoxPaint(nil);
end;

procedure TfrxCrossEditorForm.SaveStyleMIClick(Sender: TObject);
var
  s: String;
  Style: TfrxStyles;
begin
  s := '';
  s := InputBox(frxGet(4313), frxResources.Get('crStName'), s);
  if s <> '' then
  begin
    Style := FStyleSheet.Find(s);
    if Style = nil then
      Style := FStyleSheet.Add;
    Style.Name := s;
    FCross.GetStyle(Style);
    FStyleSheet.SaveToFile(ExtractFilePath(Application.ExeName) + 'crossstyles.xml');
    CreateStyleMenu;
  end;
end;

procedure TfrxCrossEditorForm.PaintBoxPaint(Sender: TObject);
begin
  with PaintBox.Canvas do
  begin
    Brush.Color := clWindow;
    FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));
  end;
  FCross.DrawCross(PaintBox.Canvas, 1, 1, 0, 0);
end;

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

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

procedure TfrxCrossEditorForm.LBDrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
  HasSubtotal: Boolean;
  sort: String;
begin
  if FUpdating then exit;
  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.CellsLBDrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
begin
  with TListBox(Control), TListBox(Control).Canvas do
  begin
    FillRect(ARect);
    TextOut(ARect.Left + 2, ARect.Top + 1, Items[Index]);
    TextOut(ARect.Left + 200, ARect.Top + 1, FFuncNames[FCross.CellFunctions[Index]]);
    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;


initialization
  frxComponentEditors.Register(TfrxCrossView, TfrxCrossEditor);
  frxComponentEditors.Register(TfrxDBCrossView, TfrxCrossEditor);

end.


//

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -