jvggroupbox.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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: JvgGroupBox.PAS, released on 2003-01-15.

The Initial Developer of the Original Code is Andrey V. Chudin,  [chudin att yandex dott ru]
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
All Rights Reserved.

Contributor(s):
Michael Beck [mbeck att bigfoot dott com].

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: JvgGroupBox.pas,v 1.31 2005/02/17 10:21:20 marquardt Exp $

unit JvgGroupBox;

{$I jvcl.inc}

// Illumination - fake :)
interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls,
  {$IFDEF USEJVCL}
  JVCLVer,
  {$ENDIF USEJVCL}
  JvgTypes, JvgCommClasses;

type
  TCaptionAlignment = (fcaNone, fcaLeft, fcaRight, fcaCenter, fcaWidth);
  TJvgGroupBox = class(TCustomGroupBox)
  private
    {$IFDEF USEJVCL}
    FAboutJVCL: TJVCLAboutInfo;
    {$ENDIF USEJVCL}
    FBorder: TJvgBevelOptions;
    FCaptionBorder: TJvgBevelOptions;
    FGradient: TJvgGradient;
    FCaptionGradient: TJvgGradient;
    FCaptionShift: TJvgPointClass;
    FCaptionTextStyle: TglTextStyle;
    FCaptionAlignment: TCaptionAlignment;
    FColors: TJvgGroupBoxColors;
    FIllumination: TJvgIllumination;
    FTransparent: Boolean;
    FTransparentCaption: Boolean;
    FOptions: TglGroupBoxOptions;
    FCollapsed: Boolean;
    FAfterPaint: TNotifyEvent;
    FOnCollapsed: TNotifyEvent;
    FOnExpanded: TNotifyEvent;
    FGroupIndex: Integer;
    FGlyphCollapsed: TBitmap;
    FGlyphExpanded: TBitmap;

    ChildFocusedControl: TWinControl;
//    FImage: TBitmap;
    FullHeight: Integer;
    CaptionRect: TRect;
    ptScroll: TPoint;
    fScrolling: Boolean;
    procedure SetCaptionAlignment(Value: TCaptionAlignment);
    procedure SetCaptionTextStyle(Value: TglTextStyle);
    procedure SetCollapsed(Value: Boolean);
    procedure SetOptions(Value: TglGroupBoxOptions);
    procedure SetTransparent(Value: Boolean);
    procedure SetTransparentCaption(Value: Boolean);
    procedure SetGroupIndex(Value: Integer);
    function GetGlyphCollapsed: TBitmap;
    procedure SetGlyphCollapsed(Value: TBitmap);
    function GetGlyphExpanded: TBitmap;
    procedure SetGlyphExpanded(Value: TBitmap);

    procedure Collapse_(fCollapse: Boolean);
    procedure SmthChanged(Sender: TObject);
    function GetCaption: string;
    procedure SetCaption(const Value: string);
    procedure ReadFullHeight(Reader: TReader);
    procedure WriteFullHeight(Writer: TWriter);
    //    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;

    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP;
    procedure CMEnabledChanged(var Msg: TMessage);  message CM_ENABLEDCHANGED;
  protected
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure ComputeCaptionRect;
  public
    procedure Collapse(fCollapse: Boolean);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DefineProperties(Filer: TFiler); override;
  published
    {$IFDEF USEJVCL}
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    {$ENDIF USEJVCL}
    property Anchors;
    property Align;
    property Caption: string read GetCaption write SetCaption;
    property Color;
    property DragCursor;
    property DragMode;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property Enabled;
    property Border: TJvgBevelOptions read FBorder write FBorder;
    property CaptionAlignment: TCaptionAlignment
      read FCaptionAlignment write SetCaptionAlignment default fcaNone;
    property CaptionBorder: TJvgBevelOptions read FCaptionBorder write FCaptionBorder;
    property CaptionGradient: TJvgGradient read FCaptionGradient write FCaptionGradient;
    property CaptionShift: TJvgPointClass read FCaptionShift write FCaptionShift;
    property CaptionTextStyle: TglTextStyle read FCaptionTextStyle write SetCaptionTextStyle default fstNone;
    property Collapsed: Boolean read FCollapsed write SetCollapsed default False;
    property Colors: TJvgGroupBoxColors read FColors write FColors;
    property Gradient: TJvgGradient read FGradient write FGradient;
    property Illumination: TJvgIllumination read FIllumination write FIllumination stored False;
    property Options: TglGroupBoxOptions read FOptions write SetOptions;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property TransparentCaption: Boolean read FTransparentCaption write SetTransparentCaption default False;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property GlyphCollapsed: TBitmap read GetGlyphCollapsed write SetGlyphCollapsed;
    property GlyphExpanded: TBitmap read GetGlyphExpanded write SetGlyphExpanded;
    property AfterPaint: TNotifyEvent read FAfterPaint write FAfterPaint;
    property OnCollapsed: TNotifyEvent read FOnCollapsed write FOnCollapsed;
    property OnExpanded: TNotifyEvent read FOnExpanded write FOnExpanded;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvgGroupBox.pas,v $';
    Revision: '$Revision: 1.31 $';
    Date: '$Date: 2005/02/17 10:21:20 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  Math,
  JvgUtils;

constructor TJvgGroupBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //  ControlStyle := ControlStyle + [csOpaque];
  FBorder := TJvgBevelOptions.Create;
  FCaptionBorder := TJvgBevelOptions.Create;
  FGradient := TJvgGradient.Create;
  FCaptionGradient := TJvgGradient.Create;
  FColors := TJvgGroupBoxColors.Create;
  FIllumination := TJvgIllumination.Create;
  FCaptionShift := TJvgPointClass.Create;
  //...defaults

  FColors.Caption := clBtnShadow;
  FColors.CaptionActive := clBtnShadow;
  FColors.Text := clHighlightText;
  FColors.TextActive := clHighlightText;
  FBorder.Outer := bvNone;
  FBorder.Inner := bvSpace;
  FCaptionBorder.Outer := bvNone;
  FCaptionBorder.Inner := bvSpace;
  FGradient.FromColor := clBlack;
  FGradient.ToColor := clGray;
  FCaptionShift.X := 8;
  FCaptionShift.Y := 0;
  FCaptionTextStyle := fstNone;
  FCaptionAlignment := fcaNone;
  FOptions := [fgoCanCollapse, fgoFilledCaption, fgoFluentlyCollapse,
    fgoFluentlyExpand, fgoHideChildrenWhenCollapsed, fgoSaveChildFocus];
  {$IFDEF GL_RUS}
  Font.CharSet := RUSSIAN_CHARSET;
  {$ENDIF GL_RUS}
  FBorder.OnChanged := SmthChanged;
  FCaptionBorder.OnChanged := SmthChanged;
  FGradient.OnChanged := SmthChanged;
  FCaptionGradient.OnChanged := SmthChanged;
  FCaptionShift.OnChanged := SmthChanged;
  FColors.OnChanged := SmthChanged;
  FIllumination.OnChanged := SmthChanged;
  ControlStyle := ControlStyle + [csOpaque];
end;

destructor TJvgGroupBox.Destroy;
begin
  FBorder.Free;
  FCaptionBorder.Free;
  FGradient.Free;
  FCaptionGradient.Free;
  FCaptionShift.Free;
  FColors.Free;
  FIllumination.Free;
//  FImage.Free;
  FGlyphExpanded.Free;
  FGlyphCollapsed.Free;
  inherited Destroy;
end;

procedure TJvgGroupBox.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('FullHeight', ReadFullHeight, WriteFullHeight, True);
end;

procedure TJvgGroupBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if Transparent or TransparentCaption then
    Params.ExStyle := Params.ExStyle or WS_EX_Transparent;
end;

procedure TJvgGroupBox.AdjustClientRect(var Rect: TRect);
begin
  inherited AdjustClientRect(Rect);
  Inc(Rect.Top, 1);
end;

procedure TJvgGroupBox.WMLButtonDown(var Msg: TWMLButtonDown);
var
  pt: TPoint;
begin
  inherited;
  if fgoIgnoreMouse in Options then
    Exit;
  pt.X := Msg.Pos.X;
  pt.Y := Msg.Pos.Y;
  if (fgoCanCollapse in Options) and PtInRect(CaptionRect, pt) then
    Collapse(not Collapsed)
  else
  begin
    Screen.Cursor := crHandPoint;
    {ptScroll.X := pt.X;} ptScroll.Y := pt.Y;
    fScrolling := True;
  end;

end;

procedure TJvgGroupBox.WMMouseMove(var Msg: TWMMouseMove);
begin
  if fScrolling and (Parent is TScrollBox) then
    (Parent as TScrollBox).VertScrollBar.Position := (Parent as
      TScrollBox).VertScrollBar.Position + ptScroll.Y - Msg.Pos.Y;
  inherited;
end;

procedure TJvgGroupBox.WMLButtonUp(var Msg: TWMLButtonUp);
begin
  inherited;
  if fgoIgnoreMouse in Options then
    Exit;
  fScrolling := False;
  Screen.Cursor := crDefault;
end;

procedure TJvgGroupBox.CMEnabledChanged(var Msg: TMessage);
var
  I: Integer;
begin
  for I := 0 to ControlCount - 1 do
    Controls[I].Enabled := Enabled;
end;

procedure TJvgGroupBox.ReadFullHeight(Reader: TReader);
begin
  FullHeight := Reader.ReadInteger;
end;

procedure TJvgGroupBox.WriteFullHeight(Writer: TWriter);
begin
  Writer.WriteInteger(FullHeight);
end;

procedure TJvgGroupBox.Paint;
type
  TgbColor = record
    Text: TColor;
    Caption: TColor;
    Background: TColor;
    Client: TColor;
    Delineate: TColor;
  end;
var
  H, GlyphWidth: Integer;
  R, NewR: TRect;
  Glyph: TBitmap;
  DrawState: TglDrawState;
  Interspace: Integer;
  Color: TgbColor;
begin
  //inherited;
  //Exit;
  Interspace := 2;
  if Collapsed then
  begin
    Color.Text := Colors.Text;
    Color.Caption := Colors.Caption;
    //    Color.Background := Colors.Background;
    Color.Client := Colors.Client;
    Color.Delineate := Colors.Delineate;
  end
  else
  begin
    Color.Text := Colors.TextActive;
    Color.Caption := Colors.CaptionActive;
    //    Color.Background := Colors.BackgroundActive;
    Color.Client := Colors.ClientActive;
    Color.Delineate := Colors.DelineateActive;
  end;

  with Canvas do
  begin
    Canvas.Font.Assign(Self.Font);
    R := GetClientRect;
    //Font := Self.Font;
//    if CaptionHeight = 0 then H := TextHeight('0') - FCaptionShift.Y
//                         else H := CaptionHeight - FCaptionShift.Y
    H := TextHeight(Text) - FCaptionShift.Y;
    R := Rect(0, H div 2 { - 1}, Width, Height);
    if FGradient.Active then
      GradientBox(Handle, R, FGradient, PS_SOLID, 1);

    Dec(R.Right);
    Dec(R.Bottom);
    DrawBoxEx(Canvas.Handle, R,
      Border.Sides, Border.Inner, Border.Outer,
      Border.Bold, Color.Client, FGradient.Active or Transparent);

    if Text <> '' then
    begin
      if Assigned(FGlyphExpanded) then
        GlyphWidth := FGlyphExpanded.Width
      else
        GlyphWidth := 0;
      if Assigned(FGlyphCollapsed) then
        GlyphWidth := max(FGlyphCollapsed.Width, GlyphWidth);

      if Collapsed then
        Glyph := FGlyphCollapsed
      else
        Glyph := FGlyphExpanded;

      ComputeCaptionRect;
      R := CaptionRect;

      if not TransparentCaption then
      begin
        Canvas.Brush.Color := Colors.Caption;
        Windows.FillRect(Canvas.Handle, R, Canvas.Brush.Handle);
      end;
      GradientBox(Canvas.Handle, R, FCaptionGradient, PS_SOLID, 1);

      NewR := DrawBoxEx(Canvas.Handle, R, CaptionBorder.Sides,
        CaptionBorder.Inner, CaptionBorder.Outer,
        CaptionBorder.Bold, Color.Caption,
        TransparentCaption or not (fgoFilledCaption in Options));
      //      Brush.Color := Color;

      SetBkMode(Handle, Integer(TRANSPARENT));

      if Assigned(Glyph) then
      begin
        if Enabled then
          DrawState := fdsDefault
        else
          DrawState := fdsDisabled;
        CreateBitmapExt(Handle, Glyph, NewR, 0, max(0, (NewR.Bottom -