jvbuttons.pas

East make Tray Icon in delphi

    NumGlyphs := OldNumGlyphs;
    FColor := OldColor;
    if not IgnoreOld then
      GlyphChanged(FOriginal);
  end;
end;

procedure TJvButtonGlyph.CalcTextRect(Canvas: TCanvas; var TextRect: TRect;
  Caption: string);
begin
  TextRect := Rect(0, 0, TextRect.Right - TextRect.Left, 0);
  DrawText(Canvas, Caption, Length(Caption), TextRect, DT_CALCRECT);
end;

procedure TJvHTButtonGlyph.DrawButtonText(Canvas: TCanvas; const Caption: string;
  TextBounds: TRect; State: TButtonState);
var
  Cap: string;
begin
  Cap := '<ALIGN CENTER>' + Caption; // Kaczkowski
  with Canvas do
  begin
    Brush.Style := bsClear;
    if State = bsDisabled then
    begin
      OffsetRect(TextBounds, 1, 1);
      Font.Color := clBtnHighlight;
      ItemHtDraw(Canvas, TextBounds, [], Cap);
      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      ItemHtDraw(Canvas, TextBounds, [], Cap);
    end
    else
      ItemHtDraw(Canvas, TextBounds, [], Cap);
  end;
end;

procedure TJvHTButtonGlyph.CalcTextRect(Canvas: TCanvas; var TextRect: TRect;
  Caption: string);
begin
  TextRect := Rect(0, 0, ItemHtWidth(Canvas, TextRect, [], Caption),
    ItemHtHeight(Canvas, Caption));     // Kaczkowski
end;

//=== { TJvaCaptionButton } ==================================================

{$IFDEF VCL}

constructor TJvaCaptionButton.Create(AOwner: TComponent);

  function FindButtonPos: Integer;
  var
    I: Integer;
    B: TComponent;
  begin
    Result := 4;
    for I := 0 to Owner.ComponentCount - 1 do
    begin
      B := Owner.Components[I];
      if B is TJvaCaptionButton then
        Result := Max(Result, (B as TJvaCaptionButton).FBPos + 1);
    end;
  end;

begin
  if not (AOwner is TForm) then
    raise EJVCLException.CreateResFmt(@RsEOwnerMustBeForm, [ClassName]);
  inherited Create(AOwner);

  FGlyph := TJvButtonGlyph.Create;
  TJvButtonGlyph(FGlyph).OnChange := GlyphChanged;
  FFont := TFont.Create;
  FFont.OnChange := FontChange;
  FBPos := FindButtonPos;
  FMouseLButtonDown := False;
  FPress := False;
  FWidth := -1;
  FMargin := -1;
  FVisible := True;
  WHook := TJvWindowHook.Create(nil);
  WHook.BeforeMessage := DoBeforeMsg;
  WHook.AfterMessage := DoAfterMsg;
  WHook.Control := (Owner as TForm);
  WHook.Active := True;
  Resize;
end;

destructor TJvaCaptionButton.Destroy;
begin
  WHook.Free;
  if Owner <> nil then
    RedrawWindow((Owner as TForm).Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT or RDW_INVALIDATE);
  TJvButtonGlyph(FGlyph).Free;
  FFont.Free;
  inherited Destroy;
end;

function TJvaCaptionButton.BorderStyle: TFormBorderStyle;
begin
  if csDesigning in ComponentState then
    Result := bsSizeable
  else
    Result := (Owner as TForm).BorderStyle;
end;

function TJvaCaptionButton.GetHeight: Integer;
begin
  if BorderStyle in [bsSizeToolWin, bsToolWindow] then
    Result := GetSystemMetrics(SM_CYSMSIZE)
  else
    Result := GetSystemMetrics(SM_CYSIZE);
end;

function TJvaCaptionButton.GetWidth: Integer;
begin
  if FWidth <> -1 then
    Result := FWidth
  else
  if BorderStyle in [bsSizeToolWin, bsToolWindow] then
    Result := GetSystemMetrics(SM_CXSMSIZE)
  else
    Result := GetSystemMetrics(SM_CXSIZE);
end;

function TJvaCaptionButton.GetLeft: Integer;
var
  F: Integer;

  function FirstButtonPos: Integer;
  var
    I: Integer;
    B: TComponent;
  begin
    Result := FBPos;
    for I := 0 to Owner.ComponentCount - 1 do
    begin
      B := Owner.Components[I];
      if B is TJvaCaptionButton then
        Result := Min(Result, (B as TJvaCaptionButton).FBPos);
    end;
  end;

  function RightButtonWidth: Integer;
  var
    I: Integer;
    B: TComponent;
  begin
    Result := 0;
    for I := 0 to Owner.ComponentCount - 1 do
    begin
      B := Owner.Components[I];
      if (B is TJvaCaptionButton) and
        ((B as TJvaCaptionButton).FBPos <= FBPos) then
        Inc(Result, (B as TJvaCaptionButton).GetWidth);
    end;
  end;

begin
  if BorderStyle in [bsSizeToolWin, bsToolWindow] then
    F := GetSystemMetrics(SM_CXSMSIZE)
  else
    F := GetSystemMetrics(SM_CXSIZE);
  Result := (Owner as TForm).Width - CalcOffset.X * 2 - F * FirstButtonPos;
  Result := Result - RightButtonWidth;
  // Result := 100;
end;

procedure TJvaCaptionButton.Resize;
begin
  FRect := Bounds(GetLeft, 0, GetWidth, GetHeight);
  RedrawWindow((Owner as TForm).Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT or RDW_INVALIDATE);
end;

function TJvaCaptionButton.CalcOffset: TPoint;
begin
  case BorderStyle of
    bsSingle:
      begin
        { Result.X := GetSystemMetrics(SM_CXBORDER) + 1;
         Result.Y := GetSystemMetrics(SM_CYBORDER) + 1; }
        Result.X := GetSystemMetrics(SM_CXDLGFRAME);
        Result.Y := GetSystemMetrics(SM_CYDLGFRAME);
      end;
    bsDialog:
      begin
        Result.X := GetSystemMetrics(SM_CXDLGFRAME) - 1 {?};
        Result.Y := GetSystemMetrics(SM_CYDLGFRAME);
      end;
    bsSizeable:
      begin
        Result.X := GetSystemMetrics(SM_CXFRAME);
        Result.Y := GetSystemMetrics(SM_CYFRAME);
      end;
    bsNone:
      begin
        Result.X := 0;
        Result.Y := 0;
      end;
    bsToolWindow:
      begin
        Result.X := GetSystemMetrics(SM_CXDLGFRAME);
        Result.Y := GetSystemMetrics(SM_CYDLGFRAME);
      end;
    bsSizeToolWin:
      begin
        Result.X := GetSystemMetrics(SM_CXFRAME);
        Result.Y := GetSystemMetrics(SM_CYFRAME);
      end;
  end;
end;

procedure TJvaCaptionButton.Draw;
var
  DC: HDC;
  R: TRect;
  Canvas: TCanvas;
  Offset: TPoint;
const
  CaptionColor: array [Boolean] of TColor = (clInactiveCaption, clActiveCaption);
begin
  if not FVisible then
    Exit;
  Offset := CalcOffset;
  DC := GetWindowDC((Owner as TForm).Handle);
  Canvas := TCanvas.Create;
  Canvas.Font := FFont;
  try
    SetWindowOrgEx(DC, -Offset.X, -Offset.Y, nil);
    R := FRect;
    Canvas.Handle := DC;
    Canvas.Brush.Color := CaptionColor[FActive];
    //Canvas.FillRect(R); { commented for Windows98 gradient caption compatibility }
    Inc(R.Left, 2);
    Inc(R.Top, 2);
    Dec(R.Bottom, 2);
    if FPress then
      DrawThemedFrameControl(WHook.Control, DC, R, DFC_BUTTON, DFCS_BUTTONPUSH or DFCS_PUSHED)
    else
      DrawThemedFrameControl(WHook.Control, DC, R, DFC_BUTTON, DFCS_BUTTONPUSH);

    R := Rect(R.Left + 1, R.Top + 1, R.Right - 2, R.Bottom - 2);
    if FPress then
      OffsetRect(R, 1, 1);

    if FPress then
      TJvButtonGlyph(FGlyph).Draw(Canvas, R, Point(0, 0),
        FCaption, FLayout, FMargin, FSpacing, bsDown, True)
    else
      TJvButtonGlyph(FGlyph).Draw(Canvas, R, Point(0, 0),
        FCaption, FLayout, FMargin, FSpacing, bsUp, True);
  finally
    Canvas.Handle := 0;
    Canvas.Free;
    ReleaseDC((Owner as TForm).Handle, DC);
  end;
end;

(*
procedure TJvaCaptionButton.HookWndProc(var Msg: TMessage);
var
  P: TPoint;
  OldPress: Boolean;
begin
  if Owner = nil then
    Exit;
  case Msg.Msg of
    WM_NCACTIVATE: // after
      begin
        FActive := Boolean(Msg.wParam);
        WHook.CallOldProc(Msg);
        Draw;
      end;
    WM_SETTEXT, WM_NCPAINT: // after
      begin
        WHook.CallOldProc(Msg);
        Draw;
      end;
    WM_SIZE: // after
      begin
        WHook.CallOldProc(Msg);
        Resize;
      end;
    WM_NCLBUTTONDOWN: // before
      if FVisible and
        MouseOnButton(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor) then
      begin
        SetCapture((Owner as TForm).Handle);
        FMouseLButtonDown := True;
        FPress := True;
        Draw;
      end
      else
        WHook.CallOldProc(Msg);
    WM_NCLBUTTONDBLCLK: // before
      if FVisible and
        MouseOnButton(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor) then
      begin
        { FPress := True;
          Draw;
          FPress := False;
          Draw;}
      end
      else
        WHook.CallOldProc(Msg);
    WM_LBUTTONUP: // before
      if FVisible and FMouseLButtonDown then
      begin
        ReleaseCapture;
        FMouseLButtonDown := False;
        FPress := False;
        Draw;
        P := (Owner as TForm).ClientToScreen(Point(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor));
        if MouseOnButton(P.X, P.Y) then
          Click;
      end
      else
        WHook.CallOldProc(Msg);
    WM_MOUSEMOVE: // before
      if FMouseLButtonDown then
      begin
        P := (Owner as TForm).ClientToScreen(Point(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor));
        OldPress := FPress;
        FPress := MouseOnButton(P.X, P.Y);
        if OldPress <> FPress then
          Draw;
      end
      else
        WHook.CallOldProc(Msg);
    WM_NCHITTEST: // before
      if FVisible and
        MouseOnButton(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor) then
        Msg.Result := HTBORDER
      else
        WHook.CallOldProc(Msg);
    WM_NCRBUTTONDOWN: // before
      { if FVisible and
          MouseOnButton(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor) then
         WHook.CallOldProc(Msg)
       else} WHook.CallOldProc(Msg);
    WM_SETTINGCHANGE: // after
      begin
        WHook.CallOldProc(Msg);
        Changed;
      end;
  else
    WHook.CallOldProc(Msg);
  end;
end;
*)

procedure TJvaCaptionButton.Changed;
var
  I: Integer;
  B: TComponent;
begin
  for I := 0 to Owner.ComponentCount - 1 do
  begin
    B := Owner.Components[I];
    if (B is TJvaCaptionButton) then
    begin
      (B as TJvaCaptionButton).Resize;
      (B as TJvaCaptionButton).Draw;
    end;
  end;
end;

function TJvaCaptionButton.MouseOnButton(X, Y: Integer): Boolean;
begin
  with (Owner as TForm) do
    Result := PtInRect(FRect, Point(X - Left - CalcOffset.X, Y - Top - CalcOffset.Y));
end;

procedure TJvaCaptionButton.Click;
begin
  if csDesigning in ComponentState then
    DesignerSelectComponent(Self);
  if Assigned(FOnClick) then
    FOnClick(Self);
end;

procedure TJvaCaptionButton.GlyphChanged(Sender: TObject);
begin
  Changed;
end;

procedure TJvaCaptionButton.SetCaption(Value: string);
begin
  if FCaption <> Value then
  begin
    FCaption := Value;
    Changed;
  end;
end;

function TJvaCaptionButton.IsCaptionStored: Boolean;
begin
  Result := FCaption <> '';
end;

procedure TJvaCaptionButton.SetFont(Value: TFont);
begin
  if FFont <> Value then
  begin
    FFont.Assign(Value);
    Changed;
  end;
end;

procedure TJvaCaptionButton.FontChange(Sender: TObject);
begin
  Changed;
end;

function TJvaCaptionButton.GetGlyph: TBitmap;
begin
  Result := FGlyph.Glyph;
end;

procedure TJvaCaptionButton.SetGlyph(Value: TBitmap);
begin
  if FGlyph.Glyph <> Value then
  begin
    FGlyph.Glyph := Value;
    Changed;
  end;
end;

function TJvaCaptionButton.GetNumGlyphs: TNumGlyphs;
begin
  Result := FGlyph.NumGlyphs;
end;

procedure TJvaCaptionButton.SetNumGlyphs(Value: TNumGlyphs);
begin
  if Value < 0 then
    Value := 1
  else
  if Value > 4 then
    Value := 4;
  if Value <> FGlyph.NumGlyphs then
  begin
    FGlyph.NumGlyphs := Value;
    Changed;
  end;
end;

procedure TJvaCaptionButton.SetBPos(const Value: Integer);
begin
  if FBPos <> Value then
  begin
    FBPos := Value;
    Changed;
  end;
end;

procedure TJvaCaptionButton.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin