jvgpage.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: JvgPage.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

Description:
  PageControl  component  that can  display  its  pages captions  in
  3D styles with 3D borders.  Component  can display  glyphs  on  own
  captions and fill background with bitmap.  You  can  set  different
  fonts for selected page caption and for other captions.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvgPage.pas,v 1.20 2005/02/17 10:21:21 marquardt Exp $

unit JvgPage;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, CommCtrl, ImgList, ExtCtrls,
  {$IFDEF USEJVCL}
  JVCLVer,
  {$ENDIF USEJVCL}
  JvgTypes, JvgDrawTab, JvgTabComm, JvgCommClasses;

// (rom) disabled  unused
//const
//  TCM_SETTEXTCOLOR = TCM_FIRST + 36;

type
  TJvgPageControl = class(TPageControl)
  private
    {$IFDEF USEJVCL}
    FAboutJVCL: TJVCLAboutInfo;
    {$ENDIF USEJVCL}
    FGlyphs: TImageList;
    FSingleGlyph: Boolean;
    FTabStyle: TJvgTabStyle;
    FTabSelectedStyle: TJvgTabStyle;
    FWallpaper: TJvgTabsWallpaper;
    FDrawGlyphsOption: TglWallpaperOption;
    FLookLikeButtons: Boolean;
    FTabsPosition: TglSide;
    FOptions: TglTabOptions;
    FFontDirection: TglLabelDir;
    FOnGetItemColor: TglOnGetItemColorEvent;
    FOnGetItemFontColor: TglOnGetItemColorEvent;
    FOnGetGradientColors: TglOnGetGradientColors;
    FGlyphsChangeLink: TChangeLink;
    FDrawTabStr: TDRAWTABSTRUCT;
    FGlyphTmpBitmap: TBitmap;
    FFontNormal: TFont;
    FFontSelected: TFont;
    FNotFirst: Boolean;
    FTabColors: array [0..100] of TColor;
    FSuppressDraw: Boolean;
    function GetGlyphIndex(Index: Integer): Integer;
    procedure SetGlyphIndex(Index: Integer; ImgIndex: Integer);
    procedure SetGlyphs(Value: TImageList);
    procedure SetSingleGlyph(Value: Boolean);
    procedure SetDrawGlyphsOption(Value: TglWallpaperOption);
    procedure SetLookLikeButtons(Value: Boolean);
    procedure SetTabsPosition(Value: TglSide);
    procedure SetOptions(Value: TglTabOptions);
    procedure SetFontDirection(Value: TglLabelDir);
    function GetFont: TFont;
    procedure SetFont(Value: TFont);
    function GetTabColor(Index: Integer): TColor;
    procedure SetTabColor(Index: Integer; Value: TColor);
    procedure SmthChanged(Sender: TObject);
    procedure FontsChanged(Sender: TObject);
    procedure DrawItem(lpDrawItemStr: PDrawItemStruct);
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
    procedure SetTabStyle(const Value: TJvgTabStyle);
    procedure SetTabSelectedStyle(const Value: TJvgTabStyle);
  protected
    procedure GlyphsListChanged(Sender: TObject);
    procedure WndProc(var Mesg: TMessage); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    procedure RemakeFonts;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property GlyphIndex[Index: Integer]: Integer read GetGlyphIndex write SetGlyphIndex;
    property TabColor[Index: Integer]: TColor read GetTabColor write SetTabColor;
    //     property GlyphState[Index: Integer]: Integer read GetGlyphState write SetGlyphState;
  published
    {$IFDEF USEJVCL}
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    {$ENDIF USEJVCL}
    property Glyphs: TImageList read FGlyphs write SetGlyphs;
    property SingleGlyph: Boolean read FSingleGlyph write SetSingleGlyph default False;
    property TabStyle: TJvgTabStyle read FTabStyle write SetTabStyle;
    property TabSelectedStyle: TJvgTabStyle read FTabSelectedStyle write SetTabSelectedStyle;
    property Wallpaper: TJvgTabsWallpaper read FWallpaper write FWallpaper;
    property DrawGlyphsOption: TglWallpaperOption read FDrawGlyphsOption
      write SetDrawGlyphsOption default fwoNone;
    property LookLikeButtons: Boolean read FLookLikeButtons write SetLookLikeButtons default False;
    property TabsPosition: TglSide read FTabsPosition write SetTabsPosition default fsdTop;
    property Options: TglTabOptions read FOptions write SetOptions;
    property FontDirection: TglLabelDir read FFontDirection
      write SetFontDirection default fldLeftRight;
    property Font: TFont read GetFont write SetFont;
    property OnGetItemColor: TglOnGetItemColorEvent read FOnGetItemColor write FOnGetItemColor;
    property OnGetItemFontColor: TglOnGetItemColorEvent read FOnGetItemFontColor
      write FOnGetItemFontColor;
    property OnGetGradientColors: TglOnGetGradientColors read FOnGetGradientColors
      write FOnGetGradientColors;
  end;

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

implementation

uses
  Math,
  JvgUtils;

const
  FontDirs: array [TglSide] of TglLabelDir =
    (fldDownUp, fldLeftRight, fldUpDown, fldLeftRight);

constructor TJvgPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  TabStop := False;
  FTabStyle := TJvgTabStyle.Create(Self);
  with FTabStyle do
  begin
    BackgrColor := clBtnShadow;
    Font.Color := clBtnHighlight;
    CaptionHAlign := fhaCenter;
  end;
  FTabSelectedStyle := TJvgTabStyle.Create(Self);
  with FTabSelectedStyle do
  begin
    BackgrColor := clBtnFace;
    Font.Color := clBtnText;
    CaptionHAlign := fhaCenter;
  end;

  FWallpaper := TJvgTabsWallpaper.Create;
  FFontNormal := TFont.Create;
  FFontSelected := TFont.Create;
  FDrawTabStr.Font_ := TFont.Create;

  FTabStyle.Font.Name := 'Arial';
  FTabSelectedStyle.Font.Name := 'Arial';

  FGlyphTmpBitmap := TBitmap.Create;
  FGlyphsChangeLink := TChangeLink.Create;
  FGlyphsChangeLink.OnChange := GlyphsListChanged;
  FDrawTabStr.Gradient := TJvgGradient.Create;
  //...set defaults
  FSingleGlyph := False;
  FDrawGlyphsOption := fwoNone;
  FTabsPosition := fsdTop;
  FOptions := [ftoAutoFontDirection, ftoExcludeGlyphs];
  FFontDirection := fldLeftRight;
  FTabStyle.OnChanged := SmthChanged;
  FTabSelectedStyle.OnChanged := SmthChanged;
  FTabStyle.OnFontChanged := FontsChanged;
  FTabSelectedStyle.OnFontChanged := FontsChanged;
  FWallpaper.OnChanged := SmthChanged;
  FillChar(FTabColors, SizeOf(FTabColors), $FF);
end;

destructor TJvgPageControl.Destroy;
begin
  FTabStyle.Free;
  FTabSelectedStyle.Free;
  FGlyphTmpBitmap.Free;
  FWallpaper.Free;
  FGlyphsChangeLink.Free;
  FFontNormal.Free;
  FFontSelected.Free;
  FDrawTabStr.Font_.Free;
  if Assigned(FDrawTabStr.Gradient) then
    FDrawTabStr.Gradient.Free;
  inherited Destroy;
end;

procedure TJvgPageControl.SmthChanged;
begin
  Invalidate;
end;

procedure TJvgPageControl.FontsChanged;
begin
  RemakeFonts;
  Invalidate;
end;

procedure TJvgPageControl.CreateParams(var Params: TCreateParams);
const
  PosStyles: array [TglSide] of DWORD =
    (TCS_VERTICAL, 0, TCS_VERTICAL or TCS_RIGHT, TCS_BOTTOM);
      //or TCS_SCROLLOPPOSITE or TCS_BUTTONS
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if LookLikeButtons then
      Style := Style or TCS_BUTTONS;
    Style := Style or TCS_OWNERDRAWFIXED or PosStyles[FTabsPosition];
  end;
end;

procedure TJvgPageControl.Loaded;
begin
  inherited Loaded;
  RemakeFonts;
  if Assigned(Wallpaper.Bitmap) and (not Wallpaper.Bitmap.Empty) then
    Wallpaper.Bmp := Wallpaper.Bitmap;
end;

procedure TJvgPageControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Assigned(Wallpaper) and (AComponent = Wallpaper.Image) and
    (Operation = opRemove) then
    Wallpaper.Image := nil;
end;

procedure TJvgPageControl.CNDrawItem(var Msg: TWMDrawItem);
begin
  DrawItem(Msg.DrawItemStruct);
end;

procedure TJvgPageControl.WndProc(var Mesg: TMessage);
var
  GlyphID: Integer;
begin
  inherited WndProc(Mesg);
  with Mesg do
    case Msg of
      TCM_INSERTITEM:
        begin
          Result := 0;
          if not Assigned(FGlyphs) then
            Exit;
          GlyphID := -1;
          if FSingleGlyph then
            GlyphID := 0
          else
          if WParam < FGlyphs.Count then
            GlyphID := WParam;
          if GlyphID = -1 then
            Exit;
          TTCItem(Pointer(Mesg.LParam)^).iImage := GlyphID;
          TTCItem(Pointer(Mesg.LParam)^).mask := TCIF_IMAGE;
          SendMessage(Handle, TCM_SETITEM, WParam, LParam);
        end;
      TCM_DELETEITEM:
        ;
      TCM_DELETEALLITEMS: