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]; SetDefaultPrinterEx(szDeviceName); end; end.