123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408 |
- 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.
|