tntjvpanel.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

constructor TTntJvCustomArrangePanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  {$IFDEF VCL}
  IncludeThemeStyle(Self, [csNeedsBorderPaint, csParentBackground]);
  {$ENDIF VCL}
  FMultiLine := False;
  FTransparent := False;
  FFlatBorder := False;
  FFlatBorderColor := clBtnShadow;
  FHotTrack := False;
  FHotTrackFont := TFont.Create;
  FHotTrackFontOptions := DefaultTrackFontOptions;
  FHotTrackOptions := TJvPanelHotTrackOptions.Create;

  FArrangeSettings := TJvArrangeSettings.Create;
  FArrangeSettings.OnChangeProperty := DoArrangeSettingsPropertyChanged;
end;

destructor TTntJvCustomArrangePanel.Destroy;
begin
  FreeAndNil(FHotTrackFont);
  FreeAndNil(FHotTrackOptions);
  FreeAndNil(FArrangeSettings);
  {$IFDEF VisualCLX}
  FreeAndNil(FGripBmp);
  {$ENDIF VisualCLX}
  inherited Destroy;
end;

{$IFDEF VCL}

procedure TTntJvCustomArrangePanel.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 TTntJvCustomArrangePanel.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 TTntJvCustomArrangePanel.WMExitSizeMove(var Msg: TMessage);
begin
  inherited;
  if FWasMoved then
    DoAfterMove;
  FWasMoved := False;
end;

{$ENDIF VCL}

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

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

{$IFDEF VisualCLX}

function TTntJvCustomArrangePanel.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 TTntJvCustomArrangePanel.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 TTntJvCustomArrangePanel.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 TTntJvCustomArrangePanel.Paint;
var
  X, Y: Integer;
  {$IFDEF VisualCLX}
  I: Integer;
  {$ENDIF VisualCLX}
  R: TRect;
  OldPenColor:TColor;
  OldPenWidth: Integer;
begin
  if Assigned(FOnPaint) then
  begin
    FOnPaint(Self);
    Exit;
  end;

  if MouseOver and HotTrack then
  begin
    Canvas.Font := Self.HotTrackFont;
    if HotTrackOptions.Enabled then
    begin
      Canvas.Brush.Color := HotTrackOptions.Color;
      if HotTrackOptions.FrameVisible then
      begin
        Canvas.Brush.Style := bsSolid;
        OldPenColor := Canvas.Pen.Color;
        Canvas.Pen.Color := HotTrackOptions.FrameColor;
        Canvas.Rectangle(0, 0, Width, Height);
        Canvas.Pen.Color := OldPenColor;
      end
      else
      begin
        R := ClientRect;
        InflateRect(R,-BevelWidth,-BevelWidth);
        Canvas.FillRect(R);
      end;
    end;
  end
  else
  begin
    Canvas.Font := Self.Font;
    Canvas.Brush.Color := Color;
    if not Transparent or IsThemed then
      DrawThemedBackground(Self, Canvas, ClientRect)
    else
      Canvas.Brush.Style := bsClear;
    if FFlatBorder then
    begin
      if BorderWidth > 0 then
      begin
        OldPenWidth:= Canvas.Pen.Width;
        OldPenColor := Canvas.Pen.Color;
        Canvas.Pen.Width := BorderWidth;
        Canvas.Pen.Color := FFlatBorderColor;
        Canvas.Brush.Style := bsClear;

        R := ClientRect;
        X := (BorderWidth div 2);
        if Odd(BorderWidth) then
          Y := X
        else
          Y := X -1;

        Inc(R.Left,X);
        Inc(R.Top,X);
        Dec(R.Bottom,Y);
        Dec(R.Right,Y);

        Canvas.Rectangle(R);

        Canvas.Pen.Width := OldPenWidth;
        Canvas.Pen.Color := OldPenColor;
     end;
    end
    else
      DrawBorders;
  end;

  DrawCaption;
  if Sizeable then
  begin
    {$IFDEF JVCLThemesEnabled}
    if ThemeServices.ThemesEnabled then
      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))
    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;
end;

{$IFDEF VCL}
// (asn) with VisualCLX Width := Width + 1 will call AdjustSize
procedure TTntJvCustomArrangePanel.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 TTntJvCustomArrangePanel.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 TTntJvCustomArrangePanel.DrawCaption;
begin
  DrawCaptionTo(Self.Canvas);
end;

procedure TTntJvCustomArrangePanel.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
      if (MouseOver or FDragging) and HotTrack then
        ACanvas.Font := Self.HotTrackFont
      else
        ACanvas.Font := Self.Font;

      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
      Tnt_DrawTextW(ACanvas.Handle, PWideChar(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);
      Tnt_DrawTextW(ACanvas.Handle, PWideChar(Caption), -1, ATextRect, Flags);
    end;
  end;
end;

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

procedure TTntJvCustomArrangePanel.MouseEnter(Control: TControl);
var
  NeedRepaint: Boolean;
  OtherDragging:Boolean;
begin
  if csDesigning in ComponentState then
    Exit;

  if not MouseOver and Enabled  and (Control = nil) then
  begin
    OtherDragging :=
      {$IFDEF VCL}
       {$IFDEF COMPILER6_UP}
      Mouse.IsDragging;
       {$ELSE}
      KeyPressed(VK_LBUTTON);
      {$ENDIF COMPILER6_UP}
     {$ENDIF VCL}
     {$IFDEF VisualCLX}
      DragActivated;
     {$ENDIF VisualCLX}
    NeedRepaint := not Transparent and
     (IsThemed or (FHotTrack and Enabled and not FDragging and not OtherDragging));
    inherited MouseEnter(Control); // set MouseOver
    if NeedRepaint then
      Repaint;
  end
  else
    inherited MouseEnter(Control);
end;

procedure TTntJvCustomArrangePanel.MouseLeave(Control: TControl);
var
  NeedRepaint: Boolean;
  OtherDragging:Boolean;
begin
  if csDesigning in ComponentState then
    Exit;
  OtherDragging :=
    {$IFDEF VCL}
     {$IFDEF COMPILER6_UP}
    Mouse.IsDragging;
     {$ELSE}
    KeyPressed(VK_LBUTTON);
     {$ENDIF COMPILER6_UP}
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    DragActivated;
    {$ENDIF VisualCLX}
  if MouseOver and Enabled and (Control = nil) then
  begin
    NeedRepaint := not Transparent and
     (IsThemed or (FHotTrack and (FDragging or (Enabled and not OtherDragging))));
    inherited MouseLeave(Control); // set MouseOver
    if NeedRepaint then
      Repaint;
  end
  else
    inherited MouseLeave(Control);
end;

procedure TTntJvCustomArrangePanel.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 TTntJvCustomArrangePanel.SetFlatBorder(const Value: Boolean);
begin
  if Value <> FFlatBorder then
  begin
    FFlatBorder := Value;
    Invalidate;
  end;
end;

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

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

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

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