[lmikle]

Ну, только вот разве так:

Код:

unit Unit1;
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, XPMan;
 
type
TForm1 = class(TForm)
Panel1: TPanel;
BtnRectangle: TBitBtn;
BtnEllipse: TBitBtn;
BtnRoundRect: TBitBtn;
Panel2: TPanel;
editRed: TEdit;
editGreen: TEdit;
editBlue: TEdit;
RedUpDown: TUpDown;
GreenUpDown: TUpDown;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
sbRedScroll: TScrollBar;
sbGreenScroll: TScrollBar;
sbBlueScroll: TScrollBar;
shShape: TShape;
StatusBar1: TStatusBar;
blueUpDown: TUpDown;
XPManifest1: TXPManifest;
procedure FormCreate(Sender: TObject);
procedure FGK(n: TObject);
procedure sbScrollChange(Sender: TObject);
procedure BtnClick(Sender: TObject);
procedure editChange(Sender: TObject);
private
RedColor,GreenColor,BlueColor: TColor;
{ Private declarations }
public
{ Public declarations }
end;
 
var
Form1: TForm1;
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);

  procedure SetCntrls(AUpDown : TUpDown; AScrollBar : TScrollBar; AEdit : TEdit; AValue : TColor);
  begin
    AupDown.Position := AValue;
    AScrollBar.Position := AValue;
    AEdit.Text := IntToStr(AValue);
  end;
  
begin
  RedColor := 127;
  SetCntrls(redUpDown, sbRedScroll, editRed, RedColor);
 
  GreenColor := 127;
  SetCntrls(greenUpDown, sbGreenScroll, editGreen, GreenColor);
 
  BlueColor := 127;
  SetCntrls(blueUpDown, sbBlueScroll, editBlue, BlueColor);
 
  shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
end;
 
procedure TForm1.BtnClick(Sender: TObject);
begin
  case (sender as TBitBtn).tag of
    0: shShape.Shape:=stRectangle;
    1: shShape.Shape:=stEllipse;
    2: shShape.Shape:=stRoundRect;
  end;
end;
 
procedure TForm1.editChange(Sender: TObject);

  procedure UpdEditCntrls(AEdit : TEdit; AUpDown : TUpDown; AScrollBar : TScrollBar; var AValue : TColor);
  var
    S: String;
  begin
    S:=AEdit.Text;
    S := StringReplace(S,' ','',[rfReplaceAll])
    if S = '' then Exit;
    AValue := StrToInt(S);
    if AValue < 0 then AValue := 0;
    if AValue > 255 then AValue := 255;
    AUpDown.Position:=AValue;
    AScrollBar.Position:=AValue;
  end;
  
begin
  if (sender as TEdit).Name='editred' 
    then UpdEditCntrls((sender as TEdit).Text, RedUpDown, sbRedScroll, RedColor);
  if (sender as TEdit).Name='editgreen'
    then UpdEditCntrls((sender as TEdit).Text, GreenUpDown, sbGreenScroll, GreenColor);
  if (sender as TEdit).Name='editblue'
    then UpdEditCntrls((sender as TEdit).Text, BlueUpDown, sbBlueScroll, BlueColor);
  shShape.Brush.Color:=RGB(RedColor,GreenColor,BlueColor);    
end;
 
procedure TForm1.sbScrollChange(Sender: TObject);

  procedure UpdScrollCntrls(AScrollBar : TScrollBar; AUpDown : TUpDown; AEdit : TEdit; var AValue : TColor);
  begin
    AValue := AScrollBar.Position;
    AUpDown.Position := AValue;
    AEdit.Text := IntToStr(AValue);
    FGK(AScrollBar);
  end;
  
begin
  if (sender as TScrollBar).Name='sbRedScroll' 
    then UpdScrollCntrls(sbRedScroll, RedUpDown, editRed, RedColor);
  if (sender as TScrollBar).Name='sbGreenScroll'
    then UpdScrollCntrls(sbGreenScroll, GreenUpDown, editGreen, GreenColor);
  if (sender as TScrollBar).Name='sbBlueScroll'
    then UpdScrollCntrls(sbBlueScroll, BlueUpDown, editBlue, BlueColor);
  shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
end;
 
procedure TForm1.FGK(n: TObject);
begin
  case (n as TScrollBar).Position of
    1..50: StatusBar1.Panels[(n as TScrollBar).tag].Text:= 'Насыщенние цвета отсутсвует'; 
    51..100: StatusBar1.Panels[(n as TScrollBar).tag].Text:= 'Слабо насыщенный';
    101..150: StatusBar1.Panels[(n as TScrollBar).tag].Text:= 'Слабо насыщенный';
    151..200: StatusBar1.Panels[(n as TScrollBar).tag].Text:= 'Сильно насыщенный';
    201..255: StatusBar1.Panels[(n as TScrollBar).tag].Text:= 'Насыщеннеее максимальное';
  end;
end;
 
end.

Там особо сокращать нечего, только общие части вытащить в отдельные процедурки.