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

Вниз

Пропорциональный вывод изображения на екран   Найти похожие ветки 

 
Pesad   (2008-01-03 02:38) [0]

Доброго время суток уважаемые програмисты. У меня к вам такой вопрос. Как можно отмасштабировать картинку Bmp или Jpg, так как это делает Image1.Proportional:=true;, не используя компонент TImage
Заранее спасиба за ответ.


 
DiamondShark ©   (2008-01-03 17:18) [1]

StretchBlt


 
DVM ©   (2008-01-03 19:12) [2]


> DiamondShark ©   (03.01.08 17:18) [1]

и чем человеку поможет данная функция?


> Pesad

Изучи вот этот фрагмент:


function TImage.DestRect: TRect;
var
 w, h, cw, ch: Integer;
 xyaspect: Double;
begin
 w := Picture.Width;
 h := Picture.Height;
 cw := ClientWidth;
 ch := ClientHeight;
 if Stretch or (Proportional and ((w > cw) or (h > ch))) then
 begin
if Proportional and (w > 0) and (h > 0) then
begin
     xyaspect := w / h;
     if w > h then
     begin
       w := cw;
       h := Trunc(cw / xyaspect);
       if h > ch then  // woops, too big
       begin
         h := ch;
         w := Trunc(ch * xyaspect);
       end;
     end
     else
     begin
       h := ch;
       w := Trunc(ch * xyaspect);
       if w > cw then  // woops, too big
       begin
         w := cw;
         h := Trunc(cw / xyaspect);
       end;
     end;
   end
   else
   begin
     w := cw;
     h := ch;
   end;
 end;

 with Result do
 begin
   Left := 0;
   Top := 0;
   Right := w;
   Bottom := h;
 end;

 if Center then
OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
end;



 
MetalFan ©   (2008-01-03 20:31) [3]

а можно еще вот так:
function FitRectInRect( ASourceRect, ADestRect: TRect; ACenterRect: Boolean ): TRect;
var
 lsW, lsH, ldW, ldH, lnW, lnH: Integer;
 lcY, lcX, lc: Extended;
begin
 Result := ADestRect;
 if IsRectEmpty( ASourceRect ) or
    IsRectEmpty( ADestRect ) or
    EqualRect(ASourceRect, ADestRect) then exit;
 //исходная ширина/высота
 lsW := ASourceRect.Right - ASourceRect.Left;
 lsH := ASourceRect.Bottom - ASourceRect.Top;
 //размеры, во что вписываем
 ldW := ADestRect.Right - ADestRect.Left;
 ldH := ADestRect.Bottom - ADestRect.Top;
 //коэффициенты
 lcX := lsW / ldW;
 lcY := lsH / ldH;
 lc := Max( lcY, lcX );
 //размеры пропорционально уменьшенного исходного прямоугольника
 lnW := Round( lsW / lc );
 lnH := Round( lsH / lc );
 Result := ADestRect;
 Result.Right := Result.Left + lnW;
 Result.Bottom := Result.Top + lnH;

 if ACenterRect then
   OffsetRect( Result, (ldW - lnW) div 2, (ldH - lnH) div 2 );
end;


 
Pesad   (2008-01-03 21:24) [4]

Большое спасибо за ответы буду разбираться.

и чем человеку поможет данная функция?

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

Кстати, попутно еще один вопрос. Напиши, пожалуйста функцию Max(lcY, lcX);.


 
engine ©   (2008-01-03 21:30) [5]

> [4] Pesad   (03.01.08 21:24)
> Кстати, попутно еще один вопрос. Напиши, пожалуйста функцию
> Max(lcY, lcX);.

uses math;


 
DVM ©   (2008-01-03 21:31) [6]


> вот и понадобылась мне функция, которая могла бы пропорционально
> отмасштабировать изображение

StretchBlt тут не помошник. Она пропорций не вычислит.


> Напиши, пожалуйста функцию Max(lcY, lcX);.

uses Math;


 
Pesad   (2008-01-03 21:34) [7]

thx all :)


 
MetalFan ©   (2008-01-03 21:47) [8]

упс, да, забыл uses указать...
кстати, после написания на коленке, не тестил "центрование" прямоугольника... но на первый взгляд все д.б. норм


 
Pesad   (2008-01-03 22:10) [9]

Да вторая функция вроде работает на все 100. А вот первая ошибку выбрасывает. Может подскажете, что надо делать чтобы вкинув функцию function TImage.DestRect: TRect; на голую форму, она заработала. Я еще новичок. З такими сложными задачами еще не имел дела.


 
DVM ©   (2008-01-03 22:15) [10]


> А вот первая ошибку выбрасывает

Что за ошибку и куда она ее выбрасывает?

Эта функция - метод класса TImage, над ней было предложено подумать и разобраться как работает, а не просто копировать. По сути там то же самое, что и в [3].



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

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

Наверх





Память: 0.47 MB
Время: 0.007 c
2-1199083426
Mister
2007-12-31 09:43
2008.01.27
подключения ресурсного файла


3-1190408298
Kostafey
2007-09-22 00:58
2008.01.27
Использование таблиц и полей в качестве параметров хранимых про-


15-1198089746
serega
2007-12-19 21:42
2008.01.27
Установка


2-1198877639
mr1Andersen
2007-12-29 00:33
2008.01.27
txt


2-1198586565
Kolan
2007-12-25 15:42
2008.01.27
Запуск долгой операции через ADO, ошибка «Время ожидания вышло»&#133





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский