Текущий архив: 2002.05.30;
Скачать: CL | DM;

Вниз

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

← →
.: 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 вся ветка

Текущий архив: 2002.05.30;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.011 c