jvqcaptionpanel.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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: JvCaptionPanel.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Thrnqvist [peter3 at sourceforge dot net]
Portions created by Peter Thrnqvist are Copyright  1997-2002 Peter Thrnqvist.
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:
  TJvCaptionPanel is a panel that looks like a form, with a Caption area,
  system buttons but is derived from a normal panel.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQCaptionPanel.pas,v 1.25 2004/11/06 22:08:15 asnepvangers Exp $

unit JvQCaptionPanel;

{$I jvcl.inc}

interface

// Define JVCAPTIONPANEL_STD_BEHAVE to not use the previous undocumented WM_SYSCOMMAND with SC_DRAGMOVE but instead handle
// the dragging "manually" within the control. Defining this means that you actually get the Mouse events
// and the OnEndAutoDrag event. Additionally, the form displays scrollbars as expected when the component is dragged
// The downside is that the control "flashes" more when it's dragged
{$DEFINE JVCAPTIONPANEL_STD_BEHAVE}


 {$DEFINE JVCAPTIONPANEL_STD_BEHAVE}


uses
  QWindows, QMessages, 
  Qt, 
  Classes, QGraphics, QControls, QForms,
  JvQComponent, JvQExControls;

type
  TJvCapBtnStyle = (capClose, capMax, capMin, capRestore, capHelp);
  TJvCapBtnStyles = set of TJvCapBtnStyle;
  TJvDrawPosition = (dpLeft, dpTop, dpRight, dpBottom);
  TJvCapBtnEvent = procedure(Sender: TObject; Button: TJvCapBtnStyle) of object;
  TJvAutoDragStartEvent = procedure(Sender: TObject; var AllowDrag: Boolean) of object;
  { internal class }

  TJvCapBtn = class(TJvGraphicControl)
  private
    FOwner: TComponent;
    FStyle: TJvCapBtnStyle;
    FMouseDown: Boolean;
    FDown: Boolean;
    FFlat: Boolean;
    FOver: Boolean;
    procedure SetFlat(Value: Boolean);
    procedure SetStyle(Value: TJvCapBtnStyle);
    procedure BtnClick;
  protected
    procedure Click; override;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Style: TJvCapBtnStyle read FStyle write SetStyle default capClose;
    property Flat: Boolean read FFlat write SetFlat default False;
    property Visible default False;
  end;

  TJvCaptionPanel = class(TJvCustomPanel, IJvDenySubClassing)
  private
    FButtonArray: array [TJvCapBtnStyle] of TJvCapBtn;
    FButtonClick: TJvCapBtnEvent;
    FCaptionPosition: TJvDrawPosition;
    FCaptionWidth: Integer;
    FOffset: Integer;
    FButtons: TJvCapBtnStyles;
    FAutoDrag: Boolean;
    FMouseDown: Boolean;
    FCaptionRect: TRect;
    FCaption: string;
    FCaptionColor: TColor;
    FFlat: Boolean;
    FBevel: Integer;
    FDragging: Boolean;
    FEndDrag: TNotifyEvent;
    FCaptionFont: TFont;
    FOnStartAutoDrag: TJvAutoDragStartEvent;
    FOutlookLook: Boolean;
    FCaptionOffsetSmall: Integer;
    FCaptionOffsetLarge: Integer;
    FIcon: TIcon;
    {$IFDEF JVCAPTIONPANEL_STD_BEHAVE}
    FAnchorPos: TPoint;
    {$ENDIF JVCAPTIONPANEL_STD_BEHAVE} 
    procedure SetIcon(Value: TIcon);
    procedure SetCaptionFont(Value: TFont);
    procedure SetCaptionColor(Value: TColor);
    procedure SetFlat(Value: Boolean);
    procedure SetButtons(Value: TJvCapBtnStyles);
    procedure SetCaption(Value: string);
    procedure SetCaptionPosition(Value: TJvDrawPosition);
    procedure DrawRotatedText(Rotation: Integer);
    procedure DrawButtons; 
    procedure SetOutlookLook(const Value: Boolean);
    procedure DoCaptionFontChange(Sender: TObject);
  protected
    procedure Paint; override;
    procedure Resize; override;

    procedure AlignControls(AControl: TControl; var Rect: TRect); override; 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure ClickButton(Button: TJvCapBtnStyle); virtual;
    function CanStartDrag: Boolean; virtual;
    procedure DoLeaveDrag; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Align;
    property AutoDrag: Boolean read FAutoDrag write FAutoDrag default True;
    property Buttons: TJvCapBtnStyles read FButtons write SetButtons;
    property BorderStyle default bsSingle;
    property Caption: string read FCaption write SetCaption;
    property CaptionColor: TColor read FCaptionColor write SetCaptionColor default clActiveCaption;
    property CaptionPosition: TJvDrawPosition read FCaptionPosition write SetCaptionPosition default dpLeft;
    property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
    property Color;
    property Cursor; 
    property DragMode;
    property Enabled;
    property FlatButtons: Boolean read FFlat write SetFlat default False;
    property Font;
    property Hint;
    property Icon: TIcon read FIcon write SetIcon;
    property OutlookLook: Boolean read FOutlookLook write SetOutlookLook;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu; 
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnButtonClick: TJvCapBtnEvent read FButtonClick write FButtonClick;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartAutoDrag: TJvAutoDragStartEvent read FOnStartAutoDrag write FOnStartAutoDrag;
    property OnEndAutoDrag: TNotifyEvent read FEndDrag write FEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnResize;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, QExtCtrls;

//=== { TJvCapBtn } ==========================================================

constructor TJvCapBtn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOwner := AOwner;
  Width := GetSystemMetrics(SM_CYCAPTION) - 3;
  Height := Width - 2;
  FStyle := capClose;
  Visible := False;
  FFlat := False;
end;

procedure TJvCapBtn.BtnClick;
begin
  if FOwner is TJvCaptionPanel then
    TJvCaptionPanel(FOwner).ClickButton(Style);
end;

procedure TJvCapBtn.SetFlat(Value: Boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TJvCapBtn.SetStyle(Value: TJvCapBtnStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;

procedure TJvCapBtn.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not Enabled then
    Exit;
  inherited MouseDown(Button, Shift, X, Y);
  if not FMouseDown then
  begin
    FMouseDown := True;
    FDown := True;
    Repaint;
  end;
end;

procedure TJvCapBtn.Click;
begin
  inherited Click;
  BtnClick;
end;

procedure TJvCapBtn.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not Enabled then
    Exit;
  inherited MouseUp(Button, Shift, X, Y);
  if FMouseDown then
  begin
    FMouseDown := False;
    FDown := False;
    Repaint;
  end;
end;

procedure TJvCapBtn.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if FMouseDown then
  begin
    FOver := PtInRect(ClientRect, Point(X, Y));
    if not FOver then
    begin
      if FDown then { mouse has slid off, so release }
      begin
        FDown := False;
        Repaint;
      end;
    end
    else
    begin
      if not FDown then { mouse has slid back on, so push }
      begin
        FDown := True;
        Repaint;
      end;
    end;
  end;
end;

procedure TJvCapBtn.MouseEnter(Control: TControl);
var
  R: TRect;
begin
  if csDesigning in ComponentState then
    Exit;
  if not FOver then
  begin
    FOver := True;
    if FFlat then
    begin
      R := ClientRect;
      if FDown then
        Frame3D(Canvas, R, clBtnShadow, clBtnHighLight, 1)
      else
        Frame3D(Canvas, R, clBtnHighLight, clBtnShadow, 1);
    end;
    inherited MouseEnter(Control);
  end;
end;

procedure TJvCapBtn.MouseLeave(Control: TControl);
var
  R: TRect;
begin
  if FOver then
  begin
    FOver := False;
    if FFlat then
    begin
      R := ClientRect;
      Frame3D(Canvas, R, clBtnFace, clBtnFace, 1);
    end;
    inherited MouseLeave(Control);
  end;
end;

procedure TJvCapBtn.Paint;
var
  Flags: Integer;
  R: TRect;
begin
  if not Visible then
    Exit;
  Flags := 0;
  case FStyle of
    capClose:
      Flags := DFCS_CAPTIONCLOSE;
    capMax:
      Flags := DFCS_CAPTIONMAX;
    capMin:
      Flags := DFCS_CAPTIONMIN;
    capRestore:
      Flags := DFCS_CAPTIONRESTORE;
    capHelp:
      Flags := DFCS_CAPTIONHELP;
  end;

  if not Enabled then
    Flags := Flags or DFCS_INACTIVE
  else
  if FDown and FMouseDown and Enabled then
    Flags := Flags or DFCS_PUSHED;
  if FFlat then
    Flags := Flags or DFCS_FLAT;

  Canvas.Brush.Color := Color; 
  Canvas.Start;
  try 
    SetBkMode(Canvas.Handle, TRANSPARENT);
    DrawFrameControl(Canvas.Handle, ClientRect, DFC_CAPTION, Flags);
    if FFlat then
    begin
      R := ClientRect;
      if FDown and FMouseDown then
        Frame3D(Canvas, R, clBtnShadow, clBtnHighLight, 1)
      else
      if FOver then
        Frame3D(Canvas, R, clBtnHighLight, clBtnShadow, 1)
      else
        Frame3D(Canvas, R, clBtnFace, clBtnFace, 1);
    end; 
  finally
    Canvas.Stop;
  end; 
end;

//=== { TJvCaptionPanel } ====================================================

constructor TJvCaptionPanel.Create(AOwner: TComponent);
var
  I: TJvCapBtnStyle;
begin
  inherited Create(AOwner); 
  FCaptionFont := TFont.Create;
  FIcon := TIcon.Create;  
  FCaptionFont.Name := 'Helvetica';
  FCaptionFont.Height := 13; 
  FCaptionFont.Style := [fsBold];
  FCaptionFont.Color := clWhite;
  FCaptionFont.OnChange := DoCaptionFontChange;
  FCaptionPosition := dpLeft;
  FCaptionWidth := GetSystemMetrics(SM_CYCAPTION);
  FAutoDrag := True;  
  FOffset := 3;
  FCaptionColor := clActiveHighlight; 
  FFlat := False;
  for I := Low(FButtonArray) to High(FButtonArray) do //Iterate
  begin
    FButtonArray[I] := TJvCapBtn.Create(Self);
    FButtonArray[I].Parent := Self;
    FButtonArray[I].Style := I;
    FButtonArray[I].Flat := FFlat;
  end;
  FButtons := [];
  BorderStyle := bsSingle;

  FCaptionOffsetSmall := 2;
  FCaptionOffsetLarge := 3;
  FOutlookLook := False; 
end;

destructor TJvCaptionPanel.Destroy;
begin
  FIcon.Free;
  FCaptionFont.Free;
  inherited Destroy;
end;

procedure TJvCaptionPanel.SetCaptionFont(Value: TFont);
begin
  FCaptionFont.Assign(Value);
  Invalidate;
end;

procedure TJvCaptionPanel.SetCaption(Value: string);
begin
  FCaption := Value;
  inherited Caption := '';