scontrolsmanager.pas

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

unit sControlsManager;

interface

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

type

  TsControlsManager = class;
  TsControlBackground = class;

  TsControlShadow = class(TPersistent)
  private
    FEnabled : boolean;
    FColor : TColor;
    FOffset : integer;
    FOwner : TsControlsManager;
    FTransparency : integer;
    FBlur : integer;

    procedure SetBoolean(const Index: Integer; const Value: boolean);
    procedure SetInteger(Index: Integer; Value: integer);
    procedure SetColors (Index: Integer; Value: TColor);
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(AOwner : TsControlsManager);
    destructor Destroy; override;
  published
    property Transparency: integer index 0 read FTransparency write SetInteger default 60;
    property Enabled : boolean index 0 read FEnabled write SetBoolean default False;
    property Color : TColor index 0 read FColor write SetColors default clBlack;
    property Offset : integer index 1 read FOffset write SetInteger default 8;
    property Blur : integer index 2 read FBlur write SetInteger default 4;
  end;

  TsControlsManager = class(TComponent)
  private
    FForm : TCustomForm;
    FBackground : TsControlBackground;
    FShadow : TsControlShadow;
    FActive : boolean;
    FGroupIndex : integer;
    FOnAssign : TNotifyEvent;
    FSoftControls: boolean;
    procedure SetActive(const Value: boolean);
    procedure SetSoftControls(const Value: boolean);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromFile(FileName : string);
    procedure SaveToFile(FileName : string);
  published
    property OnAssign: TNotifyEvent read FOnAssign write FOnAssign;
    property Background : TsControlBackground read FBackground write FBackground;
    property Shadow : TsControlShadow read FShadow write FShadow;

    property GroupIndex : integer read FGroupIndex write FGroupIndex;
    property Active : boolean read FActive write SetActive default False;
    property SoftControls : boolean read FSoftControls write SetSoftControls default True;
  end;

  // Basic type for background painting
  TsControlBackground = class(TPersistent)
  protected
    { @EXCLUDE}
    FOwner : TsControlsManager;
    { @EXCLUDE}
    FImage : TPicture;
    { @EXCLUDE}
    procedure SetImage(const Value: TPicture);
  public
    // Store FileName of last loaded image
    ImageFileName : string;
    { @EXCLUDE}
    constructor Create(AOwner : TsControlsManager);
    { @EXCLUDE}
    destructor Destroy; override;
    // Void method for background updates
    procedure BkGroundsUpdate; { @EXCLUDE} dynamic;
    // Assigns properties of Background to Src
    procedure Assign(Source: TPersistent); override;
  published
    // Picture for pattern
    property Image : TPicture read FImage write SetImage;
  end;

procedure AssignSC(cmp: TComponent; src: TsControlsManager);
function GeTsControlsManager(Form: TCustomForm; GroupIndex : integer) : TsControlsManager;
procedure ChangeBkGround(Form: TWinControl; Bg : TsControlBackground);

implementation

uses sMessages, sStyleSimply, sStoreUtils, sGraphUtils;

procedure AssignSC(cmp: TComponent; src: TsControlsManager);
var
  i: integer;
begin
  for i := 0 to cmp.ComponentCount-1 do begin
    if cmp.Components[i] is TsControlsManager
      then TsControlsManager(cmp.Components[i]).Assign(src)
      else AssignSC(cmp.Components[i], src);
  end;
end;

procedure ChangeBkGround(Form: TWinControl; Bg : TsControlBackground);
var
  M : TSMSetBground;
begin
  M.sBackground := Bg;
  M.GroupIndex := GI_FORPANELPATTERN;
  M.Msg := CM_SETPATTERN;
  M.Result := 0;
  if Assigned(Form) then begin
    BroadCastS(Form, M);
  end
  else begin
    AppBroadCasts(M);
  end;
end;

function GeTsControlsManager(Form: TCustomForm; GroupIndex : integer) : TsControlsManager;
var
  i : integer;
begin
  Result := nil;
  if Assigned(Form) then begin
    for i := 0 to Form.ComponentCount - 1 do begin
      if (Form.Components[i] is TsControlsManager) then
        if ((TsControlsManager(Form.Components[i]).GroupIndex = GroupIndex) or (TsControlsManager(Form.Components[i]).GroupIndex = 0))
          and TsControlsManager(Form.Components[i]).Active then begin
        Result := TsControlsManager(Form.Components[i]);
        exit;
      end;
    end;
  end;
end;

{ TsControlsManager }

constructor TsControlsManager.Create(AOwner: TComponent);
begin
  inherited;
  FBackground           := TsControlBackground.Create(Self);
  FShadow               := TsControlShadow.Create(Self);

  FActive               := False;
  FSoftControls         := True;
  if not (AOwner is TCustomForm) then FForm := GetParentForm(TWinControl(AOwner)) else FForm := TCustomForm(AOwner);
end;

procedure TsControlsManager.Assign(Source: TPersistent);
var
  M : TCMChangeAll;
begin
  if Assigned(Source) then begin
    FActive := False;


    FShadow.Assign(TsControlsManager(Source).Shadow);
    FBackground.Assign(TsControlsManager(Source).Background);


    FSoftControls := TsControlsManager(Source).SoftControls;

    FActive := True;

    M.sStyleControl := Self;
    M.GroupIndex := GroupIndex;
    M.Msg := CM_CHANGEALL;
    BroadCastS(FForm, M);

    if Assigned(OnAssign) then OnAssign(Self);

  end;
end;

destructor TsControlsManager.Destroy;
begin
  if Assigned(FBackground) then FreeAndNil(FBackground);
  FreeAndNil(FShadow);
  inherited Destroy;
end;

procedure TsControlsManager.SetActive(const Value: boolean);
begin
  if FActive <> Value then begin
    if Value then begin
      Assign(Self);
    end
    else FActive := False;
  end;
end;

procedure TsControlsManager.LoadFromFile(FileName: string);
const
  Section = 'Controls';
var
  s : string;
  IniFile : TMemIniFile;
begin
  if not FileExists(FileName) then Exit;
  Active := False;
  IniFile := TMemIniFile.Create(FileName);

  // Background
  s := sStoreUtils.ReadIniString(Section, 'Style', IniFile);
  if s = '' then s := '0';

  Background.ImageFileName := sStoreUtils.ReadIniString(Section, 'Pattern', IniFile);
  LoadJpegOrBmp(Background.Image, Background.ImageFileName, False);

  // Shadow
  Shadow.Color       := ReadIniInteger(Section, 'ControlShadowColor', integer(clBlack), IniFile);
  Shadow.Enabled := sStoreUtils.ReadIniString(Section, 'ControlShadowEnabled', IniFile) = 'True';
  Shadow.Offset := ReadIniInteger(Section, 'ControlShadowOffset', 8, IniFile);
  Shadow.Blur := ReadIniInteger(Section, 'ControlShadowBlur', 4, IniFile);
  Shadow.Transparency := ReadIniInteger(Section, 'ControlShadowTransparency', 60, IniFile);

  Active := True;
  AssignSC(Application, Self);
  FreeAndNil(IniFile);
end;

procedure TsControlsManager.SaveToFile(FileName: string);
const
  Section = 'Controls';
var
  IniFile : TMemIniFile;
begin
  IniFile := TMemIniFile.Create(FileName);
  // Background
  WriteIniStr(Section, 'Pattern', Background.ImageFileName, IniFile);

  // Shadow
  WriteIniStr(Section, 'ControlShadowColor', IntToStr(Shadow.Color), IniFile);
  WriteIniStr(Section, 'ControlShadowOffset', IntToStr(Shadow.Offset), IniFile);
  WriteIniStr(Section, 'ControlShadowBlur', IntToStr(Shadow.Blur), IniFile);
  WriteIniStr(Section, 'ControlShadowTransparency', IntToStr(Shadow.Transparency), IniFile);
  WriteIniStr(Section, 'ControlShadowEnabled', iff(Shadow.Enabled, 'True', 'False'), IniFile);
  IniFile.UpdateFile;
  FreeAndNil(IniFile);
end;

procedure TsControlsManager.SetSoftControls(const Value: boolean);
var
  M : TSMsetBoolean;
begin
  if (FSoftControls <> Value) then begin
    FSoftControls := Value;
    if FActive then begin
      M.Value := Value;
      M.GroupIndex := GroupIndex;
      M.Msg := CM_SETSOFT;
      BroadCastS(FForm, M);
    end;
  end;
end;

{ TsControlShadow }

procedure TsControlShadow.Assign(Source: TPersistent);
begin
  FBlur         := TsControlShadow(Source).Blur;
  FColor        := TsControlShadow(Source).Color;
  FOffset       := TsControlShadow(Source).Offset;
  FTransparency := TsControlShadow(Source).Transparency;
  FEnabled      := TsControlShadow(Source).Enabled;
end;

constructor TsControlShadow.Create(AOwner: TsControlsManager);
begin
  FOwner := AOwner;
  FColor := clBlack;
  FBlur := 4;
  FOffset := 8;
  FTransparency := 60;
  FEnabled := False;
end;

destructor TsControlShadow.Destroy;
begin
  if Enabled then begin
    Enabled := False;
  end;
  inherited Destroy;
end;

procedure TsControlShadow.SetBoolean(const Index: Integer; const Value: boolean);
var
  M : TSMsetBoolean;
begin
  if FOwner.FActive then begin
    M.Value := Value;
    M.GroupIndex := FOwner.GroupIndex;
    case Index of
      0: M.Msg := CM_SETSHADOWENABLED;
    end;
    BroadCastS(FOwner.FForm, M);
    UpdateShadows(FOwner.FForm, FOwner.GroupIndex);
  end;
  case Index of
    0: begin
      FEnabled := Value;
    end;
  end;
end;

{
procedure TsControlShadow.SetColor(const Value: TColor);
begin

end;
}
procedure TsControlShadow.SetColors(Index: Integer; Value: TColor);
var
  M : TSMSetColor;
begin
  if FOwner.FActive then begin
    M.Value := Value;
    M.GroupIndex := FOwner.GroupIndex;
    case index of
      0: M.Msg := CM_SETCOLORSHADOW;
    end;
    BroadCastS(FOwner.FForm, M);
  end;
  case index of
    0: begin
      FColor := Value;
      UpdateShadows(FOwner.FForm, FOwner.GroupIndex);
    end;
  end;
end;

procedure TsControlShadow.SetInteger(Index, Value: integer);
var
  M : TSMSetInteger;
begin
  if FOwner.FActive then begin
    M.Value := Value;
    M.GroupIndex := FOwner.GroupIndex;
    case Index of
      0: M.Msg := CM_SHADOWTRANSPARENCY;
      1: M.Msg := CM_SHADOWOFFSET;
      2: M.Msg := CM_SHADOWBLUR;
    end;
    BroadCastS(FOwner.FForm, M);
  end;
  Case Index of
    0: FTransparency := Value;
    1: FOffset := Value;
    2: FBlur := Value;
  end;
  UpdateShadows(FOwner.FForm, FOwner.GroupIndex);
end;

{ TsControlBackground }

procedure TsControlBackground.Assign(Source: TPersistent);
begin
  try
    FImage.Assign(TsControlBackground(Source).FImage);
    ImageFileName := TsControlBackground(Source).ImageFileName;
  except
  end;
end;

procedure TsControlBackground.BkGroundsUpdate;
begin
  if FOwner.Active then ChangeBkGround(FOwner.FForm, Self);
end;

constructor TsControlBackground.Create(AOwner: TsControlsManager);
begin
  FOwner := AOwner;
  FImage := TPicture.Create;
end;

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

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

end.