jvqctrls.pas

East make Tray Icon in delphi

    if Flat then
    begin
      FCanvas.Brush.Color := Color;
      FCanvas.FillRect(R); // (p3) TWinControls don't support Transparent anyway 
      if FMouseInControl or FIsFocused or (csDesigning in ComponentState) then
      begin
        if IsDown then
          Frame3D(FCanvas, R, clBtnShadow, clBtnHighlight, 1)
        else
          Frame3D(FCanvas, R, clBtnHighlight, clBtnShadow, 1);
      end;
    end
    else
    begin
      Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
      if IsDown then
        Flags := Flags or DFCS_PUSHED;
      if not IsEnabled then
        Flags := Flags or DFCS_INACTIVE;

      if FIsFocused or IsDefault then
      begin
        if not IsEnabled then
          FCanvas.Pen.Color := clInactiveCaption
        else
          FCanvas.Pen.Color := clWindowFrame;
        FCanvas.Pen.Width := 1;
        FCanvas.Brush.Style := bsClear;
        FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
        InflateRect(R, -1, -1);
      end;

      if IsDown then
      begin
        FCanvas.Pen.Color := clBtnShadow;
        FCanvas.Pen.Width := 1;
        FCanvas.Brush.Color := clBtnFace;
        FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
        InflateRect(R, -1, -1);
      end
      else
        DrawFrameControl(FCanvas.Handle, R, DFC_BUTTON, Flags);
      FCanvas.Brush.Color := Color;
      FCanvas.FillRect(R);
    end;

    // Return content rect
    RectContent := ClientRect;
    InflateRect(RectContent, -4, -4);
  end;
end;

procedure TJvCustomImageButton.DrawButtonImage(ImageBounds: TRect);

var
  Glyph: TBitmap;

begin
  if csDestroying in ComponentState then
    Exit;
  with ImageBounds do
    if IsImageVisible then  
      if Assigned(FImages) then
        FImages.Draw(FCanvas, Left, Top, GetImageIndex, itImage, Enabled)
      else
      begin
        Glyph := TBitmap.Create;
        DefaultImgBtnImagesList.GetBitmap(GetKindImageIndex, Glyph);
        Glyph.TransparentColor := clOlive;
        FCanvas.Draw(Left, Top, Glyph);
        Glyph.Free;
      end; 
end;

procedure TJvCustomImageButton.DrawButtonText(TextBounds: TRect; TextEnabled: Boolean);
var
  Flags: DWORD;
  RealCaption: string;
begin
  Flags := DrawTextBiDiModeFlags(DT_VCENTER or Alignments[FAlignment]);
  RealCaption := GetRealCaption;
  with Canvas do
  begin
    Brush.Style := bsClear;
    if not TextEnabled then
    begin
      OffsetRect(TextBounds, 1, 1);
      Font.Color := clBtnHighlight;
      DrawText(Canvas, RealCaption, Length(RealCaption), TextBounds, Flags);
      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText(Canvas, RealCaption, Length(RealCaption), TextBounds, Flags);
    end
    else
      DrawText(Canvas, RealCaption, Length(RealCaption), TextBounds, Flags);
  end;
end;

procedure TJvCustomImageButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
  R, RectContent, RectText, RectImage, RectArrow: TRect;
begin
  DrawButtonFrame(DrawItemStruct, RectContent);

  //R := ClientRect;
  //InflateRect(R, -4, -4);
  R := RectContent;
  if (DrawItemStruct.itemState and ODS_SELECTED <> 0) and Enabled then
  begin 
      OffsetRect(R, 1, 1);
  end;

  CalcButtonParts(R, RectText, RectImage);
  if DropArrow and Assigned(DropDownMenu) then
  begin
    RectArrow := Rect(Width - 16, Height div 2, Width - 9, Height div 2 + 7);
    if (DrawItemStruct.itemState and ODS_SELECTED <> 0) then
      OffsetRect(RectArrow, 1, 1);
    DrawDropArrow(FCanvas, RectArrow);
    if (DrawItemStruct.itemState and ODS_SELECTED <> 0) then
      OffsetRect(RectContent, 1, -1)
  end;
  DrawButtonText(RectText, Enabled);
  DrawButtonImage(RectImage);
  DrawButtonFocusRect(RectContent);
end;

function TJvCustomImageButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TJvImgBtnActionLink;
end;

function TJvCustomImageButton.GetCustomCaption: string;
const
  Captions: array [TJvImgBtnKind] of string =
    ('', SOKButton, SCancelButton, SHelpButton, SYesButton, SNoButton,
      SCloseButton, SAbortButton, SRetryButton, SIgnoreButton, SAllButton);
begin
  Result := Captions[FKind];
end;

function TJvCustomImageButton.GetImageIndex: Integer;
begin
  if FAnimating then
  begin
    Result := FImageIndex + FCurrentAnimateFrame - 1;
    if Assigned(FOnGetAnimateIndex) then
      FOnGetAnimateIndex(Self, FCurrentAnimateFrame, Result);
  end
  else
    Result := FImageIndex;
end;

function TJvCustomImageButton.GetImageList: TCustomImageList;
begin
  if Assigned(FImages) then
    Result := FImages
  else
    Result := DefaultImgBtnImagesList;
end;

function TJvCustomImageButton.GetKindImageIndex: Integer;
const
  ImageKindIndexes: array [TJvImgBtnKind] of Integer =
    (-1, 2, 4, 0, 3, 1, 5, 8, 6, 9, 7);
begin
  Result := ImageKindIndexes[FKind];
end;

function TJvCustomImageButton.GetRealCaption: string;
begin
  if (FKind <> bkCustom) and (Caption = '') then
    Result := GetCustomCaption
  else
    Result := inherited GetRealCaption;
end;

procedure TJvCustomImageButton.ImageListChange(Sender: TObject);
begin
  InvalidateImage;
end;

class procedure TJvCustomImageButton.InitializeDefaultImageList;

var
  ResBmp: TBitmap;

begin
  if not Assigned(DefaultImgBtnImagesList) then
  begin
    DefaultImgBtnImagesList := TImageList.CreateSize(18, 18);  
    ResBmp := TBitmap.Create;
    try
      ResBmp.LoadFromResourceName(HInstance, 'JvCustomImageButtonDEFAULT');
      DefaultImgBtnImagesList.Add(ResBmp, nil);
    finally
      ResBmp.Free;
    end; 
  end;
end;

procedure TJvCustomImageButton.InvalidateImage;
begin
  Invalidate;
end;

function TJvCustomImageButton.IsImageVisible: Boolean;
begin
  Result := FImageVisible and
    ((Assigned(FImages) and (GetImageIndex <> -1)) or
    (not Assigned(FImages) and (FKind <> bkCustom)));
end;

procedure TJvCustomImageButton.Loaded;
begin
  inherited Loaded;
  if FAnimate then
    StartAnimate;
end;

procedure TJvCustomImageButton.RestartAnimate;
begin
  if FAnimating then
  begin
    StopAnimate;
    StartAnimate;
    InvalidateImage;
  end;
end;

procedure TJvCustomImageButton.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate;
  end;
end;

procedure TJvCustomImageButton.SetAnimate(const Value: Boolean);
begin
  if FAnimate <> Value then
  begin
    FAnimate := Value;
    if Value then
      StartAnimate
    else
      StopAnimate;
    InvalidateImage;
  end;
end;

procedure TJvCustomImageButton.SetAnimateFrames(const Value: Integer);
begin
  if FAnimateFrames <> Value then
  begin
    FAnimateFrames := Value;
    RestartAnimate;
  end;
end;

procedure TJvCustomImageButton.SetAnimateInterval(const Value: Cardinal);
begin
  if FAnimateInterval <> Value then
  begin
    FAnimateInterval := Value;
    RestartAnimate;
  end;
end;

procedure TJvCustomImageButton.SetButtonStyle(ADefault: Boolean);
begin
  if ADefault <> FIsFocused then
  begin
    FIsFocused := ADefault;
    Refresh;
  end;
end;

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

procedure TJvCustomImageButton.SetImages(const Value: TCustomImageList);
begin
  if FImages <> nil then
    FImages.UnRegisterChanges(FImageChangeLink);
  FImages := Value;
  if FImages <> nil then
  begin
    FImages.RegisterChanges(FImageChangeLink);
    FImages.FreeNotification(Self);
  end
  else
    SetImageIndex(-1);
  InvalidateImage;
end;

procedure TJvCustomImageButton.SetImageVisible(const Value: Boolean);
begin
  if FImageVisible <> Value then
  begin
    FImageVisible := Value;
    Invalidate;
  end;
end;

procedure TJvCustomImageButton.SetKind(const Value: TJvImgBtnKind);
begin
  if FKind <> Value then
  begin
    if Value <> bkCustom then
    begin
      Default := Value in [bkOK, bkYes];
      Cancel := Value in [bkCancel, bkNo];
      if not (csLoading in ComponentState) and (FKind = bkCustom) then
      begin
        Caption := '';
        Images := nil;
      end;
    end;
    ModalResult := JvImgBtnModalResults[Value];
    FKind := Value;
    Invalidate;
  end;
end;

procedure TJvCustomImageButton.SetLayout(const Value: TJvImgBtnLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    if (csDesigning in ComponentState) and (FAlignment <> taCenter) then
      case FLayout of
        blImageLeft: FAlignment := taLeftJustify;
        blImageRight: FAlignment := taRightJustify;
      end;
    Invalidate;
  end;
end;

procedure TJvCustomImageButton.SetMargin(const Value: Integer);
begin
  if (FMargin <> Value) and (Value >= -1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TJvCustomImageButton.SetOwnerDraw(const Value: Boolean);
begin
  if FOwnerDraw <> Value then
  begin
    FOwnerDraw := Value;
    Invalidate;
  end;
end;

procedure TJvCustomImageButton.SetSpacing(const Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TJvCustomImageButton.SetFlat(const Value: Boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TJvCustomImageButton.ShowNextFrame;
begin
  Inc(FCurrentAnimateFrame);
  if FCurrentAnimateFrame > FAnimateFrames then
    FCurrentAnimateFrame := 1;
  InvalidateImage;
end;

procedure TJvCustomImageButton.StartAnimate;
begin
  if ComponentState * [csDesigning, csLoading] = [] then
  begin
    DoubleBuffered := True;
    FCurrentAnimateFrame := 0;
    ShowNextFrame;
    OSCheck(SetTimer(Handle, 1, FAnimateInterval, nil) <> 0);
    FAnimating := True;
  end;
end;

procedure TJvCustomImageButton.StopAnimate;
begin
  if FAnimating then
  begin
    KillTimer(Handle, 1);
    FCurrentAnimateFrame := 0;
    DoubleBuffered := False;
    FAnimating := False;
  end;
end;




procedure TJvCustomImageButton.DestroyWidget;
begin
  StopAnimate;
  inherited DestroyWidget;
end;


procedure TJvCustomImageButton.WMTimer(var Msg: TWMTimer);
begin
  if Msg.TimerID = 1 then
  begin
    ShowNextFrame;
    Msg.Result := 1;
  end
  else
    inherited;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQCtrls.pas,v $';
    Revision: '$Revision: 1.16 $';
    Date: '$Date: 2005/02/06 14:06:04 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}



initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

finalization
  FreeAndNil(DefaultImgBtnImagesList);
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.