stabcontrol.pas

Alpha Controls 界面控件包

          Offset := Width - ((RowCount - Row) * ItemSize + 1);

          TabsArray[j].Row := Row;
          TabsArray[j].Processed := True;

          for i := 0 to l - 1 do begin
            if not TabsArray[i].Processed and Between(TabsArray[i].R.Left, TabsArray[j].R.Left - 2, TabsArray[j].R.Left + 2) then begin
              TabsArray[i].R.Right := Offset;
              TabsArray[i].R.Left := Offset - ItemSize;
              TabsArray[i].Row := Row;
              TabsArray[i].Processed := True;
            end;
          end;
          TabsArray[j].R.Right := Offset;
          TabsArray[j].R.Left := Offset - ItemSize;
        end;
      end;
    end;
  end;
end;

procedure TsCustomTabControl.RebuildTabs;
var
  Row, ActiveRow : integer;
  procedure MoveToEnd(ActiveRow : integer);
  var
    i, j, l : integer;
    TempItem : TsTabInfo;
  begin
    l := Length(TabsArray);
    i := 0;
    while (i < l) do if TabsArray[i].Row = ActiveRow then begin
      TempItem.Caption    := TabsArray[i].Caption;
      TempItem.ImageIndex := TabsArray[i].ImageIndex;
      TempItem.Index      := TabsArray[i].Index;

      for j := i to l - 2 do begin
        TabsArray[j].Caption    := TabsArray[j + 1].Caption;
        TabsArray[j].ImageIndex := TabsArray[j + 1].ImageIndex;
        TabsArray[j].Index      := TabsArray[j + 1].Index;
        TabsArray[j].Row        := TabsArray[j + 1].Row;
      end;

      TabsArray[l - 1].Caption    := TempItem.Caption;
      TabsArray[l - 1].ImageIndex := TempItem.ImageIndex;
      TabsArray[l - 1].Index      := TempItem.Index;
      TabsArray[l - 1].Row        := Row;
      TabsArray[l - 1].Caption    := TempItem.Caption;

    end else inc(i);
  end;
begin
  if (csReading in ComponentState) then Exit;
  UpdateTabRects;

  if ActiveTabIndex > -1 then ActiveRow := TabsArray[ActiveTabIndex].Row else ActiveRow := 0;
  Row := 1;
  if ActiveRow <> Row then MoveToEnd(ActiveRow);
//  if not (csCreating in ControlState) and (ActiveTabIndex > -1) then CheckUpDown; v4.21
end;

function TsCustomTabControl.ActualIndex(Index: integer): integer;
var
  i, l : integer;
begin
  l := Length(TabsArray);
  Result := -1;
  for i := 0 to l - 1 do begin
    if TabsArray[i].Index = Index then begin
      Result := i;
      Exit;
    end;
  end;
end;

function TsCustomTabControl.SkinTabRect(Index : integer): TRect;
begin
  Result := Rect(0, 0, 0, 0);
  if Index > Length(TabsArray) - 1 then Exit;
  if (Index < 0) then Exit;
  Result := TabsArray[Index].R;
  if (Style <> tsTabs) or (Result.Left = Result.Right) then Exit;
  if ActiveTabIndex = Index then begin
    dec(Result.Bottom, 1);
  end
  else begin
    inc(Result.Bottom, 3);
    dec(Result.Right, 1);
  end;

  case TabPosition of
    tpTop : begin
      InflateRect(Result, 2 * Integer(ActiveTabIndex = Index), Integer(ActiveTabIndex = Index));
      inc(Result.Bottom, 2);
    end;
    tpBottom : begin
      InflateRect(Result, 2 * Integer(ActiveTabIndex = Index), Integer(ActiveTabIndex = Index));
      dec(Result.Top, 2);
      if ActiveTabIndex = Index then inc(Result.Bottom) else dec(Result.Bottom, 3);
    end;
    tpLeft : begin
      InflateRect(Result, 0, 1);
      inc(Result.Right, 2);
      if ActiveTabIndex = Index then InflateRect(Result, 1, 1) else begin
        dec(Result.Bottom, 4);
        inc(Result.Right, 2);
      end;
    end;
    tpRight : begin
      InflateRect(Result, 1, 0);
      OffsetRect(Result, -1, -1);
      if ActiveTabIndex = Index then begin
        InflateRect(Result, 1, 1);
        inc(Result.Bottom, 3);
      end
      else dec(Result.Bottom, 2);
    end;
  end;

{
  case TabPosition of
    tpTop : begin
    end;
    tpBottom : begin
      InflateRect(Result, 2 * Integer(FSavedTabIndex = TabsArray[Index].Index), Integer(FSavedTabIndex = TabsArray[Index].Index));
      dec(Result.Top, 2);
      if Index = ActiveTabIndex then begin
        inc(Result.Bottom, 1);
      end
      else begin
        dec(Result.Bottom, 3);
      end;
    end;
    tpLeft : begin
      InflateRect(Result, 0, 1);
      inc(Result.Right, 2);
      if Index = ActiveTabIndex then begin
        InflateRect(Result, 1, 1);
      end
      else begin
        dec(Result.Bottom, 4);
        inc(Result.Right, 2);
      end;
    end;
    tpRight : begin
      InflateRect(Result, 1, 0);
      OffsetRect(Result, -1, -1);
      if Index = ActiveTabIndex then begin
        InflateRect(Result, 1, 1);
        inc(Result.Bottom, 3);
      end
      else begin
        dec(Result.Bottom, 2);
      end;
    end;
  end;
}
end;

procedure TsCustomTabControl.WMHScroll(var Message: TWMHScroll);
begin
  inherited;
  FCommonData.Invalidate;
end;

procedure TsCustomTabControl.WMKeyDown(var Message: TWMKeyDown);
var
  ShiftState: TShiftState;
  TabCenter : TPoint;
  R : TRect;
  NewIndex : integer;
begin
  inherited;
  if not FCommonData.Skinned then Exit;
  ShiftState := KeyDataToShiftState(Message.KeyData);
  if OwnCalc and (ShiftState = []) and (Tabs.Count > 0) then begin
    R := SkinTabRect(ActualIndex(TabIndex));
    TabCenter.x := R.Left + WidthOf(R) div 2;
    TabCenter.y := R.top + HeightOf(R) div 2;

    NewIndex := TabIndex;

    case Message.CharCode of
      VK_UP, VK_DOWN : begin
        case TabPosition of
          tpTop, tpBottom : begin
            if RowCount > 1 then begin
              if Message.CharCode = VK_UP
                then NewIndex := IndexOfSkinTab(TabCenter.x, (TabCenter.y - HeightOf(R)))
                else NewIndex := IndexOfSkinTab(TabCenter.x, (TabCenter.y + HeightOf(R)));
            end;
          end;
          tpLeft, tpRight : begin
            if (NewIndex <> FindNextTab(TabIndex, Message.CharCode = VK_DOWN)) and CanChange then begin
              NewIndex := FindNextTab(TabIndex, Message.CharCode = VK_DOWN);
            end;
          end;
        end;
      end;
      VK_LEFT, VK_RIGHT : begin
        case TabPosition of
          tpTop, tpBottom : begin
            NewIndex := FindNextTab(TabIndex, Message.CharCode = VK_RIGHT);
          end;
          tpLeft, tpRight : begin
            if RowCount > 1 then begin
              if Message.CharCode = VK_Left
                then NewIndex := IndexOfSkinTab(TabCenter.x - WidthOf(R), TabCenter.y)
                else NewIndex := IndexOfSkinTab(TabCenter.x + WidthOf(R), TabCenter.y);
            end;
          end;
        end;
      end;
      VK_HOME : begin
        NewIndex := 0;
        Message.Result := 1;
      end;
      VK_END : begin
        NewIndex := Tabs.Count - 1;
      end;
    end;
    if (NewIndex > -1) and (TabIndex <> NewIndex) and CanChange and (TabIndex <> NewIndex) then begin
//      DrawShadows := False;
      TabIndex := NewIndex;
//      Change;
    end;
  end;
end;

function TsCustomTabControl.FindNextTab(CurTab: integer; GoForward: Boolean): integer;
var
  I, StartIndex: Integer;
begin
  if Tabs.Count <> 0 then begin
    StartIndex := CurTab;
    if StartIndex = -1 then begin
      if GoForward then StartIndex := Tabs.Count - 1 else StartIndex := 0;
    end;
    I := StartIndex;
    repeat
      if GoForward then begin
        Inc(I);
        if I = Tabs.Count then I := 0;
      end else begin
        if I = 0 then I := Tabs.Count;
        Dec(I);
      end;
      Result := I;
      Exit;
    until I = StartIndex;
  end;
  Result := CurTab;
end;

function TsCustomTabControl.Tabvisible(Index: integer): boolean;
begin
  Result := True;
end;

function TsCustomTabControl.InvisibleTabs(Index: integer): integer;
var
  i : integer;
begin
  i := 0;
  Result := 0;
  while (i <= Index) and (i <= Tabs.Count - 1) do begin
    if not TabVisible(i) then inc(Result);
    inc(i);
  end;
end;

procedure TsCustomTabControl.WMNCPaint(var Message: TWMPaint);
begin
  if not FCommonData.Skinned then inherited;
end;

procedure TsCustomTabControl.OnUpDownClick(Sender: TObject; Button: TUDBtnType);
begin
  SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_THUMBPOSITION, Word(UpDown.Position)), 0);
end;

procedure TsCustomTabControl.ShowSkinUpDown;
begin
  if csDesigning in ComponentState
    then UpDown := TsUpDown.Create(Application)
    else UpDown := TsUpDown.Create(Self);
  UpDown.Visible := False;
  UpDown.Orientation := udHorizontal;
  UpDown.Width := 2 * GetSystemMetrics(SM_CXHSCROLL);
  UpDown.Height := GetSystemMetrics(SM_CYHSCROLL);
  UpDown.Parent := Self;
  UpDown.Max := GetInVisibleItemCount;// + 1;
  UpDown.Min := 0;
  UpDown.Increment := 1;
  UpDown.ShowInaccessibility := False;
  UpdateUpDown;
  UpDown.OnClick := OnUpDownClick;
  UpDown.Visible := True;
end;

function TsCustomTabControl.GetInVisibleItemCount: Integer;
var
  i, j, k, MaxWidth: Integer;
  R: TRect;
begin
  j := 0;
  if FCommonData.Skinned then begin
    if UpDown = nil then MaxWidth := Width - 3 else MaxWidth := Width - UpDown.Width - 3;
    k := -1;
    for i := 0 to Tabs.Count - 1 do if TabVisible(i) then begin
      inc(k);
      R := SkinTabRect(k);
      if (R.Right <> R.Left) and ((R.Right > MaxWidth) or (R.Right <= 4)) then inc(j);
    end;
  end;
  Result := j;
end;

procedure TsCustomTabControl.CheckUpDown;
var
  Wnd : HWND;
  i : Integer;
begin
  if (csLoading in ComponentState) or (csCreating in ControlState) then Exit;
  if FCommonData.Skinned {and not (csDesigning in ComponentState)} then begin
    Wnd := FindWindowEx(Handle, 0, 'msctls_updown32', nil);
    if Wnd <> 0 then DestroyWindow(Wnd);
    i := GetInVisibleItemCount;
    if TabPosition in [tpLeft, tpRight] then i := 0;
    if (i < 1) or Multiline then begin
      if (UpDown <> nil) then FreeAndNil(UpDown)
    end
    else begin
      if (UpDown = nil) then ShowSkinUpDown else UpdateUpDown;
    end;
  end
  else if UpDown <> nil then FreeAndNil(UpDown);
end;

procedure TsCustomTabControl.UpdateUpDown;
var
  i, j : integer;
begin
  if UpDown = nil then Exit;
  UpDown.Left := Width - UpDown.Width;
  UpDown.Max := GetInVisibleItemCount;// v4.61
  if TabPosition = tpTop then UpDown.Top := 0 else UpDown.Top := Height - UpDown.Height;
  j := 0;
  for i := 0 to Tabs.Count - 1 do begin
    if (TabRect(i).Left > 0) then begin
      Break;
    end
    else inc(j);
  end;
  UpDown.Position := j;
end;

function TsCustomTabControl.GetTabs: TStrings;
begin
  if FSaveTabs <> nil then Result := FSaveTabs else Result := FTabs;
end;

end.