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

The Initial Developer of the Original Code is Peter Th鰎nqvist [peter3 att users dott sourceforge dott net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2002 Peter Th鰎nqvist.
All Rights Reserved.

Contributor(s):

Last Modified: 2002-05-26

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:
-----------------------------------------------------------------------------}

{$I JVCL.INC}

{ A component that can display a grid of images taken from a TCustomImageList }

unit JvImageWindow;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, ExtCtrls, CommCtrl, ImgList,
  JvComponent;

type
  TJvMargin = 2..24;
  TJvPositive = 1..MaxInt;

  TJvImageWindow = class(TJvGraphicControl)
  private
    FImageList: TCustomImageList;
    FIndex: Integer;
    OldX: Integer;
    OldY: Integer;
    imWidth: Integer;
    imHeight: Integer;
    FBackColor: TColor;
    FFrontColor: TColor;
    FGridColor: TColor;
    FMargin: TJvMargin;
    FColCount: TJvPositive;
    FImageCount: Integer;
    FShowFrame: Boolean;
    FShowGrid: Boolean;
    FGhost: Boolean;
    FAutoSize: Boolean;
    FOptimal: Boolean;
    FImageChangeLink: TChangeLink;
    procedure DrawFocusFrame(X, Y: Integer);
    procedure SetBackColor(Value: TColor);
    procedure SetFrontColor(Value: TColor);
    procedure SetGridColor(Value: TColor);
    procedure SetMargin(Value: TJvMargin);
    procedure SetColCount(Value: TJvPositive);
    procedure SetImageCount(Value: Integer);
    procedure SetShowFrame(Value: Boolean);
    procedure SetShowGrid(Value: Boolean);
    procedure SetGhost(Value: Boolean);
    procedure SetImageList(Value: TCustomImageList);
    procedure ImageListChange(Sender: Tobject);
  protected
    procedure Paint; override;
    procedure Changed; dynamic;
    {$IFDEF COMPILER6_UP}
    procedure SetAutoSize(Value: Boolean); override;
    {$ENDIF}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SaveImage(Index: Integer; Filename: string; AsBmp: Boolean);
    procedure SaveImageList(Filename: string);
    property ImageIndex: Integer read FIndex default -1; { read-only }
  published
    property Optimal: Boolean read FOptimal write FOptimal default False;
    {$IFDEF COMPILER6_UP}
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    {$ENDIF}
    property BackColor: TColor read FBackColor write SetBackColor default clWindow;
    //    property Filled: Boolean read FFilled write SetFilled default False;
    property FrontColor: TColor read FFrontColor write SetFrontColor default clWindowText;
    property Ghost: Boolean read FGhost write SetGhost;
    property Margin: TJvMargin read FMargin write SetMargin default 2;
    property ColCount: TJvPositive read FColCount write SetColCount default 4;
    property ImageCount: Integer read FImageCount write SetImageCount default 0;
    property Images: TCustomImageList read FImageList write SetImageList;
    property ShowFrame: Boolean read FShowFrame write SetShowFrame default True;
    property ShowGrid: Boolean read FShowGrid write SetShowGrid default True;
    property GridColor: TColor read FGridColor write SetGridColor default clActiveCaption;
    property Width default 64;
    property Height default 64;
    property Align;
    property Visible;
    property Enabled;
    property DragCursor;
    property DragMode;
    property PopupMenu;
    property ParentShowHint;
    property Hint;
    property ShowHint;
    property OnClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
  end;

  TJvImageSquare = class(TJvGraphicControl)
  private
    FHiColor, TmpColor, FBackColor: TColor;
    FBorderStyle: TBorderStyle;
    FImageList: TCustomImageList;
    FIndex: Integer;
    FOnEnter: TNotifyEvent;
    FOnExit: TNotifyEvent;
    FDown: Boolean;
    FShowClick: Boolean;
    FImageChangeLink: TChangeLink;
    procedure SetHiColor(Value: TColor);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetIndex(Value: Integer);
    procedure SetImageList(Value: TCustomImageList);
    procedure ImageListChange(Sender: Tobject);
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  protected
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure PaintFrame; virtual;
    procedure Paint; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Color default clWindow;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property HiColor: TColor read FHiColor write SetHiColor default clActiveCaption;
    property Images: TCustomImageList read FImageList write SetImageList;
    property ImageIndex: Integer read FIndex write SetIndex default 0;
    property ShowClick: Boolean read FShowClick write FShowClick default False;
    property Width default 36;
    property Height default 36;

    property Align;
    property Anchors;
    property Action;
    property Text;
    property Visible;
    property Enabled;
    property DragCursor;
    property DragMode;
    property PopupMenu;
    property ParentShowHint;
    property Hint;
    property ShowHint;
    property OnMouseEnter: TNotifyEvent read FOnEnter write FOnEnter;
    property OnMouseLeave: TNotifyEvent read FOnExit write FOnExit;
    property OnClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
  end;

implementation

uses
  Math,
  JvConsts, JvTypes, JvThemes, JvResources;

//=== TJvImageWindow =========================================================

constructor TJvImageWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBackColor := clWindow;
  FFrontColor := clWindowText;
  FColCount := 4;
  FImageCount := 0;
  FShowFrame := True;
  FGhost := False;
  FShowGrid := True;
  FIndex := -1;
  FMargin := 2;
  FAutoSize := False;
  FOptimal := False;
  OldX := -1;
  OldY := -1;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  SetBounds(0, 0, 64, 64);
  Changed;
end;

destructor TJvImageWindow.Destroy;
begin
  FImageChangeLink.Free;
  inherited Destroy;
end;

procedure TJvImageWindow.SaveImageList(Filename: string);
var
  TmpBmp, Bmp: TBitmap;
  I: Integer;
begin
  if not Assigned(FImageList) then
  begin
    EJVCLException.Create(RsEImagesNotAssigned);
    Exit;
  end;
  Bmp := TBitmap.Create;
  TmpBmp := TBitmap.Create;

  try
    Bmp.Height := FImageList.Height;
    Bmp.Width := FImageList.Width * FImageList.Count;
    for I := 0 to FImageList.Count - 1 do
    begin
      FImageList.GetBitmap(I, TmpBmp);
      Bmp.Canvas.Draw(FImageList.Width * I, 0, TmpBmp);
    end;
    Bmp.SaveToFile(Filename);
  finally
    Bmp.Free;
    TmpBmp.Free;
  end;
end;

procedure TJvImageWindow.SaveImage(Index: Integer; Filename: string; AsBmp: Boolean);
var
  Bmp: TBitmap;
  Ico: TIcon;
begin
  if Assigned(FImageList) then
    if AsBmp then
    begin
      Bmp := TBitmap.Create;
      FImageList.GetBitmap(Index, Bmp);
      Bmp.SaveToFile(Filename);
      Bmp.Free;
    end
    else
    begin
      Ico := TIcon.Create;
      FImageList.GetIcon(ImageIndex, Ico);
      Ico.SaveToFile(Filename);
      Ico.Free;
    end;

end;

procedure TJvImageWindow.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (aComponent = FImageList) and (Operation = opRemove) then
  begin
    FImageList := nil;
    SetImageCount(0);
  end;
end;

procedure TJvImageWindow.Paint;
var
  I, X, Y: Integer;
begin
  with Canvas do
  begin
    Brush.Color := FBackColor;
    Pen.Color := FFrontColor;
    if csDesigning in ComponentState then
      Rectangle(0, 0, Width, Height)
    else
      FillRect(Rect(0, 0, Width, Height));
  end;

  if Assigned(FImageList) then
  begin
    X := 0;
    Y := 0;
    for I := 0 to Min(FImageCount - 1, FImageList.Count - 1) do
    begin
      if FShowGrid then
        DrawFocusFrame(X + FMargin, Y + FMargin);
      ImageList_DrawEx(FImageList.Handle, I,
        Canvas.Handle, X + FMargin * 2, Y + Fmargin * 2, 0, 0, CLR_NONE, CLR_NONE, ILD_TRANSPARENT);
      Inc(X, imWidth + FMargin * 2);
      if I mod FColCount = FColCount - 1 then
      begin
        Inc(Y, imHeight + FMargin * 2);
        X := 0;
      end;
    end;
  end;
end;

procedure TJvImageWindow.DrawFocusFrame(X, Y: Integer);
var
  iWidth, iHeight: Integer;
  Rec: TRect;
  Leaving: Boolean;
  FRows: Integer;
begin
  Leaving := False;

  iWidth := Max(imWidth + FMargin * 2, 1);
  iHeight := Max(imHeight + FMargin * 2, 1);

  { get index for X and Y }
  X := trunc(X / iWidth);
  Y := trunc(Y / iHeight);
  FRows := Max((FImageCount div FColCount), 1);

  { inside bounds ? }
  { special case FRows = 1 }
  if ((Y > FRows) and (FRows < 2)) then
    Leaving := True;
  if (X >= FColCount) or (X + Y * FColCount >= FImageCount)
    or ((Y > FRows) and (FImageCount mod FRows = 0)) then
    Leaving := True;
  { get new starting points }
  X := X * (iWidth);
  Y := Y * (iHeight);

  { erase old frame }
  if ((OldX <> X) or (OldY <> Y)) and (OldX <> -1) then
  begin
    //    if FShowGrid then
    Canvas.Brush.Color := FGridColor;
    //    else
    //      Canvas.Brush.Color := FBackColor;
    Rec := Rect(FMargin, FMargin, iWidth + FMargin + 1, iHeight + FMargin + 1);
    OffsetRect(Rec, OldX, OldY);
    {    if FFilled then
          Canvas.FillRect(Rec)
        else}
    Canvas.FrameRect(Rec);
  end;
  if Leaving then
    Exit;

  // draw the actual frame
  Canvas.Brush.Color := FFrontColor;
  Rec := Rect(FMargin, FMargin, iWidth + FMargin + 1, iHeight + FMargin + 1);
  //  if FImageCount > 1 then
  OffsetRect(Rec, X, Y);
  {  if FFilled then
      Canvas.FillRect(Rec)
    else}
  Canvas.FrameRect(Rec);
  if FGhost and FShowGrid then
  begin
    InflateRect(Rec, -1, -1);
    Canvas.FrameRect(Rec);
  end;
  OldX := X;
  OldY := Y;
end;

procedure TJvImageWindow.MouseMove(Shift: TShiftState; X, Y: Integer);