tntjvpanel.pas

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

procedure TTntJvCustomArrangePanel.Invalidate;
begin
{  if Transparent and Visible and Assigned(Parent) and Parent.HandleAllocated and HandleAllocated then
    RedrawWindow(Parent.Handle, nil, 0, RDW_ERASE or RDW_FRAME or RDW_INTERNALPAINT or
      RDW_INVALIDATE or RDW_ERASENOW or RDW_UPDATENOW or RDW_ALLCHILDREN); }
  inherited Invalidate;
end;

procedure TTntJvCustomArrangePanel.SetSizeable(const Value: Boolean);
begin
  if FSizeable <> Value then
  begin
    FSizeable := Value;
    {$IFDEF VisualCLX}
    if Value then
      CreateSizeGrip
    else
      FreeAndNil(FGripBmp);
    {$ENDIF VisualCLX}
    Invalidate;
  end;
end;

procedure TTntJvCustomArrangePanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  {$IFDEF VCL}
  if Sizeable and (Button = mbLeft) and ((Width - X) < 12) and ((Height - Y) < 12) then
  begin
    FDragging := True;
    FLastPos := Point(X, Y);
    MouseCapture := True;
    Screen.Cursor := crSizeNWSE;
  end
  else
    inherited MouseDown(Button, Shift, X, Y);
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  if Sizeable and (Button = mbLeft) and IsInsideGrip(X, Y) then
  begin
    FDragging := True;
    FLastPos := Point(X, Y);
    MouseCapture := True;
    Screen.Cursor := crSizeNWSE;
  end
  else
    if FMovable and QWindows.PtInRect(Rect( 5, 5, Width - 5, Height -5), X, Y) and DoBeforeMove( X, Y ) then
    begin
      FMoving := True;
      FLastPos := Point(X, Y);
      MouseCapture := True;
      Screen.Cursor := crDrag;
    end
    else
      inherited MouseDown(Button, Shift, X, Y);
  {$ENDIF VisualCLX}
end;

procedure TTntJvCustomArrangePanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  R: TRect;
  X1, Y1: Integer;
begin
  if FDragging and Sizeable then
  begin
    R := BoundsRect;
    X1 := R.Right - R.Left + X - FLastPos.X;
    Y1 := R.Bottom - R.Top + Y - FLastPos.Y;
    if (X1 > 1) and (Y1 > 1) then
    begin
      if X1 >= 0 then
        FLastPos.X := X;
      if Y1 >= 0 then
        FLastPos.Y := Y;
      SetBounds(Left, Top, X1, Y1);
      Refresh;
    end;
  end
  else
  {$IFDEF VCL}
    inherited MouseMove(Shift, X, Y);
  if Sizeable and ((Width - X) < 12) and ((Height - Y) < 12) then
    Cursor := crSizeNWSE
  else
    Cursor := crDefault;
  {$ENDIF VCL}
  begin
    {$IFDEF VisualCLX}
    if Movable and FMoving then
    begin
      SetBounds(Left + X - FLastPos.X, Top + Y - FLastPos.Y, Width, Height);
      FWasMoved := True;
    end
    else
    begin
      inherited MouseMove(Shift, X, Y);
      if Sizeable and IsInsideGrip(X, Y) then
        Cursor := crSizeNWSE
      else
        Cursor := crDefault;
    end;
    {$ENDIF VisualCLX}
  end;
end;

procedure TTntJvCustomArrangePanel.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if FDragging and Sizeable then
  begin
    FDragging := False;
    MouseCapture := False;
    Screen.Cursor := crDefault;
    Refresh;
  end
  {$IFDEF VisualCLX}
  else
  if FMoving and Movable then
  begin
    FMoving := False;
    MouseCapture := False;
    Screen.Cursor := crDefault;
    if FWasMoved then
      DoAfterMove;
    FWasMoved := False;
    Refresh;
  end
  {$ENDIF VisualCLX}
  else
    inherited MouseUp(Button, Shift, X, Y);
end;

procedure TTntJvCustomArrangePanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Transparent and not IsThemed then
    Invalidate;
end;

procedure TTntJvCustomArrangePanel.Resize;
begin
  if Assigned(FArrangeSettings) then // (asn)
    if FArrangeSettings.AutoArrange then
      ArrangeControls;
  inherited Resize;
end;

procedure TTntJvCustomArrangePanel.EnableArrange;
begin
  EnableAlign;
  if FEnableArrangeCount > 0 then
    Dec(FEnableArrangeCount);
end;

procedure TTntJvCustomArrangePanel.DisableArrange;
begin
  Inc(FEnableArrangeCount);
  DisableAlign;
end;

function TTntJvCustomArrangePanel.ArrangeEnabled: Boolean;
begin
  Result := FEnableArrangeCount <= 0;
end;

procedure TTntJvCustomArrangePanel.Loaded;
begin
  inherited Loaded;
  if FArrangeSettings.AutoArrange then
    ArrangeControls;
end;

procedure TTntJvCustomArrangePanel.AlignControls(AControl: TControl; var Rect: TRect);
begin
  inherited AlignControls(AControl, Rect);
  if FArrangeSettings.AutoArrange then
    ArrangeControls;
end;

function TTntJvCustomArrangePanel.GetNextControlByTabOrder(ATabOrder: Integer): TWinControl;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to ControlCount - 1 do
    if Controls[I] is TWinControl then
      if TWinControl(Controls[I]).TabOrder = ATabOrder then
      begin
        Result := TWinControl(Controls[I]);
        Break;
      end;
end;

procedure TTntJvCustomArrangePanel.ArrangeControls;
var
  AktX, AktY, NewX, NewY, MaxY, NewMaxX: Integer;
  ControlMaxX, ControlMaxY: Integer;
  TmpWidth, TmpHeight: Integer;
  LastTabOrder: Integer;
  CurrControl: TWinControl;
  I: Integer;
  OldHeight, OldWidth: Integer;
begin
  if (not ArrangeEnabled) or FArrangeControlActive or (ControlCount = 0) then
    Exit;
  if [csLoading, csReading] * ComponentState <> [] then
    Exit;
  FArrangeWidth := 0;
  FArrangeHeight := 0;
  FArrangeControlActive := True;
  try
    OldHeight := Height;
    OldWidth := Width;
    TmpHeight := Height;
    TmpWidth := Width;
    AktY := FArrangeSettings.BorderTop;
    AktX := FArrangeSettings.BorderLeft;
    LastTabOrder := -1;
    MaxY := -1;
    if (FArrangeSettings.AutoSize in [asWidth, asBoth]) then
      ControlMaxX := TmpWidth - 2 * FArrangeSettings.BorderLeft
    else
      ControlMaxX := -1;
    if (FArrangeSettings.AutoSize in [asHeight, asBoth]) then
      ControlMaxY := TmpHeight - 2 * FArrangeSettings.BorderTop
    else
      ControlMaxY := -1;

    for I := 0 to ControlCount - 1 do
      if Controls[I] is TWinControl then
      begin
        if Controls[I] is TTntJvCustomArrangePanel then
          TTntJvCustomArrangePanel(Controls[I]).Rearrange;
        if (Controls[I].Width + 2 * FArrangeSettings.BorderLeft > TmpWidth) then
          TmpWidth := Controls[I].Width + 2 * FArrangeSettings.BorderLeft;
      end;

    if (TmpWidth > FArrangeSettings.MaxWidth) and (FArrangeSettings.MaxWidth > 0) then
      TmpWidth := FArrangeSettings.MaxWidth ;
    CurrControl := GetNextControlByTabOrder(LastTabOrder+1);
    while Assigned(CurrControl) do
    begin
      LastTabOrder := CurrControl.TabOrder;
      if CurrControl.Visible or
        ((csDesigning in ComponentState) and FArrangeSettings.ShowNotVisibleAtDesignTime) then
      begin
        NewMaxX := AktX + CurrControl.Width + FArrangeSettings.DistanceHorizontal +
          FArrangeSettings.BorderLeft;
        if (((NewMaxX > TmpWidth) and not (FArrangeSettings.AutoSize in [asWidth, asBoth])) or
            ((NewMaxX > FArrangeSettings.MaxWidth) and (FArrangeSettings.MaxWidth > 0))) and
           (AktX > FArrangeSettings.BorderLeft) and // Only Valid if there is one control in the current line
           FArrangeSettings.WrapControls then
        begin
          AktX := FArrangeSettings.BorderLeft;
          AktY := AktY + MaxY + FArrangeSettings.DistanceVertical;
          MaxY := -1;
          NewX := AktX;
          NewY := AktY;
        end
        else
        begin
          NewX := AktX;
          NewY := AktY;
        end;
        AktX := AktX + CurrControl.Width;
        if AktX > ControlMaxX then
          ControlMaxX := AktX;
        AktX := AktX + FArrangeSettings.DistanceHorizontal;
        CurrControl.Left := NewX;
        CurrControl.Top := NewY;
        if CurrControl.Height > MaxY then
          MaxY := CurrControl.Height;
        ControlMaxY := AktY + MaxY;
      end;
      CurrControl := GetNextControlByTabOrder(LastTabOrder+1);
    end;

    if not (csLoading in ComponentState) then
    begin
      if (FArrangeSettings.AutoSize in [asWidth, asBoth]) then
        if ControlMaxX >= 0 then
          if (FArrangeSettings.MaxWidth > 0) and (ControlMaxX >= FArrangeSettings.MaxWidth) then
            TmpWidth := FArrangeSettings.MaxWidth
          else
            TmpWidth := ControlMaxX + FArrangeSettings.BorderLeft
        else
          TmpWidth := 0;
      if (FArrangeSettings.AutoSize in [asHeight, asBoth]) then
        if ControlMaxY >= 0 then
          TmpHeight := ControlMaxY + FArrangeSettings.BorderTop
        else
          TmpHeight := 0;
      Width := TmpWidth;
      Height := TmpHeight;
    end;
    FArrangeWidth := ControlMaxX + 2 * FArrangeSettings.BorderLeft;
    FArrangeHeight := ControlMaxY + 2 * FArrangeSettings.BorderTop;
    if (OldWidth <> TmpWidth) or (OldHeight <> Height) then
      {$IFDEF VCL}
      SendMessage(GetFocus, WM_PAINT, 0, 0);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      UpdateWindow(GetFocus);
      {$ENDIF VisualCLX}
  finally
    FArrangeControlActive := False;
  end;
end;

procedure TTntJvCustomArrangePanel.SetWidth(Value: Integer);
var
  Changed: Boolean;
begin
  Changed := inherited Width <> Value;
  inherited Width := Value;
  if Changed then
  begin
    if Assigned(FOnChangedWidth) then
      FOnChangedWidth (Self, Value);
    if Assigned(FOnResizeParent) then
      FOnResizeParent(Self, Left, Top, Value, Height)
    else
    if Parent is TTntJvCustomArrangePanel then
      TTntJvCustomArrangePanel(Parent).Rearrange;
  end;
end;

function TTntJvCustomArrangePanel.GetWidth: Integer;
begin
  Result := inherited Width;
end;

procedure TTntJvCustomArrangePanel.SetHeight(Value: Integer);
var
  Changed: Boolean;
begin
  Changed := inherited Height <> Value;
  inherited Height := Value;
  if Changed then
  begin
    if Assigned(FOnChangedHeight) then
      FOnChangedHeight (Self, Value);
    if Assigned(FOnResizeParent) then
      FOnResizeParent(Self, Left, Top, Width, Value)
    else
    if Parent is TTntJvCustomArrangePanel then
      TTntJvCustomArrangePanel(Parent).Rearrange;
  end;
end;

function TTntJvCustomArrangePanel.GetHeight: Integer;
begin
  Result := inherited Height;
end;

procedure TTntJvCustomArrangePanel.SetArrangeSettings(Value: TJvArrangeSettings);
begin
  if (Value <> nil) and (Value <> FArrangeSettings) then
    FArrangeSettings.Assign(Value);
end;

function TTntJvCustomArrangePanel.GetHotTrack: Boolean;
begin
  Result := FHotTrack;
end;

function TTntJvCustomArrangePanel.GetHotTrackFont: TFont;
begin
  Result := FHotTrackFont;
end;

function TTntJvCustomArrangePanel.GetHotTrackFontOptions: TJvTrackFontOptions;
begin
  Result := FHotTrackFontOptions;
end;

function TTntJvCustomArrangePanel.GetHotTrackOptions: TJvHotTrackOptions;
begin
  Result := FHotTrackOptions;
end;

procedure TTntJvCustomArrangePanel.SetHotTrack(Value: Boolean);
begin
  FHotTrack := Value;
end;

procedure TTntJvCustomArrangePanel.SetHotTrackFont(Value: TFont);
begin
  if (FHotTrackFont<>Value) and (Value <> nil) then
    FHotTrackFont.Assign(Value);
end;

procedure TTntJvCustomArrangePanel.SetHotTrackFontOptions(Value: TJvTrackFontOptions);
begin
  if FHotTrackFontOptions <> Value then
  begin
    FHotTrackFontOptions := Value;
    UpdateTrackFont(HotTrackFont, Font, FHotTrackFontOptions);
  end;
end;

procedure TTntJvCustomArrangePanel.SetHotTrackOptions(Value: TJvHotTrackOptions);
begin
  if (FHotTrackOptions <> Value) and (Value <> nil) then
    FHotTrackOptions.Assign(Value);
end;

procedure TTntJvCustomArrangePanel.Rearrange;
begin
  if FArrangeSettings.AutoArrange and not (csLoading in ComponentState) then
    ArrangeControls;
end;

procedure TTntJvCustomArrangePanel.DoArrangeSettingsPropertyChanged(Sender: TObject;
  const PropName: string);
begin
  if SameText(PropName,'AutoArrange') then
  begin
    if ArrangeSettings.AutoArrange then
      Rearrange;
  end
  else
  if SameText(PropName,'AutoSize') then
  begin
    if ArrangeSettings.AutoSize <> asNone then
      Rearrange;
  end
  else //otherwise call Rearrange
    Rearrange;
end;

{$IFDEF VisualCLX}
procedure TTntJvCustomArrangePanel.CreateSizeGrip;
var
  I: Integer;
begin
  FGripBmp := TBitmap.Create;
  FGripBmp.Width := 13; //GetSystemMetrics(SM_CXVSCROLL);
  FGripBmp.Height := 13; //GetSystemMetrics(SM_CXYSCROLL);
  with FGripBmp.Canvas do
  begin
    Brush.Color := clBackground;
    FillRect(Bounds(0, 0, Width, Height));
    Pen.Width := 1;
    for I := 0 to 2 do
    begin
      Pen.Color := clLight;
      MoveTo(3 * I, FGripBmp.Height);
      LineTo(FGripBmp.Width, 3 * I);
      Pen.Color := clDark;
      MoveTo(3 * I + 1, FGripBmp.Height);
      LineTo(FGripBmp.Width, 3 * I + 1);
//      Pen.Color := clMid;
      MoveTo(3 * I + 2, FGripBmp.Height);
      LineTo(FGripBmp.Width, 3 * I + 2);
    end;
  end;
  FGripBmp.TransparentColor := clBackground;
  FGripBmp.TransparentMode := tmFixed;
  FGripBmp.Transparent := True;
end;
{$ENDIF VisualCLX}

{ TTntJvPanel }

procedure TTntJvPanel.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  { For backward compatibility }
  FFilerTag := 'HotColor';
  Filer.DefineProperty(FFilerTag, ReadData, nil, False);
end;

procedure TTntJvPanel.ReadData(Reader: TReader);
var
  C: Integer;
begin
  if SameText(FFilerTag, 'HotColor') then
  begin
    if Reader.NextValue = vaIdent then
    begin
      if IdentToColor(Reader.ReadIdent, C) then
        HotTrackOptions.Color := C;
    end
    else
      HotTrackOptions.Color := Reader.ReadInteger;
  end;
end;

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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.