jvqerrorindicator.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: JvErrorIndicator.pas, released on 2002-11-16.

The Initial Developer of the Original Code is Peter Th鰎nqvist <peter3 at sourceforge dot net>.
Portions created by Joe Doe are Copyright (C) 2002 Peter Th鰎nqvist . All Rights Reserved.

Contributor(s):

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:
* Setting AutoScroll to True for a form and displaying error icons beyond the form's right
edge can make the form's scrollbars "jump up and down"
* Resizing components while displaying error images, doesn't move the error image smoothly
(this is caused by the image being moved only when the BlinkThread triggers)

Description:
  A component patterned on the ErrorProvider in .NET:
  "Provides a user interface for indicating that a control
  on a form has an error associated with it."
  To set the error, use the Error property: an empty error string, removes the error image

-----------------------------------------------------------------------------}
// $Id: JvQErrorIndicator.pas,v 1.23 2005/02/26 06:59:08 marquardt Exp $

unit JvQErrorIndicator;

{$I jvcl.inc}

interface

uses
  QWindows, Classes, QGraphics, QControls, QImgList,
  JvQComponent;

type
  IJvErrorIndicatorClient = interface;

  // IJvErrorIndicator is implemented by the TJvErrorIndicator
  IJvErrorIndicator = interface
    ['{5BCB5404-9C17-4CC6-96EC-46567CA19A12}']
    procedure SetError(AControl: TControl; const AErrorMessage: WideString);
    procedure SetClientError(const AClient: IJvErrorIndicatorClient);
  end;

  // IJvErrorIndicatorClient should be implemented by controls that wants to be able
  // to update the error indicator through it's own properties
  IJvErrorIndicatorClient = interface
    ['{9871F250-631E-4119-B073-71B28711C9B8}']
    procedure SetErrorIndicator(const Value: IJvErrorIndicator);
    function GetErrorIndicator: IJvErrorIndicator;
    function GetControl: TControl;
    procedure SetErrorMessage(const Value: WideString);
    function GetErrorMessage: WideString;

    property ErrorIndicator: IJvErrorIndicator read GetErrorIndicator write SetErrorIndicator;
    property ErrorMessage: WideString read GetErrorMessage write SetErrorMessage;
  end;

  TJvErrorBlinkStyle = (ebsAlwaysBlink, ebsBlinkIfDifferentError, ebsNeverBlink);
  TJvErrorImageAlignment = (eiaBottomLeft, eiaBottomRight, eiaMiddleLeft, eiaMiddleRight,
    eiaTopLeft, eiaTopRight);

  TJvErrorControl = class(TGraphicControl)
  private
    FImageList: TCustomImageList;
    FImageIndex: Integer;
    FImagePadding: Integer;
    FControl: TControl;
    FImageAlignment: TJvErrorImageAlignment;
    FBlinkCount: Integer;
    procedure SetError(const Value: string);
    function GetError: string;
    procedure SetImageIndex(const Value: Integer);
    procedure SetImageList(const Value: TCustomImageList);
    procedure SetControl(const Value: TControl);
  protected
    procedure Paint; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    function CalcBoundsRect: TRect;
    property Images: TCustomImageList read FImageList write SetImageList;
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
    property Control: TControl read FControl write SetControl;
    property Error: string read GetError write SetError;
    property BlinkCount: Integer read FBlinkCount write FBlinkCount;
    property ImageAlignment: TJvErrorImageAlignment read FImageAlignment write FImageAlignment;
    property ImagePadding: Integer read FImagePadding write FImagePadding;

    procedure DrawImage(Erase: Boolean);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ShowHint default True;
    property Width default 16;
    property Height default 16;
  end;

  TJvErrorIndicator = class(TJvComponent, IUnknown, IJvErrorIndicator)
  private
    FUpdateCount: Integer;
    FControls: TList;
    FBlinkRate: Integer;
    FImageList: TCustomImageList;
    FBlinkThread: TThread;
    FBlinkStyle: TJvErrorBlinkStyle;
    FChangeLink: TChangeLink;
    FImageIndex: Integer;
    FDefaultImage: TImageList;
    function GetError(AControl: TControl): string;
    function GetImageAlignment(AControl: TControl): TJvErrorImageAlignment;
    function GetImagePadding(AControl: TControl): Integer;
    procedure SetBlinkRate(const Value: Integer);
    procedure SetBlinkStyle(const Value: TJvErrorBlinkStyle);
    procedure SetError(AControl: TControl; const Value: string);
    procedure SetImageList(const Value: TCustomImageList);
    procedure SetImageAlignment(AControl: TControl; const Value: TJvErrorImageAlignment);
    procedure SetImagePadding(AControl: TControl; const Value: Integer);
    procedure SetImageIndex(const Value: Integer);
    procedure DoChangeLinkChange(Sender: TObject);
    procedure DoBlink(Sender: TObject; Erase: Boolean);
    procedure StopThread;
    procedure StartThread;
    function GetControl(Index: Integer): TJvErrorControl;
    function GetCount: Integer;
  protected
    { IJvErrorIndicator }
    procedure IJvErrorIndicator.SetError = IndicatorSetError;
    procedure IndicatorSetError(AControl: TControl; const ErrorMessage: WideString);
    procedure SetClientError(const AClient: IJvErrorIndicatorClient);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function IndexOf(AControl: TControl): Integer;
    function Add(AControl: TControl): Integer;
    procedure UpdateControls;
    procedure Delete(Index: Integer);
    property Controls[Index: Integer]: TJvErrorControl read GetControl;
    property Count: Integer read GetCount;
  public
    constructor Create(AComponent: TComponent); override;
    destructor Destroy; override;

    // Call ClearErrors to remove all error images with one call
    // After a call to ClearErrors, the internal error image list is emptied
    // Calling ClearErrors is the same as setting Error[nil] := '' but is slightly faster
    procedure ClearErrors;
    // The BeginUpdate method suspends the blinking thread until the EndUpdate method is called.
    procedure BeginUpdate;
    // EndUpdate re-enables the blinking thread that was turned off with the BeginUpdate method.
    procedure EndUpdate;
    // Gets or sets the error message associated with a control
    // Setting the error message to an empty string removes the error image
    // (this is the only way to remove an error image for a single control)
    // Use Error[nil] := 'SomeValue'; to assign the error message 'SomeValue' to all controls
    // Using Error[nil] := ''; is equivalent to calling ClearErrors but ClearErrors is faster
    property Error[AControl: TControl]: string read GetError write SetError;
    // Gets or sets a value indicating where the error image should be placed in relation to the control.
    // The location can be further modified by assigning a non-zero value to ImagePadding
    // Possible values:
    //   eiaBottomLeft - display the error image on the controls left side aligned to the bottom edge of the control
    //   eiaBottomRight - display the error image on the controls right side aligned to the bottom edge of the control
    //   eiaMiddleLeft - display the error image on the controls left side aligned to the middle of the control
    //   eiaMiddleRight - display the error image on the controls right side aligned to the middle of the control
    //   eiaTopLeft - display the error image on the controlsleft side aligned to the top edge of the control
    //   eiaTopRight - display the error image on the controls right side aligned to the top edge of the control
    // Use AControl = nil to set the same Alignment for all controls
    property ImageAlignment[AControl: TControl]: TJvErrorImageAlignment read GetImageAlignment write SetImageAlignment;
    // Gets or sets the amount of extra space to leave between the specified control and the error image.
    // Use AControl = nil to set the same padding for all controls.
    property ImagePadding[AControl: TControl]: Integer read GetImagePadding write SetImagePadding;
  published
    // The rate at which the error image should flash. The rate is expressed in milliseconds. The default is 250 milliseconds.
    // A value of zero sets BlinkStyle to ebsNeverBlink.
    property BlinkRate: Integer read FBlinkRate write SetBlinkRate default 250;
    // The error Image flashes in the manner specified by the assigned BlinkStyle when an error occurs.
    // Possible values:
    //   ebsBlinkIfDifferentError - blink if the new error message differs from the previous
    //   ebsAlwaysBlink - always blink when the error message changes, even if it's the same message
    //   ebsNeverBlink - never bink, just display the error image and the description
    // Setting the BlinkRate to zero sets the BlinkStyle to ebsNeverBlink.
    // The default is ebsBlinkIfDifferentError
    property BlinkStyle: TJvErrorBlinkStyle read FBlinkStyle write SetBlinkStyle default ebsBlinkIfDifferentError;
    // Gets or sets the ImageList where to retrieve an image to display next to a control when an error description
    // string has been set for the control.
    // This property is used in conjunction with ImageIndex to select the image to display
    // If either is nil, invalid or out of range, no error image is displayed
    property Images: TCustomImageList read FImageList write SetImageList;
    // Gets or sets the ImageIndex in ImageList to use when displaying an image next to a control
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING} 
  SysUtils, 
  JvQTypes, JvQResources;




{$IFDEF MSWINDOWS}
{$R ..\Resources\JvQErrorIndicator.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvQErrorIndicator.res}
{$ENDIF UNIX}



const
  cDefBlinkCount = 5;

type
  TJvBlinkThreadEvent = procedure(Sender: TObject; Erase: Boolean) of object;

  TJvBlinkThread = class(TThread)
  private
    FBlinkRate: Integer;
    FErase: Boolean;
    FOnBlink: TJvBlinkThreadEvent;
    procedure Blink;
  protected
    procedure Execute; override;
  public
    constructor Create(BlinkRate: Integer);
    property OnBlink: TJvBlinkThreadEvent read FOnBlink write FOnBlink;
  end;

//=== { TJvErrorIndicator } ==================================================

constructor TJvErrorIndicator.Create(AComponent: TComponent);

var
  Bmp: TBitmap;

begin
  inherited Create(AComponent);
  FDefaultImage := TImageList.CreateSize(16, 16);  
  Bmp := TBitmap.Create;
  Bmp.LoadFromResourceName(hInstance, 'XJVERRORINDICATORICON');
  FDefaultImage.AddMasked(Bmp, clBlack);
  Bmp.Free; 
  FBlinkStyle := ebsBlinkIfDifferentError;
  FBlinkRate := 250;
  FControls := TList.Create;
  FChangeLink := TChangeLink.Create;
  FChangeLink.OnChange := DoChangeLinkChange;
end;

destructor TJvErrorIndicator.Destroy;
begin
  StopThread;
  ClearErrors;
  FControls.Free;
  FChangeLink.Free;
  FDefaultImage.Free;
  inherited Destroy;
end;

function TJvErrorIndicator.Add(AControl: TControl): Integer;
var
  Ci: TJvErrorControl;
begin
  Result := IndexOf(AControl);
  if (Result < 0) and (AControl <> nil) then
  begin
    Ci := TJvErrorControl.Create(Self);
    Ci.Control := AControl;
    //    Ci.Name := Ci.Control.Name + '_ErrorControl';
    Result := FControls.Add(Ci);
  end;
end;

procedure TJvErrorIndicator.Delete(Index: Integer);
begin
  Controls[Index].Free;
  FControls.Delete(Index);
end;

function TJvErrorIndicator.GetError(AControl: TControl): string;
var
  I: Integer;
begin
  I := IndexOf(AControl);
  if I > -1 then
    Result := Controls[I].Error
  else
    raise EJVCLException.CreateRes(@RsEControlNotFoundInGetError);
end;

function TJvErrorIndicator.GetImageAlignment(AControl: TControl): TJvErrorImageAlignment;
var
  I: Integer;
begin
  I := IndexOf(AControl);
  if I > -1 then
    Result := Controls[I].ImageAlignment
  else
    raise EJVCLException.CreateRes(@RsEControlNotFoundInGetImageAlignment);
end;

function TJvErrorIndicator.GetImagePadding(AControl: TControl): Integer;
var
  I: Integer;
begin
  I := IndexOf(AControl);
  if I > -1 then
    Result := Controls[I].ImagePadding
  else
    raise EJVCLException.CreateRes(@RsEControlNotFoundInGetImagePadding);
end;

function TJvErrorIndicator.IndexOf(AControl: TControl): Integer;
begin
  if AControl <> nil then
    for Result := 0 to Count - 1 do
      if Controls[Result].Control = AControl then
        Exit;
  Result := -1;
end;

procedure TJvErrorIndicator.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I: Integer;
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent is TControl then
      I := IndexOf(TControl(AComponent))
    else
      I := -1;
    if I > -1 then
      Delete(I);
    if AComponent = Images then
      Images := nil;
  end;
end;

procedure TJvErrorIndicator.SetBlinkRate(const Value: Integer);
begin
  if FBlinkRate <> Value then
  begin
    StopThread;
    FBlinkRate := Value;
    if FBlinkRate <= 0 then
    begin
      FBlinkRate := 0;
      FBlinkStyle := ebsNeverBlink;
    end;
    UpdateControls;
  end;
end;

procedure TJvErrorIndicator.SetBlinkStyle(const Value: TJvErrorBlinkStyle);
begin
  if FBlinkStyle <> Value then
  begin
    StopThread;
    FBlinkStyle := Value;
    UpdateControls;
  end;
end;

procedure TJvErrorIndicator.SetError(AControl: TControl;
  const Value: string);
var
  I: Integer;
  Ei: TJvErrorControl;
begin
  StopThread;
  if AControl = nil then
  begin
    if Value = '' then
      ClearErrors
    else
      for I := 0 to Count - 1 do
      begin
        Ei := Controls[I];
        if ((Ei.Error <> Value) and (BlinkStyle = ebsBlinkIfDifferentError)) or (BlinkStyle = ebsAlwaysBlink) then
          Ei.BlinkCount := cDefBlinkCount
        else
        if BlinkStyle = ebsNeverBlink then
          Ei.BlinkCount := 0;
        Ei.Error := Value;
      end;
  end