jvpanel.pas

East make Tray Icon in delphi

begin
  inherited Create(AOwner);
  {$IFDEF VCL}
  IncludeThemeStyle(Self, [csNeedsBorderPaint, csParentBackground]);
  {$ENDIF VCL}
  FTransparent := False;
  FFlatBorder := False;
  FFlatBorderColor := clBtnShadow;
  FHotColor := clBtnFace;

  FArrangeSettings := TJvArrangeSettings.Create(Self);
end;

destructor TJvPanel.Destroy;
begin
  FArrangeSettings.Free;
  {$IFDEF VisualCLX}
  FreeAndNil(FGripBmp);
  {$ENDIF VisualCLX}
  inherited Destroy;
end;

{$IFDEF VCL}

procedure TJvPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if Transparent and not IsThemed then
  begin
    // (rom) gives a better look in IDE if always set (not fully correct though)
    //if not (csDesigning in ComponentState) then
      Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
    ControlStyle := ControlStyle - [csOpaque];
  end
  else
  begin
    //if not (csDesigning in ComponentState) then
      Params.ExStyle := Params.ExStyle and not WS_EX_TRANSPARENT;
    ControlStyle := ControlStyle + [csOpaque];
  end;
end;

procedure TJvPanel.WMNCHitTest(var Msg: TWMNCHitTest);
var
  P: TPoint;
begin
  inherited;
  if Movable then
  begin
    P := ScreenToClient(SmallPointToPoint(Msg.Pos));
    with P do
      if (X > 5) and (Y > 5) and (X < Width - 5) and (Y < Height - 5) and DoBeforeMove(P.X,P.Y) then
      begin
         Msg.Result := HTCAPTION;
         FWasMoved := True;
      end;
  end;
end;


procedure TJvPanel.WMExitSizeMove(var Msg: TMessage);
begin
  inherited;
  if FWasMoved then
    DoAfterMove;
  FWasMoved := False;
end;

{$ENDIF VCL}

function TJvPanel.DoBeforeMove(X,Y: Integer): Boolean;
begin
  Result := True;
  if Assigned(FOnBeforeMove) then
    FOnBeforeMove(Self, X, Y, Result);
end;

procedure TJvPanel.DoAfterMove;
begin
  if Assigned(FOnAfterMove) then
    FOnAfterMove(Self);
end;


{$IFDEF VisualCLX}

function TJvPanel.GetFrameWidth: Integer;
begin
  if FFlatBorder then
    Result := 1
  else
  begin
    Result := BorderWidth ; //Total Width of BevelInner and Outer;
    if BevelOuter <> bvNone then
      Inc(Result, BevelWidth);
    if BevelInner <> bvNone then
      Inc(Result, BevelWidth);
  end;
end;

function TJvPanel.IsInsideGrip(X, Y: Integer): Boolean;
var
  R: TRect;
  I: Integer;
begin
  I := GetFrameWidth;
  R := Bounds(Width - 12 - I, Height - 12 - I, 12, 12);
  Result := QWindows.PtInRect(R, X, Y);
end;

procedure TJvPanel.DrawMask(ACanvas: TCanvas);
var
  R: TRect;
  I, J, X, Y: Integer;
begin
  inherited DrawMask(ACanvas);
  ACanvas.Brush.Style := bsClear;
  ACanvas.Pen.Color := clDontMask;
  R := Bounds(0, 0, Width, Height);
  I := GetFrameWidth;
  for J := 0 to I do
  begin
    ACanvas.Rectangle(R);
    InflateRect(R, -1, -1)
  end;
  DrawCaptionTo(ACanvas, True);
  if Sizeable then
  begin
    X := ClientWidth - FGripBmp.Width - I;
    Y := ClientHeight - FGripBmp.Height - I;
    for I := 0 to 2 do
      for J := 0 to 2 do
      begin
        ACanvas.MoveTo(X + 4 * I + J, Y + FGripBmp.Height);
        ACanvas.LineTo(X + FGripBmp.Width, Y + 4 * I + J);
      end
  end;
end;

{$ENDIF VisualCLX}

procedure TJvPanel.Paint;
var
  X, Y: Integer;
  {$IFDEF VisualCLX}
  I: Integer;
  {$ENDIF VisualCLX}
begin
  if Assigned(FOnPaint) then
  begin
    FOnPaint(Self);
    Exit;
  end;
  Canvas.Brush.Color := Color;
  if not Transparent or IsThemed then
    DrawThemedBackground(Self, Canvas, ClientRect)
  else
    Canvas.Brush.Style := bsClear;
  if FFlatBorder then
  begin
    Canvas.Brush.Color := FFlatBorderColor;
    {$IFDEF VCL}
    Canvas.FrameRect(ClientRect);
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    FrameRect(Canvas, ClientRect);
    {$ENDIF VisualCLX}
    Canvas.Brush.Color := Color;
  end
  else
    DrawBorders;
  Self.DrawCaption;
  if Sizeable then
    {$IFDEF JVCLThemesEnabled}
    if ThemeServices.ThemesEnabled then
    begin
      ThemeServices.DrawElement(Canvas.Handle, ThemeServices.GetElementDetails(tsGripper),
        Rect(ClientWidth - GetSystemMetrics(SM_CXVSCROLL) - BevelWidth - 2,
          ClientHeight - GetSystemMetrics(SM_CYHSCROLL) - BevelWidth - 2,
          ClientWidth - BevelWidth - 2, ClientHeight - BevelWidth - 2));
    end
    else
    {$ENDIF JVCLThemesEnabled}
      with Canvas do
      begin
        {$IFDEF VisualCLX}
        I := GetFrameWidth;
        X := ClientWidth - FGripBmp.Width - I;
        Y := ClientHeight - FGripBmp.Height - I;
        Draw(X, Y, FGripBmp);
        {$ENDIF VisualCLX}
        {$IFDEF VCL}
        Font.Name := 'Marlett';
        Font.Charset := DEFAULT_CHARSET;
        Font.Size := 12;
        Canvas.Font.Style := [];
        Brush.Style := bsClear;
        X := ClientWidth - GetSystemMetrics(SM_CXVSCROLL) - BevelWidth - 2;
        Y := ClientHeight - GetSystemMetrics(SM_CYHSCROLL) - BevelWidth - 2;
        // (rom) bsClear takes care of that already
        //if Transparent and not IsThemed then
        //  SetBkMode(Handle, BkModeTransparent);
        Canvas.Font.Color := clBtnHighlight;
        TextOut(X, Y, 'o');
        Canvas.Font.Color := clBtnShadow;
        TextOut(X, Y, 'p');
        {$ENDIF VCL}
      end;
end;

{$IFDEF VCL}
// (asn) with VisualCLX Width := Width + 1 will call AdjustSize
procedure TJvPanel.AdjustSize;
begin
  inherited AdjustSize;
  if Transparent and not IsThemed then
  begin
    // (ahuser) That is the only way to draw the border of the contained controls.
    Width := Width + 1;
    Width := Width - 1;
  end;
end;
{$ENDIF VCL}

procedure TJvPanel.DrawBorders;
var
  Rect: TRect;
  TopColor, BottomColor: TColor;

  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then
      TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then
      BottomColor := clBtnHighlight;
  end;

begin
  Rect := ClientRect;
  if BevelOuter <> bvNone then
  begin
    AdjustColors(BevelOuter);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
  Frame3D(Canvas, Rect, Color, Color, BorderWidth);
  if BevelInner <> bvNone then
  begin
    AdjustColors(BevelInner);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
end;

procedure TJvPanel.DrawCaption;
begin
  DrawCaptionTo(Self.Canvas);
end;

procedure TJvPanel.DrawCaptionTo(ACanvas: TCanvas {$IFDEF VisualCLX}; DrawingMask: Boolean = False {$ENDIF});
const
  Alignments: array [TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWrap: array [Boolean] of Longint = (DT_SINGLELINE, DT_WORDBREAK);
var
  ATextRect: TRect;
  BevelSize: Integer;
  Flags: Longint;
begin
  with ACanvas do
  begin
    if Caption <> '' then
    begin
      SetBkMode(Handle, BkModeTransparent);
      Font := Self.Font;
      ATextRect := GetClientRect;
      InflateRect(ATextRect, -BorderWidth, -BorderWidth);
      BevelSize := 0;
      if BevelOuter <> bvNone then
        Inc(BevelSize, BevelWidth);
      if BevelInner <> bvNone then
        Inc(BevelSize, BevelWidth);
      InflateRect(ATextRect, -BevelSize, -BevelSize);
      Flags := DT_EXPANDTABS or WordWrap[MultiLine] or Alignments[Alignment];
      Flags := DrawTextBiDiModeFlags(Flags);
      //calculate required rectangle size
      DrawText(ACanvas.Handle, Caption, -1, ATextRect, Flags or DT_CALCRECT);
      // adjust the rectangle placement
      OffsetRect(ATextRect, 0, -ATextRect.Top + (Height - (ATextRect.Bottom - ATextRect.Top)) div 2);
      case Alignment of
        taRightJustify:
          OffsetRect(ATextRect, -ATextRect.Left + (Width - (ATextRect.Right - ATextRect.Left) - BorderWidth -
            BevelSize), 0);
        taCenter:
          OffsetRect(ATextRect, -ATextRect.Left + (Width - (ATextRect.Right - ATextRect.Left)) div 2, 0);
      end;
      {$IFDEF VisualCLX}
      if DrawingMask then
        Font.Color := clDontMask
      else
      {$ENDIF VisualCLX}
        if not Enabled then
          Font.Color := clGrayText;
      //draw text
      if Transparent and not IsThemed then
        SetBkMode(ACanvas.Handle, BkModeTransparent);
      DrawText(ACanvas.Handle, Caption, -1, ATextRect, Flags);
    end;
  end;
end;

procedure TJvPanel.ParentColorChanged;
begin
  Invalidate;
  inherited ParentColorChanged;
end;

procedure TJvPanel.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not MouseOver and (Control = nil) then
  begin
    FOldColor := Color;
    if not Transparent or IsThemed then
    begin
      Color := HotColor;
      MouseTimer.Attach(Self);
    end;
  end;
  inherited MouseEnter(Control);
end;

procedure TJvPanel.MouseLeave(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if MouseOver and (Control = nil) then
  begin
    if not Transparent or IsThemed then
    begin
      Color := FOldColor;
      MouseTimer.Detach(Self);
    end;
  end;
  inherited MouseLeave(Control);
end;

procedure TJvPanel.SetTransparent(const Value: Boolean);
begin
  if Value <> FTransparent then
  begin
    FTransparent := Value;
    if not IsThemed then
    begin
      {$IFDEF VCL}
      RecreateWnd;
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      Masked := FTransparent;
      if FTransparent then
        ControlStyle := ControlStyle - [csOpaque]
      else
        ControlStyle := ControlStyle + [csOpaque]
      {$ENDIF VisualCLX}
    end;
  end;
end;

procedure TJvPanel.SetFlatBorder(const Value: Boolean);
begin
  if Value <> FFlatBorder then
  begin
    FFlatBorder := Value;
    Invalidate;
  end;
end;

procedure TJvPanel.SetFlatBorderColor(const Value: TColor);
begin
  if Value <> FFlatBorderColor then
  begin
    FFlatBorderColor := Value;
    Invalidate;
  end;
end;

function TJvPanel.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
begin
  if Transparent and not IsThemed then
    Result := True
  else
    Result := inherited DoEraseBackground(Canvas, Param);
end;

procedure TJvPanel.SetMultiLine(const Value: Boolean);
begin
  if FMultiLine <> Value then
  begin
    FMultiLine := Value;
    Invalidate;
  end;
end;

procedure TJvPanel.TextChanged;
begin
  inherited TextChanged;
  Invalidate;
end;

procedure TJvPanel.Invalidate;
begin
{  if Transparent and Visible and Assigned(Parent) and Parent.HandleAllocated and HandleAllocated then