Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2008.01.27;
Скачать: CL | DM;

Вниз

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

 
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;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.016 c
15-1198055878
Kolan
2007-12-19 12:17
2008.01.27
Delphi не ищет в подпапках SearchPath.


15-1198163457
oldman
2007-12-20 18:10
2008.01.27
Разве так нельзя создавать образ диска?


15-1198017563
Dezigo
2007-12-19 01:39
2008.01.27
Калькулятор в строке


15-1198322066
homm
2007-12-22 14:14
2008.01.27
У меня счас крыша поедет


2-1197658894
Unicode
2007-12-14 22:01
2008.01.27
Как вводить символы Unicode в окно редактора кода и в приложения?