Nadesłany przez Tomasz Lubiński, 05 listopada 2007 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
RGB - Delphi/Unit1.pas:
// Model RGB
// www.algorytm.org
// (c)2007 by Tomasz Lubinski
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Math;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Model: TImage;
Label1: TLabel;
Button1: TButton;
WidthVal: TEdit;
GroupBox2: TGroupBox;
ProbeLarge: TImage;
ProbeSmall: TImage;
Probe: TImage;
RVal: TEdit;
GVal: TEdit;
BVal: TEdit;
RButton: TRadioButton;
GButton: TRadioButton;
BButton: TRadioButton;
GroupBox3: TGroupBox;
AllLayers: TImage;
LayerR: TImage;
LayerG: TImage;
LayerB: TImage;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
white: TRadioButton;
black: TRadioButton;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure ReDrawProbe(Sender: TObject);
procedure ReDrawRectangle(Sender: TObject);
procedure RButtonClick(Sender: TObject);
procedure GButtonClick(Sender: TObject);
procedure BButtonClick(Sender: TObject);
procedure RValChange(Sender: TObject);
procedure GValChange(Sender: TObject);
procedure BValChange(Sender: TObject);
procedure ProbeLargeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ProbeSmallMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormActivate(Sender: TObject);
procedure DrawLayers();
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
r, g, b, width, shift_x, shift_y, side, side_sign, i, j: Integer;
begin
Model.Canvas.Brush.Color := clWhite;
Model.Canvas.Rectangle(0, 0, Model.Width, Model.Height);
width := StrToInt(WidthVal.Text);
shift_x := Model.Width div 2 - Round(width / 1.5);
shift_y := Round(width * 1.5 + 50);
if (black.Checked) then
begin
side := 0;
side_sign := -1;
end
else
begin
side := 255;
side_sign := 1;
end;
for i:=0 to width-1 do
for j:=0 to width-1 do
begin
g := side;
b := Round(side - (255.0/width) * i * side_sign);
r := Round(side - (255.0/width) * j * side_sign);
if (i=0) or (j=0) or (j = width -1) then
begin
g := 0;
b := 0;
r := 0;
end;
Model.Canvas.Pixels[i+shift_x, shift_y-j] := r + (g shl 8) + (b shl 16);
end;
for i:=0 to width-1 do
for j:=0 to (width div 2)-1 do
begin
r := 255 - side;
b := Round(side - (255.0/width) * i * side_sign);
g := Round(side - (255.0/(width/2)) * j * side_sign);
if (i=0) or (i = width -1) or (j = (width div 2)-1) then
begin
g := 0;
b := 0;
r := 0;
end;
Model.Canvas.Pixels[i+j+shift_x, shift_y-j-width] := r + (g shl 8) + (b shl 16);
end;
for i:=0 to (width div 2)-1 do
for j:=0 to width-1 do
begin
b := 255 - side;
g := Round(side - (255.0/(width/2)) * i * side_sign);
r := Round(side - (255.0/width) * j * side_sign);
if (i=0) or (j=0) or (i = (width div 2)-1) then
begin
g := 0;
b := 0;
r := 0;
end;
Model.Canvas.Pixels[i+shift_x+width, shift_y-j-i-1] := r + (g shl 8) + (b shl 16);
end;
Model.Canvas.MoveTo(shift_x, shift_y + 20);
Model.Canvas.LineTo(shift_x + width, shift_y + 20);
Model.Canvas.LineTo(shift_x + width - 5, shift_y + 15);
Model.Canvas.MoveTo(shift_x + width, shift_y + 20);
Model.Canvas.LineTo(shift_x + width - 5, shift_y + 25);
Model.Canvas.TextOut(shift_x + 10, shift_y + 7, 'B');
Model.Canvas.MoveTo(shift_x - 20, shift_y);
Model.Canvas.LineTo(shift_x - 20, shift_y - width);
Model.Canvas.LineTo(shift_x - 25, shift_y - width + 5);
Model.Canvas.MoveTo(shift_x - 20, shift_y - width);
Model.Canvas.LineTo(shift_x - 15, shift_y - width + 5);
Model.Canvas.TextOut(shift_x - 15, shift_y - 20, 'R');
Model.Canvas.MoveTo(shift_x + width + 2, shift_y + 18);
Model.Canvas.LineTo(Round(shift_x + width * 1.5 + 2), shift_y + 18 - width div 2);
Model.Canvas.LineTo(Round(shift_x + width * 1.5 - 5), shift_y + 18 - width div 2);
Model.Canvas.MoveTo(Round(shift_x + width * 1.5 + 2), shift_y + 18 - width div 2);
Model.Canvas.LineTo(Round(shift_x + width * 1.5 + 2), shift_y + 25 - width div 2);
Model.Canvas.TextOut(shift_x + width + 10, shift_y - 10, 'G');
end;
procedure TForm1.ReDrawProbe(Sender: TObject);
var
r, g, b, i, j: Integer;
begin
r := StrToInt(RVal.Text);
g := StrToInt(GVal.Text);
b := StrToInt(BVal.Text);
ProbeSmall.Canvas.Brush.Color := clWhite;
ProbeSmall.Canvas.Rectangle(0, 0, ProbeSmall.Width, ProbeSmall.Height);
if (RButton.Checked) then
begin
for i:=0 to 255 do
begin
r := i;
ProbeSmall.Canvas.Pixels[1, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[2, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[3, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[4, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[5, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[6, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[7, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[8, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[9, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[10, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[11, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[12, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[13, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[14, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[15, i] := r + (g shl 8) + (b shl 16);
end
end
else if (GButton.Checked) then
begin
for i:=0 to 255 do
begin
g := i;
ProbeSmall.Canvas.Pixels[1, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[2, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[3, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[4, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[5, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[6, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[7, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[8, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[9, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[10, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[11, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[12, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[13, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[14, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[15, i] := r + (g shl 8) + (b shl 16);
end
end
else if (BButton.Checked) then
begin
for i:=0 to 255 do
begin
b := i;
ProbeSmall.Canvas.Pixels[1, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[2, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[3, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[4, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[5, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[6, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[7, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[8, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[9, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[10, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[11, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[12, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[13, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[14, i] := r + (g shl 8) + (b shl 16);
ProbeSmall.Canvas.Pixels[15, i] := r + (g shl 8) + (b shl 16);
end
end;
r := StrToInt(RVal.Text);
g := StrToInt(GVal.Text);
b := StrToInt(BVal.Text);
ProbeLarge.Canvas.Brush.Color := clWhite;
ProbeLarge.Canvas.Rectangle(0, 0, ProbeLarge.Width, ProbeLarge.Height);
if (RButton.Checked) then
begin
for i:=0 to 255 do
begin
for j:=0 to 255 do
begin
g := i;
b := 255-j;
ProbeLarge.Canvas.Pixels[i, 255-j] := r + (g shl 8) + (b shl 16);
end;
end;
end
else if (GButton.Checked) then
begin
for i:=0 to 255 do
begin
for j:=0 to 255 do
begin
r := i;
b := 255-j;
ProbeLarge.Canvas.Pixels[i, 255-j] := r + (g shl 8) + (b shl 16);
end;
end;
end
else if (BButton.Checked) then
begin
for i:=0 to 255 do
begin
for j:=0 to 255 do
begin
r := i;
g := 255-j;
ProbeLarge.Canvas.Pixels[i, 255-j] := r + (g shl 8) + (b shl 16);
end;
end;
end;
ReDrawRectangle(Sender);
end;
procedure TForm1.ReDrawRectangle(Sender: TObject);
var
r, g, b: Integer;
begin
r := StrToInt(RVal.Text);
g := StrToInt(GVal.Text);
b := StrToInt(BVal.Text);
Probe.Canvas.Brush.Color := r + (g shl 8) + (b shl 16);
Probe.Canvas.Rectangle(0, 0, Probe.Width, Probe.Height);
if (RButton.Checked) then
begin
ProbeSmall.Canvas.Ellipse(5, r-3, 13, r+3);
ProbeLarge.Canvas.Ellipse(g-3, b-3, g+3, b+3);
end
else if (GButton.Checked) then
begin
ProbeSmall.Canvas.Ellipse(5, g-3, 13, g+3);
ProbeLarge.Canvas.Ellipse(r-3, b-3, r+3, b+3);
end
else if (BButton.Checked) then
begin
ProbeSmall.Canvas.Ellipse(5, b-3, 13, b+3);
ProbeLarge.Canvas.Ellipse(r-3, g-3, r+3, g+3);
end;
end;
procedure TForm1.RButtonClick(Sender: TObject);
begin
ReDrawProbe(Sender);
end;
procedure TForm1.GButtonClick(Sender: TObject);
begin
ReDrawProbe(Sender);
end;
procedure TForm1.BButtonClick(Sender: TObject);
begin
ReDrawProbe(Sender);
end;
procedure TForm1.RValChange(Sender: TObject);
begin
ReDrawProbe(Sender);
end;
procedure TForm1.GValChange(Sender: TObject);
begin
ReDrawProbe(Sender);
end;
procedure TForm1.BValChange(Sender: TObject);
begin
ReDrawProbe(Sender);
end;
procedure TForm1.ProbeLargeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (RButton.Checked) then
begin
GVal.Text := IntToStr(X);
BVal.Text := IntToStr(Y);
end
else if (GButton.Checked) then
begin
RVal.Text := IntToStr(X);
BVal.Text := IntToStr(Y);
end
else if (BButton.Checked) then
begin
RVal.Text := IntToStr(X);
GVal.Text := IntToStr(Y);
end;
end;
procedure TForm1.ProbeSmallMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (RButton.Checked) then
begin
RVal.Text := IntToStr(Y);
end
else if (GButton.Checked) then
begin
GVal.Text := IntToStr(Y);
end
else if (BButton.Checked) then
begin
BVal.Text := IntToStr(Y);
end;
end;
procedure TForm1.DrawLayers();
var
color: TColor;
r, g, b, i, j: Integer;
begin
for i:=0 to AllLayers.Width-1 do
for j:=0 to AllLayers.Height-1 do
begin
color := AllLayers.Canvas.Pixels[i, j];
r := (color and $FF);
g := ((color and $FF00) shr 8);
b := ((color and $FF0000) shr 16);
LayerR.Canvas.Pixels[i, j] := r;
LayerG.Canvas.Pixels[i, j] := g shl 8;
LayerB.Canvas.Pixels[i, j] := b shl 16;
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
ReDrawProbe(Sender);
Button1Click(Sender);
DrawLayers();
end;
end.

