AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

My Delphi 2010 is sick

Ein Thema von WojTec · begonnen am 4. Jul 2012 · letzter Beitrag vom 9. Jul 2012
 
WojTec

Registriert seit: 17. Mai 2007
482 Beiträge
 
Delphi XE6 Professional
 
#17

Re: My Delphi 2010 is sick

  Alt 8. Jul 2012, 16:14
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.
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 04:59 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz