jvqgradientcaption.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{  WARNING:  JEDI preprocessor generated unit.  Do not edit.                                       }
{**************************************************************************************************}

{-----------------------------------------------------------------------------
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/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvGrdCpt.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQGradientCaption.pas,v 1.4 2004/05/16 10:05:33 asnepvangers Exp $

{$I jvcl.inc}

unit JvQGradientCaption;

interface

uses
  
  
  QClasses, QGraphics, QControls, QForms, QMenus,
  JvQJCLUtils, JvQWndProcHook;
  

type
  THideDirection = (hdLeftToRight, hdRightToLeft);

  TJvCaption = class;
  TJvCaptionList = class;

  TJvGradientCaption = class(TComponent)
  private
    FActive: Boolean;
    FWindowActive: Boolean;
    FSaveRgn: HRgn;
    FRgnChanged: Boolean;
    FWinHook: TJvWindowHook;
    FStartColor: TColor;
    FCaptions: TJvCaptionList;
    FFont: TFont;
    FDefaultFont: Boolean;
    FPopupMenu: TPopupMenu;
    FClicked: Boolean;
    FHideDirection: THideDirection;
    FGradientInactive: Boolean;
    FGradientActive: Boolean;
    FFontInactiveColor: TColor;
    FFormCaption: string;
    FGradientSteps: Integer;
    FOnActivate: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    procedure SetHook;
    procedure ReleaseHook;
    procedure CheckToggleHook;
    function GetActive: Boolean;
    procedure SetActive(Value: Boolean);
    procedure SetStartColor(Value: TColor);
    procedure DrawGradientCaption(DC: HDC);
    procedure CalculateGradientParams(var R: TRect; var Icons: TBorderIcons);
    function GetForm: TForm;
    function GetFormCaption: string;
    procedure SetFormCaption(const Value: string);
    procedure BeforeMessage(Sender: TObject; var Msg: TMessage; var Handled: Boolean);
    procedure AfterMessage(Sender: TObject; var Msg: TMessage; var Handled: Boolean);
    function CheckMenuPopup(X, Y: Integer): Boolean;
    procedure SetFont(Value: TFont);
    procedure FontChanged(Sender: TObject);
    procedure SetDefaultFont(Value: Boolean);
    procedure SetFontDefault;
    function IsFontStored: Boolean;
    function GetTextWidth: Integer;
    procedure SetCaptions(Value: TJvCaptionList);
    procedure SetGradientActive(Value: Boolean);
    procedure SetGradientInactive(Value: Boolean);
    procedure SetGradientSteps(Value: Integer);
    procedure SetFontInactiveColor(Value: TColor);
    procedure SetHideDirection(Value: THideDirection);
    procedure SetPopupMenu(Value: TPopupMenu);
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function IsRightToLeft: Boolean;
    property Form: TForm read GetForm;
    property TextWidth: Integer read GetTextWidth;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MoveCaption(FromIndex, ToIndex: Integer);
    procedure Update;
    procedure Clear;
  published
    property Active: Boolean read GetActive write SetActive default True;
    property Captions: TJvCaptionList read FCaptions write SetCaptions;
    property DefaultFont: Boolean read FDefaultFont write SetDefaultFont default True;
    property FormCaption: string read GetFormCaption write SetFormCaption;
    property FontInactiveColor: TColor read FFontInactiveColor
      write SetFontInactiveColor default clInactiveCaptionText;
    property Font: TFont read FFont write SetFont stored IsFontStored;
    property GradientActive: Boolean read FGradientActive
      write SetGradientActive default True;
    property GradientInactive: Boolean read FGradientInactive
      write SetGradientInactive default False;
    property GradientSteps: Integer read FGradientSteps write SetGradientSteps default 64;
    property HideDirection: THideDirection read FHideDirection
      write SetHideDirection default hdLeftToRight;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property StartColor: TColor read FStartColor write SetStartColor
      default clWindowText;
    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
  end;

  TJvCaptionList = class(TCollection)
  private
    FParent: TJvGradientCaption;
    function GetCaption(Index: Integer): TJvCaption;
    procedure SetCaption(Index: Integer; Value: TJvCaption);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AParent: TJvGradientCaption);
    function Add: TJvCaption;
    procedure RestoreDefaults;
    property Parent: TJvGradientCaption read FParent;
    property Items[Index: Integer]: TJvCaption read GetCaption write SetCaption; default;
  end;

  TJvCaption = class(TCollectionItem)
  private
    FCaption: string;
    FFont: TFont;
    FParentFont: Boolean;
    FVisible: Boolean;
    FGlueNext: Boolean;
    FInactiveColor: TColor;
    procedure SetCaption(const Value: string);
    procedure SetFont(Value: TFont);
    procedure SetParentFont(Value: Boolean);
    procedure FontChanged(Sender: TObject);
    function IsFontStored: Boolean;
    function GetTextWidth: Integer;
    procedure SetVisible(Value: Boolean);
    procedure SetInactiveColor(Value: TColor);
    procedure SetGlueNext(Value: Boolean);
  protected
    function GetParentCaption: TJvGradientCaption;
    property TextWidth: Integer read GetTextWidth;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure RestoreDefaults; virtual;
    property GradientCaption: TJvGradientCaption read GetParentCaption;
  published
    property Caption: string read FCaption write SetCaption;
    property Font: TFont read FFont write SetFont stored IsFontStored;
    property ParentFont: Boolean read FParentFont write SetParentFont default True;
    property InactiveColor: TColor read FInactiveColor write SetInactiveColor
      default clInactiveCaptionText;
    property GlueNext: Boolean read FGlueNext write SetGlueNext default False;
    property Visible: Boolean read FVisible write SetVisible default True;
  end;

function GradientFormCaption(AForm: TCustomForm; AStartColor: TColor): TJvGradientCaption;

implementation

uses
  SysUtils,
  JvQConsts;

function GradientFormCaption(AForm: TCustomForm; AStartColor: TColor): TJvGradientCaption;
begin
  Result := TJvGradientCaption.Create(AForm);
  with Result do
  try
    FStartColor := AStartColor;
    FormCaption := AForm.Caption;
    Update;
  except
    Free;
    raise;
  end;
end;

function InternalGetTextWidth(Font: TFont; Caption: string): Integer;
var
  Canvas: TCanvas;
  PS: TPaintStruct;
begin
  BeginPaint(Application.Handle, PS);
  try
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := PS.hDC;
      Canvas.Font := Font;
      Result := Canvas.TextWidth(Caption);
    finally
      Canvas.Free;
    end;
  finally
    EndPaint(Application.Handle, PS);
  end;
end;

//=== TJvCaptionList =========================================================

constructor TJvCaptionList.Create(AParent: TJvGradientCaption);
begin
  inherited Create(TJvCaption);
  FParent := AParent;
end;

function TJvCaptionList.Add: TJvCaption;
begin
  Result := TJvCaption(inherited Add);
end;

function TJvCaptionList.GetCaption(Index: Integer): TJvCaption;
begin
  Result := TJvCaption(inherited Items[Index]);
end;

function TJvCaptionList.GetOwner: TPersistent;
begin
  Result := FParent;
end;

procedure TJvCaptionList.RestoreDefaults;
var
  I: Integer;
begin
  BeginUpdate;
  try
    for I := 0 to Count - 1 do
      Items[I].RestoreDefaults;
  finally
    EndUpdate;
  end;
end;

procedure TJvCaptionList.SetCaption(Index: Integer; Value: TJvCaption);
begin
  Items[Index].Assign(Value);
end;

procedure TJvCaptionList.Update(Item: TCollectionItem);
begin
  if (FParent <> nil) and not (csLoading in FParent.ComponentState) then
    if FParent.Active then
      FParent.Update;
end;

//=== TJvCaption =============================================================

constructor TJvCaption.Create(Collection: TCollection);
var
  Parent: TJvGradientCaption;
begin
  Parent := nil;
  if Assigned(Collection) and (Collection is TJvCaptionList) then
    Parent := TJvCaptionList(Collection).Parent;
  try
    inherited Create(Collection);
    FFont := TFont.Create;
    if Assigned(Parent) then
    begin
      FFont.Assign(Parent.Font);
      FFont.Color := Parent.Font.Color;
    end
    else
      FFont.Color := clCaptionText;
    FFont.OnChange := FontChanged;
    FCaption := '';
    FParentFont := True;
    FVisible := True;
    FGlueNext := False;
    FInactiveColor := clInactiveCaptionText;
  finally
    if Assigned(Parent) then
      Changed(False);
  end;
end;

destructor TJvCaption.Destroy;
begin
  FFont.Free;
  FFont := nil;
  inherited Destroy;
end;

procedure TJvCaption.Assign(Source: TPersistent);
begin
  if Source is TJvCaption then
  begin
    if Assigned(Collection) then
      Collection.BeginUpdate;
    try
      RestoreDefaults;
      Caption := TJvCaption(Source).Caption;
      ParentFont := TJvCaption(Source).ParentFont;
      if not ParentFont then
        Font.Assign(TJvCaption(Source).Font);
      InactiveColor := TJvCaption(Source).InactiveColor;
      GlueNext := TJvCaption(Source).GlueNext;
      Visible := TJvCaption(Source).Visible;
    finally
      if Assigned(Collection) then
        Collection.EndUpdate;
    end;
  end
  else
    inherited Assign(Source);
end;

procedure TJvCaption.RestoreDefaults;
begin
  FInactiveColor := clInactiveCaptionText;
  FVisible := True;
  ParentFont := True;
end;

function TJvCaption.GetParentCaption: TJvGradientCaption;
begin
  if Assigned(Collection) and (Collection is TJvCaptionList) then
    Result := TJvCaptionList(Collection).Parent
  else
    Result := nil;
end;

procedure TJvCaption.SetCaption(const Value: string);
begin
  FCaption := Value;
  Changed(False);
end;

procedure TJvCaption.FontChanged(Sender: TObject);
begin
  FParentFont := False;
  Changed(False);
end;

procedure TJvCaption.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TJvCaption.SetParentFont(Value: Boolean);
begin
  if Value and (GradientCaption <> nil) then
  begin
    FFont.OnChange := nil;
    try
      FFont.Assign(GradientCaption.Font);
    finally
      FFont.OnChange := FontChanged;
    end;
  end;
  FParentFont := Value;
  Changed(False);
end;

function TJvCaption.IsFontStored: Boolean;
begin
  Result := not ParentFont;
end;

function TJvCaption.GetTextWidth: Integer;
begin
  Result := InternalGetTextWidth(Font, Caption);