algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Model RGB - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 1
SłabyŚwietny
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.
Dodaj komentarz