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

Вниз

Рисование градиента   Найти похожие ветки 

 
hoper   (2003-01-17 23:24) [0]

очень хочется нарисовать прямоугольный чёрно-белый (светло-тёмно-серый) градиент, но столкнулся с некоторыми проблемами:
1. неужели 256 градаций серого - это предел (исходя из TColor)
2. можно ли это сделать эффективнее, чем Bitmap.Canvas.Pixels[i,j]:=color
3. (главное) как правильнее рисовать градиент при Bitmap.Width не явл. степенью 2
при 256 цветах, наверное, будут резкие переходы при некоторых width


 
vvvaaa   (2003-01-18 00:35) [1]

Посмотри чуть ниже я это уже спрашивал


 
hoper   (2003-01-18 01:44) [2]

спасибо vvvaaa, Hooch и, особенно, некто Михаил


 
hoper   (2003-01-18 01:46) [3]

а насчёт 256 цветов?


 
Danlicha   (2003-01-18 01:50) [4]

Так хватает, что и 128 хватило бы. Можешь быть спокоен. И переходов, даже если очень захочешь, не заметишь.


 
MBo   (2003-01-18 11:08) [5]

>неужели 256 градаций серого - это предел
Да, поскольку каждая составляющая цвета - один байт


 
Evgeny   (2003-01-18 12:33) [6]

>неужели 256 градаций серого - это предел
Существует еще 16-битные картинки в серых тонах, но для данного случая это слишком жирно.
Дополнительно.
Исходники градиентной заливки можно посмотреть в библиотеке RxLIB, файл VCLUtils.pas. Кстати, указанные выше исходники и есть упрощенный вариант из указанной библиотеки. На случай, если указанной библиотеки нет, в следующем сообщении код проседуры:



 
Evgeny   (2003-01-18 12:33) [7]

type
TFillDirection = (fdTopToBottom, fdBottomToTop, fdLeftToRight, fdRightToLeft);

function Max(A, B: Longint): Longint;
begin
if A > B then Result := A
else Result := B;
end;

function Min(A, B: Longint): Longint;
begin
if A < B then Result := A
else Result := B;
end;

function HeightOf(R: TRect): Integer;
begin
Result := R.Bottom - R.Top;
end;

function WidthOf(R: TRect): Integer;
begin
Result := R.Right - R.Left;
end;

{ Gradient fill procedure - displays a gradient beginning with a chosen }
{ color and ending with another chosen color. Based on TGradientFill }
{ component source code written by Curtis White, cwhite@teleport.com. }
procedure GradientFillRect(Canvas: TCanvas; ARect: TRect; StartColor,
EndColor: TColor; Direction: TFillDirection; Colors: Byte);
var
StartRGB: array[0..2] of Byte; { Start RGB values }
RGBDelta: array[0..2] of Integer; { Difference between start and end RGB values }
ColorBand: TRect; { Color band rectangular coordinates }
I, Delta: Integer;
Brush: HBrush;
begin
if IsRectEmpty(ARect) then Exit;
if Colors < 2 then begin
Brush := CreateSolidBrush(ColorToRGB(StartColor));
FillRect(Canvas.Handle, ARect, Brush);
DeleteObject(Brush);
Exit;
end;
StartColor := ColorToRGB(StartColor);
EndColor := ColorToRGB(EndColor);
case Direction of
fdTopToBottom, fdLeftToRight: begin
{ Set the Red, Green and Blue colors }
StartRGB[0] := GetRValue(StartColor);
StartRGB[1] := GetGValue(StartColor);
StartRGB[2] := GetBValue(StartColor);
{ Calculate the difference between begin and end RGB values }
RGBDelta[0] := GetRValue(EndColor) - StartRGB[0];
RGBDelta[1] := GetGValue(EndColor) - StartRGB[1];
RGBDelta[2] := GetBValue(EndColor) - StartRGB[2];
end;
fdBottomToTop, fdRightToLeft: begin
{ Set the Red, Green and Blue colors }
{ Reverse of TopToBottom and LeftToRight directions }
StartRGB[0] := GetRValue(EndColor);
StartRGB[1] := GetGValue(EndColor);
StartRGB[2] := GetBValue(EndColor);
{ Calculate the difference between begin and end RGB values }
{ Reverse of TopToBottom and LeftToRight directions }
RGBDelta[0] := GetRValue(StartColor) - StartRGB[0];
RGBDelta[1] := GetGValue(StartColor) - StartRGB[1];
RGBDelta[2] := GetBValue(StartColor) - StartRGB[2];
end;
end; {case}
{ Calculate the color band"s coordinates }
ColorBand := ARect;
if Direction in [fdTopToBottom, fdBottomToTop] then begin
Colors := Max(2, Min(Colors, HeightOf(ARect)));
Delta := HeightOf(ARect) div Colors;
end
else begin
Colors := Max(2, Min(Colors, WidthOf(ARect)));
Delta := WidthOf(ARect) div Colors;
end;
with Canvas.Pen do begin { Set the pen style and mode }
Style := psSolid;
Mode := pmCopy;
end;
{ Perform the fill }
if Delta > 0 then begin
for I := 0 to Colors do begin
case Direction of
{ Calculate the color band"s top and bottom coordinates }
fdTopToBottom, fdBottomToTop: begin
ColorBand.Top := ARect.Top + I * Delta;
ColorBand.Bottom := ColorBand.Top + Delta;
end;
{ Calculate the color band"s left and right coordinates }
fdLeftToRight, fdRightToLeft: begin
ColorBand.Left := ARect.Left + I * Delta;
ColorBand.Right := ColorBand.Left + Delta;
end;
end; {case}
{ Calculate the color band"s color }
Brush := CreateSolidBrush(RGB(
StartRGB[0] + MulDiv(I, RGBDelta[0], Colors - 1),
StartRGB[1] + MulDiv(I, RGBDelta[1], Colors - 1),
StartRGB[2] + MulDiv(I, RGBDelta[2], Colors - 1)));
FillRect(Canvas.Handle, ColorBand, Brush);
DeleteObject(Brush);
end;
end;
if Direction in [fdTopToBottom, fdBottomToTop] then
Delta := HeightOf(ARect) mod Colors
else Delta := WidthOf(ARect) mod Colors;
if Delta > 0 then begin
case Direction of
{ Calculate the color band"s top and bottom coordinates }
fdTopToBottom, fdBottomToTop: begin
ColorBand.Top := ARect.Bottom - Delta;
ColorBand.Bottom := ColorBand.Top + Delta;
end;
{ Calculate the color band"s left and right coordinates }
fdLeftToRight, fdRightToLeft: begin
ColorBand.Left := ARect.Right - Delta;
ColorBand.Right := ColorBand.Left + Delta;
end;
end; {case}
case Direction of
fdTopToBottom, fdLeftToRight:
Brush := CreateSolidBrush(EndColor);
else {fdBottomToTop, fdRightToLeft }
Brush := CreateSolidBrush(StartColor);
end;
FillRect(Canvas.Handle, ColorBand, Brush);
DeleteObject(Brush);
end;
end;


 
hoper   (2003-01-21 03:10) [8]

> Evgeny
ух-ты, сажусь читать
>MBo
>Да, поскольку каждая составляющая цвета - один байт
я это.. как бы.. знаю (см. "исходя из TColor")



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

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

Наверх





Память: 0.47 MB
Время: 0.009 c
14-67552
MVVD
2003-04-04 16:11
2003.04.21
Почему не работает F1 в DELPHI6?


4-67610
MC.Daemon
2003-02-20 16:16
2003.04.21
Активизация процесса:


14-67483
Тих
2003-03-30 21:37
2003.04.21
ВОт такая вот статья


6-67414
matlash
2003-02-20 15:37
2003.04.21
Панель для MS Internet Explorer.


3-67131
Инна
2003-04-02 18:08
2003.04.21
ADOQuery в цикле





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