delphi XE2 之 FireMonkey 入门1-5

Delphi XE2 的 FireMonkey 是跨平台的, 暂时只准备看看它在 Windows 下(我是 32 位 Win7)的应用情况.

很新的东西, 相信有了它, 以后的界面将会更灵活、漂亮, 也会淘汰掉诸多皮肤、透明、图像等第三方组件, 但不知和 Win8 的 WinRT 有无关联.
--------------------------------------------------------------------------------

为了它, Delphi XE2 的诸多单元加了前缀, 诸如:
Bde、Data、Datasnap、FMX、IB、Macapi、Posix、Soap、System、System.Bindings、System.Generics、System.Internal、System.Mac、System.Win、Vcl、Winapi、Xml...

这样也好, 单元类别一幕了然. 和 FireMonkey 相关的单元有:
--------------------------------------------------------------------------------
FMX.Ani.pas
 FMX.ASE.Importer.pas
 FMX.ASE.Lexer.pas
 FMX.ASE.Model.pas
 FMX.Canvas.D2D.pas
 FMX.Canvas.GDIP.pas
 FMX.Canvas.Mac.pas
 FMX.Colors.pas
 FMX.Consts.pas
 FMX.Context.DX9.pas
 FMX.Context.Mac.pas
 FMX.Controls.pas
 FMX.DAE.Importer.pas
 FMX.DAE.Model.pas
 FMX.DAE.Schema.pas
 FMX.Dialogs.pas
 FMX.Edit.pas
 FMX.Effects.pas
 FMX.ExtCtrls.pas
 FMX.Filter.Effects.pas
 FMX.Filter.pas
 FMX.FilterCatBlur.pas
 FMX.FilterCatColor.pas
 FMX.FilterCatColorAdjust.pas
 FMX.FilterCatComposite.pas
 FMX.FilterCatDistortion.pas
 FMX.FilterCatGenerator.pas
 FMX.FilterCatGeometry.pas
 FMX.FilterCatStyle.pas
 FMX.FilterCatTiles.pas
 FMX.FilterCatTransition.pas
 FMX.Forms.pas
 FMX.Grid.pas
 FMX.Import.pas
 FMX.Layers3D.pas
 FMX.Layouts.pas
 FMX.ListBox.pas
 FMX.Memo.pas
 FMX.Menus.pas
 FMX.OBJ.Importer.pas
 FMX.OBJ.Model.pas
 FMX.Objects.pas
 FMX.Objects3D.pas
 FMX.Platform.Mac.pas
 FMX.Platform.pas
 FMX.Platform.Win.pas
 FMX.Printer.Mac.pas
 FMX.Printer.pas
 FMX.Printer.Win.pas
 FMX.TabControl.pas
 FMX.TreeView.pas
 FMX.Types.pas
 FMX.Types3D.pas
 FMX.Video.Mac.pas
 FMX.Video.pas
 FMX.Video.Win.pas
--------------------------------------------------------------------------------

 FireMonkey 自成体系, 有自己的 TApplication、TControl 等和 VCL 对应的大多数构件, 但基本还是根植于早期的 TComponent, 应该属于 VCL 的深度扩展.

在 Windows 下创建 FireMonkey 工程可建立 FireMonkey HD Application(2D) 或 FireMonkey 3D Application,
然后可随意添加 FireMonkey HD Form 或 FireMonkey 3D Form. 其窗体文件的后缀是 fmx 了.
--------------------------------------------------------------------------------

在新 FireMonkey HD Application 下简单测试:
--------------------------------------------------------------------------------

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs;

type
  TForm1 = class(TForm)
    Button1: TButton; //现在的 TButton 来自 FMX.Controls 单元
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('Hello FireMonkey!'); //现在 ShowMessage 方法来自 FMX.Dialogs 单元; 底层实现不同但用法一样, 太好了
end;

end.


$show_page$
Delphi XE2 之 FireMonkey 入门(2)

FireMonkey 的控件都是自己绘制的(而不是基于系统组件), 我想它们应该是基于一些基本图形; 就从基本图形开始吧.

FMX.Objects 单元给出的类:
--------------------------------------------------------------------------------
TShape //基本图形的基类
TLine
TRectangle
TRoundRect
TCalloutRectangle
TEllipse
TCircle
TPie
TArc
TPath
TText

TImage
TPaintBox
TSelection
TSelectionPoint



--------------------------------------------------------------------------------

添加一个 TRectangle, 先纵观一下它的可用功能:
--------------------------------------------------------------------------------

{ TRectangle }
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Fill;
    property Stroke;
    property StrokeCap;
    property StrokeDash;
    property StrokeJoin;
    property StrokeThickness;
    property XRadius: Single read FXRadius write SetXRadius;
    property YRadius: Single read FYRadius write SetYRadius;
    property Corners: TCorners read FCorners write SetCorners stored IsCornersStored;
    property CornerType: TCornerType read FCornerType write SetCornerType default TCornerType.ctRound;
    property Sides: TSides read FSides write SetSides stored IsSidesStored;

{ TRectangle 的父类 TShape }
  protected
    procedure FillChanged(Sender: TObject); virtual;
    procedure StrokeChanged(Sender: TObject); virtual;
    function GetShapeRect: TRectF;
    procedure Painting; override;
    procedure AfterPaint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Fill: TBrush read FFill write SetFill;
    property Stroke: TBrush read FStroke write SetStroke;
    property StrokeThickness: Single read FStrokeThickness write SetStrokeThickness stored IsStrokeThicknessStored;
    property StrokeCap: TStrokeCap read FStrokeCap write SetStrokeCap default TStrokeCap.scFlat;
    property StrokeDash: TStrokeDash read FStrokeDash write SetStrokeDash default TStrokeDash.sdSolid;
    property StrokeJoin: TStrokeJoin read FStrokeJoin write SetStrokeJoin default TStrokeJoin.sjMiter;
    property ShapeRect: TRectF read GetShapeRect;

{ TShape 的父类 TControl(来自 FMX.Types) }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddObject(AObject: TFmxObject); override;
    procedure RemoveObject(AObject: TFmxObject); override;
    procedure SetNewScene(AScene: IScene); virtual;
    procedure SetBounds(X, Y, AWidth, AHeight: Single); virtual;
    { matrix }
    function AbsoluteToLocal(P: TPointF): TPointF; virtual;
    function LocalToAbsolute(P: TPointF): TPointF; virtual;
    function AbsoluteToLocalVector(P: TVector): TVector; virtual;
    function LocalToAbsoluteVector(P: TVector): TVector; virtual;
    function PointInObject(X, Y: Single): Boolean; virtual;
    { optimizations }
    procedure RecalcUpdateRect; virtual;
    procedure RecalcNeedAlign; virtual;
    procedure RecalcOpacity; virtual;
    procedure RecalcAbsolute; virtual;
    procedure RecalcEnabled; virtual;
    procedure RecalcHasEffect; virtual;
    { drag and drop }
    function MakeScreenshot: TBitmap;
    { caret }
    procedure ShowCaretProc;
    procedure SetCaretPos(const APoint: TPointF);
    procedure SetCaretSize(const ASize: TPointF);
    procedure SetCaretColor(const AColor: TAlphaColor);
    procedure HideCaret;
    { align }
    procedure BeginUpdate; virtual;
    procedure EndUpdate; virtual;
    procedure Realign; virtual;
    { paining }
    procedure ApplyEffect;
    procedure Painting; virtual;
    procedure DoPaint; virtual;
    procedure AfterPaint; virtual;
    { effects }
    procedure UpdateEffects;
    { }
    procedure SetFocus;
    procedure PaintTo(const ACanvas: TCanvas; const ARect: TRectF; const AParent: TFmxObject = nil);
    procedure Repaint;
    procedure InvalidateRect(ARect: TRectF);
    procedure Lock;
    property AbsoluteMatrix: TMatrix read GetAbsoluteMatrix;
    property AbsoluteOpacity: Single read GetAbsoluteOpacity;
    property AbsoluteWidth: Single read GetAbsoluteWidth;
    property AbsoluteHeight: Single read GetAbsoluteHeight;
    property AbsoluteScale: TPointF read GetAbsoluteScale;
    property AbsoluteEnabled: Boolean read GetAbsoluteEnabled;
    property HasEffect: Boolean read GetAbsoluteHasEffect;
    property HasDisablePaintEffect: Boolean read GetAbsoluteHasDisablePaintEffect;
    property HasAfterPaintEffect: Boolean read GetAbsoluteHasAfterPaintEffect;
    property ChildrenRect: TRectF read GetChildrenRect;
    property InvertAbsoluteMatrix: TMatrix read GetInvertAbsoluteMatrix;
    property InPaintTo: Boolean read FInPaintTo;
    property LocalRect: TRectF read GetLocalRect;
    property AbsoluteRect: TRectF read GetAbsoluteRect;
    property UpdateRect: TRectF read GetUpdateRect;
    property BoundsRect: TRectF read GetBoundsRect write SetBoundsRect;
    property ParentedRect: TRectF read GetParentedRect;
    property ParentedVisible: Boolean read GetParentedVisible;
    property ClipRect: TRectF read GetClipRect;
    property Canvas: TCanvas read GetCanvas;
    property Scene: IScene read FScene;
    property AutoCapture: Boolean read FAutoCapture write FAutoCapture default False;
    property CanFocus: Boolean read FCanFocus write FCanFocus default False;
    property DisableFocusEffect: Boolean read FDisableFocusEffect write FDisableFocusEffect default False;
    property DisableDefaultAlign: Boolean read FDisableDefaultAlign write FDisableDefaultAlign;
    property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1;
  published
    { triggers }
    property IsMouseOver: Boolean read FIsMouseOver;
    property IsDragOver: Boolean read FIsDragOver;
    property IsFocused: Boolean read FIsFocused;
    property IsVisible: Boolean read FVisible;
    { props }
    property Align: TAlignLayout read FAlign write SetAlign default TAlignLayout.alNone;
    property Cursor: TCursor read GetCursor write SetCursor default crDefault;
    property DragMode: TDragMode read GetDragMode write SetDragMode default TDragMode.dmManual;
    property EnableDragHighlight: Boolean read FEnableDragHighlight write FEnableDragHighlight default True;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Position: TPosition read FPosition write SetPosition;
    property RotationAngle: Single read FRotationAngle write SetRotationAngle;
    property RotationCenter: TPosition read FRotationCenter write FRotationCenter;
    property Locked: Boolean read FLocked write SetLocked default False;
    property Width: Single read FWidth write SetWidth;
    property Height: Single read FHeight write SetHeight;
    property Margins: TBounds read FMargins write FMargins;
    property Padding: TBounds read FPadding write FPadding;
    property Opacity: Single read FOpacity write SetOpacity stored IsOpacityStored;
    property ClipChildren: Boolean read FClipChildren write SetClipChildren default False;
    property ClipParent: Boolean read FClipParent write FClipParent default False;
    property HitTest: Boolean read FHitTest write SetHitTest default True;
    property CanClip: Boolean read FCanClip write FCanClip default True;
    property PopupMenu: TCustomPopupMenu read FPopupMenu write SetPopupMenu;
    property Scale: TPosition read FScale write FScale;
    property Visible: Boolean read FVisible write SetVisible default True;
    property DesignVisible: Boolean read FDesignVisible write SetDesignVisible default True;
    property OnDragEnter: TDragEnterEvent read FOnDragEnter write FOnDragEnter;
    property OnDragLeave: TNotifyEvent read FOnDragLeave write FOnDragLeave;
    property OnDragOver: TDragOverEvent read FOnDragOver write FOnDragOver;
    property OnDragDrop: TDragDropEvent read FOnDragDrop write FOnDragDrop;
    property OnDragEnd: TNotifyEvent read FOnDragEnd write FOnDragEnd;
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnCanFocus: TCanFocusEvent read FOnCanFocus write FOnCanFocus;
    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnPainting: TOnPaintEvent read FOnPainting write FOnPainting;
    property OnPaint: TOnPaintEvent read FOnPaint write FOnPaint;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
    property OnApplyStyleLookup: TNotifyEvent read FOnApplyStyleLookup write FOnApplyStyleLookup;

{ TControl 的父类 TFmxObject (来自 FMX.Types) }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Release(Delay: Single = 0.1);
    { check for support interface }
    function IsIControl: Boolean;
    function AsIControl: IControl;
    procedure SetRoot(ARoot: IRoot);
    { design }
    procedure SetDesign(Value: Boolean; SetChildren: Boolean = True);
    function ItemClass: string; virtual;
    { clone }
    function Clone(const AOwner: TComponent): TFmxObject;
    procedure CloneChildFromStream(AStream: TStream);
    { childs }
    procedure AddObject(AObject: TFmxObject); virtual;
    procedure InsertObject(Index: Integer; AObject: TFmxObject); virtual;
    procedure RemoveObject(AObject: TFmxObject); overload; virtual;
    procedure RemoveObject(Index: Integer); overload; virtual;
    procedure Exchange(AObject1, AObject2: TFmxObject); virtual;
    procedure DeleteChildren; virtual;
    procedure BringToFront;
    procedure SendToBack;
    procedure AddObjectsToList(const AList: TList);
    procedure AddControlsToList(const AList: TList);
    procedure Sort(Compare: TFmxObjectSortCompare); virtual;
    { notify }
    procedure AddFreeNotify(const AObject: IFreeNotification);
    procedure RemoveFreeNotify(const AObject: IFreeNotification);
    { tab }
    procedure GetTabOrderList(const List: TList; AChildren: Boolean);
    { i/o }
    procedure LoadFromStream(const AStream: TStream);
    procedure SaveToStream(const Stream: TStream);
    procedure LoadFromBinStream(const AStream: TStream);
    procedure SaveToBinStream(const AStream: TStream);
    { resource }
    function FindStyleResource(const AStyleLookup: string): TFmxObject; virtual;
    procedure UpdateStyle; virtual;
    { animations }
    procedure StartAnimation(const AName: string); virtual;
    procedure StopAnimation(const AName: string); virtual;
    procedure StartTriggerAnimation(AInstance: TFmxObject; const ATrigger: string); virtual;
    procedure StartTriggerAnimationWait(AInstance: TFmxObject; const ATrigger: string); virtual;
    procedure StopTriggerAnimation(AInstance: TFmxObject); virtual;
    procedure ApplyTriggerEffect(AInstance: TFmxObject; const ATrigger: string); virtual;
    { animation property }
    procedure AnimateFloat(const APropertyName: string; const NewValue: Single; Duration: ...);
    procedure AnimateColor(const APropertyName: string; NewValue: TAlphaColor; Duration: ...);
    procedure AnimateFloatDelay(const APropertyName: string; const NewValue: Single; Duration: ...);
    procedure AnimateFloatWait(const APropertyName: string; const NewValue: Single; Duration: ...);
    procedure StopPropertyAnimation(const APropertyName: string);
    { }
    property Root: IRoot read FRoot;
    property Stored: Boolean read FStored write SetStored;
    { }
    property TagObject: TObject read FTagObject write FTagObject;
    property TagFloat: Single read FTagFloat write FTagFloat;
    property TagString: string read FTagString write FTagString;
    { children }
    property ChildrenCount: Integer read GetChildrenCount;
    property Children[Index: Integer]: TFmxObject read GetChild;
    { binding }
    function FindBinding(const ABinding: string): TFmxObject;
    property Data: Variant read GetData write SetData;
    property Binding[const Index: string]: Variant read GetBinding write SetBinding;
    property Parent: TFmxObject read FParent write SetParent;
    property Index: Integer read GetIndex write SetIndex;
  published
    property BindingName: string read FBindingName write SetBindingName;
    property StyleName: string read FStyleName write SetStyleName;

{ TFmxObject 的父类 TComponent (来自 System.Classes), 到这里不新鲜了 }
  public
    constructor Create(AOwner: TComponent); virtual;
    destructor Destroy; override;
    procedure BeforeDestruction; override;
    procedure DestroyComponents;
    procedure Destroying;
    function ExecuteAction(Action: TBasicAction): Boolean; dynamic;
    function FindComponent(const AName: string): TComponent;
    procedure FreeNotification(AComponent: TComponent);
    procedure RemoveFreeNotification(AComponent: TComponent);
    procedure FreeOnRelease;
    function GetEnumerator: TComponentEnumerator;
    function GetParentComponent: TComponent; dynamic;
    function GetNamePath: string; override;
    function HasParent: Boolean; dynamic;
    procedure InsertComponent(AComponent: TComponent);
    procedure RemoveComponent(AComponent: TComponent);
    procedure SetSubComponent(IsSubComponent: Boolean);
    function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
    function UpdateAction(Action: TBasicAction): Boolean; virtual;
    function IsImplementorOf(const I: IInterface): Boolean;
    function ReferenceInterface(const I: IInterface; Operation: TOperation): Boolean;
    property ComObject: IUnknown read GetComObject;
    property Components[Index: Integer]: TComponent read GetComponent;
    property ComponentCount: Integer read GetComponentCount;
    property ComponentIndex: Integer read GetComponentIndex write SetComponentIndex;
    property ComponentState: TComponentState read FComponentState;
    property ComponentStyle: TComponentStyle read FComponentStyle;
    property DesignInfo: Longint read FDesignInfo write FDesignInfo;
    property Owner: TComponent read FOwner;
    property VCLComObject: Pointer read FVCLComObject write FVCLComObject;
    property Observers: TObservers read GetObservers;
  published
    property Name: TComponentName read FName write SetName stored False;
    property Tag: NativeInt read FTag write FTag default 0;

{ TComponent 的父类 TPersistent (来自 System.Classes) }
  public
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); virtual;
    function GetNamePath: string; dynamic;

{ TPersistent 的父类 TObject (来自 System) }
  public
    constructor Create;
    procedure Free;
    class function InitInstance(Instance: Pointer): TObject;
    procedure CleanupInstance;
    function ClassType: TClass; inline;
    class function ClassName: string;
    class function ClassNameIs(const Name: string): Boolean;
    class function ClassParent: TClass;
    class function ClassInfo: Pointer; inline;
    class function InstanceSize: Longint; inline;
    class function InheritsFrom(AClass: TClass): Boolean;
    class function MethodAddress(const Name: ShortString): Pointer; overload;
    class function MethodAddress(const Name: string): Pointer; overload;
    class function MethodName(Address: Pointer): string;
    class function QualifiedClassName: string;
    function FieldAddress(const Name: ShortString): Pointer; overload;
    function FieldAddress(const Name: string): Pointer; overload;
    function GetInterface(const IID: TGUID; out Obj): Boolean;
    class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
    class function GetInterfaceTable: PInterfaceTable;
    class function UnitName: string;
    class function UnitScope: string;
    function Equals(Obj: TObject): Boolean; virtual;
    function GetHashCode: Integer; virtual;
    function ToString: string; virtual;
    function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; virtual;
    procedure AfterConstruction; virtual;
    procedure BeforeDestruction; virtual;
    procedure Dispatch(var Message); virtual;
    procedure DefaultHandler(var Message); virtual;
    class function NewInstance: TObject; virtual;
    procedure FreeInstance; virtual;
    destructor Destroy; virtual;


$show_page$
Delphi XE2 之 FireMonkey 入门(3) - 关于 TPosition

把 FireMonkey 简称为 FM 吧. FM 的窗体继续使用 Left、Top 属性, 但更多控件不是了.
--------------------------------------------------------------------------------

//FM 控件的位置控制不再是 Left、Top, 取而代之的是 Position 属性
procedure TForm1.Button1Click(Sender: TObject);
begin
  Rectangle1.Position.X := Rectangle1.Position.X + 10;
  Rectangle1.Position.Y := Rectangle1.Position.Y + 10;
end;

//TPosition 是类
procedure TForm1.Button2Click(Sender: TObject);
var
  posObj: TPosition;
begin
  posObj := TPosition.Create(TPointF.Create(10, 10));
  Rectangle1.Position.Assign(posObj);
  posObj.Free;
end;

//TPosition.Point 是 TPointF 类型的结构
procedure TForm1.Button3Click(Sender: TObject);
begin
  Rectangle1.Position.Point := TPointF.Create(50, 50);
end;

//TPointF 结构也拥有许多方便的方法和运算符重载
procedure TForm1.Button4Click(Sender: TObject);
var
  ptf: TPointF;
begin
  ptf.X := ClientWidth / 2;
  ptf.Y := ClientHeight / 2;
  ptf.Offset(-Rectangle1.Width / 2, -Rectangle1.Height / 2);
  Rectangle1.Position.Point := ptf;
end;

//TVector 是包含三个元素的结构体, TPosition 可以直接使用其前两个数据
procedure TForm1.Button5Click(Sender: TObject);
var
  vector: TVector;
begin
  vector.X := ClientWidth - Rectangle1.Width;
  vector.Y := ClientHeight - Rectangle1.Height;
//  vector.W := 0.0;
  Rectangle1.Position.Vector := vector;
end;


$show_page$

Delphi XE2 之 FireMonkey 入门(4) - 控件天生可做容器


1、新建 FM(HD) 工程, 先添加 TLine(默认名称是 Line1);
 2、在 Line1 选择状态下添加 Button1;
 3、取消选择后添加 Button2

此时, Button1.Parent 是 Line1; Button2.Parent 是窗体.
--------------------------------------------------------------------------------

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Objects;

type
  TForm1 = class(TForm)
    Line1: TLine;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button2.OnClick := Button1.OnClick; { TLine }
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption := TButton(Sender).Parent.ClassName; { TForm1; 现在的窗体没有 Text 属性了 }
  Line1.Position.X := Line1.Position.X + 10;   { Btuuon1 会随同移动 }
end;

end.

$show_page$

Delphi XE2 之 FireMonkey 入门(5) - TAlphaColor


不是 TColor, 是 TAlphaColor 了.

TAlphaColor = type Cardinal; 还是一个整数.

四个字节分别是: AA RR GG BB(透明度、红、绿、蓝); 这和 TColor 的颜色序相反, 并增加了透明度.
--------------------------------------------------------------------------------

在 HD 窗体上添加一个 TRectangle 和三个 TButton, 测试:
--------------------------------------------------------------------------------

//下面四种赋值方法相同
procedure TForm1.Button1Click(Sender: TObject);
begin
  Rectangle1.Fill.Color := $FFFF0000;
  Rectangle1.Fill.Color := claRed;
  Rectangle1.Fill.Color := TAlphaColors.Red;
  Rectangle1.Fill.Color := TAlphaColorRec.Red;
end;

//通过函数构建 TAlphaColor
procedure TForm1.Button2Click(Sender: TObject);
begin
  Rectangle1.Fill.Color := MakeColor(0, 0, 255);
  //另有 AppendColor()、SubtractColor() 等颜色加减或转换函数
end;

//通过 TAlphaColorRec 结构调整颜色获取或设置颜色分量
procedure TForm1.Button3Click(Sender: TObject);
var
  C: TAlphaColor;
  A,R,G,B: Byte;
begin
  C := MakeColor($82, $00, $4B, $FF);
  Rectangle1.Fill.Color := C;

  A := TAlphaColorRec(C).A;
  R := TAlphaColorRec(C).R;
  G := TAlphaColorRec(C).G;
  B := TAlphaColorRec(C).B;
  ShowMessageFmt('%x %x %x %x', [A, R, G, B]);

  TAlphaColorRec(C).A := 127; //调下透明度
  Rectangle1.Fill.Color := C;
  A := TAlphaColorRec(C).A;
  ShowMessageFmt('%x %x %x %x', [A, R, G, B]);
end;



--------------------------------------------------------------------------------

调整颜色的控件也很方便, 现在也能方便地调整: 色调、饱和度、亮度.

添加 TRectangle、TColorComboBox、TColorPanel、TColorPicker、TComboColorBox、TColorQuad 各一个, 测试:
--------------------------------------------------------------------------------

//在 TColorComboBox 的 OnChange 中修改颜色
procedure TForm1.ColorComboBox1Change(Sender: TObject);
begin
  Rectangle1.Fill.Color := ColorComboBox1.Color;
end;

//在 TColorPanel 的 OnChange 中修改颜色
procedure TForm1.ColorPanel1Change(Sender: TObject);
begin
  Rectangle1.Fill.Color := ColorPanel1.Color;
end;

//在 TColorPicker 的 OnChange 中修改颜色
procedure TForm1.ColorPicker1Click(Sender: TObject);
begin
  Rectangle1.Fill.Color := ColorPicker1.Color;
end;

//在 TComboColorBox 的 OnChange 中修改颜色
procedure TForm1.ComboColorBox1Change(Sender: TObject);
begin
  Rectangle1.Fill.Color := ComboColorBox1.Color;
end;

//通过 TColorQuad 调整 HSL(色调、饱和度、亮度)
procedure TForm1.ColorQuad1Change(Sender: TObject);
var
  C: TAlphaColor;
begin
  C := Rectangle1.Fill.Color;
  Rectangle1.Fill.Color := ChangeHSL(C, ColorQuad1.Hue, ColorQuad1.Sat, ColorQuad1.Lum);
  Caption := Format('%f, %f, %f', [ColorQuad1.Hue, ColorQuad1.Sat, ColorQuad1.Lum]);
end;



--------------------------------------------------------------------------------

在 System.UIConsts 单元也有 StringToAlphaColor()、AlphaColorToIdent()、IdentToAlphaColor() 等相关函数.