jvupdown.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: JvUpDown.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is Peter Below <100113 dott 1101 att compuserve dott com>
Portions created by Peter Below are Copyright (C) 2000 Peter Below.
All Rights Reserved.

Contributor(s):
Sebastien Buysse [sbuysse att buypin dott com].
Peter Th鰎nqvist [peter3 at sourceforge dot net] - TJvDomainUpDown

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  TJvDomainUpDown works just like a TJvUpDown but instead of scrolling
  a range of integer value, it scrolls a list of strings (as defined by Items)

Known Issues:
- Can't set Position of TJvDomainUpDown at design-time. SOLVED 2003-05-30
-----------------------------------------------------------------------------}
// $Id: JvUpDown.pas,v 1.17 2005/02/17 10:21:16 marquardt Exp $

unit JvUpDown;

{$I jvcl.inc}
{$I vclonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, ComCtrls, CommCtrl,
  JvExComCtrls;

type
  TJvAlignButton = (abLeft, abRight, abNone);
  TJvUpDownFormat = (ufInt, ufHex);

  TJvCustomUpDown = class(TJvExCustomUpDown)
  private
    FIncrement: Integer;
    FMin: Integer;
    FMax: Integer;
    FPosition: Integer;
    FAssociate: TWinControl;
    FHotTrack: Boolean;
    FAlignButton: TJvAlignButton;
    FFormat: TJvUpDownFormat;
    FAcceptsInteger: Boolean;
    FFirstTime: Boolean;
    function GetPosition: Integer;
    procedure SetIncrement(const Value: Integer);
    procedure SetMax(const Value: Integer);
    procedure SetMin(const Value: Integer);
    procedure SetPosition(const Value: Integer);
    procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
    procedure SetAssociate(const Value: TWinControl);
    procedure SetHotTrack(const Value: Boolean);
    procedure SetAlignButton(const Value: TJvAlignButton);
    procedure SetFormat(const Value: TJvUpDownFormat);
    procedure UndoAutoResizing(Value: TWinControl);
  protected
    procedure UpdateAssociate; virtual;
    procedure CreateWnd; override;
    procedure CreateParams(var Params: TCreateParams); override;
    function AcceptPosition(Value: Integer): Boolean; virtual;
    function CanChange: Boolean; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property AlignButton: TJvAlignButton read FAlignButton write SetAlignButton default abRight;
    property Associate: TWinControl read FAssociate write SetAssociate;
    property Format: TJvUpDownFormat read FFormat write SetFormat default ufInt;
    property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
    property Increment: Integer read FIncrement write SetIncrement default 1;
    property Max: Integer read FMax write SetMax default 100;
    property Min: Integer read FMin write SetMin default 0;
    property Position: Integer read GetPosition write SetPosition default 0;
  public
    constructor Create(AOwner: TComponent); override;
    function AcceptInteger: Boolean;
  end;

  TJvCustomDomainUpDown = class(TJvCustomUpDown)
  private
    FItems: TStringList;
    FCurrentText: string;
    function GetText: string;
    function GetItems: TStrings;
    procedure SetItems(const Value: TStrings);
    procedure SetText(const Value: string);
  protected
    procedure DoItemsChange(Sender: TObject);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure UpdateAssociate; override;
    procedure Click(Button: TUDBtnType); override;
    function AcceptPosition(Value: Integer): Boolean; override;
    property Thousands default False;
    property Items: TStrings read GetItems write SetItems;
    property Text: string read GetText write SetText;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TJvUpDown = class(TJvCustomUpDown)
  protected
    procedure UpdateAssociate; override;
  published
    property AlignButton;
    property Anchors;
    property Associate;
    property ArrowKeys;
    property Color;
    property Enabled;
    property Format;
    property Hint;
    property HintColor;
    property HotTrack;
    property Min;
    property Max;
    property Increment;
    property Constraints;
    property Orientation;
    property ParentShowHint;
    property PopupMenu;
    property Position;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Thousands;
    property Visible;
    property Wrap;

    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;
    property OnChanging;
    property OnChangingEx;
    property OnContextPopup;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

  TJvDomainUpDown = class(TJvCustomDomainUpDown)
  published
    property Associate;
    property Items;
    property Position;
    property Text;

    property AlignButton;
    property Anchors;
    property ArrowKeys;
    property Enabled;
    property Hint;
    property HintColor;
    property HotTrack;
    property Constraints;
    property Orientation;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property Wrap;

    property OnChanging;
    property OnChangingEx;
    property OnContextPopup;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

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

implementation


const
  UDM_SETPOS32 = WM_USER + 113;
  UDM_GETPOS32 = WM_USER + 114;
  UDS_HOTTRACK = $0100;

//=== { TJvCustomUpDown } ====================================================

constructor TJvCustomUpDown.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMin := 0;
  FMax := 100;
  FPosition := 0;
  FHotTrack := False;
  FIncrement := 1;
  FAlignButton := abRight;
  FFormat := ufInt;
  FFirstTime := True;
end;

function TJvCustomUpDown.GetPosition: Integer;
begin
  if HandleAllocated then
  begin
    if AcceptInteger then
      Result := SendMessage(Handle, UDM_GETPOS32, 0, 0)
    else
      Result := SendMessage(Handle, UDM_GETPOS, 0, 0);
    FPosition := Result;
  end
  else
    Result := FPosition;
end;

procedure TJvCustomUpDown.SetIncrement(const Value: Integer);
var
  AccelArray: array [0..0] of TUDAccel;
begin
  if Value <> FIncrement then
  begin
    FIncrement := Value;
    if HandleAllocated then
    begin
      SendMessage(Handle, UDM_GETACCEL, 1, LPARAM(@AccelArray[0]));
      AccelArray[0].nInc := Value;
      SendMessage(Handle, UDM_SETACCEL, 1, LPARAM(@AccelArray[0]));
    end;
  end;
end;

procedure TJvCustomUpDown.SetMax(const Value: Integer);
begin
  if Value <> FMax then
  begin
    FMax := Value;
    if HandleAllocated then
      SendMessage(Handle, UDM_SETRANGE32, FMin, FMax);
  end;
end;

procedure TJvCustomUpDown.SetMin(const Value: Integer);
begin
  if Value <> FMin then
  begin
    FMin := Value;
    if HandleAllocated then
      SendMessage(Handle, UDM_SETRANGE32, FMin, FMax);
  end;
end;

procedure TJvCustomUpDown.SetPosition(const Value: Integer);
begin
  if Value <> FPosition then
  begin
    if AcceptPosition(Value) then
    begin
      FPosition := Value;
      if HandleAllocated then