Measure/Forms/ReportAdjustFrm.pas

unit ReportAdjustFrm;

interface

uses
  ReportManager, Globals,
  Printers,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ZjGridDBA, ImgList, XPMenu, StdCtrls, ZJGrid, ExtCtrls,
  MScrollBox, JimPages, ComCtrls, ToolWin, Spin, Buttons;

type
  TReportAdjustForm = class(TForm)
    btnOk: TButton;
    btnCancel: TButton;
    pnlTop: TPanel;
    tbTop: TToolBar;
    tobtnPaper: TToolButton;
    tobtnPage: TToolButton;
    tobtnTemplateFormat: TToolButton;
    pnlBlank: TPanel;
    jpsReportAdjust: TJimPages;
    jpsReportAdjustPaper: TJimPage;
    pnlPaper: TPanel;
    jpsReportAdjustPage: TJimPage;
    jpsReportAdjustTemplate: TJimPage;
    leView: TLabel;
    pnlViewBar: TPanel;
    cbShowPriceChange: TCheckBox;
    cbShowBGLCode: TCheckBox;
    xpm: TXPMenu;
    imgTopButton: TImageList;
    rbPaperType: TGroupBox;
    lblPaperType: TLabel;
    lblWidth: TLabel;
    lblHeight: TLabel;
    cbPageName: TComboBox;
    gbPercent: TGroupBox;
    lblPercentSign: TLabel;
    sePercent: TSpinEdit;
    gbMargin: TGroupBox;
    lblUpEdge: TLabel;
    lblDownEdge: TLabel;
    lblLeftEdge: TLabel;
    lblRightEdge: TLabel;
    seUpEdge: TSpinEdit;
    seDownEdge: TSpinEdit;
    seLeftEdge: TSpinEdit;
    seRightEdge: TSpinEdit;
    gbPrinter: TGroupBox;
    cbPrinter: TComboBox;
    pnlPage: TPanel;
    gbFont: TGroupBox;
    imgFontType: TImage;
    sbBold: TSpeedButton;
    sbItalic: TSpeedButton;
    sbUnderline: TSpeedButton;
    lblLineHeight: TLabel;
    cbFontName: TComboBox;
    cbFontSize: TComboBox;
    seRowHeight: TSpinEdit;
    edtReportCellLine: TEdit;
    seBorderLine: TSpinEdit;
    chkRepBorderUnderLine: TCheckBox;
    chkRepBorderVerLine: TCheckBox;
    chkRepCellVerLine: TCheckBox;
    chkRepCellHorLine: TCheckBox;
    chkAutoRetLine: TCheckBox;
    chkNarrow: TCheckBox;
    lblReportCellLine: TLabel;
    lblBorderLine: TLabel;
    tobtnGather: TToolButton;
    jpsReportAdjustGather: TJimPage;
    rgGatherLevel: TRadioGroup;
    gbXmjCompare: TGroupBox;
    rbXmjCode: TRadioButton;
    rbXmjName: TRadioButton;
    rbXmjCode_Name: TRadioButton;
    gbGclCompare: TGroupBox;
    rbGclCode: TRadioButton;
    rbGclName: TRadioButton;
    rbGclCode_Name: TRadioButton;
    lblLevelTitle: TLabel;
    pnlLevelBar: TPanel;
    lblCompareTitle: TLabel;
    pnlCompareBar: TPanel;
    procedure tobtnPaperClick(Sender: TObject);
    procedure cbPageNameSelect(Sender: TObject);
    procedure imgFontTypeMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure rbGclCodeClick(Sender: TObject);
    procedure rbXmjCodeClick(Sender: TObject);
    procedure cbPrinterSelect(Sender: TObject);
  private
    procedure PaintFontTypeImage(AIndex: Integer);
    procedure AssignFontData(AIndex: Integer);
  public
    procedure Init;
    procedure Save;
  end;

function AdjustReport: Boolean;

procedure SetPrinterPageSize(const APageSize: string);

implementation

uses
  WinSpool, PrintComTypeDefUnit;

{$R *.dfm}

function AdjustReport: Boolean;
var
  ReportAdjustForm: TReportAdjustForm;
begin
  ReportAdjustForm := TReportAdjustForm.Create(nil);
  try
    ReportAdjustForm.Init;
    Result := ReportAdjustForm.ShowModal = mrOk;
    if Result then
      ReportAdjustForm.Save;
  finally
    ReportAdjustForm.Free;
  end;
end;

procedure SetPrinterPageSize(const APageSize: string);
var
  arr_szDeviceName: array[0..64] of char;
  arr_szDriver: array[0..64] of char;
  arr_szPort: array[0..64] of char;
  DevHandle,DevSetHandle: THandle;
  pDevModeInput: PDeviceMode;
begin
  Printer.GetPrinter(arr_szDeviceName, arr_szDriver, arr_szPort, DevHandle);
  try
    pDevModeInput := PDeviceMode(GlobalLock(DevHandle));
    StrCopy(pDevModeInput.dmFormName, PChar(APageSize));
    if SameText(APageSize, 'A4') then
      pDevModeInput.dmPaperSize := DMPAPER_A4
    else if SameText(APageSize, 'A3') then
      pDevModeInput.dmPaperSize := DMPAPER_A3;

    //要改变项
    pDevModeInput.dmFields := pDevModeInput.dmFields or DM_FORMNAME;
    pDevModeInput.dmFields := pDevModeInput.dmFields or DM_PAPERSIZE;

    DocumentProperties(0, Printer.Handle, arr_szDeviceName, pDevModeInput^,
                          pDevModeInput^, DM_OUT_BUFFER);
  finally
    GlobalUnLock(DevHandle);
  end;
end;

{ TReportAdjustForm }

procedure TReportAdjustForm.Init;

  procedure LoadPrinterPageSetting;
  var
    arr_szDeviceName: array[0..64] of char;
    arr_szDriver: array[0..64] of char;
    arr_szPort: array[0..64] of char;
    DevHandle,DevSetHandle: THandle;
    pDevModeInput: PDeviceMode;
  begin
    Printer.GetPrinter(arr_szDeviceName, arr_szDriver, arr_szPort, DevHandle);
    try
      pDevModeInput := PDeviceMode(GlobalLock(DevHandle));
      if pDevModeInput.dmPaperSize = DMPAPER_A4 then
      begin
        cbPageName.ItemIndex := 0;
        lblWidth.Caption := '宽度(W):  21';
        lblHeight.Caption := '高度(H):  29.7';
      end
      else if pDevModeInput.dmPaperSize = DMPAPER_A3 then
      begin
        cbPageName.ItemIndex := 1;
        lblWidth.Caption := '宽度(W):  29.7';
        lblHeight.Caption := '高度(H):  42';
      end;
    finally
      GlobalUnLock(DevHandle);
    end;
  end;

  procedure InitPrinter;
  var
    iPrinter: Integer;
  begin
    try
      for iPrinter := 0 to Printer.Printers.Count - 1 do
        cbPrinter.Items.Add(Printer.Printers[iPrinter]);
      cbPrinter.ItemIndex := Printer.PrinterIndex;
      LoadPrinterPageSetting;
    except
    end;
  end;

  procedure InitPaperSettings;
  begin
    InitPrinter;
    seUpEdge.Text := IntToStr(ReportConfig.UpEdge);
    seDownEdge.Text := IntToStr(ReportConfig.DownEdge);
    seLeftEdge.Text := IntToStr(ReportConfig.LeftEdge);
    seRightEdge.Text := IntToStr(ReportConfig.RightEdge);
  end;

  procedure InitFontNameList;
  begin
    cbFontName.Clear;
    cbFontName.Items.Assign(Screen.Fonts);
  end;

  procedure InitPageSettings;
  begin
    InitFontNameList;
    AssignFontData(0);
    edtReportCellLine.Text := FloatToStr(ReportConfig.ReportCellLine);
    seBorderLine.Text := IntToStr(ReportConfig.BorderLine);
    chkRepBorderUnderLine.Checked := ReportConfig.RepBorderUnderLine;
    chkRepBorderVerLine.Checked := ReportConfig.RepBorderVerLine;
    chkRepCellHorLine.Checked := ReportConfig.RepCellHorLine;
    chkRepCellVerLine.Checked := ReportConfig.RepCellVerLine;
    chkAutoRetLine.Checked := ReportConfig.AutoRetLine;
    chkNarrow.Checked := ReportConfig.ContentIsNarrow;
  end;

  procedure InitGatherSettings;
  begin
    rgGatherLevel.ItemIndex := ReportConfig.GatherLevel;
    rbXmjCode.Checked := ReportConfig.XmjCompare = rbXmjCode.Tag;
    rbXmjName.Checked := ReportConfig.XmjCompare = rbXmjName.Tag;
    rbXmjCode_Name.Checked := ReportConfig.XmjCompare = rbXmjCode_Name.Tag;
    rbGclCode.Checked := ReportConfig.GclCompare = rbGclCode.Tag;
    rbGclName.Checked := ReportConfig.GclCompare = rbGclName.Tag;
    rbGclCode_Name.Checked := ReportConfig.GclCompare = rbGclCode_Name.Tag;
  end;

begin
  InitPaperSettings;
  InitPageSettings;
  InitGatherSettings;
end;

procedure TReportAdjustForm.Save;

  procedure SavePaperSettings;
  begin
    ReportConfig.PageSize := cbPageName.Text;
    ReportConfig.UpEdge := StrToIntDef(seUpEdge.Text, 12);
    ReportConfig.DownEdge := StrToIntDef(seDownEdge.Text, 12);
    ReportConfig.LeftEdge := StrToIntDef(seLeftEdge.Text, 12);
    ReportConfig.RightEdge := StrToIntDef(seRightEdge.Text, 12);
  end;

  procedure SavePageSetttings;
  begin
    ReportConfig.ReportCellLine := StrToFloatDef(edtReportCellLine.Text, 0.75);
    ReportConfig.BorderLine := StrToIntDef(seBorderLine.Text, 2);
    ReportConfig.RepBorderUnderLine := chkRepBorderUnderLine.Checked;
    ReportConfig.RepBorderVerLine := chkRepBorderVerLine.Checked;
    ReportConfig.RepCellHorLine := chkRepCellHorLine.Checked;
    ReportConfig.RepCellVerLine := chkRepCellVerLine.Checked;
    ReportConfig.AutoRetLine := chkAutoRetLine.Checked;
    ReportConfig.ContentIsNarrow := chkNarrow.Checked;
  end;

  procedure SaveGatherSettings;
  begin
    ReportConfig.GatherLevel := rgGatherLevel.ItemIndex;
    ReportConfig.XmjCompare := gbXmjCompare.Tag;
    ReportConfig.GclCompare := gbGclCompare.Tag;
  end;

begin
  SavePaperSettings;
  SavePageSetttings;
  SaveGatherSettings;
  ReportConfig.Save;
end;

procedure TReportAdjustForm.tobtnPaperClick(Sender: TObject);

  procedure ResetTopButtonChecked(ATag: Integer);
  begin
    tobtnPaper.Down := tobtnPaper.Tag = ATag;
    tobtnPage.Down := tobtnPage.Tag = ATag;
    tobtnTemplateFormat.Down := tobtnTemplateFormat.Tag = ATag;
    tobtnGather.Down := tobtnGather.Tag = ATag;
  end;

begin
  ResetTopButtonChecked(TToolButton(Sender).Tag);
  jpsReportAdjust.ActivePageIndex := TToolButton(Sender).Tag;
end;

procedure TReportAdjustForm.cbPageNameSelect(Sender: TObject);
begin
  if SameText(cbPageName.Text, 'A4') then
  begin
    lblWidth.Caption := '宽度(W):  21';
    lblHeight.Caption := '高度(H):  29.7';
  end
  else if SameText(cbPageName.Text, 'A3') then
  begin
    lblWidth.Caption := '宽度(W):  29.7';
    lblHeight.Caption := '高度(H):  42';
  end;
  // 设置打印机
  SetPrinterPageSize(cbPageName.Text);
end;

procedure TReportAdjustForm.imgFontTypeMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  AssignFontData(X div 79);
end;

procedure TReportAdjustForm.AssignFontData(AIndex: Integer);

  procedure AssignFont(AFont: TFont);
  begin
    cbFontName.Text := AFont.Name;
    cbFontSize.Text := IntToStr(AFont.Size);
    sbBold.Down := fsBold in AFont.Style;
    sbItalic.Down := fsItalic in AFont.Style;
    sbUnderline.Down := fsUnderline in AFont.Style;
    seRowHeight.Text := IntToStr(AFont.Size);
  end;

begin
  PaintFontTypeImage(AIndex);
  case AIndex of
    0: AssignFont(ReportConfig.TitleFont);
    1: AssignFont(ReportConfig.ColumnFont);
    2: AssignFont(ReportConfig.ContentFont);
    3: AssignFont(ReportConfig.GatherFont);
    4: AssignFont(ReportConfig.GridHeaderFont);
    5: AssignFont(ReportConfig.HeaderFont);
  end;
end;

procedure TReportAdjustForm.PaintFontTypeImage(AIndex: Integer);

  procedure DrawFontTypeName(AType: Integer; FontRec: TFontRec);
  var
    DrawRect : TRect;
  begin
    if AType = AIndex then
      FontRec.FontBold := 600
    else
      FontRec.FontBold := 400;
    DrawRect := Rect(AType*79, 0, AType*79+78, 25);
    case AType of
      0: InDrawText('表标题', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
      1: InDrawText('列标题', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
      2: InDrawText('表正文', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
      3: InDrawText('表合计', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
      4: InDrawText('表眉/表脚', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
      5: InDrawText('页眉/页脚', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
    end;
  end;

var
  iType: Integer;
  FontRec: TFontRec;
begin
  // 画底色
  imgFontType.Canvas.Brush.Color := clInactiveCaption;
  imgFontType.Canvas.Rectangle(0, 0, imgFontType.Width, imgFontType.Height);
  imgFontType.Canvas.Brush.Color := clBtnface;
  // 画字
  IniFontRec(FontRec);
  FontRec.FontColor := clWhite;
  FontRec.FontName := Font.Name;
  FontRec.FontHeight := Round(Font.Size * Font.PixelsPerInch / 72);
  for iType := 0 to 6 do
    DrawFontTypeName(iType, FontRec);
end;

procedure TReportAdjustForm.rbGclCodeClick(Sender: TObject);
begin
  gbGclCompare.Tag := TRadioButton(Sender).Tag;
  rbGclCode.Checked := rbGclCode.Tag = gbGclCompare.Tag;
  rbGclName.Checked := rbGclName.Tag = gbGclCompare.Tag;
  rbGclCode_Name.Checked := rbGclCode_Name.Tag = gbGclCompare.Tag;
end;

procedure TReportAdjustForm.rbXmjCodeClick(Sender: TObject);
begin
  gbXmjCompare.Tag := TRadioButton(Sender).Tag;
  rbXmjCode.Checked := rbXmjCode.Tag = gbXmjCompare.Tag;
  rbXmjName.Checked := rbXmjName.Tag = gbXmjCompare.Tag;
  rbXmjCode_Name.Checked := rbXmjCode_Name.Tag = gbXmjCompare.Tag;
end;

procedure TReportAdjustForm.cbPrinterSelect(Sender: TObject);
var
  szDeviceName: string;
begin
  Printer.PrinterIndex := cbPrinter.ItemIndex;
  szDeviceName := Printer.Printers[Printer.PrinterIndex];
  ChangeDefaultPrinter(cbPrinter.Text);
end;

end.