谁用canvas自己画过报表的?我想要点原马看看。语言不限。当然,有java的最好了。因为我的东东是要用java做的。(300分)

  • 主题发起人 主题发起人 小猪
  • 开始时间 开始时间

小猪

Unregistered / Unconfirmed
GUEST, unregistred user!
我一向不擅长控制界面元素,这次真是感觉很痛苦。
请往这里发,并注明dfw网名。
wrlmmmp@263.net
 
这段程序是我用在一个打印执照中的,打印内容与位置放在数据库中
//form
object FormPreviewFb: TFormPreviewFb
Left = 200
Top = 106
Width = 577
Height = 375
Caption = '打印预览'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -14
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
PrintScale = poPrintToFit
OnActivate = FormActivate
PixelsPerInch = 96
TextHeight = 14
object CoolBar1: TCoolBar
Left = 0
Top = 0
Width = 569
Height = 28
AutoSize = True
BandBorderStyle = bsNone
Bands = <
item
Control = ToolBar1
ImageIndex = -1
MinHeight = 24
Width = 565
end>
object ToolBar1: TToolBar
Left = 9
Top = 0
Width = 552
Height = 24
AutoSize = True
Caption = 'ToolBar1'
EdgeBorders = []
TabOrder = 0
object SpeedButton2: TSpeedButton
Left = 0
Top = 2
Width = 65
Height = 22
Caption = '打印'
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00300000000000
0003377777777777777308888888888888807F33333333333337088888888888
88807FFFFFFFFFFFFFF7000000000000000077777777777777770F8F8F8F8F8F
8F807F333333333333F708F8F8F8F8F8F9F07F333333333337370F8F8F8F8F8F
8F807FFFFFFFFFFFFFF7000000000000000077777777777777773330FFFFFFFF
03333337F3FFFF3F7F333330F0000F0F03333337F77773737F333330FFFFFFFF
03333337F3FF3FFF7F333330F00F000003333337F773777773333330FFFF0FF0
33333337F3F37F3733333330F08F0F0333333337F7337F7333333330FFFF0033
33333337FFFF7733333333300000033333333337777773333333}
NumGlyphs = 2
OnClick = SpeedButton2Click
end
object SpeedButton4: TSpeedButton
Left = 65
Top = 2
Width = 102
Height = 22
Caption = '设置打印机'
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00555550FF0559
1950555FF75F7557F7F757000FF055591903557775F75557F77570FFFF055559
1933575FF57F5557F7FF0F00FF05555919337F775F7F5557F7F700550F055559
193577557F7F55F7577F07550F0555999995755575755F7FFF7F5570F0755011
11155557F755F777777555000755033305555577755F75F77F55555555503335
0555555FF5F75F757F5555005503335505555577FF75F7557F55505050333555
05555757F75F75557F5505000333555505557F777FF755557F55000000355557
07557777777F55557F5555000005555707555577777FF5557F55553000075557
0755557F7777FFF5755555335000005555555577577777555555}
NumGlyphs = 2
OnClick = SpeedButton4Click
end
object SpeedButton1: TSpeedButton
Left = 167
Top = 2
Width = 31
Height = 22
Caption = '预览'
Visible = False
OnClick = SpeedButton1Click
end
object SpeedButton3: TSpeedButton
Left = 198
Top = 2
Width = 89
Height = 22
Caption = '中断打印'
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000130B0000130B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333333FFFFF3333333333999993333333333F77777FFF333333999999999
33333337777FF377FF3333993370739993333377FF373F377FF3399993000339
993337777F777F3377F3393999707333993337F77737333337FF993399933333
399377F3777FF333377F993339903333399377F33737FF33377F993333707333
399377F333377FF3377F993333101933399377F333777FFF377F993333000993
399377FF3377737FF7733993330009993933373FF3777377F7F3399933000399
99333773FF777F777733339993707339933333773FF7FFF77333333999999999
3333333777333777333333333999993333333333377777333333}
NumGlyphs = 2
OnClick = SpeedButton3Click
end
object RzComboBox1: TRzComboBox
Left = 287
Top = 2
Width = 106
Height = 22
Style = csDropDownList
ItemHeight = 14
TabOrder = 0
OnChange = ViewBoxPaint
Items.Strings = (
'200%'
'150%'
'100%'
'75%'
'50%'
'25%'
'10%')
end
object SpeedButton5: TSpeedButton
Left = 393
Top = 2
Width = 88
Height = 22
Caption = '设置顶部空白'
OnClick = SpeedButton5Click
end
object BitBtn1: TBitBtn
Left = 481
Top = 2
Width = 75
Height = 22
Caption = '退出'
TabOrder = 1
Kind = bkClose
end
end
end
object RzStatusBar1: TRzStatusBar
Left = 0
Top = 329
Width = 569
Height = 19
AutoStyle = False
BorderInner = fsNone
BorderOuter = fsNone
BorderSides = [sdLeft, sdTop, sdRight, sdBottom]
BorderWidth = 0
FrameSides = []
TabOrder = 1
end
object ScrollBox1: TScrollBox
Left = 0
Top = 28
Width = 569
Height = 301
Align = alClient
Color = clWhite
ParentColor = False
TabOrder = 2
object ViewPanel: TRzPanel
Left = 12
Top = 12
Width = 361
Height = 145
BorderOuter = fsNone
Color = clWhite
TabOrder = 0
object ViewPanel2: TRzPanel
Left = 60
Top = 24
Width = 185
Height = 41
BorderOuter = fsNone
BorderHighlight = clActiveBorder
Color = clWhite
FrameSides = [sdLeft, sdTop, sdRight, sdBottom]
TabOrder = 0
object ViewBox: TPaintBox
Left = 2
Top = 2
Width = 181
Height = 37
OnPaint = ViewBoxPaint
end
end
end
end
object PrinterSetupDialog1: TPrinterSetupDialog
Left = 243
Top = 54
end
object PrintDialog1: TPrintDialog
Left = 187
Top = 94
end
end

unit PreviewFb;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, IniFiles ,
StdCtrls, RzCmboBx, ComCtrls, ToolWin, ExtCtrls, RzPanel, Buttons ,Printers;
type
TTextControlCode = record
Font:String;
OutText:String;
Position:TPoint;
FontSize:TPoint;
end;
TFormPreviewFb = class(TForm)
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
RzComboBox1: TRzComboBox;
RzStatusBar1: TRzStatusBar;
ScrollBox1: TScrollBox;
PrinterSetupDialog1: TPrinterSetupDialog;
PrintDialog1: TPrintDialog;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
ViewPanel: TRzPanel;
ViewPanel2: TRzPanel;
ViewBox: TPaintBox;
BitBtn1: TBitBtn;
SpeedButton5: TSpeedButton;
procedure SetOutType(oType:integer);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure ViewBoxPaint(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure GetOutDeviceCaps(uDevice :Thandle);
function PixelToDec(Pixels:TPoint):TPoint;
//点到丝米转换
function DecToPixel(Pixels:TPoint):TPoint;
//丝米到点转换
function PrintSingleLine(Texts:TTextControlCode):boolean;
procedure OutPutAll;
procedure SetOutValueAndPrint;
procedure GetPageSize;
procedure SetScale(s:String);
function CalcScale(tTexts:TTextControlCode):TTextControlCode;
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Const
IniFileName = 'htPrint.ini';
var FormPreviewFb: TFormPreviewFb;
OutDevice:TCanvas;
OutDeviceCaps:TPoint;
OutType :integer;
OutDeviceSize:TPoint;
nScale:Integer;
opTitle : String;
SpaceOnTop : Integer;
implementation
uses dbm, Preview_01;
{$R *.DFM}
procedure TFormPreviewFb.SetOutType(oType:integer);
begin
OutType := oType;
if oType = 0 then
OutDevice := ViewBox.Canvas
else
begin
// Printer.begin
Doc;
OutDevice := Printer.Canvas;
// Printer.EndDoc;
end;
end;

procedure TFormPreviewFb.GetOutDeviceCaps(uDevice :Thandle);
begin
OutDeviceCaps.X := GetDeviceCaps(uDevice,LOGPIXELSX);
OutDeviceCaps.Y := GetDeviceCaps(uDevice,LOGPIXELSY);
end;

function TFormPreviewFb.PixelToDec(Pixels:TPoint):TPoint;
//点到丝米转换
var tmpPoints:TPoint;
begin
tmpPoints.x := round ( OutDeviceCaps.X /254 * Pixels.X );
tmpPoints.y := round ( OutDeviceCaps.Y /254 * Pixels.Y) ;
result := tmpPoints;
end;

function TFormPreviewFb.DecToPixel(Pixels:TPoint):TPoint;
//丝米到点转换
var tmpPoints:TPoint;
begin
tmpPoints.x := round ( Pixels.X /254 * OutDeviceCaps.X );
tmpPoints.Y := round ( Pixels.Y /254 * OutDeviceCaps.Y );
result := tmpPoints;
end;

function TFormPreviewFb.PrintSingleLine(Texts:TTextControlCode):boolean;
var
LogFont: TLogFont;
MyFont, OldFont: HFONT;
tmpPoint:TPoint;
begin
Texts := CalcScale(Texts);
with LogFontdo
try
tmpPoint:=DecToPixel ( Texts.FontSize);
lfHeight := tmpPoint.Y;
lfWidth := tmpPoint.x div 2;
lfEscapement := 0;
lfOrientation := 0;
lfWeight := FW_NORMAL;
lfItalic := 0;
lfUnderline := 0;
lfStrikeOut := 0;
lfCharSet := GB2312_CHARSET;
lfOutPrecision := OUT_DEFAULT_PRECIS ;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
lfQuality := DEFAULT_QUALITY;
lfPitchAndFamily := FIXED_PITCH;
StrPCopy(@lfFaceName,Texts.Font);
finally
MyFont := CreateFontIndirect(LogFont);
with OutDevicedo
begin
OldFont := SelectObject(Handle, MyFont);
tmpPoint:=DecToPixel ( Texts.Position);
TextOut ( TmpPoint.X , TmpPoint.Y , Texts.OutText);
SelectObject(Handle, OldFont);
DeleteObject(MyFont);
end;
result := True;
end;
end;

procedure TFormPreviewFb.SetOutValueAndPrint;
var oneText:TTextControlCode;
strlen:Integer;
begin
With dm.TbDyszfbdo
begin
OneText.Font := FieldByName('FontName').AsString;
OneText.FontSize.x := FieldByName('FontWidth').AsInteger;
OneText.FontSize.Y := FieldByName('FontHeight').AsInteger;
OneText.Position.Y := FieldByName('Top').AsInteger;
if OutType = 0 then
begin
OneText.OutText := FieldByName('Label').AsString;
StrLen := Length ( OneText.OutText );
OneText.Position.x := FieldByName('Left').AsInteger - (OneText.FontSize.x div 2) * StrLen;
OneText.OutText := OneText.OutText + FieldByName('Value').AsString;
PrintSingleLine(oneText);
end else
begin
if Not FieldByName('onlyView').AsBoolean then
begin
if FieldByName('HasLabel').AsBoolean then
begin
OneText.OutText := FieldByName('Label').AsString+
FieldByName('Value').AsString;
end else
begin
OneText.OutText := FieldByName('Value').AsString;
end;
OneText.Position.x := FieldByName('Left').AsInteger;
PrintSingleLine(oneText);
end;
end;
end;
end;


procedure TFormPreviewFb.OutPutAll;
begin
if OutType <>0 then
begin
Printer.Title := opTitle;
Printer.begin
Doc;
end;
With dm.TbDyszFbdo
begin
first;
While not eofdo
begin
if OutType = 0 then
begin
SetOutValueAndPrint;
end else
begin
if not FieldByName('OnlyView').AsBoolean then
begin
SetOutValueAndPrint;
end;
end;
next;
end;
end;
if OutType <> 0 then
Printer.EndDoc;
end;

procedure TFormPreviewFb.GetPageSize;
var tmpHandle:THandle;
tmpPoint:TPoint;
begin
tmpHandle := Printer.Handle;
tmpPoint.x:= GetDeviceCaps ( tmpHandle,HORZSIZE)*10;
tmpPoint.Y:= GetDeviceCaps ( tmpHandle,VERTSIZE)*10;
OutDeviceSize:= DecToPixel(tmpPoint);
end;

procedure TFormPreviewFb.SpeedButton1Click(Sender: TObject);
begin
SetOutType(0);
if OutType =0 then
GetOutDeviceCaps(ViewBox.Canvas.Handle) else
GetOutDeviceCaps(Printer.Handle);
GetPageSize;
ViewPanel.Width := round ( OutDevicesize.x *nScale / 100 )+20;
ViewPanel.Height :=round ( OutDevicesize.y *nScale / 100 ) +20;
ViewPanel2.Width :=round ( OutDevicesize.x *nScale / 100 )+4;
ViewPanel2.Height :=round ( OutDevicesize.y *nScale / 100 )+4;
ViewBox.Width := round ( OutDevicesize.x *nScale / 100 );
ViewBox.Height := round ( OutDevicesize.y *nScale / 100 );
OutPutAll;
end;

procedure TFormPreviewFb.SpeedButton4Click(Sender: TObject);
begin
if PrinterSetupDialog1.Execute then
begin
SpeedButton1Click(Sender);
end;
end;

procedure TFormPreviewFb.ViewBoxPaint(Sender: TObject);
var r:Trect;
begin
r.Top :=0;
r.Left := 0;
r.Right := ViewBox.Width;
r.Bottom := ViewBox.Height;
ViewBox.Canvas.FillRect(r);
SetScale(RzComboBox1.Text);
SpeedButton1Click(Sender);
end;

procedure TFormPreviewFb.SetScale(s:String);
var n:integer;
begin
n:=Pos('%',s);
s := Copy (s,1,n-1);
nScale := StrToInt(s);
end;

function TFormPreviewFb.CalcScale(tTexts:TTextControlCode):TTextControlCode;
begin
if OutType <>0 then
tTexts.Position.Y := tTexts.Position.Y - SpaceOnTop
else
begin
tTexts.Position.x := round ( tTexts.Position.x /100 *nScale);
tTexts.Position.Y := round ( tTexts.Position.Y /100 *nScale);
tTexts.FontSize.x := round ( tTexts.FontSize.x /100 *nScale);
tTexts.FontSize.Y := round ( tTexts.FontSize.Y /100 *nScale);
end;
result := tTexts;
end;

procedure TFormPreviewFb.FormActivate(Sender: TObject);
var
IniFile : TIniFile;
begin
IniFile := TIniFile.Create(IniFileName);
SpaceOnTop := IniFile.ReadInteger(Printer.Printers[Printer.PrinterIndex],
'SpaceOnTop', 0 );
IniFile.Free;
RzComboBox1.ItemIndex := 4;
ViewPanel.Left := 0;
ViewPanel.Top := 0;
ViewPanel2.Left := 10;
ViewPanel2.Top := 10;
ViewBox.Left := 1;
ViewBox.Top := 1;
end;

procedure TFormPreviewFb.SpeedButton2Click(Sender: TObject);
begin
SetOutType(1);
GetOutDeviceCaps(Printer.Handle);
GetPageSize;
OutPutAll;
end;

procedure TFormPreviewFb.SpeedButton3Click(Sender: TObject);
begin
if Printer.Printing then
Printer.Abort;
end;

procedure TFormPreviewFb.SpeedButton5Click(Sender: TObject);
var
IniFile : TIniFile;
begin
IniFile := TIniFile.Create(IniFileName);
SpaceOnTop := IniFile.ReadInteger(Printer.Printers[Printer.PrinterIndex],
'SpaceOnTop', 0 );
FormInputNum.RzNumericEdit1.IntValue := SpaceOnTop;
FormInputNum.ShowModal;
if FormInputNum.ModalResult = mrOk then
begin
SpaceOnTop := FormInputNum.RzNumericEdit1.IntValue;
IniFile.WriteInteger(Printer.Printers[Printer.PrinterIndex],
'SpaceOnTop', SpaceOnTop );
end;
IniFile.Free;
end;

end.
 
谢谢,我看看先。
 
小猪;
我没有画过,不过我给你寄了两个来,NDSP 和ehlib,都是用canvas.
 
谢谢htw,我正看着呢。
先谢谢两位的热情。
 
谢谢两位。
不过总感觉有点便宜你们两个了。:)
 
后退
顶部