this slowpoke moves

Draw RGB Color Wall

private
	{ Private declarations }
    xm,ym : integer;
    BkColor : TColor;
    bm : TBitmap;
    
//

procedure TForm1.Init(Sender: TObject); // OnEvent Form.Activate
begin
  xm := PaintBox1.Width div 2;
  ym := PaintBox1.Height div 2;
  bm := TBitmap.Create;
  bm.Width := 2*xm;
  bm.Height := 2*ym;
  bm.Canvas.Brush.Color := clBtnFace;
  bm.Canvas.Rectangle (0, 0, bm.Width, bm.Height);
  bm.Canvas.Brush.Style := bsClear;    // keine Füllfarbe
end;

procedure TForm1.Strip(Sender: TObject);  // OnEvent PaintBox.OnPaint
var Red,Green,Blue : integer;
             f,s,x : integer;
begin
  BkColor := PaintBox1.Canvas.Pixels [xm,ym];  // Hintergrundfarbe merken
  for x:=0 to 359 do
    begin
      s := x div 60;
      f := round(255/60*(x-60*s));
      case s of
        0 : begin Red := 255; Green := 0; Blue := f end;
        1 : begin Red := 255-f; Green := 0; Blue := 255 end;
        2 : begin Red := 0; Green := f; Blue := 255 end;
        3 : begin Red := 0; Green := 255; Blue := 255-f end;
        4 : begin Red := f; Green := 255; Blue := 0 end;
       else begin Red := 255; Green := 255-f; Blue := 0 end;
      end;
      bm.Canvas.Pen.Color := 65536*Blue + 256*Green + Red;
      bm.Canvas.MoveTo (xm-180+x, ym-30);
      bm.Canvas.LineTo (xm-180+x, ym+35);
    end;
  PaintBox1.Canvas.Draw (0,0,bm);
end;

function Value (w: byte): string;
var s : string[5];
begin
  s := IntToStr (w);
  if w < 100 then s := '  ' + s;
  if w <  10 then s := '  ' + s;
  Value := s;
end;

// OnEvent PaintBox.OnMouseMove
procedure TForm1.GetRGB(Sender:TObject; Shift:TShiftState; x,y:integer);
var col, Rot,Gruen,Blau : integer;
begin
  col := PaintBox1.Canvas.Pixels [x,y];
  Rot := col and $FF;
  Gruen := (col and $FF00) shr 8;
  Blau := col shr 16;
  if col = BkColor then Panel1.Caption := ''
                   else Panel1.Caption := 'R:' + Value(Rot) + '   G:' + Value(Gruen) + '   B:' + Value(Blau);
end;

procedure TForm1.Exit(Sender: TObject; var Action: TCloseAction);
begin
  bm.Free
end;


Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate