jvqerrorindicator.pas

East make Tray Icon in delphi

  else
  begin
    I := Add(AControl);
    if I > -1 then
    begin
      if Value = '' then
        Delete(I)
      else
      begin
        Ei := Controls[I];
        if ((Ei.Error <> Value) and (BlinkStyle = ebsBlinkIfDifferentError)) or
          (BlinkStyle = ebsAlwaysBlink) then
        begin
          Ei.Error := Value;
          Ei.BlinkCount := cDefBlinkCount;
          Ei.Visible := (csDesigning in ComponentState);
          if (FUpdateCount = 0) and (FBlinkThread = nil) then
            StartThread;
        end
        else
        if BlinkStyle = ebsNeverBlink then
        begin
          Ei.BlinkCount := 0;
          Ei.Error := Value;
          Ei.Visible := (Value <> '');
        end;
      end;
      UpdateControls;
    end
    else
      raise EJVCLException.CreateRes(@RsEUnableToAddControlInSetError);
  end;
end;

procedure TJvErrorIndicator.SetImageAlignment(AControl: TControl;
  const Value: TJvErrorImageAlignment);
var
  I: Integer;
begin
  if AControl = nil then
    for I := 0 to Count - 1 do
      Controls[I].ImageAlignment := Value
  else
  begin
    I := Add(AControl);
    if I > -1 then
      Controls[I].ImageAlignment := Value
    else
      raise EJVCLException.CreateRes(@RsEUnableToAddControlInSetImageAlignme);
  end;
end;

procedure TJvErrorIndicator.SetImagePadding(AControl: TControl;
  const Value: Integer);
var
  I: Integer;
begin
  if AControl = nil then
    for I := 0 to Count - 1 do
      Controls[I].ImagePadding := Value
  else
  begin
    I := Add(AControl);
    if I > 1 then
      Controls[I].ImagePadding := Value
    else
      raise EJVCLException.CreateRes(@RsEUnableToAddControlInSetImagePadding);
  end;
end;

procedure TJvErrorIndicator.UpdateControls;
var
  I, J: Integer;
  IL: TCustomImageList;
begin
  if Images <> nil then
  begin
    IL := Images;
    J := ImageIndex;
  end
  else
  begin
    IL := FDefaultImage;
    J := 0;
  end;
  for I := 0 to Count - 1 do
  begin
    Controls[I].Images := IL;
    Controls[I].ImageIndex := J;
  end;
end;

procedure TJvErrorIndicator.SetImageList(const Value: TCustomImageList);
begin
  if FImageList <> Value then
  begin
    StopThread;
    if Assigned(FImageList) then
    begin
      FImageList.UnRegisterChanges(FChangeLink);
      FImageList.RemoveFreeNotification(Self);
    end;
    FImageList := Value;
    if Assigned(FImageList) then
    begin
      FImageList.RegisterChanges(FChangeLink);
      FImageList.FreeNotification(Self);
    end;
    UpdateControls;
  end;
end;

procedure TJvErrorIndicator.SetImageIndex(const Value: Integer);
begin
  if FImageIndex <> Value then
  begin
    StopThread;
    FImageIndex := Value;
    UpdateControls;
  end;
end;

procedure TJvErrorIndicator.DoChangeLinkChange(Sender: TObject);
begin
  UpdateControls;
end;

procedure TJvErrorIndicator.ClearErrors;
var
  I: Integer;
begin
  StopThread;
  for I := 0 to Count - 1 do
    Controls[I].Free;
  FControls.Clear;
end;

procedure TJvErrorIndicator.BeginUpdate;
var
  I: Integer;
begin
  Inc(FUpdateCount);
  StopThread;
  for I := 0 to Count - 1 do
    Controls[I].Visible := False;
end;

procedure TJvErrorIndicator.EndUpdate;
begin
  if FUpdateCount > 0 then
  begin
    Dec(FUpdateCount);
    if FUpdateCount = 0 then
    begin
      UpdateControls;
      StartThread;
    end;
  end;
end;

procedure TJvErrorIndicator.StartThread;
begin
  FBlinkThread := TJvBlinkThread.Create(BlinkRate);
  TJvBlinkThread(FBlinkThread).OnBlink := DoBlink;
  TJvBlinkThread(FBlinkThread).Resume;
end;

procedure TJvErrorIndicator.StopThread;
begin
  if FBlinkThread <> nil then
    FBlinkThread.Terminate;
  FreeAndNil(FBlinkThread);
end;

procedure TJvErrorIndicator.DoBlink(Sender: TObject; Erase: Boolean);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Controls[I].DrawImage(Erase);
end;

function TJvErrorIndicator.GetControl(Index: Integer): TJvErrorControl;
begin
  Result := TJvErrorControl(FControls[Index]);
end;

function TJvErrorIndicator.GetCount: Integer;
begin
  Result := FControls.Count;
end;

procedure TJvErrorIndicator.SetClientError(const AClient: IJvErrorIndicatorClient);
begin
  if AClient <> nil then
    SetError(AClient.GetControl, AClient.ErrorMessage);
end;

procedure TJvErrorIndicator.IndicatorSetError(AControl: TControl;
  const ErrorMessage: WideString);
begin
  SetError(AControl, ErrorMessage);
end;

//=== { TJvErrorControl } ====================================================

constructor TJvErrorControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FImageAlignment := eiaMiddleRight;
  ShowHint := True;
  Visible := False;
  Width := 16;
  Height := 16;
end;

destructor TJvErrorControl.Destroy;
begin
  Control := nil;
  inherited Destroy;
end;

procedure TJvErrorControl.DrawImage(Erase: Boolean);
begin
  if not Assigned(Control) or not Assigned(Control.Parent) or not Assigned(Images) then
    Exit;
  Visible := (Error <> '') and (not Erase or (BlinkCount < 2));
  if not Visible and (BlinkCount > 1) then
    Dec(FBlinkCount);
  if Visible then
    BoundsRect := CalcBoundsRect;
end;

function TJvErrorControl.CalcBoundsRect: TRect;
begin
  if (Control = nil) or (Images = nil) then
    Result := Rect(0, 0, 0, 0)
  else
  begin
    case ImageAlignment of
      eiaBottomLeft:
        begin
          // must qualify Result fully since Delphi confuses the TRect with the controls Top/Left properties
          Result.Right := Control.Left - 1;
          Result.Left := Result.Right - Images.Width;
          Result.Bottom := Control.Top + Control.Height;
          Result.Top := Result.Bottom - Images.Height;
          OffsetRect(Result, -ImagePadding, 0);
        end;
      eiaBottomRight:
        begin
          Result.Left := Control.Left + Control.Width + 1;
          Result.Right := Result.Left + Images.Width;
          Result.Bottom := Control.Top + Control.Height;
          Result.Top := Result.Bottom - Images.Height;
          OffsetRect(Result, ImagePadding, 0);
        end;
      eiaMiddleLeft:
        begin
          Result.Right := Control.Left - 1;
          Result.Left := Result.Right - Images.Width;
          Result.Top := Control.Top + (Control.Height - Images.Height) div 2;
          Result.Bottom := Result.Top + Images.Height;
          OffsetRect(Result, -ImagePadding, 0);
        end;
      eiaMiddleRight:
        begin
          Result.Left := Control.Left + Control.Width + 1;
          Result.Right := Result.Left + Images.Width;
          Result.Top := Control.Top + (Control.Height - Images.Height) div 2;
          Result.Bottom := Result.Top + Images.Height;
          OffsetRect(Result, ImagePadding, 0);
        end;
      eiaTopLeft:
        begin
          Result.Right := Control.Left - 1;
          Result.Left := Result.Right - Images.Width;
          Result.Top := Control.Top;
          Result.Bottom := Result.Top + Control.Height;
          OffsetRect(Result, -ImagePadding, 0);
        end;
      eiaTopRight:
        begin
          Result.Left := Control.Left + Control.Width + 1;
          Result.Right := Result.Left + Images.Width;
          Result.Top := Control.Top;
          Result.Bottom := Result.Top + Images.Height;
          OffsetRect(Result, ImagePadding, 0);
        end;
    end;
  end;
end;

procedure TJvErrorControl.Paint;
begin
  //  inherited Paint;
  if (Images <> nil) and Visible then  
    Images.Draw(Canvas, 0, 0, ImageIndex); 
end;

procedure TJvErrorControl.SetError(const Value: string);
begin
  Hint := Value;
end;

function TJvErrorControl.GetError: string;
begin
  Result := Hint;
end;

procedure TJvErrorControl.SetImageIndex(const Value: Integer);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    Invalidate;
  end;
end;

procedure TJvErrorControl.SetImageList(const Value: TCustomImageList);
begin
  if FImageList <> Value then
  begin
    FImageList := Value;
    if FImageList <> nil then
      BoundsRect := CalcBoundsRect
    else
      SetBounds(Left, Top, 16, 16);
    //    Invalidate;
  end;
end;

procedure TJvErrorControl.SetControl(const Value: TControl);
begin
  if FControl <> Value then
  begin
    if FControl <> nil then
      FControl.RemoveFreeNotification(Self);
    FControl := Value;
    if FControl <> nil then
    begin
      FControl.FreeNotification(Self);
      Parent := FControl.Parent;
    end
    else
      Parent := nil;
  end;
end;

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

//=== { TJvBlinkThread } =====================================================

constructor TJvBlinkThread.Create(BlinkRate: Integer);
begin
  inherited Create(True);
  FBlinkRate := BlinkRate;
  FErase := False;
end;

procedure TJvBlinkThread.Blink;
begin
  if Assigned(FOnBlink) then
    FOnBlink(Self, FErase);
end;

procedure TJvBlinkThread.Execute;
begin
  FErase := False;
  while not Terminated and not Suspended do
  begin
    Sleep(FBlinkRate);
    Synchronize(Blink);
    if FBlinkRate = 0 then
      Exit;
    FErase := not FErase;
  end;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQErrorIndicator.pas,v $';
    Revision: '$Revision: 1.23 $';
    Date: '$Date: 2005/02/26 06:59:08 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.