lazarus-ccr/components/industrialstuff/source/indcyClasses.pas

{  Unit indcyClasses from cyClasses

    Description:
    Unit with sub-properties for components.


    * ***** BEGIN LICENSE BLOCK *****
    *
    * Version: MPL 1.1
    *
    * The contents of this file are subject to the Mozilla Public License Version
    * 1.1 (the "License"); you may not use this file except in compliance with the
    * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
    *
    * Software distributed under the License is distributed on an "AS IS" basis,
    * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
    * the specific language governing rights and limitations under the License.
    *
    * The Initial Developer of the Original Code is Mauricio
    * (https://sourceforge.net/projects/tcycomponents/).
    *
    * No contributors for now ...
    *
    * Alternatively, the contents of this file may be used under the terms of
    * either the GNU General Public License Version 2 or later (the "GPL"), or the
    * GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which
    * case the provisions of the GPL or the LGPL are applicable instead of those
    * above. If you wish to allow use of your version of this file only under the
    * terms of either the GPL or the LGPL, and not to allow others to use your
    * version of this file under the terms of the MPL, indicate your decision by
    * deleting the provisions above and replace them with the notice and other
    * provisions required by the LGPL or the GPL. If you do not delete the
    * provisions above, a recipient may use your version of this file under the
    * terms of any one of the MPL, the GPL or the LGPL.
    *
    * ***** END LICENSE BLOCK *****}
    
unit indcyClasses;

{$mode objfpc}{$H+}

// {$I cyCompilerDefines.inc}

interface

uses
   LCLIntf, Classes, Graphics, Controls, SysUtils,
   indcyTypes, indcyGraphics;

type
  tcyBevel = class(TCollectionItem)
  private
    FHighlightColor: TColor;
    FShadowColor: TColor;
    FWidth: Word;
    FStyle: TcyBevelCut;
    FDrawRight: Boolean;
    FDrawLeft: Boolean;
    FDrawTop: Boolean;
    FDrawBottom: Boolean;
    FNeedOwnerRealign: Boolean;
    procedure SetHighlightColor(const Value: TColor);
    procedure SetShadowColor(const Value: TColor);
    procedure SetWidth(const Value: Word);
    procedure SetStyle(const Value: TcyBevelCut);
    procedure SetDrawBottom(const Value: Boolean);
    procedure SetDrawLeft(const Value: Boolean);
    procedure SetDrawRight(const Value: Boolean);
    procedure SetDrawTop(const Value: Boolean);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(ACollection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
    property DrawLeft: Boolean read FDrawLeft write SetDrawLeft default True;
    property DrawTop: Boolean read FDrawTop write SetDrawTop default True;
    property DrawRight: Boolean read FDrawRight write SetDrawRight default True;
    property DrawBottom: Boolean read FDrawBottom write SetDrawBottom default True;
    property HighlightColor: TColor read FHighlightColor write SetHighlightColor default clBtnHighlight;
    property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow;
    property Style: TcyBevelCut read FStyle write SetStyle default bcRaised;
    property Width: Word read FWidth write SetWidth default 1;
  end;

  TcyBevelClass = class of tcyBevel;

  tcyBevels = Class(TCollection)
  private
    FControl: TControl;
    FOnChange: TNotifyEvent;
    FNeedOwnerRealign: Boolean;
    function GetBevel(Index: Integer): TcyBevel;
  protected
    function GetOwner: TPersistent; Override;
    procedure Update(Item: TCollectionItem); Override;
  public
    constructor Create(aControl: TControl; BevelClass: TcyBevelClass);
    function Add: TcyBevel;
    procedure Delete(Index: Integer);
    procedure DrawBevels(aCanvas: TCanvas; var BoundsRect: TRect; RoundRect: Boolean);
    function xBevelsWidth: Integer;
    function BevelsWidth: Integer;
    property Items[Index: Integer]: TcyBevel read GetBevel; default;
    property NeedOwnerRealign: Boolean read FNeedOwnerRealign;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

implementation

{ tcyBevel }
procedure tcyBevel.Assign(Source: TPersistent);
begin
  if Source is tcyBevel then
  begin
    FHighlightColor := tcyBevel(Source).FHighlightColor;
    FShadowColor := tcyBevel(Source).FShadowColor;
    FWidth := tcyBevel(Source).FWidth;
    FStyle  := tcyBevel(Source).FStyle;
    FDrawRight  := tcyBevel(Source).FDrawRight;
    FDrawLeft    := tcyBevel(Source).FDrawLeft;
    FDrawTop := tcyBevel(Source).FDrawTop;
    FDrawBottom := tcyBevel(Source).FDrawBottom;
  end;
//  inherited Assign(Source);
end;

constructor tcyBevel.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);
  FHighlightColor := clBtnHighlight;
  FShadowColor := clBtnShadow;
  FWidth := 1;
  FStyle := bcRaised;
  FDrawLeft := true;
  FDrawTop := true;
  FDrawRight := true;
  FDrawBottom := true;
  FNeedOwnerRealign := true;
end;

function tcyBevel.GetDisplayName: string;
begin
  case FStyle of
    bcLowered: Result := 'Lowered';
    bcRaised: Result := 'Raised';
    bcNone: Result := 'None';
    bcTransparent: Result := 'Transparent';
  end;

  Result := Result + ' Bevel';
  Result := Result + ' Width = ' + intToStr(FWidth);
end;

procedure tcyBevel.SetDrawBottom(const Value: Boolean);
begin
  FDrawBottom := Value;
  Changed(false);            // It will call TcyBevels.Update !
end;

procedure tcyBevel.SetDrawLeft(const Value: Boolean);
begin
  FDrawLeft := Value;
  Changed(false);
end;

procedure tcyBevel.SetDrawRight(const Value: Boolean);
begin
  FDrawRight := Value;
  Changed(false);
end;

procedure tcyBevel.SetDrawTop(const Value: Boolean);
begin
  FDrawTop := Value;
  Changed(false);
end;

procedure tcyBevel.SetHighlightColor(const Value: TColor);
begin
  FHighlightColor := Value;
  Changed(false);
end;

procedure tcyBevel.SetShadowColor(const Value: TColor);
begin
  FShadowColor := Value;
  Changed(false);
end;

procedure tcyBevel.SetStyle(const Value: TcyBevelCut);
begin
  if FStyle = Value then EXIT;

  if (FStyle = bcNone) or (Value = bcNone)
  then FNeedOwnerRealign := true;

  FStyle := Value;
  Changed(false);
end;

procedure tcyBevel.SetWidth(const Value: Word);
begin
  if FWidth = Value then EXIT;

  FWidth := Value;
  FNeedOwnerRealign := true;
  Changed(false);
end;

{TcyBevels}
constructor TcyBevels.Create(aControl: TControl; BevelClass: TcyBevelClass);
begin
  inherited Create(BevelClass);
  FControl := aControl;
  FNeedOwnerRealign := false;
end;

function TcyBevels.GetBevel(Index: Integer): TcyBevel;
begin
  Result := TcyBevel(inherited Items[Index]);
end;

function TcyBevels.GetOwner: TPersistent;
begin
  Result := FControl;
end;

// Event Called by setting properties/events of TcyBevel :
procedure TcyBevels.Update(Item: TCollectionItem);
begin
  Inherited;
  if Assigned(FOnChange)
  then begin
    if Item <> nil
    then
      if TcyBevel(Item).FNeedOwnerRealign
      then begin
        FNeedOwnerRealign := true;
        TcyBevel(Item).FNeedOwnerRealign := false;
      end;

    FOnChange(Self);
    FNeedOwnerRealign := false;
  end
  else
    FControl.Invalidate;
end;

function TcyBevels.Add: TcyBevel;
begin
  Result := TcyBevel(inherited Add);
  Result.Changed(false);      // It will call TcyBevels.Update only at run-time!
end;

procedure TcyBevels.Delete(Index: Integer);
begin
  Inherited;
  FNeedOwnerRealign := true;
  Update(Nil);
end;

procedure TcyBevels.DrawBevels(aCanvas: TCanvas; var BoundsRect: TRect; RoundRect: Boolean);
var i: Integer;
begin
  for i := 0 to Count-1 do
    case Items[i].FStyle of
      bcRaised:
        begin
          cyFrame3D(aCanvas, BoundsRect, Items[i].FHighlightColor, Items[i].FShadowColor, Items[i].FWidth,
              Items[i].FDrawLeft, Items[i].FDrawTop, Items[i].FDrawRight, Items[i].FDrawBottom, RoundRect);
          RoundRect := false;
        end;

      bcLowered:
        begin
          cyFrame3D(aCanvas, BoundsRect, Items[i].FShadowColor, Items[i].FHighlightColor, Items[i].FWidth,
              Items[i].FDrawLeft, Items[i].FDrawTop, Items[i].FDrawRight, Items[i].FDrawBottom, RoundRect);
          RoundRect := false;
        end;

      bcTransparent:   // Just Inflate Rect
        begin
          InflateRect(BoundsRect, (-1) * Items[i].FWidth, (-1) * Items[i].FWidth);
          RoundRect := false;
        end;

      bcNone: ;
    end;
end;

function TcyBevels.xBevelsWidth: Integer;
begin
  RESULT := 0;
end;

// 9999 for All other units like TcySimpleGauge
function TcyBevels.BevelsWidth: Integer;
var i: Integer;
begin
  RESULT := 0;
  for i := 0 to Count-1 do
    if Items[i].FStyle <> bcNone
    then Inc(RESULT, Items[i].FWidth);
end;

end.