jvgradientcaption.pas

East make Tray Icon in delphi

function TJvCaption.GetTextWidth: Integer;
begin
  Result := InternalGetTextWidth(Font, Caption);
end;

procedure TJvCaption.SetVisible(Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Changed(False);
  end;
end;

procedure TJvCaption.SetInactiveColor(Value: TColor);
begin
  if FInactiveColor <> Value then
  begin
    FInactiveColor := Value;
    if (GradientCaption = nil) or not GradientCaption.FWindowActive then
      Changed(False);
  end;
end;

procedure TJvCaption.SetGlueNext(Value: Boolean);
begin
  if FGlueNext <> Value then
  begin
    FGlueNext := Value;
    Changed(False);
  end;
end;

//=== { TJvGradientCaption } ================================================

function SysGradient: Boolean;
var
  Info: BOOL;
begin
  if SystemParametersInfo(SPI_GETGRADIENTCAPTIONS, SizeOf(Info), @Info, 0) then
    Result := Info
  else
    Result := False;
end;

constructor TJvGradientCaption.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGradientSteps := 64;
  FGradientActive := True;
  FActive := True;
  FCaptions := TJvCaptionList.Create(Self);
  FWinHook := TJvWindowHook.Create(Self);
  FWinHook.BeforeMessage := BeforeMessage;
  FWinHook.AfterMessage := AfterMessage;
  FStartColor := clWindowText;
  FFontInactiveColor := clInactiveCaptionText;
  FFormCaption := '';
  FFont := TFont.Create;
  SetFontDefault;
end;

destructor TJvGradientCaption.Destroy;
begin
  FOnDeactivate := nil;
  FOnActivate := nil;
  if not (csDesigning in ComponentState) then
    ReleaseHook;
  FCaptions.Free;
  FCaptions := nil;
  FFont.Free;
  FFont := nil;
  inherited Destroy;
end;

procedure TJvGradientCaption.Loaded;
var
  Loading: Boolean;
begin
  Loading := csLoading in ComponentState;
  inherited Loaded;
  if not (csDesigning in ComponentState) then
  begin
    if Loading and (Owner is TCustomForm) then
      Update;
  end;
end;

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

procedure TJvGradientCaption.SetPopupMenu(Value: TPopupMenu);
begin
  FPopupMenu := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

procedure TJvGradientCaption.SetCaptions(Value: TJvCaptionList);
begin
  Captions.Assign(Value);
end;

procedure TJvGradientCaption.SetDefaultFont(Value: Boolean);
begin
  if FDefaultFont <> Value then
  begin
    if Value then
      SetFontDefault;
    FDefaultFont := Value;
    if Active then
      Update;
  end;
end;

procedure TJvGradientCaption.SetFontDefault;
var
  NCMetrics: TNonClientMetrics;
begin
  with FFont do
  begin
    OnChange := nil;
    try
      NCMetrics.cbSize := SizeOf(NCMetrics);
      if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCMetrics, 0) then
      begin
        if (Owner is TForm) and
          ((Owner as TForm).BorderStyle in [bsToolWindow, bsSizeToolWin]) then
          Handle := CreateFontIndirect(NCMetrics.lfSmCaptionFont)
        else
          Handle := CreateFontIndirect(NCMetrics.lfCaptionFont);
      end
      else
      begin
        Name := 'MS Sans Serif';
        Size := 8;
        Style := [fsBold];
      end;
      Color := clCaptionText;
      Charset := DEFAULT_CHARSET;
    finally
      OnChange := FontChanged;
    end;
  end;
  FDefaultFont := True;
end;

function TJvGradientCaption.IsFontStored: Boolean;
begin
  Result := not DefaultFont;
end;

function TJvGradientCaption.GetForm: TForm;
begin
  if Owner is TCustomForm then
    Result := TForm(Owner as TCustomForm)
  else
    Result := nil;
end;

function TJvGradientCaption.GetFormCaption: string;
begin
  if (Form <> nil) and (csDesigning in ComponentState) then
    FFormCaption := Form.Caption;
  Result := FFormCaption;
end;

procedure TJvGradientCaption.SetFormCaption(const Value: string);
begin
  if FFormCaption <> Value then
  begin
    FFormCaption := Value;
    if (Form <> nil) and (csDesigning in ComponentState) then
      Form.Caption := FFormCaption;
    if Active then
      Update;
  end;
end;

procedure TJvGradientCaption.SetHook;
begin
  if not (csDesigning in ComponentState) and (Owner <> nil) and
    (Owner is TCustomForm) then
    FWinHook.Control := Form;
end;

procedure TJvGradientCaption.ReleaseHook;
begin
  FWinHook.Control := nil;
end;

procedure TJvGradientCaption.CheckToggleHook;
begin
  if Active then
    SetHook
  else
    ReleaseHook;
end;

function TJvGradientCaption.CheckMenuPopup(X, Y: Integer): Boolean;
begin
  Result := False;
  if not (csDesigning in ComponentState) and Assigned(FPopupMenu) and
    FPopupMenu.AutoPopup then
  begin
    FPopupMenu.PopupComponent := Self;
    if Form <> nil then
    begin
      Form.SendCancelMode(nil);
      FPopupMenu.Popup(X, Y);
      Result := True;
    end;
  end;
end;

procedure TJvGradientCaption.BeforeMessage(Sender: TObject; var Msg: TMessage;
  var Handled: Boolean);
var
  DrawRgn: HRGN;
  R: TRect;
  Icons: TBorderIcons;
begin
  if Active then
  begin
    case Msg.Msg of
      WM_NCACTIVATE:
        FWindowActive := (Msg.WParam <> 0);
      WM_NCRBUTTONDOWN:
        if Assigned(FPopupMenu) and FPopupMenu.AutoPopup then
        begin
          FClicked := True;
          Msg.Result := 0;
          Handled := True;
        end;
      WM_NCRBUTTONUP:
        with TWMMouse(Msg) do
          if FClicked then
          begin
            FClicked := False;
            if CheckMenuPopup(XPos, YPos) then
            begin
              Result := 0;
              Handled := True;
            end;
          end;
      WM_NCPAINT:
        begin
          FSaveRgn := Msg.WParam;
          FRgnChanged := False;
          CalculateGradientParams(R, Icons);
          if RectInRegion(FSaveRgn, R) then
          begin
            DrawRgn := CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom);
            try
              Msg.WParam := CreateRectRgn(0, 0, 1, 1);
              FRgnChanged := True;
              CombineRgn(Msg.WParam, FSaveRgn, DrawRgn, RGN_DIFF);
            finally
              DeleteObject(DrawRgn);
            end;
          end;
        end;
    end;
  end;
end;

procedure TJvGradientCaption.AfterMessage(Sender: TObject; var Msg: TMessage;
  var Handled: Boolean);
var
  DC: HDC;
  S: string;
begin
  if Active then
  begin
    case Msg.Msg of
      WM_NCACTIVATE:
        begin
          DC := GetWindowDC(Form.Handle);
          try
            DrawGradientCaption(DC);
          finally
            ReleaseDC(Form.Handle, DC);
          end;
        end;
      WM_NCPAINT:
        begin
          if FRgnChanged then
          begin
            DeleteObject(Msg.WParam);
            Msg.WParam := FSaveRgn;
            FRgnChanged := False;
          end;
          DC := GetWindowDC(Form.Handle);
          try
            DrawGradientCaption(DC);
          finally
            ReleaseDC(Form.Handle, DC);
          end;
        end;
      WM_GETTEXT:
        { Delphi doesn't send WM_SETTEXT to form's window procedure,
          so we need to handle WM_GETTEXT to redraw non-client area
          when form's caption changed }
        if csDesigning in ComponentState then
        begin
          SetString(S, PChar(Msg.LParam), Msg.Result);
          if AnsiCompareStr(S, FFormCaption) <> 0 then
          begin
            FormCaption := S;
            PostMessage(Form.Handle, WM_NCPAINT, 0, 0);
          end;
        end;
    end;
  end;
end;

procedure TJvGradientCaption.SetStartColor(Value: TColor);
begin
  if FStartColor <> Value then
  begin
    FStartColor := Value;
    if Active then
      Update;
  end;
end;

function TJvGradientCaption.GetActive: Boolean;
begin
  Result := FActive;
  if not (csDesigning in ComponentState) then
    Result := Result and NewStyleControls and (Owner is TCustomForm);
end;

procedure TJvGradientCaption.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    FClicked := False;
    Update;
    if [csDestroying, csReading] * ComponentState = [] then
    begin
      if FActive then
      begin
        if Assigned(FOnActivate) then
          FOnActivate(Self);
      end
      else
      begin
        if Assigned(FOnDeactivate) then
          FOnDeactivate(Self);
      end;
    end;
  end;
end;

procedure TJvGradientCaption.Clear;
begin
  if FCaptions <> nil then
    FCaptions.Clear;
end;

procedure TJvGradientCaption.MoveCaption(FromIndex, ToIndex: Integer);
begin
  Captions[FromIndex].Index := ToIndex;
end;

procedure TJvGradientCaption.Update;
var
  Rgn: HRGN;
begin
  if not (csDesigning in ComponentState) and (Owner is TCustomForm) and
    not (csLoading in ComponentState) then
  begin
    CheckToggleHook;
    FWindowActive := False;
    if (Form <> nil) and Form.HandleAllocated and Form.Visible then
    begin
      if Active then
        FWindowActive := (GetActiveWindow = Form.Handle) and IsForegroundTask;
      with Form do
        Rgn := CreateRectRgn(Left, Top, Left + Width, Top + Height);
      try
        SendMessage(Form.Handle, WM_NCPAINT, Rgn, 0);