jvgsplit.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: JvgSplit.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: JvgSplit.pas,v 1.15 2005/02/17 10:21:21 marquardt Exp $

unit JvgSplit;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Controls, Graphics, ExtCtrls,
  JvComponent, JVCLVer;
  {$ELSE}
  Windows, Messages, Classes, Controls, Graphics, ExtCtrls;
  {$ENDIF USEJVCL}

type
  TJvgSplitter = class(TSplitter)
  private
    {$IFDEF USEJVCL}
    FAboutJVCL: TJVCLAboutInfo;
    {$ENDIF USEJVCL}
    FHotTrack: Boolean;
    FTrackCount: Integer;
    FActive: Boolean;
    FDisplace: Boolean;
    FKeepSize: Integer; (* +++ RDB --- *)
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure WMMouseDblClick(var Msg: TMessage); message WM_LBUTTONDBLCLK;
    procedure SetTrackCount(const Value: Integer);
    procedure UpdateControlSize;
    function FindControl: TControl;
    procedure PrepareMarcs(Align: TAlign; var Pt1, Pt2, Pt3, Pt4, Pt5, Pt6: TPoint);
    procedure SetDisplace(const Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  published
    {$IFDEF USEJVCL}
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    {$ENDIF USEJVCL}
    property Displace: Boolean read FDisplace write SetDisplace default True;
    property HotTrack: Boolean read FHotTrack write FHotTrack default True;
    property TrackCount: Integer read FTrackCount write SetTrackCount default 20;
    property Width default 6;
  end;

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

implementation

{$IFDEF USEJVCL}
uses
  JvThemes;
{$ENDIF USEJVCL}

constructor TJvgSplitter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  {$IFDEF USEJVCL}
  IncludeThemeStyle(Self, [csParentBackground]);
  {$ENDIF USEJVCL}
  FKeepSize := 0;
  //..defaults
  Width := 6;
  FHotTrack := True;
  FDisplace := True;
  FTrackCount := 20;
end;

procedure TJvgSplitter.Paint;
var
  I: Integer;
  SColor: TColor;
  Pt1, Pt2, Pt3, Pt4, Pt5, Pt6: TPoint;
  R, R1, R2: TRect;
begin
  with Canvas do
  begin
    Brush.Color := Self.Color;
    {$IFDEF USEJVCL}
    DrawThemedBackground(Self, Canvas, ClientRect);
    {$ELSE}
    Canvas.FillRect(ClientRect);
    {$ENDIF USEJVCL}

    if (Align = alBottom) or (Align = alTop) then
    begin
      R1 := Classes.Bounds((Width - FTrackCount * 4) div 2, 0, 3, 3);
      R2 := Classes.Bounds((Width - FTrackCount * 4) div 2, 3, 3, 3);
    end
    else
    begin
      R1 := Classes.Bounds(0, (Height - FTrackCount * 4) div 2, 3, 3);
      R2 := Classes.Bounds(3, (Height - FTrackCount * 4) div 2, 3, 3);
    end;

    for I := 0 to FTrackCount - 1 do
    begin
      {$IFDEF JVCLThemesEnabled}
      if FActive and HotTrack and ThemeServices.ThemesEnabled then
        SColor := RGB(100, 100, 100)
      else
      {$ENDIF JVCLThemesEnabled}
      if FActive and HotTrack then
        SColor := clBlack
      else
        SColor := clBtnShadow;

      R := R1;
      Frame3D(Canvas, R, clBtnHighlight, SColor, 1);
      R := R2;
      Frame3D(Canvas, R, clBtnHighlight, SColor, 1);

      if (Align = alBottom) or (Align = alTop) then
      begin
        OffsetRect(R1, 4, 0);
        OffsetRect(R2, 4, 0);
      end
      else
      begin
        OffsetRect(R1, 0, 4);
        OffsetRect(R2, 0, 4);
      end;

    end;
    if FDisplace then
    begin
      PrepareMarcs(Align, Pt1, Pt2, Pt3, Pt4, Pt5, Pt6);
      if FActive then
        Canvas.Brush.Color := clGray
      else
        Canvas.Brush.Color := clWhite;
      Canvas.Polygon([Pt1, Pt2, Pt3]);
      Canvas.Polygon([Pt4, Pt5, Pt6]);
    end;
  end;
end;

procedure TJvgSplitter.PrepareMarcs(Align: TAlign; var Pt1, Pt2, Pt3, Pt4, Pt5, Pt6: TPoint);
begin
  case Align of
    alRight:
      begin
        Pt1.X := 1;
        Pt1.Y := (Height - FTrackCount * 4) div 2 - 30;
        Pt2.X := 1;
        Pt2.Y := Pt1.Y + 6;
        Pt3.X := 4;
        Pt3.Y := Pt1.Y + 3;

        Pt4.X := 1;
        Pt4.Y := (Height - FTrackCount * 4) div 2 + FTrackCount * 4 + 30 -
          7;
        Pt5.X := 1;
        Pt5.Y := Pt4.Y + 6;
        Pt6.X := 4;
        Pt6.Y := Pt4.Y + 3;
      end;
    alLeft:
      begin
        Pt1.X := 3;
        Pt1.Y := (Height - FTrackCount * 4) div 2 - 30;
        Pt2.X := 3;
        Pt2.Y := Pt1.Y + 6;
        Pt3.X := 0;
        Pt3.Y := Pt1.Y + 3;

        Pt4.X := 3;
        Pt4.Y := (Height - FTrackCount * 4) div 2 + FTrackCount * 4 + 30 -
          7;
        Pt5.X := 3;
        Pt5.Y := Pt4.Y + 6;
        Pt6.X := 0;
        Pt6.Y := Pt4.Y + 3;
      end;
    alTop:
      begin
        Pt1.X := (Width - FTrackCount * 4) div 2 - 30;
        Pt1.Y := 4;
        Pt2.X := Pt1.X + 6;
        Pt2.Y := 4;
        Pt3.X := Pt1.X + 3;
        Pt3.Y := 1;

        Pt4.X := (Width - FTrackCount * 4) div 2 + FTrackCount * 4 + 30 - 7;
        Pt4.Y := 4;
        Pt5.X := Pt4.X + 6;
        Pt5.Y := 4;
        Pt6.X := Pt4.X + 3;
        Pt6.Y := 1;
      end;
    alBottom:
      begin
        Pt1.X := (Width - FTrackCount * 4) div 2 - 30;
        Pt1.Y := 1;
        Pt2.X := Pt1.X + 6;
        Pt2.Y := 1;
        Pt3.X := Pt1.X + 3;
        Pt3.Y := 4;

        Pt4.X := (Width - FTrackCount * 4) div 2 + FTrackCount * 4 + 30 - 7;
        Pt4.Y := 1;
        Pt5.X := Pt4.X + 6;
        Pt5.Y := 1;
        Pt6.X := Pt4.X + 3;
        Pt6.Y := 4;
      end;
  end;
end;

procedure TJvgSplitter.CMMouseEnter(var Msg: TMessage);
begin
  inherited;
  FActive := True;
  Invalidate;
end;

procedure TJvgSplitter.CMMouseLeave(var Msg: TMessage);
begin
  inherited;
  FActive := False;
  Invalidate;
end;

procedure TJvgSplitter.SetTrackCount(const Value: Integer);
begin
  FTrackCount := Value;
  Invalidate;
end;

procedure TJvgSplitter.WMMouseDblClick(var Msg: TMessage);
begin
  if FDisplace then
    UpdateControlSize;
end;

procedure TJvgSplitter.UpdateControlSize;
const
  cNewSize = 0;
var
  FControl: TControl;
begin
  FControl := FindControl;
  if not Assigned(FControl) then
    Exit;
  if FKeepSize = 0 then
  begin
    case Align of
      alLeft:
        begin
          FKeepSize := FControl.Width;
          FControl.Width := cNewSize;
        end;
      alTop:
        begin
          FKeepSize := FControl.Height;
          FControl.Height := cNewSize;
        end;
      alRight:
        begin
          FKeepSize := FControl.Width;
          Parent.DisableAlign;
          try
            FControl.Left := FControl.Left + (FControl.Width - cNewSize);
            FControl.Width := cNewSize;
          finally
            Parent.EnableAlign;
          end;
        end;
      alBottom:
        begin
          FKeepSize := FControl.Height;
          Parent.DisableAlign;
          try
            FControl.Top := FControl.Top + (FControl.Height - cNewSize);
            FControl.Height := cNewSize;
          finally
            Parent.EnableAlign;
          end;
        end;
    end;
  end
  else (* ++++ RDB +++ *)
  begin
    case Align of
      alLeft:
        FControl.Width := FKeepSize;
      alTop:
        FControl.Height := FKeepSize;
      alRight:
        begin
          Parent.DisableAlign;
          try
            FControl.Left := FControl.Left + (FControl.Width - FKeepSize);
            FControl.Width := FKeepSize;
          finally
            Parent.EnableAlign;
          end;
        end;
      alBottom:
        begin
          Parent.DisableAlign;
          try
            FControl.Top := FControl.Top + (FControl.Height - FKeepSize);
            FControl.Height := FKeepSize;
          finally
            Parent.EnableAlign;
          end;
        end;
    end;
    FKeepSize := 0; (* --- RDB --- *)
  end;
  Update;
  if Assigned(OnMoved) then
    OnMoved(Self);
end;

function TJvgSplitter.FindControl: TControl;
var
  P: TPoint;
  I: Integer;
  R: TRect;
begin
  Result := nil;
  P := Point(Left, Top);
  case Align of
    alLeft:
      Dec(P.X);
    alRight:
      Inc(P.X, Width);
    alTop:
      Dec(P.Y);
    alBottom:
      Inc(P.Y, Height);
  else
    Exit;
  end;
  for I := 0 to Parent.ControlCount - 1 do
  begin
    Result := Parent.Controls[I];
    if Result.Visible and Result.Enabled then
    begin
      R := Result.BoundsRect;
      if (R.Right - R.Left) = 0 then
        if Align in [alTop, alLeft] then
          Dec(R.Left)
        else
          Inc(R.Right);
      if (R.Bottom - R.Top) = 0 then
        if Align in [alTop, alLeft] then
          Dec(R.Top)
        else
          Inc(R.Bottom);
      if PtInRect(R, P) then
        Exit;
    end;
  end;
  Result := nil;
end;

procedure TJvgSplitter.SetDisplace(const Value: Boolean);
begin
  FDisplace := Value;
  Invalidate;
end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.