jvglistbox.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: JvgListBox.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:
  Enhanced ListBox component that can display its items in three
  dimensional styles. Items captions align in one of 9 positions.
  Component can display glyphs on own items and fill background  with
  bitmap. You can set different fonts for selected item and for
  other list items.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvgListBox.pas,v 1.27 2005/02/17 10:21:20 marquardt Exp $

unit JvgListBox;

{$I jvcl.inc}

interface

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

const
  WordWraps: array [Boolean] of Word = (0, DT_WORDBREAK);

type
  TglLBWallpaperOption = (fwlNone, fwlStretch, fwlTile, fwlGlobal);
  TglLBChangeEvent = procedure(Sender: TObject;
    FOldSelItemIndex, FSelItemIndex: Integer) of object;
  TglLBOnDrawEvent = procedure(Sender: TObject; Msg: TWMDrawItem) of object;
  TglOnGetDragImageEvent = procedure(Sender: TObject; Bitmap: TBitmap;
    var TransparentColor: TColor; var HotSpotX, HotSpotY: Integer) of object;

  TJvgListBox = class(TCustomListBox)
  private
    {$IFDEF USEJVCL}
    FAboutJVCL: TJVCLAboutInfo;
    {$ENDIF USEJVCL}
    FAutoTransparentColor: TglAutoTransparentColor;
    FWallpaper: TBitmap;
    FWallpaperImage: TImage;
    FWallpaperOption: TglLBWallpaperOption;
    FNumGlyphs: Word;
    FGlyphsAlign: TJvg2DAlign;
    FTextAlign: TJvg2DAlign;
    FTransparentColor: TColor;
    FHotTrackColor: TColor;
    FItemStyle: TJvgListBoxItemStyle;
    FItemSelStyle: TJvgListBoxItemStyle;
    FGlyphs: TImageList;
    FItemHeight: Word;
    FTextAlign_: UINT;
    HotTrackingItemIndex: Integer;
    FOptions: TglListBoxOptions;
    FChangeGlyphColor: TJvgTwainColors;
    FDragImage: TImageList;
    FOnDrawItem: TglLBOnDrawEvent;
    FOnChange: TglLBChangeEvent;
    FOnGetItemColor: TglOnGetItemColorEvent;
    FOnGetItemFontColor: TglOnGetItemColorEvent;
    FOnGetDragImage: TglOnGetDragImageEvent;
    ThreeDColors: TJvg3DLocalColors;
    FWallpaperBmp: TBitmap;
    FTmpBitmap: TBitmap;
    FOldSelItemIndex: Integer;
    FSelItemIndex: Integer;
    FUseWallpaper: Boolean;
    procedure SetAutoTransparentColor(Value: TglAutoTransparentColor);
    procedure SetWallpaper(Value: TBitmap);
    function GetWallpaper: TBitmap;
    procedure SetWallpaperImage(Value: TImage);
    procedure SetWOpt(Value: TglLBWallpaperOption);
    procedure SetNumGlyphs(Value: Word);
    procedure SetGlyphs(Value: TImageList);
    procedure SetItemHeight(Value: Word);
    procedure SetTransparentColor(Value: TColor);
    procedure SetHotTrackColor(Value: TColor);
    procedure SetAlign;
    procedure SetOptions(Value: TglListBoxOptions);
    function GetSelectedObject: Pointer;
    procedure RecalcHeights;
    procedure SmthChanged(Sender: TObject);
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure CNMeasureItem(var Msg: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure WMMouseMove(var Msg: TMessage); message WM_MOUSEMOVE;
  protected
    function GetSelCount: Integer; {$IFDEF COMPILER6_UP} override; {$ENDIF}
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DestroyWnd; override;
    procedure CreateDragImage;
    procedure DoStartDrag(var DragObject: TDragObject); override;
    procedure InitState(var State: TOwnerDrawState; ByteState: Byte);
  public
    FLeftIndent: Integer;
    FreeObjectsOnDestroy: Boolean;
    IndentLeft: Integer;
    IndentRight: Integer;
    TextIndent: Integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetDragImages: TDragImageList; override;
    property SelectedObject: Pointer read GetSelectedObject;
    property SelCount: Integer read GetSelCount;
  published
    {$IFDEF USEJVCL}
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    {$ENDIF USEJVCL}
    property Anchors;
    property Align;
    property BorderStyle;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property MultiSelect;
    //    property IntegralHeight;
    property Items;
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property AutoTransparentColor: TglAutoTransparentColor
      read FAutoTransparentColor write SetAutoTransparentColor default ftcLeftBottomPixel;
    property Wallpaper: TBitmap read GetWallpaper write SetWallpaper;
    property WallpaperImage: TImage read FWallpaperImage write SetWallpaperImage;
    property WallpaperOption: TglLBWallpaperOption read FWallpaperOption write SetWOpt default fwlNone;
    property NumGlyphs: Word read FNumGlyphs write SetNumGlyphs default 1;
    property GlyphsAlign: TJvg2DAlign read FGlyphsAlign write FGlyphsAlign;
    property ItemStyle: TJvgListBoxItemStyle read FItemStyle write FItemStyle;
    property ItemSelStyle: TJvgListBoxItemStyle read FItemSelStyle write FItemSelStyle;
    property Glyphs: TImageList read FGlyphs write SetGlyphs;
    property TextAlign: TJvg2DAlign read FTextAlign write FTextAlign;
    property ItemHeight: Word read FItemHeight write SetItemHeight default 0;
    property TransparentColor: TColor read FTransparentColor write SetTransparentColor;
    property HotTrackColor: TColor read FHotTrackColor write SetHotTrackColor default clBlue;
    property Options: TglListBoxOptions read FOptions write SetOptions;
    property ChangeGlyphColor: TJvgTwainColors read FChangeGlyphColor write FChangeGlyphColor;
    property OnDrawItem: TglLBOnDrawEvent read FOnDrawItem write FOnDrawItem;
    property OnChange: TglLBChangeEvent read FOnChange write FOnChange;
    property OnGetItemColor: TglOnGetItemColorEvent read FOnGetItemColor write FOnGetItemColor;
    property OnGetItemFontColor: TglOnGetItemColorEvent read FOnGetItemFontColor write FOnGetItemFontColor;
    property OnGetDragImage: TglOnGetDragImageEvent read FOnGetDragImage write FOnGetDragImage;
  end;

  TJvgCheckListBox = class(TJvgListBox)
  private
    FCheckWidth: Integer;
    FCheckHeight: Integer;
    function GetState(Index: Integer): TCheckBoxState;
    procedure SetChecked(Index: Integer; State: TCheckBoxState);
    function GetChecked(Index: Integer): TCheckBoxState;
    //    procedure ToggleClickCheck( Index: Integer );
    //    procedure InvalidateCheck( Index: Integer );
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure DrawCheck(R: TRect; AState: TCheckBoxState);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    property Checked[Index: Integer]: TCheckBoxState read GetChecked write SetChecked;
    constructor Create(AOwner: TComponent); override;
  end;

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

implementation

uses
  Math,
  JvgUtils;

//=== { TJvgListBox } ========================================================

constructor TJvgListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csDisplayDragImage];
  Style := lbOwnerDrawVariable;
  ThreeDColors := TJvg3DLocalColors.Create(Self);
  FWallpaper := TBitmap.Create;
  FTmpBitmap := TBitmap.Create;
  FGlyphsAlign := TJvg2DAlign.Create;
  FTextAlign := TJvg2DAlign.Create;
  FItemStyle := TJvgListBoxItemStyle.Create;
  FItemSelStyle := TJvgListBoxItemStyle.Create;
  FChangeGlyphColor := TJvgTwainColors.Create;
  FDragImage := TImageList.CreateSize(32, 32);
  HotTrackingItemIndex := -1;
  FHotTrackColor := clBlue;
  FLeftIndent := 0;
  //...defaults
  if csDesigning in ComponentState then
  begin
    FItemStyle.Color := clBtnFace;
    FItemStyle.TextStyle := fstNone;
    FItemSelStyle.Color := clBtnShadow;
    FItemSelStyle.TextStyle := fstNone;
  end;
  FWallpaperOption := fwlNone;
  NumGlyphs := 1;
  FTransparentColor := clOlive;
  FAutoTransparentColor := ftcLeftBottomPixel;
  FOptions := [fboHotTrack, fboWordWrap, fboExcludeGlyphs];
  FChangeGlyphColor.FromColor := clBlack;
  FChangeGlyphColor.ToColor := clWhite;
  FGlyphsAlign.OnChanged := SmthChanged;
  FTextAlign.OnChanged := SmthChanged;
  FItemStyle.OnChanged := SmthChanged;
  FItemSelStyle.OnChanged := SmthChanged;
  FChangeGlyphColor.OnChanged := SmthChanged;
end;

destructor TJvgListBox.Destroy;
begin
  FWallpaper.Free;
  ThreeDColors.Free;
  FGlyphsAlign.Free;
  FTextAlign.Free;
  FTmpBitmap.Free;
  FItemStyle.Free;
  FItemSelStyle.Free;
  FChangeGlyphColor.Free;
  FDragImage.Free;
  inherited Destroy;
end;

procedure TJvgListBox.Loaded;
begin
  inherited Loaded;
  Font := ItemStyle.Font;
  Canvas.Font := ItemStyle.Font;
  SetAlign;
  RecalcHeights;

  if fboTransparent in FOptions then
  begin
    if not Assigned(FWallpaper) then
      FWallpaper := TBitmap.Create;
    FWallpaper.Width := Width;
    FWallpaper.Height := Height;
    GetParentImageRect(Self, Bounds(Left, Top, Width, Height),
      FWallpaper.Canvas.Handle);
    FWallpaperBmp := FWallpaper;
    FUseWallpaper := True;
  end
  else
  begin
    if Assigned(FWallpaper) and not FWallpaper.Empty then
      FWallpaperBmp := FWallpaper;
    FUseWallpaper := IsItAFilledBitmap(FWallpaperBmp);
  end;
end;

procedure TJvgListBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = WallpaperImage) and (Operation = opRemove) then
    WallpaperImage := nil;
end;

procedure TJvgListBox.DestroyWnd;
var
  I: Integer;
begin
  if FreeObjectsOnDestroy then
    for I := 0 to Items.Count do
      try
        Items.Objects[I].Free;
        Items.Objects[I] := nil;
      except
      end;
  inherited DestroyWnd;
end;

procedure TJvgListBox.CNMeasureItem(var Msg: TWMMeasureItem);
var
  R: TRect;
  Shift: Integer;
const
  WordBreak: array [Boolean] of Integer = (0, DT_WORDBREAK);
begin
  if csReading in ComponentState then
    Exit;
  R := Rect(0, 0, Width - FLeftIndent, 0);
  Shift := 0;
  if (fboExcludeGlyphs in Options) and Assigned(FGlyphs) then
    if FGlyphsAlign.Horizontal = fhaLeft then
      R.Left := FGlyphs.Width
    else
    if FGlyphsAlign.Horizontal = fhaRight then
      R.Right := R.Right - FGlyphs.Width;
  with Msg.MeasureItemStruct^ do
  begin
    Windows.DrawText(Canvas.Handle, PChar(Items[itemID]),
      Length(Items[itemID]), R, DT_CALCRECT or WordBreak[fboWordWrap in Options]);