256 Farben

[Blup]

Mal so zur Entspannung:

Delphi-Quellcode:

unit Main;

interface

uses
  Vcl.Graphics, Vcl.GraphUtil, Vcl.Forms, System.Classes, Vcl.Controls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private-Deklarationen }
    FColorArr: array of TColor;
    procedure DrawColorItem(ACanvas: TCanvas; x, y: Integer; AColor: TColor);
    procedure DrawColorTabelle(ACanvas: TCanvas; x0, y0: Integer);
    procedure InitColorArr;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitColorArr;
end;

procedure TForm1.DrawColorItem(ACanvas: TCanvas; x, y: Integer; AColor: TColor);
const
  {Größe des Quadrat}
  Cdx1 = 20;
  Cdy1 = 20;
  {relative Position der Schrift}
  Cdx2 = 24;
  Cdy2 = 02;
begin
  {Umrandung}
  ACanvas.Pen.Style := psSolid;
  ACanvas.Pen.Mode  := pmCopy;
  ACanvas.Pen.Color := clBlack;
  ACanvas.Pen.Width := 1;
  {Füllung}
  ACanvas.Brush.Style := bsSolid;
  ACanvas.Brush.Color := AColor;
  {Quadrat}
  ACanvas.Rectangle(x, y, x + Cdx1, y + Cdy1);

  {Hintergrund transparent}
  ACanvas.Brush.Style := bsClear;
  {Schrift}
  ACanvas.Font.Color := clBlack;
  ACanvas.Font.Size  := 9;
  ACanvas.Font.Name  := 'Courier New';
  ACanvas.TextOut(x + Cdx2, y + Cdy2, Copy(ColorToWebColorStr(ColorToRGB(AColor)), 2));
end;

procedure TForm1.DrawColorTabelle(ACanvas: TCanvas; x0, y0: Integer);
const
  {Breite der Spalten und Höhe der Zeilen}
  Cdx = 80;
  Cdy = 24;
var
  x, y, n: Integer;
begin
  n := 0;
  for x := 0 to 7 do
  begin
    if (x = 0) or (x = 7) then
    begin
      for y := 3 to 32 do
      begin
        DrawColorItem(PaintBox1.Canvas, x0 + x * Cdx, y0 + y * Cdy, FColorArr[n]);
        Inc(n);
      end;
    end
    else
    begin
      for y := 0 to 35 do
      begin
        DrawColorItem(PaintBox1.Canvas, x0 + x * Cdx, y0 + y * Cdy, FColorArr[n]);
        Inc(n);
      end;
    end;
  end;
end;

procedure TForm1.InitColorArr;
var
  i: Integer;
begin
  SetLength(FColorArr, 276);

  for i := Low(FColorArr) to High(FColorArr) do
    FColorArr[i] := TColor(Random(256*256*256));
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  DrawColorTabelle(PaintBox1.Canvas, 30, 10);
end;

end.