My Delphi 2010 is sick

[WojTec]

Delphi-Quellcode:

object GradientDialog: TGradientDialog
  Left = 0
  Top = 0
  BorderStyle = bsDialog
  Caption = 'Gradient steps'
  ClientHeight = 335
  ClientWidth = 433
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poMainFormCenter
  PixelsPerInch = 96
  TextHeight = 13
  object lblFirstR: TLabel
    Left = 8
    Top = 46
    Width = 11
    Height = 13
    Caption = 'R:'
  end
  object lblFirstG: TLabel
    Left = 8
    Top = 79
    Width = 11
    Height = 13
    Caption = 'G:'
  end
  object lblFirstB: TLabel
    Left = 8
    Top = 112
    Width = 10
    Height = 13
    Caption = 'B:'
  end
  object lblSecondR: TLabel
    Left = 8
    Top = 164
    Width = 11
    Height = 13
    Caption = 'R:'
  end
  object lblSecondG: TLabel
    Left = 8
    Top = 197
    Width = 11
    Height = 13
    Caption = 'G:'
  end
  object lblSecondB: TLabel
    Left = 9
    Top = 230
    Width = 10
    Height = 13
    Caption = 'B:'
  end
  object Bevel: TBevel
    Left = 8
    Top = 295
    Width = 417
    Height = 3
    Shape = bsTopLine
  end
  object FirstSwatch: TmbColorPreview
    Left = 76
    Top = 45
    Width = 29
    Height = 93
    BlockSize = 4
    SwatchStyle = True
    OnColorChange = ColorChange
  end
  object edtRFirst: TBMDSpinEdit
    Left = 25
    Top = 45
    Width = 45
    Height = 27
    TabOrder = 0
    OnChange = FirstChange
    Increment = 1.000000000000000000
    MaxValue = 255.000000000000000000
    Value = 255.000000000000000000
    AsInteger = 255
    GuageBeginColor = clWhite
    GuageEndColor = 2366701
    Precision = 0
    TrackBarEnabled = False
  end
  object edtGFirst: TBMDSpinEdit
    Left = 25
    Top = 78
    Width = 45
    Height = 27
    TabOrder = 1
    OnChange = FirstChange
    Increment = 1.000000000000000000
    MaxValue = 255.000000000000000000
    Value = 255.000000000000000000
    AsInteger = 255
    GuageBeginColor = clWhite
    GuageEndColor = 5285376
    Precision = 0
    TrackBarEnabled = False
  end
  object edtBFirst: TBMDSpinEdit
    Left = 25
    Top = 111
    Width = 45
    Height = 27
    TabOrder = 2
    OnChange = FirstChange
    Increment = 1.000000000000000000
    MaxValue = 255.000000000000000000
    Value = 255.000000000000000000
    AsInteger = 255
    GuageBeginColor = clWhite
    GuageEndColor = 9580590
    Precision = 0
    TrackBarEnabled = False
  end
  object SecondSwatch: TmbColorPreview
    Left = 76
    Top = 163
    Width = 29
    Height = 93
    BlockSize = 4
    SwatchStyle = True
    OnColorChange = ColorChange
  end
  object edtRSecond: TBMDSpinEdit
    Left = 24
    Top = 163
    Width = 45
    Height = 27
    TabOrder = 3
    OnChange = SecondChange
    Increment = 1.000000000000000000
    MaxValue = 255.000000000000000000
    Value = 255.000000000000000000
    AsInteger = 255
    GuageBeginColor = clWhite
    GuageEndColor = 2366701
    Precision = 0
    TrackBarEnabled = False
  end
  object edtGSecond: TBMDSpinEdit
    Left = 25
    Top = 196
    Width = 45
    Height = 27
    TabOrder = 4
    OnChange = SecondChange
    Increment = 1.000000000000000000
    MaxValue = 255.000000000000000000
    Value = 255.000000000000000000
    AsInteger = 255
    GuageBeginColor = clWhite
    GuageEndColor = 5285376
    Precision = 0
    TrackBarEnabled = False
  end
  object edtBSecond: TBMDSpinEdit
    Left = 25
    Top = 229
    Width = 45
    Height = 27
    TabOrder = 5
    OnChange = SecondChange
    Increment = 1.000000000000000000
    MaxValue = 255.000000000000000000
    Value = 255.000000000000000000
    AsInteger = 255
    GuageBeginColor = clWhite
    GuageEndColor = 9580590
    Precision = 0
    TrackBarEnabled = False
  end
  object btnOk: TButton
    Left = 269
    Top = 304
    Width = 75
    Height = 23
    Caption = 'OK'
    Default = True
    ModalResult = 1
    TabOrder = 7
  end
  object btnCancel: TButton
    Left = 350
    Top = 304
    Width = 75
    Height = 23
    Cancel = True
    Caption = 'Cancel'
    ModalResult = 2
    TabOrder = 8
  end
  object edtSteps: TSpTBXSpinEdit
    Left = 60
    Top = 268
    Width = 45
    Height = 21
    Alignment = taLeftJustify
    NumbersOnly = True
    TabOrder = 6
    OnChange = GradientChange
    SkinType = sknWindows
    ExtendedAccept = True
    SpinButton.Left = 27
    SpinButton.Top = 0
    SpinButton.Width = 14
    SpinButton.Height = 17
    SpinButton.Align = alRight
    SpinButton.DrawPushedCaption = False
    SpinButton.SkinType = sknWindows
    SpinOptions.MaxValue = 256.000000000000000000
    SpinOptions.MinValue = 1.000000000000000000
    SpinOptions.Value = 1.000000000000000000
  end
  object pnlGradientMapHolder: TPanel
    Left = 8
    Top = 8
    Width = 417
    Height = 12
    BevelOuter = bvLowered
    ShowCaption = False
    TabOrder = 11
    object imgGradient: TImage32
      Left = 1
      Top = 1
      Width = 415
      Height = 10
      Align = alClient
      Bitmap.ResamplerClassName = 'TNearestResampler'
      BitmapAlign = baTopLeft
      ParentShowHint = False
      Scale = 1.000000000000000000
      ScaleMode = smNormal
      ShowHint = True
      TabOrder = 0
    end
  end
  object cbReverse: TCheckBox
    Left = 8
    Top = 307
    Width = 97
    Height = 17
    Caption = 'Reverse'
    TabOrder = 12
    OnClick = ColorChange
  end
  object Gradient: TmbColorPalette
    Left = 119
    Top = 42
    Width = 306
    Height = 17
    HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %hex'
    AutoHeight = True
    CellSize = 17
    CellStyle = csCorel
    TabOrder = 13
    ShowHint = True
    ParentShowHint = False
  end
end

Delphi-Quellcode:

unit GradientStepsDlg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;

type
  TGradientDialog = class(TForm)
    lblFirstR: TLabel;
    lblFirstG: TLabel;
    lblFirstB: TLabel;
    lblSecondR: TLabel;
    lblSecondG: TLabel;
    lblSecondB: TLabel;
    Bevel: TBevel;
    FirstSwatch: TmbColorPreview;
    edtRFirst: TBMDSpinEdit;
    edtGFirst: TBMDSpinEdit;
    edtBFirst: TBMDSpinEdit;
    SecondSwatch: TmbColorPreview;
    edtRSecond: TBMDSpinEdit;
    edtGSecond: TBMDSpinEdit;
    edtBSecond: TBMDSpinEdit;
    btnOk: TButton;
    btnCancel: TButton;
    edtSteps: TSpTBXSpinEdit;
    pnlGradientMapHolder: TPanel;
    imgGradient: TImage32;
    cbReverse: TCheckBox;
    Gradient: TmbColorPalette;
    procedure FirstChange(Sender: TObject);
    procedure SecondChange(Sender: TObject);
    procedure GradientChange(Sender: TObject);
    procedure ColorChange(Sender: TObject);
  private
    FUpdate: Boolean;
    procedure RenderGradient;
  public
    constructor Create(const AFirst, ASecond: TColor; const ASteps: TByteVal); reintroduce;
  end;

var
  GradientDialog: TGradientDialog;

implementation

{$R *.dfm}

procedure TGradientDialog.RenderGradient;
begin
  imgGradient.Bitmap.SetSizeFrom(imgGradient);
  imgGradient.Bitmap.Clear;
  TGradient.Linear(imgGradient.Bitmap, Point(0, imgGradient.Bitmap.Height div 2),
    Point(imgGradient.Bitmap.Width, imgGradient.Bitmap.Height div 2),
    ColorArray([FirstSwatch.Color, SecondSwatch.Color]), cbReverse.Checked
  );
end;

constructor TGradientDialog.Create(const AFirst, ASecond: TColor;
  const ASteps: TByteVal);
var
  R, G, B: Byte;
begin
  inherited Create(Application);

  FUpdate := True;
  try
    FirstSwatch.Color := AFirst;
    GetRGBValues(AFirst, R, G, B);
    edtRFirst.AsInteger := R;
    edtGFirst.AsInteger := G;
    edtBFirst.AsInteger := B;

    SecondSwatch.Color := ASecond;
    GetRGBValues(ASecond, R, G, B);
    edtRSecond.AsInteger := R;
    edtGSecond.AsInteger := G;
    edtBSecond.AsInteger := B;
  finally
    FUpdate := False;
    edtSteps.Value := ASteps;
    ColorChange(nil);
  end;
end;

procedure TGradientDialog.FirstChange(Sender: TObject);
begin
  FirstSwatch.Color := SetRGBValues(edtRFirst.AsInteger, edtGFirst.AsInteger, edtBFirst.AsInteger);
end;

procedure TGradientDialog.ColorChange(Sender: TObject);
begin
  if FUpdate then Exit;

  RenderGradient;
  GradientChange(nil);
end;

procedure TGradientDialog.SecondChange(Sender: TObject);
begin
  SecondSwatch.Color := SetRGBValues(edtRSecond.AsInteger, edtGSecond.AsInteger, edtBSecond.AsInteger);
end;

procedure TGradientDialog.GradientChange(Sender: TObject);
var
  I: Integer;
  A: TColorArray;
begin
  if FUpdate then Exit;

  Gradient.ClearColors;

  A := GetGradientColors(FirstSwatch.Color, SecondSwatch.Color, TByteVal(Round(edtSteps.Value)));

  if cbReverse.Checked then  // <-- exceptions here
  begin
    for I := High(A) downto 0 do
      Gradient.AddColor('', FormatColor(A[I], cfePascal), False);
    ;
  end
  else
  begin
    for I := 0 to High(A) do
      Gradient.AddColor('', FormatColor(A[I], cfePascal), False);
    ;
  end;

  Gradient.Invalidate;
end;

end.