spagecontrol.pas

Alpha Controls.v5.46b Source

      end;
      tpLeft : begin
        Bmp.Canvas.Brush.Style := bsClear;
        MakeVertFont(-2700);

        with acTextExtent(bmp.Canvas, lCaption) do begin
          h := cx;
          w := cy;
        end;


        if not Enabled then Bmp.Canvas.Font.Color := clGray;
        if (Images <> nil) and (Pages[PageIndex].ImageIndex > -1) and (Pages[PageIndex].ImageIndex <= Images.Count - 1) then begin
          if Pages[PageIndex] = ActivePage then OffsetRect(rText, 2, 0);
          i := rText.Bottom - (HeightOf(rText) - (Images.Height + 4 + h)) div 2 - Images.Height;
          Images.Draw(Bmp.Canvas, rText.Left + (WidthOf(rText) - Images.Width) div 2, i, Pages[PageIndex].ImageIndex, Enabled);
          Bmp.Canvas.Brush.Style := bsClear;
          acTextRect(bmp.Canvas, rText, rText.Left + (WidthOf(rText) - w) div 2, i - 4, lCaption);
          InflateRect(rText, (w - WidthOf(rText)) div 2, (h - HeightOf(rText)) div 2 + 2);
          OffsetRect(rText, 0, - (4 + Images.Height) div 2);
        end
        else begin
          Bmp.Canvas.Brush.Style := bsClear;
          acTextRect(Bmp.Canvas, rText, rText.Left + (WidthOf(rText) - w) div 2, rText.Bottom - (HeightOf(rText) - h) div 2, lCaption);
          InflateRect(rText, (w - WidthOf(rText)) div 2, (h - HeightOf(rText)) div 2);
        end;
        if Focused and (State <> 0) then FocusRect(Bmp.Canvas, rText);
        KillVertFont;
      end;

      tpRight : begin
        Bmp.Canvas.Brush.Style := bsClear;
        MakeVertFont(-900);

        OffsetRect(rText, -2, -1);

        with acTextExtent(bmp.Canvas, lCaption) do begin
          h := cx;
          w := cy;
        end;


        if not Enabled then Bmp.Canvas.Font.Color := clGray;
        if (Images <> nil) and (Pages[PageIndex].ImageIndex > -1) and (Pages[PageIndex].ImageIndex <= Images.Count - 1) then begin
          if Pages[PageIndex] = ActivePage then OffsetRect(rText, 2, 0);
          i := rText.Top + (HeightOf(rText) - (Images.Height + 4 + h)) div 2;
          Images.Draw(Bmp.Canvas, rText.Left + (WidthOf(rText) - Images.Width) div 2, i, Pages[PageIndex].ImageIndex, Enabled);
          Bmp.Canvas.Brush.Style := bsClear;
          acTextRect(Bmp.Canvas, rText, rText.Left + (WidthOf(rText) - w) div 2 + Bmp.Canvas.TextHeight(lCaption), i + 4 + Images.Height, lCaption);

          InflateRect(rText, (w - WidthOf(rText)) div 2, (h - HeightOf(rText)) div 2 + 2);
          OffsetRect(rText, 0, + (4 + Images.Height) div 2);
        end
        else begin
          Bmp.Canvas.Brush.Style := bsClear;
{$IFDEF TNTUNICODE}
          if Pages[PageIndex] is TTntTabSheet then
          TextRectW(Bmp.Canvas, rText,
                              rText.Left + (WidthOf(rText) - w) div 2 + Bmp.Canvas.TextHeight(Pages[PageIndex].Caption),
                              rText.Top + (HeightOf(rText) - h) div 2,
                              PWideChar(TTntTabSheet(Pages[PageIndex]).Caption))  // (3)
                              // (TTntTabSheet(Pages[PageIndex]).Caption))  // (4)
          else
{$ENDIF}
          Bmp.Canvas.TextRect(rText,
                              rText.Left + (WidthOf(rText) - w) div 2 + Bmp.Canvas.TextHeight(Pages[PageIndex].Caption),
                              rText.Top + (HeightOf(rText) - h) div 2,
                              PChar(Pages[PageIndex].Caption));


          InflateRect(rText, (w - WidthOf(rText)) div 2, (h - HeightOf(rText)) div 2 + 2);
        end;
        KillVertFont;
        if Focused and (State <> 0) then FocusRect(Bmp.Canvas, rText);
      end;
    end;
  end
  else begin
    if Assigned(OnDrawTab) then begin
      SavedDC := Canvas.Handle;
      Canvas.Handle := Bmp.Canvas.Handle;
      if State = 2 then MoveWindowOrg(Canvas.Handle, -aRect.Left, -aRect.top);
      OnDrawTab(Self, Pages[PageIndex].TabIndex, aRect, State <> 0);
      if State = 2 then MoveWindowOrg(Canvas.Handle,  aRect.Left,  aRect.top);
      Canvas.Handle := SavedDC;
    end;
  end;
end;

procedure TsPageControl.DrawSkinTab(PageIndex, State: integer; DC: hdc);
var
  aRect : TRect;
  TempBmp : TBitmap;
begin
  if (PageIndex < 0) or (Pages[PageIndex].TabIndex < 0) then Exit;
  aRect := SkinTabRect(Pages[PageIndex].TabIndex, State = 2);
  TempBmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));

  DrawSkinTab(PageIndex, State, TempBmp, Point(-aRect.Left, -aRect.Top));
  BitBlt(DC, aRect.Left, aRect.Top, WidthOf(aRect), HeightOf(aRect), TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
  if FShowCloseBtns and TsTabSheet(Pages[PageIndex]).UseCloseBtn then PaintButton(DC, aRect, 0, TempBmp.Canvas.Handle);

  FreeAndNil(TempBmp);
end;

procedure TsPageControl.DrawSkinTabs(CI: TCacheInfo);
var
  i, Row, rc : integer;
  aRect: TRect;
begin
  if (csDestroying in ComponentState) then Exit;

  aRect := TabsRect;
  if not ci.Ready then begin
    FCommonData.FCacheBmp.Canvas.Brush.Style := bsSolid;
    FCommonData.FCacheBmp.Canvas.Brush.Color := ColorToRGB(TsHackedControl(Parent).Color);
    FCommonData.FCacheBmp.Canvas.FillRect(aRect);
  end
  else begin
    BitBlt(FCommonData.FCacheBmp.Canvas.Handle,
           aRect.Left, aRect.Top,
           min(WidthOf(aRect), ci.Bmp.Width),
           min(HeightOf(aRect), ci.Bmp.Height),
           ci.Bmp.Canvas.Handle, ci.X + Left + aRect.Left, ci.Y + Top + aRect.Top, SRCCOPY);
  end;
  // Draw tabs in special order
  rc := RowCount;
  for Row := 1 to rc do
    for i := 0 to PageCount - 1 do if Pages[i].TabVisible and (Pages[i] <> ActivePage) and (TabRow(Pages[i].TabIndex) = Row)
      then DrawSkinTab(i, 0, FCommonData.FCacheBmp, Point(0, 0));
end;

function TsPageControl.GetActivePage: TsTabSheet;
begin
  Result := TsTabSheet(inherited ActivePage);
end;

function TsPageControl.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 PageCount - 1 do if Pages[i].TabVisible then begin
      inc(k);
      R := TabRect(k);
      if (R.Right <> R.Left) and ((R.Right > MaxWidth) or (R.Right <= 4)) then inc(j);
    end;
  end;
  Result := j;
end;

function TsPageControl.GetTabUnderMouse(p: TPoint): integer;
var
  i{, j} : integer;
  R : TRect;
begin
  Result := -1;
//  j := 0;
  for i := 0 to Self.PageCount - 1 do {if Pages[i].TabVisible then} begin
//    if TsTabSheet(Pages[i]).UseCloseBtn then begin
      R := SkinTabRect(Pages[i].TabIndex, False);
      if PtInRect(R, p) then begin
        Result := i;
        Exit;
      end;
//    end;
//    inc(j);
  end;
end;

function TsPageControl.GlyphRect: TRect;
begin
  Result := Rect(0, 0, 0, 0);
  if Images <> nil then begin
    Result.Top := (TabHeight + 4 - Images.Height) div 2;
    Result.Bottom := Result.Top + Images.Height;
    Result.Left := Result.Top;
    Result.Right := Result.Left + Images.Width;
  end;
end;

procedure TsPageControl.Loaded;
begin
  inherited;
  SkinData.Loaded;
  if ActivePage <> nil then AddToAdapter(ActivePage);
  CheckUpDown;
  ArrangeButtons;
end;

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

function TsPageControl.PageRect: TRect;
var
  r : TRect;
begin
  Result := Rect(0, 0, Width, Height);
  if Tabs.Count > 0 then begin
    AdjustClientRect(r);
    case TabPosition of
      tpTop : Result.Top := R.Top - TopOffset;
      tpBottom : Result.Bottom := R.Bottom + BottomOffset;
      tpLeft : Result.Left := R.Left - LeftOffset;
      tpRight : Result.Right := R.Right + RightOffset;
    end;
  end;
end;

procedure TsPageControl.RepaintTab(i, State: integer; TabDC : hdc = 0);
var
  DC, SavedDC : hdc;
  R : TRect;
  PS : TPaintStruct;
begin
  BeginPaint(Handle, PS);
  if TabDC = 0 then DC := GetDC(Handle) else DC := TabDC;
  SavedDC := SaveDC(DC);
  try
    R := TabRect(Pages[i].TabIndex); // v4.41
    if TabDC <> 0 then OffsetRect(R, - R.Left, - R.Top) else begin
      InterSectClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
      R := SkinTabRect(ActivePage.TabIndex, True);
      ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
    end;
    DrawSkinTab(i, State, DC);
  finally
    RestoreDC(DC, SavedDC);
    if TabDC <> 0 then ReleaseDC(Handle, DC);
    EndPaint(Handle, PS);
  end;
end;

procedure TsPageControl.RepaintTabs(DC : HDC; ActiveTabNdx : integer);
var
  R : TRect;
  CI : TCacheInfo;
begin
  if not ((csDesigning in ComponentState) or not SkinData.SkinManager.AnimEffects.PageChange.Active) then Exit;
  CI := GetParentCache(FCommonData);
  if Tabs.Count > 0 then DrawSkinTabs(CI);
  R := TabsRect;
  BitBlt(DC, R.Left, R.Top, WidthOf(R), HeightOf(R) + 2, FCommonData.FCacheBmp.Canvas.Handle, R.Left, R.Top, SRCCOPY);
  PaintButtons(DC);
end;

procedure TsPageControl.SetActivePage(const Value: TsTabSheet);
begin
  inherited ActivePage := Value;
end;

procedure TsPageControl.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) + 1);
  UpDown.Height := GetSystemMetrics(SM_CYHSCROLL) + 1;
  if SkinData.SkinManager.GetSkinIndex(s_UpDown) < 0 then UpDown.ButtonSkin := s_Button else UpDown.ButtonSkin := s_UpDown;
  UpDown.Parent := Self;
  UpDown.Max := GetInVisibleItemCount;
  UpDown.Min := 0;
  UpDown.Increment := 1;
  UpDown.ShowInaccessibility := False;
  UpdateUpDown;
  UpDown.OnClick := OnUpDownClick;
  UpdateUpDownRgn;
  UpDown.Visible := True;
end;

function TsPageControl.SkinTabRect(Index: integer; Active : boolean): TRect;
begin
  Result := Rect(0, 0, 0, 0);
  if (Index > PageCount - 1) or (Index < 0) or (PageCount < 1) or (ActivePage = nil) then Exit;
  Result := TabRect(Index); // ???
  if (Style <> tsTabs) or (Result.Left = Result.Right) then Exit;
  if Active 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(Active), 2 * Integer(Active));
      inc(Result.Bottom, 1);
    end;
    tpBottom : begin
      InflateRect(Result, 2 * Integer(Active), Integer(Active));
      dec(Result.Top, 2);
      if Active then inc(Result.Bottom) else dec(Result.Bottom, 3);
    end;
    tpLeft : begin
      InflateRect(Result, 0, 1);
      inc(Result.Right, 2);
      if Active 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 Active then begin
        InflateRect(Result, 1, 1);
        inc(Result.Bottom, 3);
      end
      else dec(Result.Bottom, 2);
    end;
  end;
end;

function TsPageControl.TabRow(TabIndex: integer): integer;
var
  h, w : integer;
  R, tR : TRect;
begin
  if RowCount > 1 then begin
    R := TabRect(TabIndex);
    tR := TabsRect;
    w := WidthOf(R);
    h := HeightOf(R);
    case TabPosition of
      tpTop   : Result := (R.Bottom + h div 2) div h;
      tpLeft  : Result := (R.Right + w div 2) div w;
      tpRight : Result := RowCount - (R.Right - tR.Left + w div 2) div w + 1
      else      Result := RowCount - (R.Bottom - tR.Top + h div 2) div h + 1;
    end;
  end
  else Result := 1;
end;

function TsPageControl.TabsRect: TRect;
var
  r : TRect;
begin
  Result := Rect(0, 0, Width, Height);
  if Tabs.Count > 0 then begin
    AdjustClientRect(r);
    case TabPosition of
      tpTop : Result.Bottom := R.Top - TopOffset;
      tpBottom : Result.Top := R.Bottom + BottomOffset;
      tpLeft : Result.Right := R.Left - LeftOffset;
      tpRight : Result.Left := R.Right + RightOffset;
    end;
  end;
end;

procedure TsPageControl.UpdateActivePage;
var
  DC, SavedDC : hdc;
  PS : TPaintStruct;
begin
  Curitem := -1;
  if FCommonData.Skinned then begin
    inherited;
    if FCommonData.Updating then Exit;
    if StoredVisiblePageCount <> VisibleTabsCount then begin
      Perform(WM_PAINT, 0, 0);
      if Assigned(ActivePage) then ActivePage.Repaint
    end
    else begin
      FCommonData.BGChanged := False;
      if ActivePage <> nil then begin // Active tab repainting
        BeginPaint(Handle, PS);
        DC := GetDC(Handle);
        SavedDC := SaveDC(DC);
        RepaintTabs(DC, ActivePage.PageIndex);
        try DrawSkinTab(ActivePage.PageIndex, 2, DC)
        finally
          RestoreDC(DC, SavedDC);
          ReleaseDC(Handle, DC);
          EndPaint(Handle, PS);
        end;
        ActivePage.Repaint;
      end else FCommonData.Invalidate; 
    end;
    TabsChanging := False;
  end
  else inherited;
end;

procedure TsPageControl.UpdateUpDown;