jvgcheckbox.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: JvgCheckBox.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: JvgCheckBox.pas,v 1.34 2005/02/17 10:21:19 marquardt Exp $

unit JvgCheckBox;

{$I jvcl.inc}
{$I windowsonly.inc} // (ahuser) uses WndProc and Wnd hooks

interface

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

type
  {$IFDEF USEJVCL}
  TJvgCheckBox = class(TJvGraphicControl)
  {$ELSE}
  TJvgCheckBox = class(TGraphicControl)
  {$ENDIF USEJVCL}
  private
    FChecked: Boolean;
    FColors: TJvgLabelColors;
    FIllumination: TJvgIllumination;
    FGlyph: TBitmap;
    FGlyphOn: TBitmap;
    FGlyphOff: TBitmap;
    FGlyphDisabled: TBitmap;
    FGradient: TJvgGradient;
    FGroupIndex: Integer;
    FGlyphShift: TJvgPointClass;
    FOptions: TglCheckBoxOptions;
    FTransparent: Boolean;
    FTextStyles: TJvgLabelTextStyles;
    FDisabledMaskColor: TColor;
    FInterspace: Integer;
    FFocusControl: TWinControl;
    FFocusControlMethod: TFocusControlMethod;
    FAfterPaint: TNotifyEvent;
    FGlyphKind: TglGlyphKind;
    FPrevWndProc: Pointer;
    FNewWndProc: Pointer;
    FActiveNow: Boolean;
    FShowAsActiveWhileControlFocused: Boolean;
    FImg: TBitmap;
    FNeedUpdateOnlyMainText: Boolean;
    FSuppressCMFontChanged: Boolean;
    FOnlyTextStyleChanged: Boolean;
    FAlignment: TLeftRight;
    FNeedRebuildBackground: Boolean;
    function IsCustomGlyph: Boolean;
    procedure SetChecked(Value: Boolean);
    procedure SetGlyph(Value: TBitmap);
    function GetGlyph: TBitmap;
    procedure SetGlyphOn(Value: TBitmap);
    function GetGlyphOn: TBitmap;
    procedure SetGlyphOff(Value: TBitmap);
    function GetGlyphOff: TBitmap;
    procedure SetGlyphDisabled(Value: TBitmap);
    function GetGlyphDisabled: TBitmap;
    procedure SetGroupIndex(Value: Integer);
    procedure SetOptions(Value: TglCheckBoxOptions);
    procedure SetTransparent(Value: Boolean);
    procedure SetDisabledMaskColor(Value: TColor);
    procedure SetInterspace(Value: Integer);
    procedure SetFocusControl(Value: TWinControl);
    procedure SetGlyphKind(Value: TglGlyphKind);

    procedure OnGradientChanged(Sender: TObject);
    procedure OnIlluminationChanged(Sender: TObject);
    procedure WMLButtonUp(var Msg: TMessage); message WM_LBUTTONUP;
    procedure WMLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN;
    procedure SetAlignment(const Value: TLeftRight);
  protected
    {$IFDEF USEJVCL}
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    procedure FontChanged; override;
    procedure TextChanged; override;
    {$ENDIF USEJVCL}
    procedure Resize; override;
    procedure Paint; override;
    procedure HookFocusControlWndProc;
    procedure UnhookFocusControlWndProc;
    procedure FocusControlWndHookProc(var Msg: TMessage);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    function GetCheckedItemInGroup: TJvgCheckBox;
    procedure SetCheckedItemInGroup(TagNo: Integer);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Anchors;
    property Align;
    property Caption;
    property Enabled;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property DragCursor;
    property DragMode;
    property Font;

    property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify;
    property GlyphKind: TglGlyphKind read FGlyphKind write SetGlyphKind default fgkDefault;
    property Checked: Boolean read FChecked write SetChecked default False;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property GlyphOn: TBitmap read GetGlyphOn write SetGlyphOn stored IsCustomGlyph;
    property GlyphOff: TBitmap read GetGlyphOff write SetGlyphOff stored IsCustomGlyph;
    property GlyphDisabled: TBitmap read GetGlyphDisabled write SetGlyphDisabled stored IsCustomGlyph;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property GlyphShift: TJvgPointClass read FGlyphShift write FGlyphShift;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property TextStyles: TJvgLabelTextStyles read FTextStyles write FTextStyles;
    property Colors: TJvgLabelColors read FColors write FColors;
    property Options: TglCheckBoxOptions read FOptions write SetOptions;
    property Gradient: TJvgGradient read FGradient write FGradient;
    property Illumination: TJvgIllumination read FIllumination write FIllumination;
    property DisabledMaskColor: TColor read FDisabledMaskColor write SetDisabledMaskColor default clBlack;
    property Interspace: Integer read FInterspace write SetInterspace default 0;
    property FocusControl: TWinControl read FFocusControl write SetFocusControl;
    property FocusControlMethod: TFocusControlMethod read FFocusControlMethod write FFocusControlMethod default fcmOnMouseDown;

    {$IFDEF USEJVCL}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF USEJVCL}
    property AfterPaint: TNotifyEvent read FAfterPaint write FAfterPaint;
  end;

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

implementation

{$IFDEF USEJVCL}
uses
  Math,
  JvThemes, JvJVCLUtils;
{$ELSE}
uses
  Math;
{$ENDIF USEJVCL}

{$R ..\Resources\JvgCheckBox.res}

{$IFNDEF USEJVCL}

function JvMakeObjectInstance(Method: TWndMethod): Pointer;
begin
  {$IFDEF COMPILER6_UP}
  Result := Classes.MakeObjectInstance(Method);
  {$ELSE}
  Result := MakeObjectInstance(Method);
  {$ENDIF COMPILER6_UP}
end;

procedure JvFreeObjectInstance(ObjectInstance: Pointer);
begin
  if ObjectInstance <> nil then
    {$IFDEF COMPILER6_UP}
    Classes.FreeObjectInstance(ObjectInstance);
    {$ELSE}
    FreeObjectInstance(ObjectInstance);
    {$ENDIF COMPILER6_UP}
end;

{$ENDIF !USEJVCL}

constructor TJvgCheckBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle :=
    [csCaptureMouse, csOpaque, csClickEvents, csSetCaption, csReplicatable];
  //  ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  {$IFDEF USEJVCL}
  IncludeThemeStyle(Self, [csParentBackground]);
  {$ENDIF USEJVCL}

  //  FGlyphOn := TBitmap.Create;
  //  FGlyphOff := TBitmap.Create;
  FImg := TBitmap.Create;
  TextStyles := TJvgLabelTextStyles.Create;
  Colors := TJvgLabelColors.Create;
  Gradient := TJvgGradient.Create;
  FIllumination := TJvgIllumination.Create;
  FGlyphShift := TJvgPointClass.Create;

  //..defaults
  Width := 80;
  Height := 17;
  FAlignment := taRightJustify;
  FChecked := False;
  FTransparent := False;
  FGradient.OnChanged := OnGradientChanged;
  FIllumination.OnChanged := OnIlluminationChanged;
  TextStyles.OnChanged := OnIlluminationChanged;
  Colors.OnChanged := OnIlluminationChanged;
  FGlyphShift.OnChanged := OnGradientChanged;
  FOptions := [fcoFastDraw];
  FGroupIndex := 0;
  FInterspace := 0;
  FFocusControlMethod := fcmOnMouseDown;
  FNeedRebuildBackground := True;

  FImg.Canvas.Brush.Color := clBtnFace;
  FImg.Canvas.Brush.Style := bsSolid;
  //  FNeedUpdateOnlyMainText := False;
  {$IFDEF FR_RUS}
  Font.CharSet := RUSSIAN_CHARSET;
  {$ENDIF FR_RUS}
  GlyphKind := fgkDefault;
end;

destructor TJvgCheckBox.Destroy;
begin
  FGlyphOn.Free;
  FGlyphOff.Free;
  FGlyph.Free;
  FGlyphDisabled.Free;
  FImg.Free;
  FTextStyles.Free;
  FColors.Free;
  FGradient.Free;
  FIllumination.Free;
  FGlyphShift.Free;
  SetFocusControl(nil);
  inherited Destroy;
end;

{$IFDEF USEJVCL}

procedure TJvgCheckBox.FontChanged;
begin
  if not FSuppressCMFontChanged then
  begin
    FImg.Canvas.Font.Assign(Font);
    Invalidate;
    inherited FontChanged;
  end;
end;

procedure TJvgCheckBox.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not Enabled or (fcoIgnoreMouse in Options) or
    FShowAsActiveWhileControlFocused then
    Exit;
  if Assigned(FocusControl) and (FocusControlMethod = fcmOnMouseEnter) then
    FocusControl.SetFocus;
  FNeedRebuildBackground := True;
  FActiveNow := True;
  with TextStyles, Colors do
    if (Passive <> Active) or (fcoUnderlinedActive in Options) then
      Repaint
    else
    if (fcoDelineatedText in Options) and (DelineateActive <> Delineate) then
      Repaint
    else
    if (not Transparent) and (Colors.Background <>
      Colors.BackgroundActive) then
      Repaint
    else
    if (TextActive <> Text) or (fcoUnderlinedActive in Options) then
    begin
      FNeedUpdateOnlyMainText := True;
      Repaint;
    end;
  inherited MouseEnter(Control);
end;

procedure TJvgCheckBox.MouseLeave(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not Enabled or (fcoIgnoreMouse in Options) or
    FShowAsActiveWhileControlFocused then
    Exit;
  FNeedRebuildBackground := True;
  FActiveNow := False;
  with TextStyles, Colors do
    if (Passive <> Active) or (fcoUnderlinedActive in Options) then
      Repaint
    else
    if (fcoDelineatedText in Options) and (DelineateActive <> Delineate) then
      Repaint
    else
    if (not Transparent) and (Colors.Background <>
      Colors.BackgroundActive) then
      Repaint
    else
    if TextActive <> Text then
    begin
      FNeedUpdateOnlyMainText := True;
      Repaint;
    end;
  inherited MouseLeave(Control);
end;

procedure TJvgCheckBox.TextChanged;
begin
  inherited TextChanged;
  Invalidate;
end;

{$ENDIF USEJVCL}

procedure TJvgCheckBox.WMLButtonUp(var Msg: TMessage);
var
  pt: TPoint;
begin
  if not Enabled or (fcoIgnoreMouse in Options) then
    Exit;
  GetCursorPos(pt);
  pt := ScreenToClient(pt);
  if PtInRect(ClientRect, pt) then
    SetChecked(not FChecked);
  if Assigned(FocusControl) then
  begin
    if fcoEnabledFocusControlWhileChecked in Options then
      FocusControl.Enabled := FChecked;
    if (FocusControlMethod = fcmOnMouseUp) and FocusControl.CanFocus then
      FocusControl.SetFocus;
  end;
  inherited;
end;

procedure TJvgCheckBox.WMLButtonDown(var Msg: TMessage);
begin
  if not Enabled or (fcoIgnoreMouse in Options) then
    Exit;
  inherited;
  if (FocusControlMethod = fcmOnMouseDown) and Assigned(FocusControl) and FocusControl.CanFocus then
    FocusControl.SetFocus;
end;

procedure TJvgCheckBox.Resize;
begin
  inherited Resize;
  //  Img.Width := Width; Img.Height := Height;
end;

procedure TJvgCheckBox.Paint;
var
  X, Y: Integer;
  DrawState: TglDrawState;
  Bitmap: TBitmap;
  FontColor: TColor;
  CurrTextStyle: TglTextStyle;
  CurrDelinColor: TColor;
  isGradientActive: Boolean;
  Size: TSize;
  R: TRect;
  BackBrush: HBRUSH;
begin
  //FNeedUpdateOnlyMainText := False;
  //FNeedRebuildBackground := False;
  FSuppressCMFontChanged := True;
  if fcoBoldChecked in Options then
    if Checked then
      Font.Style := Font.Style + [fsBold]
    else
      Font.Style := Font.Style - [fsBold];
  if Enabled then
  begin
    if Checked then
      Bitmap := FGlyphOn
    else
      Bitmap := FGlyphOff;
    DrawState := fdsDefault;
  end
  else
  begin
    if FGlyphDisabled.Handle <> 0 then
    begin
      Bitmap := FGlyphDisabled;
      DrawState := fdsDefault;
    end
    else
    begin
      if Checked then
        Bitmap := FGlyphOn
      else
        Bitmap := FGlyphOff;
      DrawState := fdsDefault;
    end;
  end;

  //...CAPTION
  SetBkMode(Canvas.Handle, Integer(Transparent));
  with TextStyles, Colors do
  begin
    if FActiveNow then
    begin
      CurrTextStyle := Active;
      CurrDelinColor := DelineateActive;
      FontColor := TextActive;
    end
    else
    if Enabled then
    begin
      CurrTextStyle := Passive;
      CurrDelinColor := Delineate;
      FontColor := Text;
    end
    else