Как сделать вывод на печать в delphi

Rusl92
Member
Откуда:
Сообщений: 137
Каким образом все что находится в DbGrid е напечатать? XenoX
Member
Откуда: 0x1F0438044204350440042100
Сообщений: 1976
Никак, в DBGride ничего не находится Vlaka
Member
Откуда:
Сообщений: 515
Используйте один из генераторов отчётов типа Fast Report. LSV
Member
Откуда: Киев
Сообщений: 30008
Rusl92 Каким образом все что находится в DbGrid е напечатать? Забудьте про DBGrid. DBGridEh рулит, в т.ч. по сабжу. Rusl92
Member
Откуда:
Сообщений: 137
LSV напиши подробнее Anatoly Podgoretsky
Member
Откуда:
Сообщений: 62928
LSV затычка, в каждом вопросе LSV напиши, а ты знаешь сколько можно задать таких простейщих вопросов, да у него пальцы источится отвечать на них. Может пора книжки прочитать, посмотреть демо примеры. LSV
Member
Откуда: Киев
Сообщений: 30008
Блин!!!!! Даже в демки лазить не нужно:
http://ehlib.com/RUS/default.htm

Всё неимоверно обсосано......

quaid
Member [заблокирован]
Откуда: Киев
Сообщений: 6665
Rusl92 Каким образом все что находится в DbGrid е напечатать?
Скопировать содержимое области экрана в битмам и напечатать не подойдет? %) Rusl92
Member
Откуда:
Сообщений: 137
Я скачал инфу о компонентах, спасибо! FreeDen
Member
Откуда: Николаев
Сообщений: 505
я извращался так :) : unit PrintGrids; //Юнит PrintGrids для распечатки String- и DB-гридов. //(c) Virgo_Style aka Евгений 08.06.2005. // //Предположения: //Первая строка - заголовки, печатаются на каждой странице //Первый столбец - просто столбец %-) //Данные копируются в свой grid, так что желательно потом //его чистить ClearSource, если не освобождается весь объект. // деление на страницы немного некорректно. // регион печати на каждой странице один и тот же, хотя //заголовок есть только на 1-й. // Используем так: // PrintGridForm.SetSource(MyGrid); // PrintGridForm.Title.Text := 'Табличка какая-то'; // PrintGridForm.Title.Font.Size := 10; // PrintGridForm.ShowModal; // PrintGridForm.ClearSource; //Можно использовать SetSourceDirect - работа //напрямую с StringGrid. Чревато изменением его размеров, //но экономится память. interface USES Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, Printers, StdCtrls, ComCtrls, ExtCtrls, DBGrids; type TPageRange =record First,Last:integer; end; //Такие функции (в т.ч., User-defined) используется для форматирования type TFormatCell =function(const Title,S:string;VAR Align:TAlignment):string; type PFormatCell =^TFormatCell; type TPrintGridForm =class(TForm) Shape1:TShape; UpDown1:TUpDown; LeftFieldValue:TEdit; RightFieldValue:TEdit; UpDown2:TUpDown; TopFieldValue:TEdit; BottomFieldValue:TEdit; UpDown3:TUpDown; UpDown4:TUpDown; Title:TEdit; PagesInfo:TLabel; PrinterSetupDialog1:TPrinterSetupDialog; PrnSetup:TButton; PrintBtn:TButton; procedure FormCreate(Sender:TObject); procedure FormDestroy(Sender:TObject); procedure EditFields(Sender:TObject); procedure PrnSetupClick(Sender:TObject); procedure PrintBtnClick(Sender:TObject); private //прямая ссылка или работа с копией DirectAssign:boolean; //DPI DPIX,DPIY, //Смещение верхнего левого угла, пикс OffX,OffY, //Физ размер страницы, пикс PhsX,PhsY, //Логические размеры, пикс. logX,logY :integer; //Мертвая зона принтера, пикс. DZLeft,DZRight, DZTop, DZBottom: integer; //Источник данных Grid:TstringGrid; //Разбиение на страницы HPages, VPages:array of TPageRange; //Куда печатаем PrintingRect:TRect; //коэффициенты для перевода пикселей грида в пиксели принтера kx,ky:integer; //Деление на страницы procedure DividePagesHorizontal; procedure DividePagesVertical; //Пересчет зоны печати procedure RecalcPrintRectangle; //Информация procedure PagesInfoRefresh; //Собственно печать function PrintGridAt(Grid:TstringGrid; Rect1,RectNext:TRect):boolean; { Private declarations } public //Поля LeftField, RightField, TopField, BottomField:integer; //Выбранная функция форматирования FormatCell:TFormatCell; //А можно ли вообще печатать, принтер-то есть? %-) CanPrint:boolean; //Установка источника данных procedure ClearSource; procedure SetSource(SourceSG:TstringGrid); overload; procedure SetSourceDirect(SourceSG:TstringGrid); overload; procedure SetSource(SourceSG:TDBGrid); overload; { Public declarations } end; function fcRightAlign(const Title,S:string; VAR Align:TAlignment):string; function fcLeftAlign(const Title,S:string; VAR Align:TAlignment):string; function fcCenterAlign(const Title,S:string; VAR Align:TAlignment):string; function fcLeftNumericRight(const Title,S:string; VAR Align:TAlignment):string; implementation USES DB; {$R.dfm} //No comments function fcRightAlign(const Title,S:string; VAR Align:TAlignment):string; begin Result:=S; Align:=taRightJustify; end; function fcLeftAlign(const Title,S:string; VAR Align:TAlignment):string; begin Result:=S; Align:=taLeftJustify; end; function fcCenterAlign(const Title,S:string; VAR Align:TAlignment):string; begin Result:=S; Align:=taCenter; end; //Цифры справа, текст слева function fcLeftNumericRight(const Title,S:string; VAR Align:TAlignment):string; VAR tmp:Extended; begin Result:=S; if TryStrToFloat(S,tmp) then Align:=taRightJustify else Align:=taLeftJustify; end; //Так или не так? procedure TPrintGridForm.ClearSource; var i:integer; begin if not DirectAssign and Assigned(Grid) then for i:=0 to Grid.RowCount-1 do Grid.Rows[i].Clear; end; //Прямая ссылка на исходный grid procedure TPrintGridForm.SetSourceDirect(SourceSG:TstringGrid); begin if assigned(Grid) and not DirectAssign then Grid.Free; DirectAssign:=true; Grid:=SourceSG; PagesInfoRefresh; end; //Как-то некрасиво =) Но работает же %-) procedure TPrintGridForm.SetSource(SourceSG:TstringGrid); VAR i,j:integer; begin if not assigned(Grid) or DirectAssign then Grid:=TstringGrid.Create(self); DirectAssign:=false; Grid.Font :=SourceSG.Font; Grid.Color:=SourceSG.Color; Grid.FixedColor :=SourceSG.FixedColor; Grid.FixedRows:=SourceSG.FixedRows; Grid.RowCount :=SourceSG.RowCount; Grid.ColCount:=SourceSG.ColCount; for i:=0 to Grid.RowCount-1 do Grid.RowHeights[i] :=SourceSG.RowHeights[i]; for j:=0 to Grid.ColCount-1 do Grid.ColWidths[j]:=SourceSG.ColWidths[j]; for i:=0 to Grid.RowCount-1 do for j:=0 to Grid.ColCount-1 do Grid.Cells[j,i]:=SourceSG.Cells[j,i]; PagesInfoRefresh; end; //Как-то некрасиво =) Но работает же %-) - 2 procedure TPrintGridForm.SetSource(SourceSG:TDBGrid); VAR i,j:integer; BM:TBookmark; begin if not assigned(Grid) or DirectAssign then Grid:=TstringGrid.Create(self); DirectAssign:=false; Grid.Font :=SourceSG.Font; Grid.Color:=SourceSG.Color; Grid.FixedColor :=SourceSG.FixedColor; Grid.FixedRows:=1; Grid.RowCount :=SourceSG.DataSource.DataSet.RecordCount+1; Grid.ColCount:=SourceSG.Columns.Count; for i:=0 to Grid.RowCount-1 do Grid.RowHeights[i] :=Grid.Font.Size+4; for j:=0 to Grid.ColCount-1 do Grid.ColWidths[j]:=SourceSG.Columns[j].Width; for j:=0 to Grid.ColCount-1 do Grid.Cells[j,0]:=SourceSG.Columns.Items[j].DisPlayName; With SourceSG.DataSource.DataSet do begin try begin BM:=GetBookmark; DisableControls; First; i:=1; repeat for j:=0 to Grid.ColCount-1 do Grid.Cells[j,i]:=Fields[j].Asstring; inc(i); if i>Grid.RowCount then Grid.RowCount:=i; Next; until eof; GotoBookmark(BM); end; finally EnableControls; end; end; PagesInfoRefresh; end; procedure TPrintGridForm.FormCreate(Sender:TObject); begin DirectAssign:=false; CanPrint:=Printer.Printers.Count>0; // DoubleBuffered:=true; Grid:=nil; FormatCell:=nil; // Поля LeftField :=25; RightField :=25; TopField :=25; BottomField:=25; end; procedure TPrintGridForm.FormDestroy(Sender:TObject); begin FreeAndNil(Grid); end; procedure TPrintGridForm.DividePagesVertical; VAR pheight, r, h,vPage:integer; begin //Инициализация SetLength(VPages,1); сделать //Патамучта заголовок: VPages[0].First:=1; with PrintingRect do pheight:=Bottom-Top; h:=Grid.RowHeights[0]; //...Заголовок потому что %-) for r:=1 to Grid.RowCount-1 do begin //Кто шире страницы - порежем %-) //SIC! Сначала режем, а потом уже о настройках (ориентация) думаем %-) Нехорошо... if Grid.RowHeights[r]>pheight then Grid.RowHeights[r]:=pheight; h:=h+Grid.RowHeights[r]-1; //На какую страницу выпадет? vPage:=(hky) div pheight + 1; if vPage>Length(VPages) then begin //Следующая SetLength(VPages,vPage); VPages[vPage-1].First:=r; //h:=Grid.RowHeights[0]+Grid.RowHeights[r]; h:=h+Grid.RowHeights[0]-1; end; VPages[vPage-1].Last:=r; end; end; procedure TPrintGridForm.DividePagesHorizontal; VAR pwidth, c, w,hPage:integer; begin //Собственно все точно так же. SetLength(HPages,1); HPages[0].First:=0; with PrintingRect do pwidth:=Right-Left; w:=0; for c:=0 to Grid.ColCount-1 do begin if Grid.ColWidths[c]>pwidth then Grid.ColWidths[c]:=pwidth; w:=w+Grid.ColWidths[c]; hPage:=(wkx) div pwidth + 1; if hPage>Length(HPages) then begin SetLength(HPages,hPage); HPages[hPage-1].First:=c; end; HPages[hPage-1].Last:=c; end; end; procedure TPrintGridForm.RecalcPrintRectangle; var dpiScr:integer; begin dpiScr :=Screen.PixelsPerInch; //dpi: dpiX :=GetDeviceCaps(Printer.Handle, LogPixelsX); dpiY :=GetDeviceCaps(Printer.Handle, LogPixelsY); //pixels: logX :=GetDeviceCaps(Printer.Handle, HORZRES); logY :=GetDeviceCaps(Printer.Handle, VERTRES); //pixels offX :=GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX); offY :=GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY); //pixels phsX :=GetDeviceCaps(Printer.Handle, PHYSICALWIDTH); phsY :=GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT); //pixels мертвой зоны: DZLeft:=(offX) ; DZTop:= (offY); DZRight:= ( (phsX-logX-offX) ); DZBottom:=( (phsY-logY-offY) ); //Тот самый коэффициент... Как-то нехорошо, надо подумать над этим. //kx:=Round(0.55+Printer.Canvas.TextWidth('123')/Canvas.TextWidth('123')); //ky:=Round(0.55+Printer.Canvas.TextHeight('123')/Canvas.TextHeight('123')); //По идее, так: kx:= Round(dpiX/dpiScr); ky:= Round(dpiY/dpiScr); //Посчитаем поля PrintingRect.Left:=(dpiXLeftField div 25)-DZLeft; PrintingRect.Right:=(Printer.PageWidth - dpiXRightField div 25)+DZRight; PrintingRect.Top:=dpiYTopField div 25 - DZTop; PrintingRect.Bottom:=(Printer.PageHeight-dpiYBottomField div 25)+DZBottom; //Определение мертвой зоны if PrintingRect.Left<0 then PrintingRect.Left:=0; if (logX<PrintingRect.Right) then PrintingRect.Right := logX; if PrintingRect.Top<0 then PrintingRect.Top := 0; if logY<PrintingRect.Bottom then PrintingRect.Bottom := logY; end; procedure TPrintGridForm.EditFields(Sender:TObject); begin //Есть такое подозрение, что это на фиг не надо при //ReadOnly = true %-) Но пусть будет пока... if not TryStrToInt(LeftFieldValue.Text,LeftField) then LeftFieldValue.Color:=clRed else LeftFieldValue.Font.Color:=clBlack; if not TryStrToInt(RightFieldValue.Text,RightField) then RightFieldValue.Color:=clRed else RightFieldValue.Font.Color:=clBlack; if not TryStrToInt(TopFieldValue.Text,TopField) then TopFieldValue.Color:=clRed else TopFieldValue.Font.Color:=clBlack; if not TryStrToInt(BottomFieldValue.Text,BottomField) then BottomFieldValue.Color:=clRed else BottomFieldValue.Font.Color:=clBlack; PagesInfoRefresh; end; //Обновление информации на экране procedure TPrintGridForm.PagesInfoRefresh; begin RecalcPrintRectangle; DividePagesVertical; DividePagesHorizontal; if Printer.Orientation=poLandScape then PagesInfo.Caption:='Ориентация: Ландшафт / Горизонтальный' else PagesInfo.Caption:='Ориентация: Портрет / Вертикальный'; PagesInfo.Caption:=PagesInfo.Caption+#13; PagesInfo.Caption:=PagesInfo.Caption+'Страниц по горизонтали - '+IntToStr(Length(HPages))+#13; PagesInfo.Caption:=PagesInfo.Caption+'Страниц по вертикали - '+IntToStr(Length(VPages))+#13+#13; PagesInfo.Caption:=PagesInfo.Caption+'DPI: '+IntToStr(DPIX)+'/'+IntToStr(DPIY)+#13; PagesInfo.Caption:=PagesInfo.Caption+'Физические размеры листа: '; PagesInfo.Caption:=PagesInfo.Caption+IntToStr(phsX25 div DPIX)+'x'+IntToStr(phsY25 div DPIY)+' (мм)'+#13; PagesInfo.Caption:=PagesInfo.Caption+'Доступно для печати: '; PagesInfo.Caption:=PagesInfo.Caption+IntToStr(logX25 div DPIX)+'x'+IntToStr(logY25 div DPIY)+' (мм)'+#13; PagesInfo.Caption:=PagesInfo.Caption+'Выбранный регион печати: '; PagesInfo.Caption:=PagesInfo.Caption + IntToStr((PrintingRect.Left+DZLeft)25 div DPIX)+':'+IntToStr((PrintingRect.Top+DZTop)25 div DPIY)+' - '; PagesInfo.Caption:=PagesInfo.Caption + IntToStr((PrintingRect.Right+DZRight)25 div DPIX)+':'+IntToStr((PrintingRect.Bottom+DZBottom)25 div DPIY)+' (мм)'; end; //Настройки procedure TPrintGridForm.PrnSetupClick(Sender:TObject); begin PrinterSetupDialog1.Execute; PagesInfoRefresh; end; //Он сказал - поехали procedure TPrintGridForm.PrintBtnClick(Sender:TObject); VAR x:integer; VAR R1,Rnext:TRect; begin //Ну пусть будет пока, хотя на фига - я не знаю %-) if Grid = nil then begin MessageDlg('Нечего печатать.',mtError,[mbok],0); exit; end; //формат by default if @FormatCell=nil then FormatCell:=@fcLeftNumericRight; //И.. Поехали try begin Printer.BeginDoc; R1 :=PrintingRect; Rnext:=R1; //Заголовок есть? Печатаем... if Title.Text<>'' then begin x:=(PrintingRect.Right+PrintingRect.Left-Printer.Canvas.TextWidth(Title.Text)) div 2; Printer.Canvas.Brush.Color:=clWhite; Printer.Canvas.Font:=Title.Font; Printer.Canvas.TextOut(x,PrintingRect.Top,Title.Text); //Немного нехорошо, что верх всех страниц смещается на величину заголовка //первой. Переживем? %-) Rnext.Top:=R1.Top+2Printer.Canvas.TextHeight(Title.Text); end; //Таблицу печатаем.. if PrintGridAt(Grid, Rnext, Rnext) then Printer.EndDoc else Printer.Abort; end; finally //"Проехали, тормоз! Забудь." if Printer.Printing then Printer.Abort; end; end; // Работаем-с... function TPrintGridForm.PrintGridAt(Grid:TstringGrid; Rect1,RectNext:TRect):boolean; VAR Rect:TRect; S:string; R,C,x,y:integer; //Строка заголовков procedure DrawTitles(Canvas:TCanvas; FromColumn, ToColumn:integer); VAR i,x1:integer; R1:TRect; S:string; begin //Ну, в общем, нечего тут комментировать =) x:=Rect.Left; y:=Rect.Top; for i:=FromColumn to ToColumn do begin R1.Left:=x; R1.Top:=y; R1.Bottom:=y+Grid.RowHeights[0]ky; R1.Right:=x+Grid.ColWidths[i]kx; // if R1.Left>Rect.Right then break; if R1.Right>Rect.Right then R1.Right:=Rect.Right; Canvas.Brush.Color:=Grid.FixedColor; Canvas.Font:=Grid.Font; S:=Grid.Cells[i,0]; x1:=(R1.Right+R1.Left-Canvas.TextWidth(S)) div 2; Canvas.TextRect(R1,x1,R1.Top+2ky,S); Canvas.Brush.Color:=clGray; Canvas.FrameRect(R1); x:=R1.Right-1; end; y:=y+Grid.RowHeights[0]ky-1; end; //Печать строки procedure DrawRow(Canvas:TCanvas; R, FromColumn, ToColumn:integer); VAR i:integer; A:TAlignment; x1:integer; R1:TRect; begin //Тоже ничего особенного x:=Rect.Left; for i:=FromColumn to ToColumn do begin R1.Left:=x; R1.Top:=y; R1.Bottom:=y+Grid.RowHeights[R]ky;//CellHeight; R1.Right:=x+Grid.ColWidths[i]kx; Canvas.Brush.Color:=Grid.Color; A:=taRightJustify; if R1.Right>Rect.Right then R1.Right:=Rect.Right; S:=FormatCell(Grid.Cells[i,0],Grid.Cells[i,r],A); Canvas.Font:=Grid.Font; case A of taLeftJustify: x1:=R1.Left+2kx; taRightJustify: x1:=R1.Right-4kx-Canvas.TextWidth(S); taCenter: x1:=(R1.Right+R1.Left-Canvas.TextWidth(S)) div 2; else x1:=R1.Left+2kx; end; Canvas.TextRect(R1,x1,R1.Top+2ky,S); Canvas.Brush.Color:=clGray; Canvas.FrameRect(R1); x:=R1.Right-1; end; y:=y+Grid.RowHeights[R]ky-1; end; //Печать страницы pr в вертикальной разбивке, pc - в горизонтальной. procedure PrintPage(Canvas:TCanvas; pr,pc:integer); VAR r:integer; begin if (pr>0) or (pc>0) then Printer.NewPage; if pr>0 then Rect:=RectNext else Rect:=Rect1; { //SIC DEBUG Printer.Canvas.Brush.Color:=clBlack; Printer.Canvas.FrameRect(Rect); Printer.Canvas.Brush.Color:=clWhite; exit; } DrawTitles(Printer.Canvas,HPages[pc].First,HPages[pc].Last); for r:=VPages[pr].First to VPages[pr].Last do DrawRow(Canvas,r,HPages[pc].First,HPages[pc].Last); end; //Собственно процедура, а вы про нее уже забыли поди? %-)) begin //Ну и на фига мне тут result... Но пусть пока живет... Result:=true; Printer.Canvas.Brush.Color:=clWhite; Printer.Canvas.Pen.Color:=clBlack; //CellHeight:=Round(1.3Printer.Canvas.TextHeight('W')); try begin for r:=0 to Length(VPages)-1 do for c:=0 to Length(HPages)-1 do PrintPage(Printer.Canvas, r,c); end finally end; end; {THE} END. FreeDen
Member
Откуда: Николаев
Сообщений: 505
и еще вот так: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,PRINTERS, Grids, StdCtrls; type TForm1 = class(TForm) Button1: TButton; StringGrid1: TStringGrid; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R.dfm} procedure PrintGrid(sGrid: TStringGrid ; sTitle: string); var X1, X2: Integer; Y1, Y2: Integer; TmpI: Integer; F: Integer; TR: TRect; begin Printer.Title := sTitle; Printer.BeginDoc; Printer.Canvas.Pen.Color := 0; Printer.Canvas.Font.Name := 'Times New Roman'; Printer.Canvas.Font.Size := 12; Printer.Canvas.Font.Style := [fsBold, fsUnderline]; Printer.Canvas.TextOut(0, 100, Printer.Title); for F := 1 to sGrid.ColCount - 1 do begin X1 := 0; for TmpI := 1 to (F - 1) do X1 := X1 + 5 (sGrid.ColWidths[TmpI]); Y1 := 300; X2 := 0; for TmpI := 1 to F do X2 := X2 + 5 (sGrid.ColWidths[TmpI]); Y2 := 450; TR := Rect(X1, Y1, X2 - 30, Y2); Printer.Canvas.Font.Style := [fsBold]; Printer.Canvas.Font.Size := 7; Printer.Canvas.TextRect(TR, X1 + 50, 350, sGrid.Cells[F, 0]); Printer.Canvas.Font.Style := []; for TmpI := 1 to sGrid.RowCount - 1 do begin Y1 := 150 TmpI + 300; Y2 := 150 (TmpI + 1) + 300; TR := Rect(X1, Y1, X2 - 30, Y2); Printer.Canvas.TextRect(TR, X1 + 50, Y1 + 50, sGrid.Cells[F, TmpI]); end; end; Printer.EndDoc; end; procedure TForm1.Button1Click(Sender: TObject); begin PrintGrid(StringGrid1, 'Print Stringgrid'); end; end. DimaBr
Member
Откуда:
Сообщений: 10230
А ещё? Atsuta
Member
Откуда:
Сообщений: 497
Rusl92 Каким образом все что находится в DbGrid е напечатать?

я так понял печатать БД уже не нужно?
теперь вопрос стал печати Грида?

а мож все же почитать про генераторы отчетов (как советовали ранее) или как советуют заглянуть в демки, там есть примеры работы с QuickReport.

А то след вопрос будет как распечатать данные с монитора, которые лежат в БД, выводяться в Грид и видны на мониторе.

Alex Kuznetsov
Member
Откуда: Ростов-на-Дону
Сообщений: 1789
Atsuta....
skiped...

А то след вопрос будет как распечатать данные с монитора, которые лежат в БД, выводяться в Грид и видны на мониторе.

На это есть ответ, уважаемый :-))
К сообщению приложен файл. Размер - 0Kb

DimaBr
Member
Откуда:
Сообщений: 10230
Как страшно жить...
Источник: http://www.sql.ru/forum/516693/vyvod-dbgrid-na-pechat



Рекомендуем посмотреть ещё:


Закрыть ... [X]

Вывод на печать - Общие вопросы Delphi - Форум программистов Анекдот ракету хохлы


Вывод рисунка на печать - Мультимедиа в Delphi - Страница Различные способы печати из приложений в Delphi Delphi - Как вывести на печать данные из StringGrid Вывод на печать - C# для начинающих Вывод DbGrid на печать / Delphi / Изучаем Delphi - Отчеты в. - t Графика в Delphi 6 причин не жениться на разведённой женщине с Авторская кухня в стиле Фьюжн 853 рецепта с фото

Похожие новости