this slowpoke moves

Draw Maxwell Color Triangle

Maxwell legte den Grundstein für die Farbwissenschaft, also die Fähigkeit, Farben quantitativ zu messen. Grundlage seiner Methode ist die Verwendung von drei Primärfarben, die in variablen Proportionen gemischt werden können, um die meisten anderen Farben zu erzeugen. Das Maxwell-Farbdreieck stellt diesen Prozess dar. Die Ecken des Dreiecks sind die Primärfarben; Punkte entlang der Dreieckskanten stellen Farben dar, die durch Mischen von zwei Primärfarben entstehen. Punkte innerhalb des Dreiecks stellen quantitativ die Farben dar, die durch Mischen der drei Primärfarben in unterschiedlichen Proportionen entstehen.

Es wird benötigt : 2xButton, 4xCheckBox, 1xComboBox (2 Einträge), 1xImage, 1xSavePictureDialog

uses
    Math,       // MaxValue
    Printers;   // Printer

private
    { Private declarations }
    BlueCorner :  TPoint;
    GreenCorner:  TPoint;
    RedCorner  :  TPoint;
    PROCEDURE UpdateEverything;
    
  TYPE
    TRGBTripleArray = ARRAY[0..PixelCountMax-1] OF TRGBTriple;
    pRGBTripleArray = ^TRGBTripleArray;
    
//

  PROCEDURE PrintBitmap(Canvas:  TCanvas; DestRect:  TRect;  Bitmap:  TBitmap);
    VAR
      BitmapHeader:  pBitmapInfo;
      BitmapImage :  POINTER;
      HeaderSize  :  DWORD;    // Use DWORD for compatibility with D3 and D4
      ImageSize   :  DWORD;
  BEGIN
    GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
    GetMem(BitmapHeader, HeaderSize);
    GetMem(BitmapImage,  ImageSize);
    TRY
      GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
      StretchDIBits(Canvas.Handle,
                    DestRect.Left, DestRect.Top,     // Destination Origin
                    DestRect.Right  - DestRect.Left, // Destination Width
                    DestRect.Bottom - DestRect.Top,  // Destination Height
                    0, 0,                            // Source Origin
                    Bitmap.Width, Bitmap.Height,     // Source Width & Height
                    BitmapImage,
                    TBitmapInfo(BitmapHeader^),
                    DIB_RGB_COLORS,
                    SRCCOPY)
    FINALLY
      FreeMem(BitmapHeader);
      FreeMem(BitmapImage)
    END
  END {PrintBitmap};


  //========================================================================


  FUNCTION CreateMaxwellTriangle(CONST size:  INTEGER;
                                 CONST TriangleIndex:  INTEGER;
                                 CONST xFlag, yFlag, zFlag:  BOOLEAN;
                                 CONST FillFlag:  BOOLEAN;
                                 VAR BlueCorner,
                                     GreenCorner,
                                     RedCorner:  TPoint):  TBitmap;
    TYPE
      TPosition = (posCenter, posXaxis, posYaxis);

    VAR
      i          :  INTEGER;
      iLeft      :  INTEGER;
      iRight     :  INTEGER;
      iR,iG,iB   :  INTEGER;
      j          :  INTEGER;
      jR,jG,jB   :  INTEGER;
      MaxFraction:  DOUBLE;
      Offset     :  INTEGER;
      row        :  pRGBTripleArray;
      s          :  STRING;
      x          :  DOUBLE;
      xMax       :  DOUBLE;
      y          :  DOUBLE;
      z          :  DOUBLE;

    PROCEDURE DecileLines (CONST Canvas:  TCanvas;
      CONST iMiddle, jMiddle, i1,j1, i2,j2:  INTEGER;
      CONST red, green, blue:  INTEGER;
      CONST Position:  TPosition);
      VAR
        k    :  INTEGER;
        iA,iB:  INTEGER;
        jA,jB:  INTEGER;
        s    :  STRING;
    BEGIN
      FOR k := 10 DOWNTO 0 DO
      BEGIN
        IF   FillFlag
        THEN Canvas.Pen.Color := clSilver
        ELSE Canvas.Pen.Color :=
               RGB( MulDiv(red,  10-k,10),
                    MulDiv(green,10-k,10),
                    MulDiv(blue, 10-k,10) );

        iA := iMiddle + MulDiv(i1-iMiddle, k, 10);
        iB := iMiddle + MulDiv(i2-iMiddle, k, 10);

        jA := jMiddle + MulDiv(j1-jMiddle, k, 10);
        jB := jMiddle + MulDiv(j2-jMiddle, k, 10);

        Canvas.MoveTo(iA,jA);
        Canvas.LineTo(iB,jB);

        IF   FillFlag
        THEN Canvas.Font.Color := clDkGray
        ELSE Canvas.Font.Color := RGB(red, green, blue);
        s := Format('%.1f', [ (10-k) / 10 ]);

        CASE Position OF
          posCenter:
            Canvas.TextOut((iA+iB) DIV 2 - Canvas.TextWidth(s)  DIV 2,
                         (jA+jB) DIV 2 - Canvas.TextHeight(s) DIV 2, s);

          posXaxis:
            Canvas.TextOut((iA+iB) DIV 2 - Canvas.TextWidth(s)  DIV 2,
                            jB + Canvas.TextHeight(s) DIV 4, s);

          posYaxis:
            Canvas.TextOut( iA - 3*Canvas.TextWidth(s) DIV 2,
                           (jA+jB) DIV 2 - Canvas.TextHeight(s) DIV 2, s);
        END;
      END
    END {DecileLines};

  BEGIN
    IF   TriangleIndex = 0          // Equilateral Triangle
    THEN BEGIN
      iB := MulDiv(Size,  2, 100);
      iR := MulDiv(Size, 98, 100);
      iG := MulDiv(Size, 50, 100);
      // Center top-to-bottom based on equilateral triangle
      Offset := Round(Size - (iR - iB)*SQRT(3)/2) DIV 2;
      jB := size - Offset;
      jR := size - Offset;
      jG := Offset;
    END
    ELSE BEGIN                      // Right Triangle
      iB := MulDiv(Size, 10, 100);
      iR := MulDiv(Size, 90, 100);
      iG := iB;

      jB := MulDiv(Size, 90, 100);
      jR := jB;
      jG := MulDiv(Size, 10, 100)
    END;

    RESULT := TBitmap.Create;
    RESULT.Width  := size;
    RESULT.Height := size;
    RESULT.PixelFormat := pf24bit;
    RESULT.Canvas.Brush.Color := clBtnFace;
    RESULT.Canvas.FillRect(RESULT.Canvas.ClipRect);
    RESULT.Canvas.Pen.Color := clWhite;
    RESULT.Canvas.MoveTo (iR,jR);
    RESULT.Canvas.LineTo (iG,jG);
    RESULT.Canvas.LineTo (iB,jB);
    RESULT.Canvas.LineTo (iR,jR);
    RESULT.Canvas.Brush.Style := bsClear;

    IF  FillFlag
    THEN BEGIN

      FOR j := jG TO jB DO
      BEGIN
        row := RESULT.Scanline[j];

        xMax := (j - jG) / (jB - jG);
        y := 1.0 - xMax;      //  y = 1.0 for j = jG; 0.0 for j = jB

        iLeft  := ROUND(iG + xMax*(iB - iG));
        iRight := ROUND(iG + xMax*(iR - iG));

        IF  iRight > iLeft
        THEN BEGIN

          FOR i := iLeft TO iRight DO
          BEGIN
            x := xMax * (i - iLeft) / (iRight - iLeft);
            z := 1.0 - x - y;

            // Given fractions x,y,z such that x + y + z = 1.0,
            // assign RGB components = 255 * fraction / max [x,y,z].
            // So, equal-energy white is (x,y,z) = (1/3, 1/3, 1/3),
            // which is converted to RGB color (255, 255, 255)

            maxFraction := MaxValue([x, y, z]);

            WITH row[i] DO
            BEGIN
               rgbtRed   := ROUND( 255 * x/maxFraction );
               rgbtGreen := ROUND( 255 * y/maxFraction );
               rgbtBlue  := ROUND( 255 * z/maxFraction );
            END
          END
        END
      END
    END;

    IF   xFlag
    THEN BEGIN
      RESULT.Canvas.Font.Height := MulDiv(size, 4, 100);
      IF   TriangleIndex = 0
      THEN BEGIN
        DecileLines (RESULT.Canvas, iR,jR, iG,jG, iB,jB, 255,   0,   0, posCenter);
        RESULT.Canvas.Font.Height := MulDiv(size, 6, 100);
        RESULT.Canvas.TextOut( (iB+iG) DIV 2 - 2*RESULT.Canvas.TextWidth('x'),
                               (jB+jG) DIV 2 - RESULT.Canvas.TextHeight('x'), 'x')
      END
      ELSE BEGIN
        DecileLines (RESULT.Canvas, iR,jR, iG,jG, iB,jB, 255,   0,   0, posXAxis);
        RESULT.Canvas.Font.Height := MulDiv(size, 6, 100);
        RESULT.Canvas.TextOut( (iB+iR) DIV 2,
                               MulDiv(Size,99,100) - RESULT.Canvas.TextHeight('x'),
                               'x')
      END
    END;

    IF   yFlag
    THEN BEGIN
      RESULT.Canvas.Font.Height := MulDiv(size, 4, 100);
      IF   TriangleIndex = 0
      THEN BEGIN
        DecileLines (RESULT.Canvas, iG,jG, iB,jB, iR,jR,   0, 255,   0, posCenter);
        RESULT.Canvas.Font.Height := MulDiv(size, 6, 100);
        RESULT.Canvas.TextOut( (iB+iR) DIV 2 - RESULT.Canvas.TextWidth('y') DIV 2,
                               (jB+jR) DIV 2, 'y')
      END
      ELSE BEGIN
        DecileLines (RESULT.Canvas, iG,jG, iB,jB, iR,jR,   0, 255,   0, posYaxis);
        RESULT.Canvas.Font.Height := MulDiv(size, 6, 100);
        RESULT.Canvas.TextOut( MulDiv(Size, 1,100),
                               (jG + jR) DIV 2 - RESULT.Canvas.TextHeight('y') DIV 2,
                               'y')
      END
    END;

    IF   zFlag
    THEN BEGIN
      RESULT.Canvas.Font.Height := MulDiv(size, 4, 100);
      DecileLines (RESULT.Canvas, iB,jB, iG,jG, iR,jR,   0,   0, 255, posCenter);
      RESULT.Canvas.Font.Height := MulDiv(size, 6, 100);
      RESULT.Canvas.TextOut( (iG+iR) DIV 2 + RESULT.Canvas.TextWidth('z'),
                             (jG+jR) DIV 2 - RESULT.Canvas.TextHeight('z'),  'z');
    END;

    RESULT.Canvas.Font.Height := MulDiv(size, 6, 100);

    RESULT.Canvas.Font.Color := clRed;
    s := 'Red';
    IF   TriangleIndex = 0
    THEN i := iR - RESULT.Canvas.TextWidth(s)
    ELSE i := iR - RESULT.Canvas.TextWidth(s) DIV 2;
    RESULT.Canvas.TextOut(i, jR + RESULT.Canvas.TextHeight(s) DIV 2,  s);

    RESULT.Canvas.Font.Color := clLime;
    s := 'Green';
    IF   TriangleIndex = 0
    THEN i := iG - RESULT.Canvas.TextWidth(s) DIV 2
    ELSE i := MulDiv(Size,1,100);
    RESULT.Canvas.TextOut(i, jG - 3*RESULT.Canvas.TextHeight(s) DIV 2,  s);

    RESULT.Canvas.Font.Color := clBlue;
    s := 'Blue';
    IF   TriangleIndex = 0
    THEN i := iB
    ELSE i := MulDiv(Size,1,100);
    RESULT.Canvas.TextOut(i, jB + RESULT.Canvas.TextHeight(s) DIV 2,  s);

    BlueCorner  := Point(iB, jB);
    GreenCorner := Point(iG, jG);
    RedCorner   := Point(iR, jR)
  END {CreateMaxwellTriangle};


  //========================================================================

PROCEDURE TFormMaxwellTriangle.UpdateEverything;
  VAR
    Bitmap:  TBitmap;
BEGIN
  Bitmap := CreateMaxwellTriangle(Image.Width,
                ComboBoxTriangle.ItemIndex,
                CheckBoxDecileX.Checked,
                CheckBoxDecileY.Checked,
                CheckBoxDecileZ.Checked,
                CheckBOxFill.Checked,
                BlueCorner, GreenCorner, RedCorner);
  TRY
    Image.Picture.Graphic := Bitmap;
  FINALLY
    Bitmap.Free
  END;
END;

procedure TFormMaxwellTriangle.FormCreate(Sender: TObject);
begin
  ComboBoxTriangle.ItemIndex := 0;
  UpdateEverything
end;

procedure TFormMaxwellTriangle.CheckBoxClick(Sender: TObject);
begin
  UpdateEverything
end;

procedure TFormMaxwellTriangle.ButtonSaveToFileClick(Sender: TObject);
  CONST
    ImageSizeForFile = 512;
  VAR
    Bitmap     :  TBitmap;
    BlueCorner :  TPoint;    // dont use points that MouseMove knows about
    GreenCorner:  TPoint;
    RedCorner  :  TPoint;
BEGIN
  IF   SavePictureDialog.Execute
  THEN BEGIN
    Bitmap := CreateMaxwellTriangle(ImageSizeForFile,
                                    ComboBoxTriangle.ItemIndex,
                                    CheckBoxDecileX.Checked,
                                    CheckBoxDecileY.Checked,
                                    CheckBoxDecileZ.Checked,
                                    CheckBoxFill.Checked,
                                    BlueCorner, GreenCorner, RedCorner);

    TRY
      Bitmap.SavetoFile(SavePictureDialog.Filename);
      ShowMessage('File ' + SavePictureDialog.Filename + ' written.')
    FINALLY
      Bitmap.Free
    END

  END
end;

procedure TFormMaxwellTriangle.ButtonPrintClick(Sender: TObject);
CONST
    ImageSizeForFile = 1024;
    iMargin =  8;  //  8% margin left and right
    jMargin = 10;  // 10% margin top and bottom

  VAR
    Bitmap             :  TBitmap;
    BlueCorner         :  TPoint;   // dont use points that MouseMove knows about
    GreenCorner        :  TPoint;
    iFromLeftMargin    :  INTEGER;
    iPrintedImageWidth :  INTEGER;
    jFromPageMargin    :  INTEGER;
    jPrintedImageHeight:  INTEGER;
    RedCorner          :  TPoint;
    s                  :  STRING;
    TargetRectangle    :  TRect;
begin
  Printer.Orientation := poPortrait;

  Bitmap := CreateMaxwellTriangle(ImageSizeForFile,
                                  ComboBoxTriangle.ItemIndex,
                                  CheckBoxDecileX.Checked,
                                  CheckBoxDecileY.Checked,
                                  CheckBoxDecileZ.Checked,
                                  CheckBoxFill.Checked,
                                  BlueCorner, GreenCorner, RedCorner);
  TRY
    Printer.BeginDoc;
    TRY
      iFromLeftMargin := MulDiv(Printer.PageWidth,  iMargin, 100);
      jFromPageMargin := MulDiv(Printer.PageHeight, jMargin, 100);

      iPrintedImageWidth  := MulDiv(Printer.PageWidth, 100-2*iMargin, 100);
      jPrintedImageHeight := iPrintedImageWidth;  // Aspect ratio is 1 for these images

      TargetRectangle := Rect(iFromLeftMargin, jFromPageMargin,
                              iFromLeftMargin + iPrintedImageWidth,
                              jFromPageMargin + jPrintedImageHeight);

      // Header
      Printer.Canvas.Font.Size := 14;
      Printer.Canvas.Font.Name := 'Arial';
      Printer.Canvas.Font.Color := clBlack;
      Printer.Canvas.Font.Style := [fsBold];
      s := 'Maxwell Triangle';
      Printer.Canvas.TextOut(
        (Printer.PageWidth - Printer.Canvas.TextWidth(s)) DIV 2,  // center
        jFromPageMargin - 3*Printer.Canvas.TextHeight(s) DIV 2,
        s);

      // Bitmap
      PrintBitmap(Printer.Canvas, TargetRectangle, Bitmap);

      // Footer
      Printer.Canvas.Font.Size := 12;
      Printer.Canvas.Font.Name := 'Arial';
      Printer.Canvas.Font.Color := clBlue;
      Printer.Canvas.Font.Style := [fsBold, fsItalic];
      Printer.Canvas.TextOut(iFromLeftMargin,
                             Printer.PageHeight -
                             Printer.Canvas.TextHeight(s),
                             s);

      Printer.Canvas.Font.Style := [fsBold];
      Printer.Canvas.TextOut(Printer.PageWidth -
                             iFromLeftMargin   -
                             Printer.Canvas.TextWidth(s),
                             Printer.PageHeight -
                             Printer.Canvas.TextHeight(s),
                             s)
    FINALLY
      Printer.EndDoc
    END;

  FINALLY
    Bitmap.Free
  END;

  ShowMessage ('Image Printed')
end;


procedure TFormMaxwellTriangle.CheckBoxLabelsClick(Sender: TObject);
begin
  UpdateEverything
end;


procedure TFormMaxwellTriangle.FormMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  LabelRGB.Caption := ''
end;

procedure TFormMaxwellTriangle.ImageMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
  VAR
    a,b,c,d      :  Double;
    xChromaticity:  Double;
    yChromaticity:  Double;
    zChromaticity:  Double;
    RHS1,RHS2    :  Double;
    determinant  :  Double;
begin
  // Not worth optimizing this

  // 2-by-2 determinant coefficients
  a := RedCorner.X    - BlueCorner.X;
  b := GreenCorner.X  - BlueCorner.X;
  c := RedCorner.Y    - BlueCorner.Y;
  d := GreenCorner.Y  - BlueCorner.Y;
  determinant := a*d - b*c;

  IF   ABS(determinant) < 0.00001
  THEN BEGIN
    LabelRGB.Caption := 'Invalid Triangle Specified'
  END
  ELSE BEGIN
    RHS1 := X - BlueCorner.X;
    RHS2 := Y - BlueCorner.Y;

    xChromaticity := (RHS1 * d - RHS2 * b   ) / determinant;
    yChromaticity := (a * RHS2 - c    * RHS1) / determinant;
    zChromaticity := 1.0 - xChromaticity - yChromaticity;

    IF   (xChromaticity < 0.0) OR
         (yChromaticity < 0.0) OR
         (zChromaticity < 0.0)
    THEN LabelRGB.Caption := 'Outside of Gamut'
    ELSE  LabelRGB.Caption := Format('(x,y,z) = (%.3f,%.3f,%.3f)',
            [xChromaticity, yChromaticity, zChromaticity])
  END
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate