spagecontrol.pas

Alpha Controls 界面控件包

{$IFDEF TNTUNICODE}
          WriteTextExW(Bmp.Canvas, PACChar(lCaption), True, rText, DT_CENTER or DT_SINGLELINE or DT_VCENTER, TabIndex, State <> 0, FCommonData.SkinManager);
{$ELSE}
          WriteTextEx(Bmp.Canvas, PACChar(lCaption), True, rText, DT_CENTER or DT_SINGLELINE or DT_VCENTER, TabIndex, State <> 0, FCommonData.SkinManager);
{$ENDIF}
        end;
        if Focused and (State = 2) and (Pages[PageIndex].Caption <> '') then begin
          acDrawText(Bmp.Canvas.Handle, PACChar(lCaption), R, DT_CALCRECT);
          rText.Left := (WidthOf(rText) - WidthOf(R)) div 2;
          rText.Top := (HeightOf(rText) - HeightOf(R)) div 2;
          rText.Right := rText.Left + WidthOf(R);
          rText.Bottom := rText.Top + HeightOf(R);
          InflateRect(rText, 2, 1);
          if (Images <> nil) and (Pages[PageIndex].ImageIndex > -1) and (Pages[PageIndex].ImageIndex <= Images.Count - 1) then begin
            OffsetRect(rText, Images.Width, 0);
          end;
          FocusRect(Bmp.Canvas, rText);
        end;
      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 begin
{          acDrawText(Bmp.Canvas.Handle, PACChar(lCaption), R, DT_CALCRECT);
          rText.Left := (WidthOf(rText) - WidthOf(R)) div 2;
          rText.Top := (HeightOf(rText) - HeightOf(R)) div 2;
          rText.Right := rText.Left + WidthOf(R);
          rText.Bottom := rText.Top + HeightOf(R);
          InflateRect(rText, 2, 1);}
          FocusRect(Bmp.Canvas, rText);
        end;
        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.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 +
                                   Bmp.Canvas.TextHeight(lCaption),               // (1)
                                  //WideCanvasTextHeight(Bmp.Canvas, lCaption),   // (2)
                                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 begin
{          acDrawText(Bmp.Canvas.Handle, PACChar(lCaption), R, DT_CALCRECT);
          rText.Left := (WidthOf(rText) - WidthOf(R)) div 2;
          rText.Top := (HeightOf(rText) - HeightOf(R)) div 2;
          rText.Right := rText.Left + WidthOf(R);
          rText.Bottom := rText.Top + HeightOf(R);
          InflateRect(rText, 2, 1);}
          FocusRect(Bmp.Canvas, rText);
        end;
      end;
    end;
  end
  else begin
    if Assigned(OnDrawTab) then OnDrawTab(Self, Pages[PageIndex].TabIndex, aRect, State <> 0);
  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;
  try
  for Row := 1 to rc do begin
    for i := 0 to PageCount - 1 do if Pages[i].TabVisible and (TabRow(Pages[i].TabIndex) = Row) then DrawSkinTab(i, 0, FCommonData.FCacheBmp, Point(0, 0));
  end;
  except
  end;
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 : integer;
  R : TRect;
begin
  Result := -1;
  for i := 0 to Self.PageCount - 1 do begin
    R := SkinTabRect(Pages[i].TabIndex, False);
    if Pages[i].TabVisible and PtInRect(R, p) then begin
      Result := i;
      Exit;
    end;
  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; // v5.21
  CI := GetParentCache(FCommonData);
  if Tabs.Count > 0 then DrawSkinTabs(CI);
  R := TabsRect;

  BitBlt(DC, R.Left, R.Top, WidthOf(R), HeightOf(R) + 2{0}, FCommonData.FCacheBmp.Canvas.Handle, R.Left, R.Top, SRCCOPY);

  PaintButtons(DC);
end;

procedure TsPageControl.SetActivePage(const Value: TsTabSheet);
begin
  inherited ActivePage := Value; // v4.27
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;// + 1;
  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 : begin
        Result := (R.Bottom + h div 2) div h;
      end;
      tpLeft : begin
        Result := (R.Right + w div 2) div w;
      end;
      tpRight : begin
        Result := RowCount - (R.Right - tR.Left + w div 2) div w + 1;
      end
      else begin
        Result := RowCount - (R.Bottom - tR.Top + h div 2) div h + 1;
      end;
    end;
  end
  else Result := 1;
end;

function TsPageControl.TabsRect: TRect;