Прочитал статью: "Лучший способ печати формы"

Данный документ содержит подробное описание способа печати формы. Но как вывести только ту информацию, которая содердится в DBEdit (данные базы данных)? Если можно помогите доктору. Спасибо.

unit Prntit;

interface

uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
 Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Image1: TImage;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
var

 dc: HDC;
 isDcPalDevice: BOOL;
 MemDc: hdc;
 MemBitmap: hBitmap;
 OldMemBitmap: hBitmap;
 hDibHeader: Thandle;
 pDibHeader: pointer;
 hBits: Thandle;
 pBits: pointer;
 ScaleX: Double;
 ScaleY: Double;
 ppal: PLOGPALETTE;
 pal: hPalette;
 Oldpal: hPalette;
 i: integer;
begin

 {Получаем dc экрана}
 dc := GetDc(0);
 {Создаем совместимый dc}
 MemDc := CreateCompatibleDc(dc);
 {создаем изображение}
 MemBitmap := CreateCompatibleBitmap(Dc,
   form1.width,
   form1.height);
 {выбираем изображение в dc}
 OldMemBitmap := SelectObject(MemDc, MemBitmap);

 {Производим действия, устраняющие ошибки при работе с некоторыми типами видеодрайверов}
 isDcPalDevice := false;
 if GetDeviceCaps(dc, RASTERCAPS) and
   RC_PALETTE = RC_PALETTE then
 begin
   GetMem(pPal, sizeof(TLOGPALETTE) +
     (255 * sizeof(TPALETTEENTRY)));
   FillChar(pPal^, sizeof(TLOGPALETTE) +
     (255 * sizeof(TPALETTEENTRY)), #0);
   pPal^.palVersion := $300;
   pPal^.palNumEntries :=
     GetSystemPaletteEntries(dc,
     0,
     256,
     pPal^.palPalEntry);
   if pPal^.PalNumEntries <> 0 then
   begin
     pal := CreatePalette(pPal^);
     oldPal := SelectPalette(MemDc, Pal, false);
     isDcPalDevice := true
   end
   else
     FreeMem(pPal, sizeof(TLOGPALETTE) +
       (255 * sizeof(TPALETTEENTRY)));
 end;

 {копируем экран в memdc/bitmap}
 BitBlt(MemDc,
   0, 0,
   form1.width, form1.height,
   Dc,
   form1.left, form1.top,
   SrcCopy);

 if isDcPalDevice = true then
 begin
   SelectPalette(MemDc, OldPal, false);
   DeleteObject(Pal);
 end;

 {удаляем выбор изображения}
 SelectObject(MemDc, OldMemBitmap);
 {удаляем dc памяти}
 DeleteDc(MemDc);
 {Распределяем память для структуры DIB}
 hDibHeader := GlobalAlloc(GHND,
   sizeof(TBITMAPINFO) +
   (sizeof(TRGBQUAD) * 256));
 {получаем указатель на распределенную память}
 pDibHeader := GlobalLock(hDibHeader);

 {заполняем dib-структуру информацией, которая нам необходима в DIB}
 FillChar(pDibHeader^,
   sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256),
   #0);
 PBITMAPINFOHEADER(pDibHeader)^.biSize :=
   sizeof(TBITMAPINFOHEADER);
 PBITMAPINFOHEADER(pDibHeader)^.biPlanes := 1;
 PBITMAPINFOHEADER(pDibHeader)^.biBitCount := 8;
 PBITMAPINFOHEADER(pDibHeader)^.biWidth := form1.width;
 PBITMAPINFOHEADER(pDibHeader)^.biHeight := form1.height;
 PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;

 {узнаем сколько памяти необходимо для битов}
 GetDIBits(dc,
   MemBitmap,
   0,
   form1.height,
   nil,
   TBitmapInfo(pDibHeader^),
   DIB_RGB_COLORS);

 {Распределяем память для битов}
 hBits := GlobalAlloc(GHND,
   PBitmapInfoHeader(pDibHeader)^.BiSizeImage);
 {Получаем указатель на биты}
 pBits := GlobalLock(hBits);

 {Вызываем функцию снова, но на этот раз нам передают биты!}
 GetDIBits(dc,
   MemBitmap,
   0,
   form1.height,
   pBits,
   PBitmapInfo(pDibHeader)^,
   DIB_RGB_COLORS);

 {Пробуем исправить ошибки некоторых видеодрайверов}
 if isDcPalDevice = true then
 begin
   for i := 0 to (pPal^.PalNumEntries - 1) do
   begin
     PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed :=
       pPal^.palPalEntry[i].peRed;
     PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen :=
       pPal^.palPalEntry[i].peGreen;
     PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue :=
       pPal^.palPalEntry[i].peBlue;
   end;
   FreeMem(pPal, sizeof(TLOGPALETTE) +
     (255 * sizeof(TPALETTEENTRY)));
 end;

 {Освобождаем dc экрана}
 ReleaseDc(0, dc);
 {Удаляем изображение}
 DeleteObject(MemBitmap);

 {Запускаем работу печати}
 Printer.BeginDoc;

 {Масштабируем размер печати}
 if Printer.PageWidth < Printer.PageHeight then
 begin
   ScaleX := Printer.PageWidth;
   ScaleY := Form1.Height * (Printer.PageWidth / Form1.Width);
 end
 else
 begin
   ScaleX := Form1.Width * (Printer.PageHeight / Form1.Height);
   ScaleY := Printer.PageHeight;
 end;

 {Просто используем драйвер принтера для устройства палитры}
 isDcPalDevice := false;
 if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and
   RC_PALETTE = RC_PALETTE then
 begin
   {Создаем палитру для dib}
   GetMem(pPal, sizeof(TLOGPALETTE) +
     (255 * sizeof(TPALETTEENTRY)));
   FillChar(pPal^, sizeof(TLOGPALETTE) +
     (255 * sizeof(TPALETTEENTRY)), #0);
   pPal^.palVersion := $300;
   pPal^.palNumEntries := 256;
   for i := 0 to (pPal^.PalNumEntries - 1) do
   begin
     pPal^.palPalEntry[i].peRed :=
       PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;
     pPal^.palPalEntry[i].peGreen :=
       PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;
     pPal^.palPalEntry[i].peBlue :=
       PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;
   end;
   pal := CreatePalette(pPal^);
   FreeMem(pPal, sizeof(TLOGPALETTE) +
     (255 * sizeof(TPALETTEENTRY)));
   oldPal := SelectPalette(Printer.Canvas.Handle, Pal, false);
   isDcPalDevice := true
 end;

 {посылаем биты на принтер}
 StretchDiBits(Printer.Canvas.Handle,
   0, 0,
   Round(scaleX), Round(scaleY),
   0, 0,
   Form1.Width, Form1.Height,
   pBits,
   PBitmapInfo(pDibHeader)^,
   DIB_RGB_COLORS,
   SRCCOPY);

 {Просто используем драйвер принтера для устройства палитры}
 if isDcPalDevice = true then
 begin
   SelectPalette(Printer.Canvas.Handle, oldPal, false);
   DeleteObject(Pal);
 end;

 {Очищаем распределенную память} GlobalUnlock(hBits);
 GlobalFree(hBits);
 GlobalUnlock(hDibHeader);
 GlobalFree(hDibHeader);

 {Заканчиваем работу печати}
 Printer.EndDoc;

end;

А почему бы не воспользоваться каким либо генератором отчетов?

Генератор отчетов не дает возможности разместить в нужном порядке текст, например, рецепта:
770000 1230984563
12.11.1956

Ул. Судостроительная 28, кор. 2, кв. 36          Код заболевания:   N40
Кузмичев Дмитрий Анатольевич
                                                  СНИЛС: 123-234-345-12
Rp: Tab. Omnici 0,0004
D.t.d. №30
По 1 таблетке утром

Ну и так далее... На форме все это можно вымерить и затем напечатать.
Может быть есть еще какие-нибудь варианты?

> Виктор   (16.04.10 23:27) [2]


> Генератор отчетов не дает возможности разместить в нужном
> порядке текст, например, рецепта:

Да ну?? Вот жеж новости..
Попробуй, для начала, freereport (бесплатный) http://fast-report.com/ru/download/free-report-download.html

> Виктор  (16.04.2010 23:27:02)  [2]

Вариант один - генератор отчетов

Спасибо за подсказку turbouser!!! По ссылке http://fast-report.com/ru/download/free-report-download.html скчал FreeReport 2.34, однако после компиляции и установки его не оказалось
скомпилированного модуля - FR_Class.dcu, который должен был находиться в каталогах LIB_D2...LIB_D5 (эти каталоги отсутствуют). Поэтому я еще больше огорчился не оценив Вашей помощи. Подскажите, пожалуйста, где взять модуль FR_Class.dcu? Спасибо за отзывы и помощь.

Зачем оно тебе, это программирование? Есть же много других профессий.

> Виктор   (17.04.10 13:16) [5]

1) добавить в library_path путь к исходникам FR
2) Открываем FREEREP5.DPK (D5 ведь?)
2.1) Compile
2.2) Install
все.

Спасибо turbouser!!! После перезагрузки компьютера - все заработало!
Попробую сделать то, о чем мечтал: облегчить свой труд, обремененный написанием огромного количества бумаг - рецептов, направлений на анализы, исследования, где на каждой бумажке в разных позициях выводится одна и таже информация, а именно: ФИО, возраст, адрес, страховой полис, СНИЛС (индивидуальный номер страхователя) и т.д. На это уходим масса времени. некогда поговорить с пациентом. Спасибо за помощь. Основная задача заключается вывести данные одной записи (а точнее каждой ячейки) из таблицы Paradox в нужное место готовых уже медицинских бланков (которых огромное множество). Если самостоятельно разберусь - напишу.

> [8] Виктор   (17.04.10 14:30)

Неправильно это всё в одной таблице держать.

> Inovet  (17.04.2010 15:00:09)  [9]

Количество таблиц роли не играет, интерпретируе,правильно когда нормализовано.

> [10] Anatoly Podgoretsky ©   (17.04.10 15:04)
> Количество таблиц роли не играет, интерпретируе,правильно
> когда нормализовано.

Если только то, что перечислено, то да, одна таблица.

> [8] Виктор   (17.04.10 14:30)
> , возраст, адрес, страховой полис, СНИЛС (индивидуальный
> номер страхователя)

У меня одна таблица с 35000 записей, которую сам конвертировал из .txt в Paradox, так как имеющаяся база данных в центре обработки информации такая древняя, работает из под DOS и получить что-либо более достойного не удалось.

> Inovet  (17.04.2010 15:10:11)  [11]

Вообще то если нужна история, то почти любое поле надо выносить в отдельную таблицу.
Но не это проблема, а проблема в СУБД - может хлебнуть много горя.

turbouser! Попробовал сделать шаблон для заполнения бланка направления на анализ RW, ВИЧ. Все хорошо, но не получается разместить каждую букву в нужную клетку. В Fast Report нет настройки изменения интервала между буквами. А текст заполняется в каждую клетку шаблона. Что делать? Высылаю на t-mail шаблон.

> Виктор   (17.04.10 17:12) [14]

Вообще-то в идеале надо не печатать на бланках, а печатать уже заполненные бланки из FR. Но если так надо, то можно в обработчике OnBeforePrint у компонента, содержащего текст, изменить этот самый текст как необходимо в скрипте. Например, между буквами расставить пробелы.
А вообще, это критично что бы буквы попадали в клеточки? Эти бланки потом автоматизированно обрабатывают чтоли?

Николаю. Вот именно! Все заполняется по клеточкам печатными буквами вручную, а затем, кровь взятая на анализ отправляется в лабораторию, где буржуинское оборудование позволяет обрабатывать данные автоматизированно. А мы еще работаем с "перфокартами" как в старые времена, когда еще компьютеров не было и считали на счетах. Вышли свой е-mail, я перешлю образец бланка.

_mail собако mail тчк ru

Виктор   (17.04.10 17:34) [16]

Доктор, а ты часом выписку льготных рецептов автоматизировать не хочешь ? А то вот такая незадача - я сижу и жду, пока доктор их от руки напишет, потом в карточку перепишет, что он выписал. Опять же, у реальных больных время отнимается.
Судя по моим посещениям поликлиники, у доктора работа в основном писательская. Хотя, вероятно, что где-нибудь и компьютер стоит, пылится...

Игорю! Как раз я сейчас этим и занимаюсь, в том числе и автоматизацией выписки льготных рецептов, где опять таки все надо по клеточкам раписывать.