Форум: "Основная";
Текущий архив: 2009.11.29;
Скачать: [xml.tar.bz2];

Вниз

Печать   Найти похожие ветки 

← →
Vendict ©   (2008-11-19 07:30) [0]

В чём может быть дело? Данная процедура на виртуальном и сетевом принтере HPLaserJet5550dn печатает картинку, на других нет (выдаёт пустой лист). В BMP лежит картинка, которую нужно напечатать.


procedure TForm1.N10Click(Sender: TObject);
var
 PRect:Trect;
 BM:TBitmap;
 mx,my,w,h,i,j:Int;
 tmp:Real;

begin
If PrintDialog1.Execute then
 Begin
  With PRect do
   begin
    left:=0;
    top:=0;
    right:=Printer.PageWidth;
    Bottom:=Printer.PageHeight;
   end;

  For i:=0 to BMP.Width-1 do
   Begin
    For j:=0 to BMP.Height-1 do
     If BMP.Canvas.Pixels[i,j]<>RGB(255,255,255) then Break;
    If j<>BMP.Height then Break;
   End;
  mx:=i-5;

  For j:=0 to BMP.Height-1 do
   Begin
    For i:=0 to BMP.Width-1 do
     If BMP.Canvas.Pixels[i,j]<>RGB(255,255,255) then Break;
    If i<>BMP.Width then Break;
   End;
  my:=j-5;

  For i:=BMP.Width-1 downto 0 do
   Begin
    For j:=0 to BMP.Height-1 do
     If BMP.Canvas.Pixels[i,j]<>RGB(255,255,255) then Break;
    If j<>BMP.Height then Break;
   End;
  w:=i+5;

  For j:=BMP.Height-1 downto 0 do
   Begin
    For i:=0 to BMP.Width-1 do
     If BMP.Canvas.Pixels[i,j]<>RGB(255,255,255) then Break;
    If i<>BMP.Width then Break;
   End;
  h:=j+5;
  w:=ABS(w-mx+1);
  h:=ABS(h-my+1);
  BM:=TBitmap.Create;
  BM.Width:=w;
  BM.Height:=h;
  BitBlt(BM.Canvas.Handle,0,0,w,h,BMP.Canvas.Handle,mx,my,SRCCOPY);
  tmp:=Min(w,h)/Max(w,h);
  If w>h then tmp:=tmp*PRect.Right
         else tmp:=tmp*PRect.Bottom;
  If w>h then PRect.Bottom:=Trunc(tmp)
         else PRect.Right:=Trunc(tmp);
 
//   BM.SaveToFile("1.bmp");
  with printer do
   begin
    BeginDoc;
    Canvas.StretchDraw(PRect,BM);
    EndDoc;
   end;
  BM.Free;
 End;

End;

---

← →
KilkennyCat ©   (2008-11-19 08:02) [1]

pf

---

← →
Vendict ©   (2008-11-19 10:50) [2]

?

---

← →
KilkennyCat ©   (2008-11-19 11:01) [3]

пикселформат, возможно, спасет.
Но скорее всего, тупое бмп со стретчdraw не прокатит, ибо DIB.
И вообще, таких вопросов была куча, лень поискать ответ?

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2009.11.29;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.005 c