stabcontrol.pas

AlphaControls是一个Delphi标准控件的集合

procedure TsCustomTabControl.WMLButtonDown(var Message: TWMLButtonDown);
var
  i : integer;
  m : TWMLButtonDown;
begin
  m := Message;
  if OwnCalc then begin
    if Assigned(OnMouseDown) then OnMouseDown(Self, mbLeft, [], m.XPos, m.YPos);
    i := IndexOfSkinTab(m.XPos, m.YPos);
    if (i > -1) and CanChange then begin
      TabIndex := i;
      Change;
    end;
    if not Focused then SetFocus;
  end
  else inherited;
end;

function TsCustomTabControl.OwnCalc: boolean;
begin
  Result := IsValidSkinIndex(FCommonData.SkinIndex);
end;

procedure TsCustomTabControl.FillTabs;
const
  m = 0;
var
  i, l : integer;
begin
  if (csReading in ComponentState) then Exit;
  if (csDestroying in ComponentState) or ((Parent <> nil) and (csDestroying in Parent.ComponentState)) then Exit;
  SetLength(TabsArray, 0);
  if Tabs.Count = 0 then Exit;
  for i := 0 to Tabs.Count - 1 do begin
    l := Length(TabsArray);
    SetLength(TabsArray, l + 1);
    TabsArray[l].Caption := Tabs[i];
    TabsArray[l].Index := i;
    TabsArray[l].ImageIndex := GetImageIndex(i);
  end;
  RebuildTabs;
end;

function TsCustomTabControl.IndexOfSkinTab(X, Y: integer) : integer;
var
  i, l : integer;
begin
  Result := -1;
  l := Length(TabsArray);
  for i := 0 to l - 1 do begin
    if PtInRect(TabsArray[i].R, Point(X, Y)) then begin
      Result := TabsArray[i].Index;
      Break;
    end;
  end;
end;

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

procedure TsCustomTabControl.UpdateTabRects;
var
  i, l, j : integer;
  Row, Offset, ItemSize : integer;
begin
  if (csReading in ComponentState) then Exit;
  Row := RowCount + 1;
  l := Length(TabsArray);

  for j := 0 to l - 1 do begin
    TabCtrl_GetItemRect(Handle, TabsArray[j].Index, TabsArray[j].R);
    TabsArray[j].Size.cx := WidthOf(TabsArray[j].R);
    TabsArray[j].Size.cy := HeightOf(TabsArray[j].R);
    TabsArray[j].Processed := False;
  end;

  // Different rules for rects calcs
  case TabPosition of
    tpTop : begin
      for j := 0 to l - 1 do begin
        if not TabsArray[j].Processed and (TabsArray[j].R.Left < 4) then begin
          dec(Row);
          ItemSize := HeightOf(TabsArray[j].R);
          Offset := (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.Top, TabsArray[j].R.Top - 2, TabsArray[j].R.Top + 2) then begin
              TabsArray[i].R.Top := Offset;
              TabsArray[i].R.Bottom := Offset + ItemSize;
              TabsArray[i].Row := Row;
              TabsArray[i].Processed := True;
            end;
          end;
          TabsArray[j].R.Top := Offset;
          TabsArray[j].R.Bottom := Offset + ItemSize;
        end;
      end;
    end;
    tpLeft : begin
      for j := 0 to l - 1 do begin
        if not TabsArray[j].Processed and (TabsArray[j].R.Top < 4) then begin
          dec(Row);
          ItemSize := WidthOf(TabsArray[j].R);
          Offset := (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.Left := Offset;
              TabsArray[i].R.Right := Offset + ItemSize;
              TabsArray[i].Row := Row;
              TabsArray[i].Processed := True;
            end;
          end;
          TabsArray[j].R.Left := Offset;
          TabsArray[j].R.Right := Offset + ItemSize;
        end;
      end;
    end;
    tpBottom : begin
      for j := 0 to l - 1 do begin
        if not TabsArray[j].Processed and (TabsArray[j].R.Left < 4) then begin
          dec(Row);
          ItemSize := HeightOf(TabsArray[j].R);
          Offset := Height - ((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.Top, TabsArray[j].R.Top - 2, TabsArray[j].R.Top + 2) then begin
              TabsArray[i].R.Bottom := Offset;
              TabsArray[i].R.Top := Offset - ItemSize;
              TabsArray[i].Row := Row;
              TabsArray[i].Processed := True;
            end;
          end;
          TabsArray[j].R.Bottom := Offset;
          TabsArray[j].R.Top := Offset - ItemSize;
        end;
      end;
    end;
    tpRight : begin
      for j := 0 to l - 1 do begin
        if not TabsArray[j].Processed and (TabsArray[j].R.Top < 4) then begin
          dec(Row);
          ItemSize := WidthOf(TabsArray[j].R);
          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);
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 := TabsArray[Index].R;
  if Index = ActiveTabIndex 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(FSavedTabIndex = TabsArray[Index].Index), Integer(FSavedTabIndex = TabsArray[Index].Index));
      inc(Result.Bottom, 2);
    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;
  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 CanChange then begin
              NewIndex := FindNextTab(TabIndex, Message.CharCode = VK_DOWN); //GlobalUpdate;
            end;
          end;
        end;
        Message.Result := 1;
      end;
      VK_LEFT, VK_RIGHT : begin
        case TabPosition of
          tpTop, tpBottom : begin
            NewIndex := FindNextTab(TabIndex, Message.CharCode = VK_RIGHT); //GlobalUpdate;
          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;
        Message.Result := 1;
      end;
      VK_HOME : begin
        NewIndex := 0;
        Message.Result := 1;
      end;
      VK_END : begin
        NewIndex := Tabs.Count - 1;
        Message.Result := 1;
      end;
    end;
    if (NewIndex > -1) 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;

{
procedure TsCustomTabControl.GlobalUpdate;
begin

end;
}
end.