Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.01.13;
Скачать: [xml.tar.bz2];

Вниз

Масштабирование канвы.   Найти похожие ветки 

 
European   (2003-12-24 18:26) [0]

Здравствуйте, господа!
У меня возникли некоторые затруднения, надеюсь, вы поможете в их разрешении.
Проблема состоит в следующем: имеется некоторая канва (неважно какая), мне необходимо показать её в TImage уже масштабированной. Попытался это сделать это с помощью функции StretchBlt, которая, как говорится в дельфийской помощи, позволяет это делать, однако изображение не масштабируется. По поводу функции StretchBlt сказано:
(* The StretchBlt function copies a bitmap from a source rectangle into a destination rectangle, stretching or compressing the bitmap to fit the dimensions of the destination rectangle, if necessary. Windows stretches or compresses the bitmap according to the stretching mode currently set in the destination device context. *) .
Если я правильно понял, то Windows растягивает или сжимает bitmap согласно режиму растяжения для целевого устройства. Что я из это должен для себя уяснить?
Ниже приведён код для демонстрации примера.
Заранее благодарен.

procedure TForm1.Button1Click(Sender: TObject);
var
SrcBMP, DestBmp: TBitmap; r: longbool;
begin

SrcBMP:=TBitmap.Create; SrcBmp.Width:=200; SrcBmp.Height:=200;
DestBMP:=TBitmap.Create; DestBmp.Width:=100; DestBmp.Height:=200;

with SrcBmp.Canvas do
begin
Pen.Width:=3; MoveTo(0,0); LineTo(200,200); MoveTo(0,200); LineTo(200,0);
end;

r:=StretchBlt(DestBmp.Canvas.Handle, 0, 0, 200, 200,
SrcBMP.Canvas.Handle, 0, 0, 100, 200, SRCCOPY);
if r=false then ShowMessage(SysErrorMessage(GetLastError));

srcImage:= TImage.Create(self);
with srcImage do
begin
parent:=self; left:=10; top:=10; Width:=200; Height:=200; Picture.Bitmap:=SrcBMP;
end;

destImage:= TImage.Create(self);
with destImage do
begin
parent:=self; left:=220; top:=10; Width:=100; Height:=200; Picture.Bitmap:=DestBMP;
Stretch:=true;
end;

SrcBMP.Destroy; DestBmp.Destroy;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
srcImage.Destroy; destImage.Destroy;
end;


 
Автоответчик   (2003-12-24 21:28) [1]

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


 
romeo   (2003-12-24 22:52) [2]

r:=StretchBlt(DestBmp.Canvas.Handle, 0, 0, 100, 200,
SrcBMP.Canvas.Handle, 0, 0, 200, 200, SRCCOPY);


 
European   (2003-12-25 01:56) [3]

To Автоответчик:
Хорошего специалиста командами, написанными в одну строку не напугаешь. Об этом свидетельствует пример romeo. Всё заработало, за что ему огромное спасибо. Хотя вопрос форматирования кода дело уж очень личное.


 
Думкин   (2003-12-25 07:17) [4]

> [3] European (25.12.03 01:56)
Хотя вопрос форматирования кода дело уж очень личное

Когда он публикуется - он перестает быть личным делом.


 
European   (2003-12-25 13:45) [5]

Вопрос форматирования кода оставим для раздела "Потрепаться". Однако ваши замечания приму к сведению.


 
European   (2003-12-25 13:50) [6]

Исправляю ошибку и публикую код в более приглядном виде

procedure TForm1.Button1Click(Sender: TObject);
var
SrcBMP, DestBmp: TBitmap;
r: longbool;
begin

SrcBMP:=TBitmap.Create;
SrcBmp.Width:=200;
SrcBmp.Height:=200;

DestBMP:=TBitmap.Create;
DestBmp.Width:=100;
DestBmp.Height:=200;

with SrcBmp.Canvas do
begin
Pen.Width:=3;
MoveTo(0,0);
LineTo(200,200);
MoveTo(0,200);
LineTo(200,0);
end;

r:=StretchBlt(DestBmp.Canvas.Handle, 0, 0, 100, 200,
SrcBMP.Canvas.Handle, 0, 0, 200, 200, SRCCOPY);
if r=false then ShowMessage(SysErrorMessage(GetLastError));

srcImage:= TImage.Create(self);
with srcImage do
begin
parent:=self;
left:=10;
top:=10;
Width:=200;
Height:=200;
Picture.Bitmap:=SrcBMP;
end;

destImage:= TImage.Create(self);
with destImage do
begin
parent:=self;
left:=220;
top:=10;
Width:=100;
Height:=200;
Stretch:=true;
Picture.Bitmap:=DestBMP;
end;

SrcBMP.Destroy; DestBmp.Destroy;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
srcImage.Destroy;
destImage.Destroy;
end;

end.


 
European   (2003-12-25 13:51) [7]

Кстати, может кто подскажет ещё какие-нибудь способы, аналогичные вышеприведенному. Можно и ссылочкой помочь


 
Думкин   (2003-12-25 14:06) [8]

SetStretchBltMode - посмотри, для улучшения качества(на NT-системах).
И вообще http://g32.org/
там есть масштабирование и т.п.

.Destroy; - лучше Free. И для картинок лучше в блоке
try
finally
end


Если у тебя ошибка при блиттинге - показывается сообщение, а после независимо от результата - работа с изображениями, - какими?


 
Думкин   (2003-12-25 14:12) [9]

Но если стандартным для Дельфи образом - посмотри методы TCanvas.


 
European   (2003-12-25 14:14) [10]

to Думкин:
Насчёт Free принимается. Остальное также. Однако это код не из реальной программы. Просто отразил смысл проблемы. Если бы не это, никто бы в коде не захотел разбираться и не только из-за плохого форматирования.


 
European   (2003-12-26 20:06) [11]

Если я правильно понял, то StretchBlt может работать только с bmp. Попытался скопировать кусок с канвы Printer-a - не пошло. Подскажите как скопировать в bmp область канвы Printer.



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

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

Наверх




Память: 0.47 MB
Время: 0.014 c
14-37872
strupik
2003-10-10 17:47
2004.01.13
Компьютерные ИГРЫ и их будущее..


1-37630
Cyberjack
2003-12-27 19:18
2004.01.13
DHTMLEdit


1-37704
Крутыш
2003-12-24 22:17
2004.01.13
Как сделать обращение к MdiChild –форме из другой MdiChild-формы?


1-37674
Raduga
2003-12-26 13:53
2004.01.13
help по созданию сервисов Windows


1-37746
lovres
2003-12-30 08:58
2004.01.13
Где взять новую версию OLE?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский