ReportAdjustFrm.pas 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408
  1. unit ReportAdjustFrm;
  2. interface
  3. uses
  4. ReportManager, Globals,
  5. Printers,
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, ZjGridDBA, ImgList, XPMenu, StdCtrls, ZJGrid, ExtCtrls,
  8. MScrollBox, JimPages, ComCtrls, ToolWin, Spin, Buttons;
  9. type
  10. TReportAdjustForm = class(TForm)
  11. btnOk: TButton;
  12. btnCancel: TButton;
  13. pnlTop: TPanel;
  14. tbTop: TToolBar;
  15. tobtnPaper: TToolButton;
  16. tobtnPage: TToolButton;
  17. tobtnTemplateFormat: TToolButton;
  18. pnlBlank: TPanel;
  19. jpsReportAdjust: TJimPages;
  20. jpsReportAdjustPaper: TJimPage;
  21. pnlPaper: TPanel;
  22. jpsReportAdjustPage: TJimPage;
  23. jpsReportAdjustTemplate: TJimPage;
  24. leView: TLabel;
  25. pnlViewBar: TPanel;
  26. cbShowPriceChange: TCheckBox;
  27. cbShowBGLCode: TCheckBox;
  28. xpm: TXPMenu;
  29. imgTopButton: TImageList;
  30. rbPaperType: TGroupBox;
  31. lblPaperType: TLabel;
  32. lblWidth: TLabel;
  33. lblHeight: TLabel;
  34. cbPageName: TComboBox;
  35. gbPercent: TGroupBox;
  36. lblPercentSign: TLabel;
  37. sePercent: TSpinEdit;
  38. gbMargin: TGroupBox;
  39. lblUpEdge: TLabel;
  40. lblDownEdge: TLabel;
  41. lblLeftEdge: TLabel;
  42. lblRightEdge: TLabel;
  43. seUpEdge: TSpinEdit;
  44. seDownEdge: TSpinEdit;
  45. seLeftEdge: TSpinEdit;
  46. seRightEdge: TSpinEdit;
  47. gbPrinter: TGroupBox;
  48. cbPrinter: TComboBox;
  49. pnlPage: TPanel;
  50. gbFont: TGroupBox;
  51. imgFontType: TImage;
  52. sbBold: TSpeedButton;
  53. sbItalic: TSpeedButton;
  54. sbUnderline: TSpeedButton;
  55. lblLineHeight: TLabel;
  56. cbFontName: TComboBox;
  57. cbFontSize: TComboBox;
  58. seRowHeight: TSpinEdit;
  59. edtReportCellLine: TEdit;
  60. seBorderLine: TSpinEdit;
  61. chkRepBorderUnderLine: TCheckBox;
  62. chkRepBorderVerLine: TCheckBox;
  63. chkRepCellVerLine: TCheckBox;
  64. chkRepCellHorLine: TCheckBox;
  65. chkAutoRetLine: TCheckBox;
  66. chkNarrow: TCheckBox;
  67. lblReportCellLine: TLabel;
  68. lblBorderLine: TLabel;
  69. tobtnGather: TToolButton;
  70. jpsReportAdjustGather: TJimPage;
  71. rgGatherLevel: TRadioGroup;
  72. gbXmjCompare: TGroupBox;
  73. rbXmjCode: TRadioButton;
  74. rbXmjName: TRadioButton;
  75. rbXmjCode_Name: TRadioButton;
  76. gbGclCompare: TGroupBox;
  77. rbGclCode: TRadioButton;
  78. rbGclName: TRadioButton;
  79. rbGclCode_Name: TRadioButton;
  80. lblLevelTitle: TLabel;
  81. pnlLevelBar: TPanel;
  82. lblCompareTitle: TLabel;
  83. pnlCompareBar: TPanel;
  84. procedure tobtnPaperClick(Sender: TObject);
  85. procedure cbPageNameSelect(Sender: TObject);
  86. procedure imgFontTypeMouseDown(Sender: TObject; Button: TMouseButton;
  87. Shift: TShiftState; X, Y: Integer);
  88. procedure rbGclCodeClick(Sender: TObject);
  89. procedure rbXmjCodeClick(Sender: TObject);
  90. procedure cbPrinterSelect(Sender: TObject);
  91. private
  92. procedure PaintFontTypeImage(AIndex: Integer);
  93. procedure AssignFontData(AIndex: Integer);
  94. public
  95. procedure Init;
  96. procedure Save;
  97. end;
  98. function AdjustReport: Boolean;
  99. procedure SetPrinterPageSize(const APageSize: string);
  100. implementation
  101. uses
  102. WinSpool, PrintComTypeDefUnit;
  103. {$R *.dfm}
  104. function AdjustReport: Boolean;
  105. var
  106. ReportAdjustForm: TReportAdjustForm;
  107. begin
  108. ReportAdjustForm := TReportAdjustForm.Create(nil);
  109. try
  110. ReportAdjustForm.Init;
  111. Result := ReportAdjustForm.ShowModal = mrOk;
  112. if Result then
  113. ReportAdjustForm.Save;
  114. finally
  115. ReportAdjustForm.Free;
  116. end;
  117. end;
  118. procedure SetPrinterPageSize(const APageSize: string);
  119. var
  120. arr_szDeviceName: array[0..64] of char;
  121. arr_szDriver: array[0..64] of char;
  122. arr_szPort: array[0..64] of char;
  123. DevHandle,DevSetHandle: THandle;
  124. pDevModeInput: PDeviceMode;
  125. begin
  126. Printer.GetPrinter(arr_szDeviceName, arr_szDriver, arr_szPort, DevHandle);
  127. try
  128. pDevModeInput := PDeviceMode(GlobalLock(DevHandle));
  129. StrCopy(pDevModeInput.dmFormName, PChar(APageSize));
  130. if SameText(APageSize, 'A4') then
  131. pDevModeInput.dmPaperSize := DMPAPER_A4
  132. else if SameText(APageSize, 'A3') then
  133. pDevModeInput.dmPaperSize := DMPAPER_A3;
  134. //要改变项
  135. pDevModeInput.dmFields := pDevModeInput.dmFields or DM_FORMNAME;
  136. pDevModeInput.dmFields := pDevModeInput.dmFields or DM_PAPERSIZE;
  137. DocumentProperties(0, Printer.Handle, arr_szDeviceName, pDevModeInput^,
  138. pDevModeInput^, DM_OUT_BUFFER);
  139. finally
  140. GlobalUnLock(DevHandle);
  141. end;
  142. end;
  143. { TReportAdjustForm }
  144. procedure TReportAdjustForm.Init;
  145. procedure LoadPrinterPageSetting;
  146. var
  147. arr_szDeviceName: array[0..64] of char;
  148. arr_szDriver: array[0..64] of char;
  149. arr_szPort: array[0..64] of char;
  150. DevHandle,DevSetHandle: THandle;
  151. pDevModeInput: PDeviceMode;
  152. begin
  153. Printer.GetPrinter(arr_szDeviceName, arr_szDriver, arr_szPort, DevHandle);
  154. try
  155. pDevModeInput := PDeviceMode(GlobalLock(DevHandle));
  156. if pDevModeInput.dmPaperSize = DMPAPER_A4 then
  157. begin
  158. cbPageName.ItemIndex := 0;
  159. lblWidth.Caption := '宽度(W): 21';
  160. lblHeight.Caption := '高度(H): 29.7';
  161. end
  162. else if pDevModeInput.dmPaperSize = DMPAPER_A3 then
  163. begin
  164. cbPageName.ItemIndex := 1;
  165. lblWidth.Caption := '宽度(W): 29.7';
  166. lblHeight.Caption := '高度(H): 42';
  167. end;
  168. finally
  169. GlobalUnLock(DevHandle);
  170. end;
  171. end;
  172. procedure InitPrinter;
  173. var
  174. iPrinter: Integer;
  175. begin
  176. try
  177. for iPrinter := 0 to Printer.Printers.Count - 1 do
  178. cbPrinter.Items.Add(Printer.Printers[iPrinter]);
  179. cbPrinter.ItemIndex := Printer.PrinterIndex;
  180. LoadPrinterPageSetting;
  181. except
  182. end;
  183. end;
  184. procedure InitPaperSettings;
  185. begin
  186. InitPrinter;
  187. seUpEdge.Text := IntToStr(ReportConfig.UpEdge);
  188. seDownEdge.Text := IntToStr(ReportConfig.DownEdge);
  189. seLeftEdge.Text := IntToStr(ReportConfig.LeftEdge);
  190. seRightEdge.Text := IntToStr(ReportConfig.RightEdge);
  191. end;
  192. procedure InitFontNameList;
  193. begin
  194. cbFontName.Clear;
  195. cbFontName.Items.Assign(Screen.Fonts);
  196. end;
  197. procedure InitPageSettings;
  198. begin
  199. InitFontNameList;
  200. AssignFontData(0);
  201. edtReportCellLine.Text := FloatToStr(ReportConfig.ReportCellLine);
  202. seBorderLine.Text := IntToStr(ReportConfig.BorderLine);
  203. chkRepBorderUnderLine.Checked := ReportConfig.RepBorderUnderLine;
  204. chkRepBorderVerLine.Checked := ReportConfig.RepBorderVerLine;
  205. chkRepCellHorLine.Checked := ReportConfig.RepCellHorLine;
  206. chkRepCellVerLine.Checked := ReportConfig.RepCellVerLine;
  207. chkAutoRetLine.Checked := ReportConfig.AutoRetLine;
  208. chkNarrow.Checked := ReportConfig.ContentIsNarrow;
  209. end;
  210. procedure InitGatherSettings;
  211. begin
  212. rgGatherLevel.ItemIndex := ReportConfig.GatherLevel;
  213. rbXmjCode.Checked := ReportConfig.XmjCompare = rbXmjCode.Tag;
  214. rbXmjName.Checked := ReportConfig.XmjCompare = rbXmjName.Tag;
  215. rbXmjCode_Name.Checked := ReportConfig.XmjCompare = rbXmjCode_Name.Tag;
  216. rbGclCode.Checked := ReportConfig.GclCompare = rbGclCode.Tag;
  217. rbGclName.Checked := ReportConfig.GclCompare = rbGclName.Tag;
  218. rbGclCode_Name.Checked := ReportConfig.GclCompare = rbGclCode_Name.Tag;
  219. end;
  220. begin
  221. InitPaperSettings;
  222. InitPageSettings;
  223. InitGatherSettings;
  224. end;
  225. procedure TReportAdjustForm.Save;
  226. procedure SavePaperSettings;
  227. begin
  228. ReportConfig.PageSize := cbPageName.Text;
  229. ReportConfig.UpEdge := StrToIntDef(seUpEdge.Text, 12);
  230. ReportConfig.DownEdge := StrToIntDef(seDownEdge.Text, 12);
  231. ReportConfig.LeftEdge := StrToIntDef(seLeftEdge.Text, 12);
  232. ReportConfig.RightEdge := StrToIntDef(seRightEdge.Text, 12);
  233. end;
  234. procedure SavePageSetttings;
  235. begin
  236. ReportConfig.ReportCellLine := StrToFloatDef(edtReportCellLine.Text, 0.75);
  237. ReportConfig.BorderLine := StrToIntDef(seBorderLine.Text, 2);
  238. ReportConfig.RepBorderUnderLine := chkRepBorderUnderLine.Checked;
  239. ReportConfig.RepBorderVerLine := chkRepBorderVerLine.Checked;
  240. ReportConfig.RepCellHorLine := chkRepCellHorLine.Checked;
  241. ReportConfig.RepCellVerLine := chkRepCellVerLine.Checked;
  242. ReportConfig.AutoRetLine := chkAutoRetLine.Checked;
  243. ReportConfig.ContentIsNarrow := chkNarrow.Checked;
  244. end;
  245. procedure SaveGatherSettings;
  246. begin
  247. ReportConfig.GatherLevel := rgGatherLevel.ItemIndex;
  248. ReportConfig.XmjCompare := gbXmjCompare.Tag;
  249. ReportConfig.GclCompare := gbGclCompare.Tag;
  250. end;
  251. begin
  252. SavePaperSettings;
  253. SavePageSetttings;
  254. SaveGatherSettings;
  255. ReportConfig.Save;
  256. end;
  257. procedure TReportAdjustForm.tobtnPaperClick(Sender: TObject);
  258. procedure ResetTopButtonChecked(ATag: Integer);
  259. begin
  260. tobtnPaper.Down := tobtnPaper.Tag = ATag;
  261. tobtnPage.Down := tobtnPage.Tag = ATag;
  262. tobtnTemplateFormat.Down := tobtnTemplateFormat.Tag = ATag;
  263. tobtnGather.Down := tobtnGather.Tag = ATag;
  264. end;
  265. begin
  266. ResetTopButtonChecked(TToolButton(Sender).Tag);
  267. jpsReportAdjust.ActivePageIndex := TToolButton(Sender).Tag;
  268. end;
  269. procedure TReportAdjustForm.cbPageNameSelect(Sender: TObject);
  270. begin
  271. if SameText(cbPageName.Text, 'A4') then
  272. begin
  273. lblWidth.Caption := '宽度(W): 21';
  274. lblHeight.Caption := '高度(H): 29.7';
  275. end
  276. else if SameText(cbPageName.Text, 'A3') then
  277. begin
  278. lblWidth.Caption := '宽度(W): 29.7';
  279. lblHeight.Caption := '高度(H): 42';
  280. end;
  281. // 设置打印机
  282. SetPrinterPageSize(cbPageName.Text);
  283. end;
  284. procedure TReportAdjustForm.imgFontTypeMouseDown(Sender: TObject;
  285. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  286. begin
  287. AssignFontData(X div 79);
  288. end;
  289. procedure TReportAdjustForm.AssignFontData(AIndex: Integer);
  290. procedure AssignFont(AFont: TFont);
  291. begin
  292. cbFontName.Text := AFont.Name;
  293. cbFontSize.Text := IntToStr(AFont.Size);
  294. sbBold.Down := fsBold in AFont.Style;
  295. sbItalic.Down := fsItalic in AFont.Style;
  296. sbUnderline.Down := fsUnderline in AFont.Style;
  297. seRowHeight.Text := IntToStr(AFont.Size);
  298. end;
  299. begin
  300. PaintFontTypeImage(AIndex);
  301. case AIndex of
  302. 0: AssignFont(ReportConfig.TitleFont);
  303. 1: AssignFont(ReportConfig.ColumnFont);
  304. 2: AssignFont(ReportConfig.ContentFont);
  305. 3: AssignFont(ReportConfig.GatherFont);
  306. 4: AssignFont(ReportConfig.GridHeaderFont);
  307. 5: AssignFont(ReportConfig.HeaderFont);
  308. end;
  309. end;
  310. procedure TReportAdjustForm.PaintFontTypeImage(AIndex: Integer);
  311. procedure DrawFontTypeName(AType: Integer; FontRec: TFontRec);
  312. var
  313. DrawRect : TRect;
  314. begin
  315. if AType = AIndex then
  316. FontRec.FontBold := 600
  317. else
  318. FontRec.FontBold := 400;
  319. DrawRect := Rect(AType*79, 0, AType*79+78, 25);
  320. case AType of
  321. 0: InDrawText('表标题', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
  322. 1: InDrawText('列标题', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
  323. 2: InDrawText('表正文', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
  324. 3: InDrawText('表合计', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
  325. 4: InDrawText('表眉/表脚', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
  326. 5: InDrawText('页眉/页脚', DrawRect, FontRec, 4, False, imgFontType.Canvas, False, 1, Rect(0,0,0,0));
  327. end;
  328. end;
  329. var
  330. iType: Integer;
  331. FontRec: TFontRec;
  332. begin
  333. // 画底色
  334. imgFontType.Canvas.Brush.Color := clInactiveCaption;
  335. imgFontType.Canvas.Rectangle(0, 0, imgFontType.Width, imgFontType.Height);
  336. imgFontType.Canvas.Brush.Color := clBtnface;
  337. // 画字
  338. IniFontRec(FontRec);
  339. FontRec.FontColor := clWhite;
  340. FontRec.FontName := Font.Name;
  341. FontRec.FontHeight := Round(Font.Size * Font.PixelsPerInch / 72);
  342. for iType := 0 to 6 do
  343. DrawFontTypeName(iType, FontRec);
  344. end;
  345. procedure TReportAdjustForm.rbGclCodeClick(Sender: TObject);
  346. begin
  347. gbGclCompare.Tag := TRadioButton(Sender).Tag;
  348. rbGclCode.Checked := rbGclCode.Tag = gbGclCompare.Tag;
  349. rbGclName.Checked := rbGclName.Tag = gbGclCompare.Tag;
  350. rbGclCode_Name.Checked := rbGclCode_Name.Tag = gbGclCompare.Tag;
  351. end;
  352. procedure TReportAdjustForm.rbXmjCodeClick(Sender: TObject);
  353. begin
  354. gbXmjCompare.Tag := TRadioButton(Sender).Tag;
  355. rbXmjCode.Checked := rbXmjCode.Tag = gbXmjCompare.Tag;
  356. rbXmjName.Checked := rbXmjName.Tag = gbXmjCompare.Tag;
  357. rbXmjCode_Name.Checked := rbXmjCode_Name.Tag = gbXmjCompare.Tag;
  358. end;
  359. procedure TReportAdjustForm.cbPrinterSelect(Sender: TObject);
  360. var
  361. szDeviceName : String;
  362. begin
  363. Printer.PrinterIndex := cbPrinter.ItemIndex;
  364. szDeviceName := Printer.Printers[Printer.PrinterIndex];
  365. SetDefaultPrinterEx(szDeviceName);
  366. end;
  367. end.