jvcaptionpanel.pas

East make Tray Icon in delphi

procedure TJvCaptionPanel.SetButtons(Value: TJvCapBtnStyles);
var
  I: TJvCapBtnStyle;
begin
  if FButtons <> Value then
  begin
    FButtons := Value;
    for I := Low(FButtonArray) to High(FButtonArray) do
      FButtonArray[I].Visible := (I in FButtons);
    Invalidate;
  end;
end;

procedure TJvCaptionPanel.SetCaptionPosition(Value: TJvDrawPosition);
begin
  if FCaptionPosition <> Value then
  begin
    FCaptionPosition := Value;
    RecreateWnd;
  end;
end;

procedure TJvCaptionPanel.SetIcon(Value: TIcon);
begin
  FIcon.Assign(Value);
  Invalidate;
end;

procedure TJvCaptionPanel.AlignControls(AControl: TControl; var Rect: TRect);
begin
  case FCaptionPosition of
    dpLeft:
      Rect := Classes.Rect(FCaptionWidth + FCaptionOffsetSmall, 0, ClientWidth, ClientHeight);
    dpTop:
      Rect := Classes.Rect(0, FCaptionWidth + FCaptionOffsetSmall, ClientWidth, ClientHeight);
    dpRight:
      Rect := Classes.Rect(0, 0, ClientWidth - FCaptionWidth - FCaptionOffsetSmall, ClientHeight);
    dpBottom:
      Rect := Classes.Rect(0, 0, ClientWidth, ClientHeight - FCaptionWidth - FCaptionOffsetSmall);
  end;
  inherited AlignControls(AControl, Rect);
end;

{$IFDEF VCL}
procedure TJvCaptionPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if BorderStyle = bsSingle then
    with Params do
    begin
      {$IFDEF VCL}
      if Resizable then
        Style := Style or WS_THICKFRAME
      else
        Style := Style or WS_DLGFRAME;
      {$ELSE}
      Style := Style or WS_THICKFRAME
      {$ENDIF VCL}
      ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
    end;
end;
{$ENDIF VCL}

procedure TJvCaptionPanel.Paint;
var
  Rotation: Integer;
  R: TRect;
  FlatOffset: Integer;
begin
  R := ClientRect;
  {$IFDEF VisualCLX}
  if BorderStyle = bsSingle then
  begin
    DrawShadePanel(Canvas, R, False, 1, nil);
    InflateRect(R, -2, -2);
  end;
  {$ENDIF VisualCLX}
  with Canvas do
  begin
    Brush.Color := Color;
    FillRect(R);
    Brush.Color := FCaptionColor;
  end;
  FBevel := FCaptionOffsetSmall;
  Rotation := 0;

  FlatOffset := Ord(FlatButtons);

  if FOutlookLook then
  begin
    if CaptionPosition = dpLeft then
      FCaptionWidth := GetSystemMetrics(SM_CYCAPTION) - 3 + FlatOffset
    else
    if CaptionPosition = dpRight then
      FCaptionWidth := GetSystemMetrics(SM_CYCAPTION) - 4 + FlatOffset
    else
      FCaptionWidth := GetSystemMetrics(SM_CYCAPTION) - 5 + FlatOffset
  end
  else
    FCaptionWidth := GetSystemMetrics(SM_CYCAPTION);

  case FCaptionPosition of
    dpLeft:
      begin
        FCaptionRect := Rect(FBevel, FBevel, FCaptionWidth + FBevel, ClientHeight - FBevel);
        Rotation := 90;
      end;
    dpTop:
      FCaptionRect := Rect(FBevel, FBevel, ClientWidth - FBevel, FCaptionWidth + FBevel);
    dpRight:
      begin
        FCaptionRect := Rect(ClientWidth - FCaptionWidth - FBevel, FBevel, ClientWidth - FBevel, ClientHeight - FBevel);
        Rotation := -90;
      end;
    dpBottom:
      FCaptionRect := Rect(FBevel, ClientHeight - FCaptionWidth - FBevel, ClientWidth - FBevel, ClientHeight - FBevel);
  end; //case
  Canvas.FillRect(FCaptionRect);
  if not FIcon.Empty then
  begin
    with FCaptionRect do
      case FCaptionPosition of
      dpRight:
        Canvas.Draw( (Left + Right - FIcon.Width) div 2, Top + 1, FIcon);
      dpLeft:
        Canvas.Draw( (Left + Right - FIcon.Width) div 2, Bottom - 1 - FIcon.Height, FIcon);
      dpBottom, dpTop:
        Canvas.Draw(Left + 1, (Top + Bottom - FIcon.Height) div 2 , FIcon );
      end; //case
  end;
  DrawRotatedText(Rotation);
  DrawButtons;
end;

procedure TJvCaptionPanel.DrawRotatedText(Rotation: Integer);
var
  tH: Integer;
  {$IFDEF VCL}
  tW: Integer;
  Lf: TLogFont;
  Tf: TFont;
  Flags: Integer;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  X, Y: Integer;
  {$ENDIF VisualCLX}
  R: TRect;
begin
  if FCaption = '' then
    Exit;
  {$IFDEF VisualCLX}
  Canvas.Start;
  try
    QPainter_save(Canvas.Handle);
    Canvas.Font.Assign(CaptionFont);
  {$ENDIF VisualCLX}
    SetBkMode(Canvas.Handle, TRANSPARENT);
    with Canvas do
    begin
      {$IFDEF VCL}
      Tf := TFont.Create;
      try
        Tf.Assign(CaptionFont);
        GetObject(Tf.Handle, SizeOf(Lf), @Lf);
        Lf.lfEscapement := Rotation * 10;
        Lf.lfOrientation := Rotation * 10;
        Lf.lfOutPrecision := OUT_TT_PRECIS;
        Tf.Handle := CreateFontIndirect(Lf);
        Canvas.Font.Assign(Tf);
      finally
        Tf.Free;
      end;
      {$ENDIF VCL}
      R := FCaptionRect;
      tH := ((R.Bottom - R.Top) - Canvas.TextHeight(FCaption)) div 2;
      {$IFDEF VCL}
      tW := ((R.Right - R.Left) - Canvas.TextHeight(FCaption)) div 2;
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      X := FCaptionRect.Left;
      Y := FCaptionRect.Top;
      {$ENDIF VisualCLX}
      if FOutlookLook then
      begin
        Dec(tH);
        {$IFDEF VCL}
        Dec(tW);
        {$ENDIF VCL}
      end;
      case FCaptionPosition of
        dpLeft:
          begin
            {$IFDEF VCL}
            if not FIcon.Empty then
              Dec(R.Bottom, FIcon.Height + 2);
            with R do
              R := Rect(Left, Bottom, Right, Top);
            OffsetRect(R, tW, -FOffset);
            {$ENDIF VCL}
            {$IFDEF VisualCLX}
            X := R.Left + (FCaptionWidth + Canvas.TextHeight(Caption)) div 2 - FOffset;
            Y := R.Bottom - 1;
            if not FIcon.Empty then
              Dec(Y, FIcon.Height + 3)
            else
              Dec(Y);
            {$ENDIF VisualCLX}
          end;
        dpTop, dpBottom:
          begin
            {$IFDEF VisualCLX}
            X := R.Left;
            Y := R.Top + tH + Canvas.TextHeight(Caption) - FOffset;
            if not FIcon.Empty then
              Inc(X, FIcon.Width + 3)
            else
              Inc(X);
            {$ENDIF VisualCLX}
            {$IFDEF VCL}
            OffsetRect(R, FOffset, tH);
            if not FIcon.Empty then
              Inc(R.Left, FIcon.Width + 2);
            {$ENDIF VCL}
          end;
        dpRight:
          begin
            {$IFDEF VisualCLX}
            X := R.Left + (FCaptionWidth - Canvas.TextHeight(Caption)) div 2 + FOffset;
            Y := R.Top;
            if not FIcon.Empty then
              Inc(Y, FIcon.Height + 3)
            else
              Inc(Y);
            {$ENDIF VisualCLX}
            {$IFDEF VCL}
            if not FIcon.Empty then
              Inc(R.Top, FIcon.Height + 2);
            with R do
              R := Rect(Right, Top, Left, Bottom);
            OffsetRect(R, -tW, FOffset);
            {$ENDIF VCL}
          end;
      end;
      {$IFDEF VCL}
      Flags := DT_NOPREFIX;
      if FCaptionPosition in [dpTop, dpBottom] then
        Flags := Flags or DT_VCENTER;
      if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
        Flags := Flags or DT_NOCLIP; { bug or feature? }
      DrawText(Canvas.Handle, PChar(Caption), -1, R, Flags);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      // ToDo: replace with DrawText(Canvas, .... , Rotation)
      TextOutAngle(Canvas, Rotation, X, Y, Caption);
      {$ENDIF VisualCLX}
    end;
  {$IFDEF VisualCLX}
  finally
    QPainter_restore(Canvas.Handle);
    Canvas.Stop;
  end;
  {$ENDIF VisualCLX}
end;

procedure TJvCaptionPanel.DrawButtons;
var
  R: TRect;
  FWidth, FHeight: Integer;
begin
  if FButtons = [] then
    Exit;

  FWidth := FButtonArray[capClose].Width;
  FHeight := FButtonArray[capClose].Height;
  if FFlat then
  begin
    Inc(FWidth);
    Inc(FHeight);
  end;

  case FCaptionPosition of
    dpLeft:
      R := Rect(FCaptionRect.Left + FCaptionOffsetSmall, FCaptionRect.Top + FCaptionOffsetSmall, 0, 0);
    dpTop:
      R := Rect(FCaptionRect.Right - FWidth - FCaptionOffsetSmall, FCaptionRect.Top + FCaptionOffsetLarge, 0, 0);
    dpRight:
      R := Rect(FCaptionRect.Left + FCaptionOffsetSmall, FCaptionRect.Bottom - FHeight - FCaptionOffsetSmall, 0, 0);
    dpBottom:
      R := Rect(FCaptionRect.Right - FWidth - FCaptionOffsetSmall, FCaptionRect.Top + FCaptionOffsetLarge, 0, 0);
  end;

  if capClose in FButtons then
  begin
    FButtonArray[capClose].Top := R.Top;
    FButtonArray[capClose].Left := R.Left;
    FButtonArray[capClose].Visible := True;
    case FCaptionPosition of
      dpLeft:
        OffsetRect(R, 0, FHeight + FCaptionOffsetSmall);
      dpTop:
        OffsetRect(R, -FWidth - FCaptionOffsetSmall, 0);
      dpRight:
        OffsetRect(R, 0, -FHeight - FCaptionOffsetSmall);
      dpBottom:
        OffsetRect(R, -FWidth - FCaptionOffsetSmall, 0);
    end;
  end
  else
    FButtonArray[capClose].Visible := False;

  if (capMax in FButtons) then
  begin
    FButtonArray[capMax].Top := R.Top;
    FButtonArray[capMax].Left := R.Left;
    FButtonArray[capMax].Visible := True;
    case FCaptionPosition of
      dpLeft:
        OffsetRect(R, 0, FHeight);
      dpTop:
        OffsetRect(R, -FWidth, 0);
      dpRight:
        OffsetRect(R, 0, -FHeight);
      dpBottom:
        OffsetRect(R, -FWidth, 0);
    end;
  end
  else
    FButtonArray[capMax].Visible := False;

  if capRestore in FButtons then
  begin
    FButtonArray[capRestore].Top := R.Top;
    FButtonArray[capRestore].Left := R.Left;
    FButtonArray[capRestore].Visible := True;
    case FCaptionPosition of
      dpLeft:
        OffsetRect(R, 0, FHeight);
      dpTop:
        OffsetRect(R, -FWidth, 0);
      dpRight:
        OffsetRect(R, 0, -FHeight);
      dpBottom:
        OffsetRect(R, -FWidth, 0);
    end;
  end
  else
    FButtonArray[capRestore].Visible := False;

  if capMin in FButtons then
  begin
    FButtonArray[capMin].Top := R.Top;
    FButtonArray[capMin].Left := R.Left;
    FButtonArray[capMin].Visible := True;
    case FCaptionPosition of
      dpLeft:
        OffsetRect(R, 0, FHeight);
      dpTop:
        OffsetRect(R, -FWidth, 0);
      dpRight:
        OffsetRect(R, 0, -FHeight);
      dpBottom:
        OffsetRect(R, -FWidth, 0);
    end;
  end
  else
    FButtonArray[capMin].Visible := False;

  if capHelp in FButtons then
  begin
    FButtonArray[capHelp].Top := R.Top;
    FButtonArray[capHelp].Left := R.Left;
    FButtonArray[capHelp].Visible := True;
  end
  else
    FButtonArray[capHelp].Visible := False;
end;

{ this method is called only by the caption buttons }

procedure TJvCaptionPanel.ClickButton(Button: TJvCapBtnStyle);
begin
  if Assigned(FButtonClick) then
    FButtonClick(Self, Button);
end;

procedure TJvCaptionPanel.DoLeaveDrag;
begin
  if Assigned(FEndDrag) then
    FEndDrag(Self);
end;

procedure TJvCaptionPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging then
    DoLeaveDrag;
  FDragging := False;
end;

procedure TJvCaptionPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  {$IFDEF JVCAPTIONPANEL_STD_BEHAVE}
  if FDragging then
  begin
    Left := Left + X - FAnchorPos.X;
    Top := Top + Y - FAnchorPos.Y;
  end;
  {$ENDIF JVCAPTIONPANEL_STD_BEHAVE}
end;

procedure TJvCaptionPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);

  FMouseDown := True;
  if not PtInRect(FCaptionRect, Point(X, Y)) then
    Exit;

  if FAutoDrag and CanStartDrag then
  begin
    SetZOrder(True);
    FDragging := True;
    ReleaseCapture;
    {$IFDEF JVCAPTIONPANEL_STD_BEHAVE}
    SetCapture(Handle);
    FAnchorPos := Point(X, Y);
    {$ELSE}
    Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
    {$ENDIF JVCAPTIONPANEL_STD_BEHAVE}
  end;
end;

procedure TJvCaptionPanel.Resize;
begin
  inherited Resize;
  Repaint;
end;

function TJvCaptionPanel.CanStartDrag: Boolean;
begin
  Result := True;
  if Assigned(FOnStartAutoDrag) then
    FOnStartAutoDrag(Self, Result);
end;

{$IFDEF VCL}
procedure TJvCaptionPanel.WMNCLButtonUp(var Msg: TWMNCLButtonUp);
begin
  inherited;
  if FDragging then
    MouseUp(mbLeft, [], Msg.XCursor, Msg.YCursor);
end;

procedure TJvCaptionPanel.SetResizable(const Value: Boolean);
begin
  if FResizable <> Value then
  begin
    FResizable := Value;
    RecreateWnd;
  end;
end;
{$ENDIF VCL}

procedure TJvCaptionPanel.SetOutlookLook(const Value: Boolean);
begin
  FOutlookLook := Value;
  if FOutlookLook then
  begin
    FCaptionOffsetSmall := 0;
    FCaptionOffsetLarge := 0;
  end
  else
  begin
    FCaptionOffsetSmall := 2;
    FCaptionOffsetLarge := 3;
  end;
  Invalidate;
end;

procedure TJvCaptionPanel.DoCaptionFontChange(Sender: TObject);
begin
  Invalidate;
end;


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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.