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.