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

Вниз

Мигание TPaintBox при перерисовке Canvas   Найти похожие ветки 

← →
Алик   (2006-11-27 19:53) [0]

Добрый день всем профессионалам Дельфи!

Прошу помочь мне в следующей проблеме:
Когда я произвожу перерисовку Canvas в TPaintBox происходит мерцание на экране. PaintBox расположен на ScrollBox, а последний на TPanel.  
Везде где можно я поставил свойство DoubleBuffered := True.
Тем не менее картинка мегает.
Этого не происходит когда я использую TImage. Но он не допустим, так как размер картинки большой и он съедает большой объем памяти.

Что можно сделать с PaintBox?

Заранее всем большое спасибо!

---

← →
Loginov Dmitry ©   (2006-11-27 22:31) [1]

Рисуй на канве TBitmap"a, а после "копируй" полученную картинку на TPaintBox с помощью TCanvas.Draw либо Windows.BitBtl

---

← →
Чапаев ©   (2006-11-28 08:10) [2]

> [0] Алик   (27.11.06 19:53)
Читай на тему WM_ERASEBKGND

---

← →
RASkov   (2006-11-28 08:30) [3]

> [0] Алик   (27.11.06 19:53)
> Но он не допустим, так как размер картинки большой

По всей видимости у тебя не весь рисунок видно за раз? так?
Попробуй CopyRect

---

← →
Алик   (2006-11-28 08:34) [4]

При испольбзовании TBitmap может возникнуть такая же проблема как и с TImage - нехватка памяти.
Максимальный размер картинки составляет 38000 x 38000 пикселей.
Здесь XP обычно матюкается и закрывает программу.

---

← →
RASkov   (2006-11-28 08:40) [5]

> 38000 x 38000 пикселей

нифика себе...

---

← →
Чапаев ©   (2006-11-28 08:45) [6]

найти б ещё монитор, куда 38000х38000 влезет...

Эт я к чему... Рисуй то, что нужно, а не то, что можно. ;-)

---

← →
DimaBr   (2006-11-28 08:47) [7]

> RASkov   (28.11.06 08:40) [5]

:))), я валяюсь, Корел например работает на 45720х45720 и не валится

---

← →
Алик   (2006-11-28 08:54) [8]

RASkov   (28.11.06 08:30) [3]

С TImage была еще проблема с тем, что размер Canvas не менятеся в Runtime, рисуется только та часть Canvas которая была до загрузки проги.
Как динамически ментять размер холста Image, без всяких опций типа StretchDraw?

---

← →
Чапаев ©   (2006-11-28 09:02) [9]

> [8] Алик   (28.11.06 08:54)
У канвы вообще нет размеров, если уж на то пошло. Размеры есть у Image или Bitmap. И они вполне адекватно изменяются...

---

← →
Anatoly Podgoretsky ©   (2006-11-28 09:12) [10]

> RASkov  (28.11.2006 08:40:05)  [5]

Примерно 6 гб канва

---

← →
Anatoly Podgoretsky ©   (2006-11-28 09:13) [11]

> Чапаев  (28.11.2006 08:45:06)  [6]

> найти б ещё монитор, куда 38000х38000 влезет

А вот это не проблема TScrollBox

---

← →
Чапаев ©   (2006-11-28 09:20) [12]

> > найти б ещё монитор, куда 38000х38000 влезет
> А вот это не проблема TScrollBox
Как сказать... С одно стороны не проблема, а с другой вроде и проблема. СРАЗУ ведь 38000х38000 не отрисуешь, так зачем память такой дурой занимать и скулить, что "не влазит"?

---

← →
RASkov   (2006-11-28 12:20) [13]

> Алик   (28.11.06 08:54) [8]

Размер канвы зависит от размера BitMap"а. Но такой размер BitMap"а вряд ли получится установить. У себя я максимум, помоему, 3500х3500 делал...

> Корел например работает на 45720х45720 и не валится

Но он же не хранит это изо в памяти как битмап.
Тут однозначно нужно работать с видимой областью, а остальное... а здесь надо думать.

---

← →
ЮЮ ©   (2006-11-28 12:29) [14]

Первым шагом рисования на PaintBoxe ты затираешь старое изображение, а затем рисуешь. Так?

Как вариант:  То, что ты рисуешь на канве PaintBox нарисовать на канвеTBitmap и вывести отрисованное на PaintBox за один раз.

Максимальный размер картинки составляет 38000 x 38000 пикселей.

Имеется ввиду видимая часть PaintBox-а. Откуда такие размеры?

---

← →
Amoeba ©   (2006-11-28 12:45) [15]

Посмотри вод этот пример (из книги Дарахвелидзе и Маркова) как показывать очень большие изображения без всяких TImage или TBitmap:

unit hugeviewunit;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, Buttons, ExtCtrls, ComCtrls, Menus, ImgList, ToolWin;
type
TViewMode = (vm1x1, vmZoom, vmStretch);

 pbmi = ^TBmi;
 TBMI  = record
   bminfo : TBitmapInfo;
   colors : array[0..255] of TRGBQuad;
 end;
type
 TMainForm = class(TForm)
   OpenDialog1: TOpenDialog;
   ScrollBox1: TScrollBox;
   PaintBox: TPaintBox;
   MainMenu1: TMainMenu;
   OpenItem: TMenuItem;
   N1: TMenuItem;
   ExitItem: TMenuItem;
   FileMenu: TMenuItem;
   ToolBar1: TToolBar;
   WholeToolButton: TToolButton;
   V1x1ToolButton: TToolButton;
   ZoomToolButton: TToolButton;
   ToolButton4: TToolButton;
   ScaleComboBox: TComboBox;
   ImageList1: TImageList;
   procedure PaintMe(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure WholeButtonClick(Sender: TObject);
   procedure V1x1ButtonClick(Sender: TObject);
   procedure ZoomButtonClick(Sender: TObject);
   procedure Open1Click(Sender: TObject);
   procedure ExitItemClick(Sender: TObject);
   procedure ScaleComboBoxChange(Sender: TObject);
 private
   { Private declarations }
   procedure CloseFileMapping;
 public
   { Public declarations }
 ViewMode : TViewMode;
 bmi : TBmI;
end;

var
 MainForm: TMainForm;
 Palette : hPalette;
 wDC : hDC;

implementation

{$R *.DFM}

const scales: array[0..4] of single = (0.25,0.5,1,2,4);

var ec : Integer;

   hf, hm : THandle;
   Bits : pointer;

procedure TMainForm.FormCreate(Sender: TObject);
begin
ScaleComboBox.ItemIndex := 2;
Palette := CreateHalftonePalette(PaintBox.Canvas.Handle);
Bits := nil;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
if palette <> 0 then DeleteObject(Palette);
CloseFileMapping;
end;

procedure TMainForm.Open1Click(Sender: TObject);
var
pb: pByteArray;
bmFile : pBitmapFileHeader;
begin
CloseFileMapping;

if not OpenDialog1.execute then Exit;
try
hf := CreateFile(pChar(OpenDialog1.FileName), GENERIC_READ or GENERIC_WRITE,
 FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if hf=INVALID_HANDLE_VALUE then
 raise EAbort.CreateFmt("&#9580;°шсър юЄъЁ&#8730;Єш  Їрщыр %d",[GetLastError]);

hm := CreateFileMapping(hf, nil, PAGE_READWRITE, 0,0,nil);
if hm=0 then
  raise EAbort.CreateFmt("&#9580;°шсър ёючфрэш  юс·хъЄр юЄюсЁрцхэш  %d",[GetLastError]);

pb := MapViewOfFile(hm, FILE_MAP_ALL_ACCESS, 0,0,0);
if pb=nil then
 raise EAbort.CreateFmt("&#9580;°шсър юЄюсЁрцхэш  т ярь Є№ %d",[GetLastError]);

bmFile := pBitmapFileHeader(pb);
if (bmFile^.bfType<>$4D42) then BEGIN Exit; END;

bits := pointer(@pByteArray(bmFile)^[bmFile^.bfOffBits]);
bmi := pBmi(@pb^[SizeOf(TBitmapFileHeader)])^;
except
 on E:EAbort do
  begin
   CloseFileMapping;
   ShowMessage(E.Message);
  end;
end;

MainForm.Caption := OpenDialog1.FileName;
V1x1ToolButton.Click;
V1x1ToolButton.Down := True;
end;

procedure TMainForm.CloseFileMapping;
var ec: Integer;
begin
 if (Bits <> nil) and
 not UnMapViewOfFile(Bits) then
  begin
    ec:=GetLastError;
    ShowMessage("&#9580;°шсър чръЁ&#8730;Єш  юЄюсЁрцрхьюую Їрщыр "+IntToStr(ec));
  end;
 if (hm<>0) and (hm<>INVALID_HANDLE_VALUE) then  CloseHandle(hm);
 if (hf<>0) and (hf<>INVALID_HANDLE_VALUE) then  CloseHandle(hf);
end;

procedure TMainForm.PaintMe(Sender: TObject);
var OldP : hPalette;i : integer;
begin
if not Assigned(Bits) then Exit;
OldP := SelectPalette(PaintBox.Canvas.Handle, Palette, False);
RealizePalette(PaintBox.Canvas.Handle);
SetStretchBltMode(PaintBox.Canvas.Handle, STRETCH_DELETESCANS);
case ViewMode of
vmStretch:
with bmi.bminfo.bmiHeader  do
i := StretchDIBits(PaintBox.Canvas.Handle,0,0,PaintBox.Height,PaintBox.Width,
 0,0,biWidth,Abs(biHeight),
 Bits, pBitmapInfo(@bmi.bminfo)^, DIB_RGB_COLORS,
 PaintBox.Canvas.CopyMode);
vm1x1:
with bmi.bminfo.bmiHeader,PaintBox.ClientRect  do
i := SetDIBitsToDevice(PaintBox.Canvas.Handle,Left,Top,Right-Left,Bottom-Top,
 Left,Top,Top,Bottom-top,
 Bits, pBitmapInfo(@bmi.bminfo)^, DIB_RGB_COLORS);

vmZoom:
 with bmi.bminfo.bmiHeader,PaintBox.ClientRect do
 i := StretchDIBits(PaintBox.Canvas.Handle,Left,Top,Right-Left,Bottom-Top,
 0,0,biWidth,Abs(biHeight),
 Bits, pBitmapInfo(@bmi.bminfo)^, DIB_RGB_COLORS,
 PaintBox.Canvas.CopyMode);

end;

if (i=0) or (i=GDI_ERROR) then
  begin
  ec :=GetLastError;
  MainForm.Caption := "&#9580;°шсър "+IntToStr(ec);
  end;

SelectPalette(PaintBox.Canvas.Handle, OldP, False);
end;

procedure TMainForm.WholeButtonClick(Sender: TObject);
var px,py, sx,sy : Integer;
kx, ky : single;
begin
if not Assigned(Bits) then Exit;
ViewMode := vmStretch;
px := PaintBox.Parent.ClientWidth - 1;
py := PaintBox.Parent.ClientHeight - 1;
sx := bmi.bminfo.bmiHeader.biWidth;
sy := Abs(bmi.bminfo.bmiHeader.biHeight);
kx := px / sx; ky := py / sy;
if kx > ky then
 begin
 PaintBox.Width := Round ( sx * ky );
 PaintBox.Height := py;
 end
else
 begin
 PaintBox.Width := px;
 PaintBox.Height := Round ( sy * kx );
 end;
end;

procedure TMainForm.V1x1ButtonClick(Sender: TObject);
begin
if not Assigned(Bits) then Exit;
ViewMode := vm1x1;
PaintBox.Width := bmi.bminfo.bmiHeader.biWidth;
PaintBox.Height := Abs(bmi.bminfo.bmiHeader.biHeight);
end;

procedure TMainForm.ZoomButtonClick(Sender: TObject);
var x : single;
begin
if not Assigned(Bits) then Exit;
ViewMode := vmZoom;
x := Scales[ScaleComboBox.ItemIndex];
PaintBox.Width := Round(Integer(bmi.bminfo.bmiHeader.biWidth)*x);
PaintBox.Height := Round(Integer(Abs(bmi.bminfo.bmiHeader.biHeight))*x);
end;

procedure TMainForm.ExitItemClick(Sender: TObject);
begin
Close;
end;

procedure TMainForm.ScaleComboBoxChange(Sender: TObject);
begin
if ZoomToolButton.Down then ZoomButtonClick(Sender);
end;

end.

---

← →
Anatoly Podgoretsky ©   (2006-11-28 14:21) [16]

> ЮЮ  (28.11.2006 12:29:14)  [14]

> Максимальный размер картинки составляет 38000 x 38000 пикселей.

Я уже посчитал, это чуть меньше 6 ГИГАБАЙТ!!!

---

← →
ЮЮ ©   (2006-11-29 04:44) [17]

> Anatoly Podgoretsky ©   (28.11.06 14:21) [16]

Но он же как-то её выводит на Canvas PaintBox-а !!!
А проблема только в мерцании :).
Если с 6 ГИГАБАЙТ-ами справился, то на битмапик размеров с видимую часть PainBox-а раскошелится :)

---

← →
RASkov   (2006-11-29 07:46) [18]

> [0] Алик   (27.11.06 19:53)

С учетом [17],[0],[1]
попробуй так:

var bmp: TBitMap;

PaintBox сделай Align:=alClient и расположи его непосредственно на панели(форме), при желании добавь скролбары.
DoubleBuffered возможно убери.
на Create формы или где удобней создай bmp
bmp:=TBitMap.Create;
bmp.width:=PaintBox.width;
bmp.height:=PaintBox.height;

рисуй видимую область на этом Битмапе, а на OnPaint PaintBox"a выводи его на канву PaintBox
BitBlt(PaintBox.Canvas.Handle, 0, 0, bmp.width, bmp.height, bmp.Canvas.Handle, 0, 0, SRCCOPY);
И после того как закончишь рисовать на bmp делай PaintBox.Invalidate;

> Когда я произвожу перерисовку Canvas

Возможно тебе нужно bmp.CopyRect(bmp.Canvas.ClipRect, Cnvs, Rect(x, y, x+bmp.width, y+bmp.height));
Cnvs - канва откуда брать "кусок" изображения.
x и y - координаты "куска" на большой канве.
Хотя в этом варианте можно и без временного Битмапа. Вместо bmp следует указать PaintBox.

Может что и не учел, ну думаю суть ясна...

---

← →
Amoeba ©   (2006-11-29 11:01) [19]

А может лучше как в

> Amoeba ©   (28.11.06 12:45) [15]

и не надо никуда загружать всю картинку? С диска средствами API по мере необходимости считывается только та часть, которая будет видимой на экране.

---

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

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

Наверх

Память: 0.52 MB
Время: 0.054 c