sstyleactive.pas

AlphaControls是一个Delphi标准控件的集合

unit sStyleActive;
{$I sDefs.inc}
interface

uses
  windows, Graphics, Classes, Controls, sStyleSimply,
  sUtils, SysUtils, StdCtrls, sConst, sGradient,
  Dialogs, Forms, Messages, extctrls, IniFiles, sDefaults;

type

  TsHotStyle = class;
  TsActiveEffects = class;

  TsMaskedBorders = class(TPersistent)
  private
    FMask: TBitmap;
    procedure SetEnabled(const Value: boolean);
    procedure SetMask(const Value: TBitmap);
    procedure SetPredefined(const Value: TsPredefinedBorders);
    procedure SetTransparentColor(const Value: TColor);
  public
    FEnabled: boolean;
    FPredefined: TsPredefinedBorders;
    FTransparentColor: TColor;
    FOwner : TsActiveEffects;
    constructor Create(AOwner : TsActiveEffects);
    destructor Destroy; override;
  published
    property Mask : TBitmap read FMask write SetMask;
    property Predefined : TsPredefinedBorders read FPredefined write SetPredefined default pdBorder1;
    property TransparentColor : TColor read FTransparentColor write SetTransparentColor default clFuchsia;
    property Enabled : boolean read FEnabled write SetEnabled default DefMaskedBorders;
  end;

  TsFading = class(TPersistent)
  private
    procedure SetEnabled(const Value: boolean);
  public
    FEnabled: boolean;
    FIterations: TPercent;
    FIntervalIn: TPercent;
    FIntervalOut: TPercent;
    FOwner : TsActiveEffects;
    constructor Create(AOwner : TsActiveEffects);
  published
    property Enabled : boolean read FEnabled write SetEnabled default DefaultFadingEnabled;
    property Iterations : TPercent read FIterations write FIterations default 5;
    property IntervalIn : TPercent read FIntervalIn write FIntervalIn default 5;
    property IntervalOut : TPercent read FIntervalOut write FIntervalOut default 5;
  end;

  TsActiveEffects = class(TPersistent)
  private
    FFading: TsFading;
    FsMaskedBorders: TsMaskedBorders;
  public
    FOwner : TPersistent;
    constructor Create(AOwner : TPersistent);
    destructor Destroy; override;
  published
    property Fading : TsFading read FFading write FFading;
    property MaskedBorders : TsMaskedBorders read FsMaskedBorders write FsMaskedBorders;
  end;

  TsBGAddon = class(TPersistent)
  private
    FOwner : TPersistent;
  public
    constructor Create(AOwner : TPersistent); dynamic;
    destructor Destroy; override;
    procedure Invalidate; dynamic;
  published
  end;

  TsBGImage = class(TsBGAddon)
  private
    FImage: TPicture;
    FImageName: string;
    procedure SetImage(const Value: TPicture);
    procedure SetPercent(const Value: TPercent);
    procedure SetImageName(const Value: string);
  public
    FPercent: TPercent;
    constructor Create(AOwner : TPersistent); override;
    destructor Destroy; override;
  published
    property Image : TPicture read FImage write SetImage;
    property ImageName : string read FImageName write SetImageName;
    property Percent : TPercent read FPercent write SetPercent default 0;
  end;

  TsBGGradient = class(TsBGAddon)
  private
    procedure SetData(const Value: TsGradientData);
    procedure SetPercent(const Value: TPercent);
  public
    FData: TsGradientData;
    FPercent: TPercent;
    FGradArray : TsGradArray;
    constructor Create(AOwner : TPersistent); override;
    destructor Destroy; override;
  published
    property Data : TsGradientData read FData write SetData;
    property Percent : TPercent read FPercent write SetPercent default GradientPercent;
  end;

  TsHotBackground = class(TPersistent)
  private
    FOwner : TPersistent;
    FImage: TsBGImage;
    FGradient: TsBGGradient;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(AOwner : TPersistent); dynamic;
    destructor Destroy; override;
    procedure Invalidate; dynamic;
  published
    property Image : TsBGImage read FImage write FImage;
    property Gradient : TsBGGradient read FGradient write FGradient;
  end;

  TsBackground = class(TsHotBackground)
  private
  public
    FListenMSG: boolean;
    constructor Create(AOwner : TPersistent); override;
    destructor Destroy; override;
  published
    property ListenMSG : boolean read FListenMsg write FListenMsg default False;
  end;

  TsHotPainting = class(TPersistent)
  private
    FOwner : TPersistent;
    procedure SetBevelWidth(const Value: integer);
  public
    FColor: TColor;
    FBevel: TsControlBevel;
    FTransparency: TPercent;
    FFontColor: TColor;
    FFontStyle: TFontStyles;
    FBevelWidth: integer;
    constructor Create(AOwner : TPersistent); dynamic;
    destructor Destroy; override;
  published
    property Color : TColor read FColor write FColor default DefColorHot;
    property FontColor : TColor read FFontColor write FFontColor default clBlack;
    property FontStyle : TFontStyles read FFontStyle write FFontStyle default [];
    property Transparency : TPercent read FTransparency write FTransparency;
    property Bevel : TsControlBevel read FBevel write FBevel default cbRaisedSoft;
    property BevelWidth : integer read FBevelWidth write SetBevelWidth default 5;
  end;

  TsHotStyle = class(TPersistent)
  private
  protected
    FOwner : TPersistent;
    FHotPainting: TsHotPainting;
    FHotBackground : TsHotBackground;
  public
    constructor Create(AOwner : TPersistent); dynamic;
    destructor Destroy; override;
  published
    property HotBackground: TsHotBackground read FHotBackground write FHotBackground;
    property HotPainting: TsHotPainting read FHotPainting write FHotPainting;
  end;

implementation

uses sStyleUtil, sButtonControl,
{$IFNDEF ALITE}
  sHintManager,
{$ENDIF}
  sStylePassive, sGraphUtils;

{ TsActiveStyle }

constructor TsHotStyle.Create(AOwner: TPersistent);
begin
  FOwner := AOwner;
  FHotPainting := TsHotPainting.Create(Self);
  FHotBackground := TsHotBackground.Create(Self);
end;

destructor TsHotStyle.Destroy;
begin
  FreeAndNil(FHotPainting);
  FreeAndNil(FHotBackground);
  inherited Destroy;
end;

{ TsHotPainting }

constructor TsHotPainting.Create(AOwner: TPersistent);
begin
  FOwner := AOwner;
  FColor := DefColorHot;
  FFontColor := clBlack;
  FFontStyle := [];
  FBevel := cbRaisedSoft;
  FBevelWidth := 5;
end;

destructor TsHotPainting.Destroy;
begin
  inherited Destroy;
end;

procedure TsHotPainting.SetBevelWidth(const Value: integer);
begin
  FBevelWidth := Value;
end;

{ TsHotBackground }

procedure TsHotBackground.Assign(Source: TPersistent);
begin
  inherited;
  Image.Assign(TsHotBackground(Source).Image);
  Gradient.Assign(TsHotBackground(Source).Gradient);
end;

constructor TsHotBackground.Create(AOwner: TPersistent);
begin
  FOwner := AOwner;
  FImage := TsBGImage.Create(Self);
  FGradient := TsBGGradient.Create(Self);
end;

destructor TsHotBackground.Destroy;
begin
  FreeAndNil(FImage);
  FreeAndNil(FGradient);
  inherited Destroy;
end;

procedure TsHotBackground.Invalidate;
begin
{$IFNDEF ALITE}
{$IFDEF TSHINTS}
  if (FOwner is TsPassivePaintStyle) and (TsPassivePaintStyle(FOwner).FOwner is TsHintManager) then begin
    TsHintManager(TsPassivePaintStyle(FOwner).FOwner).SetCustomDefinition;
  end else
{$ENDIF}
{$ENDIF}
  if FOwner is TsPassiveBGStyle then begin
    TsPassiveBGStyle(FOwner).Invalidate;
  end;
end;

{ TsBGAddon }

constructor TsBGAddon.Create(AOwner: TPersistent);
begin
  FOwner := AOwner;
end;

destructor TsBGAddon.Destroy;
begin
  inherited Destroy;
end;

procedure TsBGAddon.Invalidate;
begin
  if FOwner is TsHotBackground then begin
    TsHotBackground(FOwner).Invalidate;
  end;
end;

{ TsBGImage }

constructor TsBGImage.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FImage := TPicture.Create;
  FPercent := 0;
end;

destructor TsBGImage.Destroy;
begin
  FreeAndNil(FImage);
  inherited Destroy;
end;

procedure TsBGImage.SetImage(const Value: TPicture);
begin
  if FImage <> Value then begin
    FImage.Assign(Value);
    Invalidate;
  end;
end;

procedure TsBGImage.SetImageName(const Value: string);
begin
  if FileExists(Value) then begin
    FImageName := Value;
    LoadJpegOrBmp(Image, Value, False)
  end;
end;

procedure TsBGImage.SetPercent(const Value: TPercent);
begin
  if FPercent <> Value then begin
    FPercent := Value;
    if TsBGAddon(FOwner).FOwner is TsPassivePaintStyle then begin
      if TsPassivePaintStyle(TsBGAddon(FOwner).FOwner).ActualGradPercent + Value > 100 then begin
        TsBackground(FOwner).Gradient.FPercent := 100 - Value;
      end;
    end
    else begin
      if TsPassiveBGStyle(TsHotBackground(FOwner).FOwner).ActualGradPercent + Value > 100 then begin
        TsHotBackground(FOwner).Gradient.FPercent := 100 - Value;
      end;
    end;
    Invalidate;
  end;
end;

{ TsBGGradient }

constructor TsBGGradient.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FPercent := GradientPercent;
end;

destructor TsBGGradient.Destroy;
begin
  inherited Destroy;
end;

procedure TsBGGradient.SetData(const Value: TsGradientData);
begin
  if FData <> Value then begin
    FData := Value;
    PrepareGradArray(Data, FGradArray);
    Invalidate;
  end;
end;

procedure TsBGGradient.SetPercent(const Value: TPercent);
begin
  if FPercent <> Value then begin
    FPercent := Value;
    if TsBGAddon(FOwner).FOwner is TsPassivePaintStyle then begin
      if TsBackground(FOwner).Image.Percent + Value > 100 then begin
        TsBackground(FOwner).Image.FPercent := 100 - Value;
      end;
    end
    else begin
      if TsHotBackground(FOwner).Image.Percent + Value > 100 then begin
        TsHotBackground(FOwner).Image.FPercent := 100 - Value;
      end;
    end;
    Invalidate;
  end;
end;

{ TsBackground }

constructor TsBackground.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FListenMsg := False;
end;

destructor TsBackground.Destroy;
begin
  inherited Destroy;
end;

{ TsFading }

constructor TsFading.Create(AOwner: TsActiveEffects);
begin
  FOwner := AOwner;
  FEnabled := DefaultFadingEnabled;
  FIterations := 5;
  FIntervalIn := 5;
  FIntervalOut := 5;
end;

procedure TsFading.SetEnabled(const Value: boolean);
begin
  if (FEnabled <> Value) then begin
    FEnabled := Value;
  end;
end;

{ TsActiveEffects }

constructor TsActiveEffects.Create(AOwner: TPersistent);
begin
  FOwner := AOwner;
  FFading := TsFading.Create(Self);
  FsMaskedBorders := TsMaskedBorders.Create(Self);
end;

destructor TsActiveEffects.Destroy;
begin
  FreeAndNil(FFading);
  FreeAndNil(FsMaskedBorders);
  inherited Destroy;
end;

{ TsMaskedBorders }

constructor TsMaskedBorders.Create(AOwner: TsActiveEffects);
begin
  FOwner := AOwner;
  FMask := TBitmap.Create;
  FTransparentColor := clFuchsia;
  FEnabled := DefMaskedBorders;
end;

destructor TsMaskedBorders.Destroy;
begin
  FreeAndNil(FMask);
  inherited Destroy;
end;

procedure TsMaskedBorders.SetEnabled(const Value: boolean);
begin
  if FEnabled <> Value then begin
    FEnabled := Value;
    TsGenStyle(FOwner.FOwner).RegionChanged := True;
    TsActiveBGStyle(FOwner.FOwner).CreateRgn;
    TsActiveBGStyle(FOwner.FOwner).Invalidate;
  end;
end;

procedure TsMaskedBorders.SetMask(const Value: TBitmap);
begin
  FMask.Assign(Value);
  TsActiveBGStyle(FOwner.FOwner).CreateRgn;
  TsActiveBGStyle(FOwner.FOwner).Invalidate;
  FMask.PixelFormat := pf24bit;
  FPredefined := pdCustom;
  TsGenStyle(FOwner.FOwner).RegionChanged := True;
end;

procedure TsMaskedBorders.SetPredefined(const Value: TsPredefinedBorders);
begin
  if FPredefined <> Value then begin
    FPredefined := Value;
    TsActiveBGStyle(FOwner.FOwner).CreateRgn;
    TsActiveBGStyle(FOwner.FOwner).Invalidate;
    TsGenStyle(FOwner.FOwner).RegionChanged := True;
  end;
end;

procedure TsMaskedBorders.SetTransparentColor(const Value: TColor);
begin
  if FTransparentColor <> Value then begin
    FTransparentColor := Value;
    TsActiveBGStyle(FOwner.FOwner).CreateRgn;
    TsActiveBGStyle(FOwner.FOwner).Invalidate;
    TsGenStyle(FOwner.FOwner).RegionChanged := True;
  end;
end;

end.