jvgasklistbox.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: JvgAskListBox.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].
Rob den Braasem [rbraasem att xs4all dott nl]

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

Description:
  ListBox-based component  that  provides  convenient  interface  for
  realization of the different  tests for users.  Component  is  very
  useful during setup and install processes.
  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: JvgAskListBox.pas,v 1.27 2005/02/17 10:21:19 marquardt Exp $

unit JvgAskListBox;

{$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,
  {$IFDEF USEJVCL}
  JVCLVer,
  {$ENDIF USEJVCL}
  JvgTypes, JvgCommClasses;

type
  TglAskLBOption = (aloAutoScroll, aloIgnoreMouse, aloShowFocus,
    aloTransparentButtons, aloWordWrap);
  TglAskLBOptions = set of TglAskLBOption;

  TJvgAskListBox = class(TCustomListBox)
  private
    {$IFDEF USEJVCL}
    FAboutJVCL: TJVCLAboutInfo;
    {$ENDIF USEJVCL}
    FAutoTransparentColor: TglAutoTransparentColor;
    FWallpaper: TBitmap;
    FWallpaperImage: TImage;
    FWallpaperOption: TglWallpaperOption;
    FNumGlyphs: Word;
    FGlyphsAlign: TJvg2DAlign;
    FTextAlign: TJvg2DAlign;
    FCaptionsAlign: TJvg2DAlign;
    FTransparentColor: TColor;
    FItemStyle: TJvgAskListBoxItemStyle;
    FItemSelStyle: TJvgAskListBoxItemStyle;
    FGlyphs: TImageList;
    FShowWallpaper: Boolean;
    FShowGlyphs: Boolean;
    FItemHeight: Word;
    FTextAlign_: UINT;
    FCaptionsAlign_: UINT;
    FShowText: Boolean;
    FSegment1Width: Word;
    FPushedButton: array[0..1023] of Byte;
    FOnButtonClicked: TNotifyEvent;
    FSelectedItem: Word;
    FButtons: TStringList;
    FButtonWidth: Word;
    FOptions: TglAskLBOptions;
    WallpaperBmp: TBitmap;
    TmpBitmap: TBitmap;
    BtnRect: TRect;
    BtnTxtRect: TRect;
    MouseClickPoint: TPoint;
    procedure SetAutoTransparentColor(Value: TglAutoTransparentColor);
    procedure SetWallpaper(Value: TBitmap);
    function GetWallpaper: TBitmap;
    procedure SetWallpaperImage(Value: TImage);
    procedure SetWallpaperOption(Value: TglWallpaperOption);
    procedure SetNumGlyphs(Value: Word);
    procedure SetGlyphs(Value: TImageList);
    procedure SetItemHeight(Value: Word);
    procedure SetShowText(Value: Boolean);
    procedure SetTransparentColor(Value: TColor);
    procedure SetSelectedItem(Value: Word);
    function GetButtons: TStrings;
    procedure SetButtons(Value: TStrings);
    procedure SetButtonWidth(Value: Word);
    procedure SetOptions(Value: TglAskLBOptions);
    procedure DrawWallpaper(R: TRect);
    procedure DrawGlyph(R: TRect; Index: Word; Shift: Word);
    procedure SetAlign(Align: TJvg2DAlign; var Align_: UINT);
    procedure ButtonClicked;
    procedure RecalcHeights;
    procedure SmthChanged(Sender: TObject);
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure CNMeasureItem(var Msg: TWMMeasureItem); message CN_MEASUREITEM;
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure InitState(var State: TOwnerDrawState; ByteState: Byte);
  public
    function IsFilled: Boolean;
    function CountPushedButtonsInColon(Colon: Integer): Integer;
    function GetPushedButtonInLine(Index: Word): Integer;
    function SetPushedButtonInLine(Index: Word; Value: Word): Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    {$IFDEF USEJVCL}
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    {$ENDIF USEJVCL}
    property Align;
    property BorderStyle;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property IntegralHeight;
    property Items;
    property ParentColor;
    //    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    //    property AfterItemWasDrown;
    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: TglWallpaperOption read FWallpaperOption write
      SetWallpaperOption default fwoNone;
    property NumGlyphs: Word read FNumGlyphs write SetNumGlyphs default 1;
    property GlyphsAlign: TJvg2DAlign read FGlyphsAlign write FGlyphsAlign;
    property ItemStyle: TJvgAskListBoxItemStyle read FItemStyle write FItemStyle;
    property ItemSelStyle: TJvgAskListBoxItemStyle 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 12;
    property ShowText: Boolean read FShowText write SetShowText default True;
    property TransparentColor: TColor read FTransparentColor write SetTransparentColor;
    property OnButtonClicked: TNotifyEvent read FOnButtonClicked write FOnButtonClicked;
    property SelectedItem: Word read FSelectedItem write SetSelectedItem default 0;
    property Buttons: TStrings read GetButtons write SetButtons;
    property ButtonWidth: Word read FButtonWidth write SetButtonWidth default 30;
    property Options: TglAskLBOptions read FOptions write SetOptions;
  end;

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

implementation

uses
  {$IFDEF USEJVCL}
  JvConsts, JvJCLUtils, JvResources,
  {$ENDIF USEJVCL}
  JvgUtils;

{$IFNDEF USEJVCL}
resourcestring
  RsYes = 'yes';
  RsNo = 'no';
{$ENDIF !USEJVCL}

constructor TJvgAskListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Style := lbOwnerDrawVariable;
  FGlyphsAlign := TJvg2DAlign.Create;
  FTextAlign := TJvg2DAlign.Create;
  FCaptionsAlign := TJvg2DAlign.Create;
  FButtons := TStringList.Create;
  FItemStyle := TJvgAskListBoxItemStyle.Create;
  FItemSelStyle := TJvgAskListBoxItemStyle.Create;

  TmpBitmap := TBitmap.Create;
  FButtons.Add(RsYes);
  FButtons.Add(RsNo);
  FAutoTransparentColor := ftcLeftBottomPixel;
  FWallpaperOption := fwoNone;
  FShowWallpaper := True;
  FShowGlyphs := True;
  if csDesigning in ComponentState then
  begin
    with FItemStyle do
    begin
      //      Style := idsRaised;
      Color := clBtnFace;
      BtnColor := clBtnFace;
      TextStyle := fstRaised;
      BtnTextStyle := fstPushed;
    end;
    with FItemSelStyle do
    begin
      //      Style := idsRaised;
      Color := clBtnShadow;
      BtnColor := clBtnFace;
      TextStyle := fstRaised;
      BtnTextStyle := fstPushed;
    end;
  end;
  NumGlyphs := 1;
  FTransparentColor := clOlive;
  FItemHeight := 12;
  FTextAlign_ := DT_LEFT or DT_WORDBREAK or DT_VCENTER; // or DT_SINGLELINE;
  FCaptionsAlign_ := DT_CENTER or DT_VCENTER or DT_SINGLELINE;
  FShowText := True;
  FButtonWidth := 30;
  FSelectedItem := 0;
  FOptions := [aloWordWrap];
  FItemStyle.OnChanged := SmthChanged;
  FItemSelStyle.OnChanged := SmthChanged;
  FGlyphsAlign.OnChanged := SmthChanged;
  FTextAlign.OnChanged := SmthChanged;
  FCaptionsAlign.OnChanged := SmthChanged;

  FillChar(FPushedButton, SizeOf(FPushedButton), #0);
  FWallpaper := nil;
end;

destructor TJvgAskListBox.Destroy;
begin
  FWallpaper.Free;
  TmpBitmap.Free;
  FGlyphsAlign.Free;
  FTextAlign.Free;
  FCaptionsAlign.Free;
  FButtons.Free;
  FItemStyle.Free;
  FItemSelStyle.Free;
  inherited Destroy;
end;

procedure TJvgAskListBox.Loaded;
begin
  inherited Loaded;
  RecalcHeights;
end;

procedure TJvgAskListBox.CNMeasureItem(var Msg: TWMMeasureItem);
var
  R: TRect;
begin
  R.Left := 3;
  R.Top := 0;
  R.Bottom := 0;
  R.Right := FSegment1Width;
  if FShowGlyphs and (FGlyphs <> nil) then
    Inc(R.Left, FGlyphs.Width);
  Dec(R.Right, 5);
  with Msg.MeasureItemStruct^ do
  begin
    DrawText(Canvas, Items[itemID],
      Length(Items[itemID]), R, DT_CALCRECT or DT_WORDBREAK);
    itemHeight := R.Bottom - R.Top + 6;
    if itemHeight < FItemHeight then
      itemHeight := FItemHeight;
  end;
end;

procedure TJvgAskListBox.CNDrawItem(var Msg: TWMDrawItem);
const
  w = 1;
var
  Index: Integer;
  Rect: TRect;
  State: TOwnerDrawState;
  fSelected: Boolean;
  Shift, OldPushedBtn, I: Integer;
  Rect1: TRect;
  ItemStyle: TJvgAskListBoxItemStyle;
  //  TS: TglTextStyle;
  //  TA: UINT;

  procedure DrawLBItem(ItemSt: TglItemsDrawStyle; R: TRect);
  begin
    case ItemSt of
      idsRecessed:
        begin
          Shift := 0;
          Frame3D(Canvas, R, clBtnShadow, clBtnHighlight, 1);
        end;
      idsRaised:
        begin
          Shift := 2;
          Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
        end;
    end;
  end;

  procedure DrawTextInRect(Rect: TRect; Align: Word; StrListNum: Integer);
  var
    FontColor: TColor;
    szStr: array[0..255] of Char;
    Len: Word;
    TextStyle: TglTextStyle;
  begin
    Dec(Rect.Right, 2);
    //    FillMemory(@szStr,255,0);
    if StrListNum = -1 then
      StrPCopy(szStr, Items[Index])
    else
      StrPCopy(szStr, Buttons[StrListNum - 1]);

    Len := StrLen(szStr);

    if StrListNum = -1 then
    begin
      Canvas.Font := ItemStyle.Font;
      TextStyle := ItemStyle.TextStyle;
    end
    else
    begin
      Canvas.Font := ItemStyle.BtnFont;
      if FPushedButton[Index] = StrListNum then
        TextStyle := fstNone
      else
        TextStyle := ItemStyle.BtnTextStyle;
    end;

    FontColor := Canvas.Font.Color;
    SetBkMode(Canvas.Handle, TRANSPARENT);
    InflateRect(Rect, -1, -1);
    if StrListNum <> -1 then
      Inc(Rect.Top, 2);

    case TextStyle of
      fstRaised:
        begin
          Canvas.Font.Color := clBtnHighlight;
          OffsetRect(Rect, -1, -1);
          DrawText(Canvas, szStr, Len, Rect, Align);
          Canvas.Font.Color := clBtnShadow;
          OffsetRect(Rect, 2, 2);
          DrawText(Canvas, szStr, Len, Rect, Align);
          Canvas.Font.Color := FontColor;
          OffsetRect(Rect, -1, -1);
          DrawText(Canvas, szStr, Len, Rect, Align);
        end;
      fstRecessed:
        begin
          Canvas.Font.Color := clBtnShadow;
          OffsetRect(Rect, -1, -1);
          DrawText(Canvas, szStr, Len, Rect, Align);
          Canvas.Font.Color := clBtnHighlight;
          OffsetRect(Rect, 2, 2);
          DrawText(Canvas, szStr, Len, Rect, Align);
          Canvas.Font.Color := FontColor;
          OffsetRect(Rect, -1, -1);
          DrawText(Canvas, szStr, Len, Rect, Align);
        end;
      fstPushed:
        begin
          Canvas.Font.Color := clBtnHighlight;
          DrawText(Canvas, szStr, Len, Rect, Align);
          OffsetRect(Rect, -1, -1);
          Canvas.Font.Color := clBtnShadow;
          DrawText(Canvas, szStr, Len, Rect, Align);
        end;
      fstShadow:
        begin
          Canvas.Font.Color := clBtnShadow;
          OffsetRect(Rect, 2, 2);
          DrawText(Canvas, szStr, Len, Rect, Align);
          Canvas.Font.Color := FontColor;
          OffsetRect(Rect, -2, -2);
          DrawText(Canvas, szStr, Len, Rect, Align);
        end;
    else
      begin
        Canvas.Font.Color := FontColor;
        DrawText(Canvas, szStr, Len, Rect, Align);
      end;
    end;
  end;

begin
  with Msg.DrawItemStruct^ do
  begin
    Index := itemID;
    if Index = -1 then
      Exit;
    InitState(State, WordRec(LongRec(ItemState).Lo).Lo);
    //   State := TOwnerDrawState(WordRec(LongRec(ItemState).Lo).Lo);
    Canvas.Handle := hDC;
    Rect := rcItem;
  end;

  Canvas.Brush := Brush;
  //  if State = [odSelected,odFocused] then Exit;
  Canvas.FrameRect(Rect);
  Inc(Rect.Top);
  Inc(Rect.Left);
  fSelected := (State = [odSelected, odFocused]) or (State = [odSelected]);

  if fSelected then
  begin
    ItemStyle := FItemSelStyle;
    Shift := 2;
  end
  else
  begin
    ItemStyle := FItemStyle;
    Shift := 0;
  end;
  Canvas.Brush.Color := ItemStyle.Color;

  Rect1 := Rect;
  Rect1.Right := FSegment1Width;

  if IsItAFilledBitmap(WallpaperBmp) then
  begin
    if aloTransparentButtons in Options then
      DrawWallpaper(Rect)
    else
      DrawWallpaper(Rect1);
  end
  else
    Canvas.FillRect(Rect1);

  //DrawLBItem( idsRecessed, Rect1 );
  DrawBoxEx(Canvas.Handle, Rect1, ItemStyle.Bevel.Sides, ItemStyle.Bevel.Inner,
    ItemStyle.Bevel.Outer, ItemStyle.Bevel.Bold, 0, True);
  if fSelected then
  begin
    InflateRect(Rect1, -1, -1);
    Canvas.FillRect(Rect1);
    InflateRect(Rect1, 1, 1);
  end;

  OldPushedBtn := FPushedButton[Index];

  BtnRect := Rect;
  BtnRect.Left := Rect1.Right + 2;
  BtnRect.Right := BtnRect.Left + FButtonWidth;

  Canvas.Brush.Color := ItemStyle.BtnColor;
  for I := 1 to Buttons.Count do // draw buttons
  begin
    if PtInRectExclusive(BtnRect, MouseClickPoint) then
    begin
      if I = FPushedButton[Index] then
        FPushedButton[Index] := 0 //...none pushed
      else
        FPushedButton[Index] := I;
    end;
    if not (aloTransparentButtons in Options) or