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 CMY - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 2
SłabyŚwietny
Nadesłany przez Tomasz Lubiński, 06 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.

CMY - Delphi/Unit1.pas:
// Model CMY
// 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;
    CVal: TEdit;
    MVal: TEdit;
    YVal: TEdit;
    CButton: TRadioButton;
    MButton: TRadioButton;
    YButton: TRadioButton;
    GroupBox3: TGroupBox;
    AllLayers: TImage;
    LayerC: TImage;
    LayerM: TImage;
    LayerY: 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 CButtonClick(Sender: TObject);
    procedure MButtonClick(Sender: TObject);
    procedure YButtonClick(Sender: TObject);
    procedure CValChange(Sender: TObject);
    procedure MValChange(Sender: TObject);
    procedure YValChange(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 cmy2rgb(c: Integer; m: Integer; y: Integer; var r: Integer; var g: Integer; var b: Integer);
begin
        r := 255 - c;
        g := 255 - m;
        b := 255 - y;
end;

procedure rgb2cmy(var c: Integer; var m: Integer; var y: Integer; r: Integer; g: Integer; b: Integer);
begin
        c := 255 - r;
        m := 255 - g;
        y := 255 - b;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
   r, g, b, c, m, y, 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
         m := side;
         y := Round(side - (255.0/width) * i * side_sign);
         c := Round(side - (255.0/width) * j * side_sign);
         CMY2RGB(c, m, y, r, g, b);
         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
         c := 255 - side;
         y := Round(side - (255.0/width) * i * side_sign);
         m := Round(side - (255.0/(width/2)) * j * side_sign);
         CMY2RGB(c, m, y, r, g, b);
         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
         y := 255 - side;
         m := Round(side - (255.0/(width/2)) * i * side_sign);
         c := Round(side - (255.0/width) * j * side_sign);
         CMY2RGB(c, m, y, r, g, b);
         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, 'Y');

   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, 'C');

   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, 'M');
end;

procedure TForm1.ReDrawProbe(Sender: TObject);
var
   r, g, b, c, m, y, i, j: Integer;
begin
   c := StrToInt(CVal.Text);
   m := StrToInt(MVal.Text);
   y := StrToInt(YVal.Text);
   CMY2RGB(c, m, y, r, g, b);
   ProbeSmall.Canvas.Brush.Color := clWhite;
   ProbeSmall.Canvas.Rectangle(0, 0, ProbeSmall.Width, ProbeSmall.Height);

   if (CButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         c := i;
         CMY2RGB(c, m, y, r, g, b);
         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 (MButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         m := i;
         CMY2RGB(c, m, y, r, g, b);
         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 (YButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         y := i;
         CMY2RGB(c, m, y, r, g, b);
         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;

   c := StrToInt(CVal.Text);
   m := StrToInt(MVal.Text);
   y := StrToInt(YVal.Text);

   ProbeLarge.Canvas.Brush.Color := clWhite;
   ProbeLarge.Canvas.Rectangle(0, 0, ProbeLarge.Width, ProbeLarge.Height);

   if (CButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         for j:=0 to 255 do
         begin
            m := i;
            y := 255-j;
            CMY2RGB(c, m, y, r, g, b);
            ProbeLarge.Canvas.Pixels[i, 255-j] := r + (g shl 8) + (b shl 16);
         end;
      end;
   end
   else if (MButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         for j:=0 to 255 do
         begin
            c := i;
            y := 255-j;
            CMY2RGB(c, m, y, r, g, b);
            ProbeLarge.Canvas.Pixels[i, 255-j] := r + (g shl 8) + (b shl 16);
         end;
      end;
   end
   else if (YButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         for j:=0 to 255 do
         begin
            c := i;
            m := 255-j;
            CMY2RGB(c, m, y, r, g, b);
            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, c, m, y: Integer;
begin
   c := StrToInt(CVal.Text);
   m := StrToInt(MVal.Text);
   y := StrToInt(YVal.Text);
   CMY2RGB(c, m, y, r, g, b);
   Probe.Canvas.Brush.Color := r + (g shl 8) + (b shl 16);
   Probe.Canvas.Rectangle(0, 0, Probe.Width, Probe.Height);

   if (CButton.Checked) then
   begin
      ProbeSmall.Canvas.Ellipse(5, c-3, 13, c+3);
      ProbeLarge.Canvas.Ellipse(m-3, y-3, m+3, y+3);
   end
   else if (MButton.Checked) then
   begin
      ProbeSmall.Canvas.Ellipse(5, m-3, 13, m+3);
      ProbeLarge.Canvas.Ellipse(c-3, y-3, c+3, y+3);
   end
   else if (YButton.Checked) then
   begin
      ProbeSmall.Canvas.Ellipse(5, y-3, 13, y+3);
      ProbeLarge.Canvas.Ellipse(c-3, m-3, c+3, m+3);
   end;
end;

procedure TForm1.CButtonClick(Sender: TObject);
begin
     ReDrawProbe(Sender);
end;

procedure TForm1.MButtonClick(Sender: TObject);
begin
     ReDrawProbe(Sender);     
end;

procedure TForm1.YButtonClick(Sender: TObject);
begin
     ReDrawProbe(Sender);
end;

procedure TForm1.CValChange(Sender: TObject);
begin
     ReDrawProbe(Sender);
end;

procedure TForm1.MValChange(Sender: TObject);
begin
     ReDrawProbe(Sender);
end;

procedure TForm1.YValChange(Sender: TObject);
begin
     ReDrawProbe(Sender);
end;

procedure TForm1.ProbeLargeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if (CButton.Checked) then
   begin
      MVal.Text := IntToStr(X);
      YVal.Text := IntToStr(Y);
   end
   else if (MButton.Checked) then
   begin
      CVal.Text := IntToStr(X);
      YVal.Text := IntToStr(Y);
   end
   else if (YButton.Checked) then
   begin
      CVal.Text := IntToStr(X);
      MVal.Text := IntToStr(Y);
   end;
end;

procedure TForm1.ProbeSmallMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if (CButton.Checked) then
   begin
      CVal.Text := IntToStr(Y);
   end
   else if (MButton.Checked) then
   begin
      MVal.Text := IntToStr(Y);
   end
   else if (YButton.Checked) then
   begin
      YVal.Text := IntToStr(Y);
   end;
end;

procedure TForm1.DrawLayers();
var
   color: TColor;
   r, g, b, c, m, y, 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);
          RGB2CMY(c, m, y, r, g, b);
          CMY2RGB(c, 0, 0, r, g, b);
          LayerC.Canvas.Pixels[i, j] := r + (g shl 8) + (b shl 16);
          CMY2RGB(0, m, 0, r, g, b);
          LayerM.Canvas.Pixels[i, j] := r + (g shl 8) + (b shl 16);
          CMY2RGB(0, 0, y, r, g, b);
          LayerY.Canvas.Pixels[i, j] := r + (g shl 8) + (b shl 16);
      end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
   ReDrawProbe(Sender);
   Button1Click(Sender);
   DrawLayers();
end;

end.
Dodaj komentarz