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

Вниз

Вопрос как раз в этотновый форум. :)   Найти похожие ветки 

 
.: Joiro :.   (2001-12-27 15:32) [0]

Приветствую вас, уважаемые знатоки вопросов по графике. :)

Итак, вопрос (или вернее ситуация):

Вот такой код:

procedure Something;
var
a,b,c : Smallint;
x1,y1 : Extended;
MC : TBitmap;
begin
MC := TBitmap.Create;
MC.Canvas.Brush.Color := clBlack;
MC.Width := 23;
MC.Height := 23;
c := 10;
for b := 0 to c do
begin
for a := 0 to 360 do
begin
x1 := b/2 * COS(a*Pi/180);
y1 := b * SIN(a*Pi/180);
MC.Canvas.Pixels[11+round(x1),11+round(y1)] := RGB(255-b*25,255-b*25,255-b*25);
end;
end;
// Тут есть причина для не использования Draw.
SG_MAIN.Canvas.CopyRect(Rect(0,0,23,23),MC.Canvas,Rect(0,0,23,23));
end;


То что там кое-что выглядит странно потому что попозже вместо чисел будут переменные. Что же там происходит?

Создается маска, которая будет дальше использоваться как что-то похожее на Brush"и в графических программах.

Код вроде работает, так в чём вопрос? Вопрос в том, что хотелось бы сгладить всё это дело. В профессиональных программах это красиво и гладко выглядит а тут есть ясно выдные переходы оттенков.

За идеи по оптимизации этого процесса тоже буду благодарен.


 
McSimm   (2001-12-27 16:10) [1]

Очень даже гладко и прилично выглядит. Может SG_MAIN имеет PixelFormat маленький, вроде pf8bit ?


 
.: Joiro :.   (2001-12-27 18:24) [2]

Мммм... работает и у меня в 24 битном режиме, но это не достаточно гладко. Я там немножко ошыбся и выставил код с изменениями - посмотрите, как выглядит если изменить

x1 := b/2 * COS(a*Pi/180);

на:

x1 := b * COS(a*Pi/180);

Круг весьма круглый, но переходы яркости не совсем устраивают.

Чтобы это яснее видеть можно строчку вывода изменить на такое:
SG_MAIN.Canvas.CopyRect(Rect(0,0,69,69),MC.Canvas,Rect(0,0,23,23));
При увеличении видно что не совсем гладко.

Я подумал о стандартном мэтоде создания картинки побольще и потом её уменщения суммируя точки и находя средние значения, но это громоздко и может быть медленно.

Может есть какие-нибудь идеи?


 
.: Joiro :.   (2001-12-27 19:03) [3]

Так, я тут поработал над мэтодом с другой картинкой побольше. Результат уже лучше (вот ЭТО гладкие переходы), но всегда темнее (наверное вина округления чисел) и также (и это плохо) не точные краски (слегка, но всё же) по сторонам. Также я уверен что сделал это очень не оптимально (чайник всё же). Теперь может будут какие-нибудь идеи для этого варианта?


var
Form1: TForm1;

type PSquare = Array[0..8] of Byte;

implementation

{$R *.dfm}

Function GetBrightnessX(Color:TColor):Byte;
var
r,g,b : Byte;
begin
Color:=ColorToRGB(Color);
r:=GetRValue(Color);
g:=GetGValue(Color);
b:=GetBValue(Color);
Result := (r+b+g) div 9;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
a,b,c,d : Smallint;
x1,y1 : Extended;
MC1,MC2 : TBitmap;
Koala : PSquare;
begin
MC1 := TBitmap.Create;
MC2 := TBitmap.Create;
MC1.Canvas.Brush.Color := clBlack;
MC2.Canvas.Brush.Color := clBlack;
MC1.Width := 69;
MC1.Height := 69;
MC2.Width := 23;
MC2.Height := 23;
c := 30;
for b := 0 to c do
begin
for a := 0 to 360 do
begin
x1 := b * COS(a*Pi/180);
y1 := b * SIN(a*Pi/180);
MC1.Canvas.Pixels[34+round(x1),34+round(y1)] := RGB(255-b*8,255-b*8,255-b*8);
end;
end;
d := 0;
for b := 0 to 22 do
begin
for a := 0 to 22 do
begin
Koala[0] := GetBrightnessX(MC1.Canvas.Pixels[b*3,a*3]);
Koala[1] := GetBrightnessX(MC1.Canvas.Pixels[b*3+1,a*3]);
Koala[2] := GetBrightnessX(MC1.Canvas.Pixels[b*3+2,a*3]);
Koala[3] := GetBrightnessX(MC1.Canvas.Pixels[b*3,a*3+1]);
Koala[4] := GetBrightnessX(MC1.Canvas.Pixels[b*3+1,a*3+1]);
Koala[5] := GetBrightnessX(MC1.Canvas.Pixels[b*3+2,a*3+1]);
Koala[6] := GetBrightnessX(MC1.Canvas.Pixels[b*3,a*3+2]);
Koala[7] := GetBrightnessX(MC1.Canvas.Pixels[b*3+1,a*3+2]);
Koala[8] := GetBrightnessX(MC1.Canvas.Pixels[b*3+2,a*3+2]);
for c := 0 to 8 do
d := d + Koala[c];
d := d div 5;
MC2.Canvas.Pixels[a,b]:=RGB(d,d,d);
end;
end;
Form1.Canvas.CopyRect(Rect(0,0,69,69),MC2.Canvas,Rect(0,0,23,23));
Form1.Canvas.CopyRect(Rect(0,69,23,92),MC2.Canvas,Rect(0,0,23,23));
Form1.Canvas.CopyRect(Rect(69,0,138,69),MC1.Canvas,Rect(0,0,69,69));
end;



 
.: Joiro :.   (2001-12-27 20:36) [4]

Даа... получается почти монолог... :) Sorry.

Ну, ничего - поработал ещё с этой штуковиной и получил правильное (симметричное) распределение красок и весьма точный перенос яркости.
Чтобы попробовать на форме должен находится Scrollbar.

Теперь только остаётся вопрос о эффективности и оптимальности. Есть идеи?

unit A;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
ScrollBar1: TScrollBar;
procedure ScrollBar1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ScrollBar1Change(Sender: TObject);
var
a,b,c,d,e,f : Smallint;
x1,y1,cr,cg,cb,u : Extended;
MC1,MC2 : TBitmap;
Color : TColor;
begin
MC1 := TBitmap.Create;
MC2 := TBitmap.Create;
MC1.Canvas.Brush.Color := clBlack;
MC2.Canvas.Brush.Color := clBlack;
MC1.Width := 69;
MC1.Height := 69;
MC2.Width := 23;
MC2.Height := 23;
c := ScrollBar1.Position *3;
u := 240/c;
for b := 0 to c do
begin
for a := 0 to 360 do
begin
d := 250-b*Round(u);
x1 := b * COS(a*Pi/180);
y1 := b * SIN(a*Pi/180);
MC1.Canvas.Pixels[34+round(x1),34+round(y1)] := rgb(d,d,d);
end;
end;

for b := 0 to 22 do
begin
for a := 0 to 22 do
begin
cr := 0;
cg := 0;
cb := 0;
for f := 0 to 2 do
begin
for e := 0 to 2 do
begin
Color := MC1.Canvas.Pixels[a*3+e,b*3+f];
Color:=ColorToRGB(Color);
cr:= cr+GetRValue(Color);
cg:= cg+GetGValue(Color);
cb:= cb+GetBValue(Color);
end;
end;
cr := cr/9;
cg := cg/9;
cb := cb/9;
MC2.Canvas.Pixels[a,b] := RGB(Round(cr),Round(cg),Round(cb));
end;
end;
Form1.Canvas.CopyRect(Rect(0,0,69,69),MC2.Canvas,Rect(0,0,23,23));
Form1.Canvas.CopyRect(Rect(69,0,138,69),MC1.Canvas,Rect(0,0,69,69));
MC1.Free;
MC2.Free;
end;

end.


 
.: Joiro :.   (2001-12-29 12:47) [5]

Да, похоже тут всегда надо бампнуть как следует пост чтобы что-то появилось. :) Ну, попробуем - не бейте по голове если уж очень надоедаю.

Итак - последний вариант работает нормально и выглядит нормально, но мне кажется что можно как-то оптимизировать это дело. Есть идеи на этот счёт? Плз?



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

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

Наверх




Память: 0.47 MB
Время: 0.005 c
1-97229
Dr.Pipe
2002-05-19 15:44
2002.05.30
А можно изменить значение формы. Та, которая не главная - на глав


1-97269
Как сделать?
2002-05-18 13:33
2002.05.30
Рисую содержимое PaintBox в Image, пытаюсь сохранить и ничего???


1-97312
Ross
2002-05-19 15:24
2002.05.30
Добавить свой пункт в PopupMenu Microsoft Word


3-97196
kserg@ukr.net
2002-05-07 17:36
2002.05.30
Кто работал с данными типа Time - подскажите


3-97182
LVG
2002-04-30 07:36
2002.05.30
BLOB поля





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