bsskintabs.pas

delphi 皮肤控件

  if not FWallPaper.Empty
  then
    begin
      if (Width > 0) and (Height > 0)
      then
        begin
          XCnt := Width div FWallPaper.Width;
          YCnt := Height div FWallPaper.Height;
          for X := 0 to XCnt do
          for Y := 0 to YCnt do
          C.Draw(X * FWallPaper.Width, Y * FWallPaper.Height, FWallPaper);
        end;
      C.Free;
      Exit;
    end;

  if (PC.FSD <> nil) and (not PC.FSD.Empty) and
     (PC.FIndex <> -1) and (PC.BGPictureIndex <> -1)
  then
    begin
      TabSheetBG := TBitMap(PC.FSD.FActivePictures.Items[PC.BGPictureIndex]);

      if PC.StretchEffect and (Width > 0) and (Height > 0)
      then
        begin
          case PC.StretchType of
            bsstFull:
              begin
                C.StretchDraw(Rect(0, 0, Width, Height), TabSheetBG);
              end;
            bsstVert:
              begin
                Buffer2 := TBitMap.Create;
                Buffer2.Width := Width;
                Buffer2.Height := TabSheetBG.Height;
                Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
                YCnt := Height div Buffer2.Height;
                for Y := 0 to YCnt do
                  C.Draw(0, Y * Buffer2.Height, Buffer2);
                Buffer2.Free;
              end;
           bsstHorz:
             begin
               Buffer2 := TBitMap.Create;
               Buffer2.Width := TabSheetBG.Width;
               Buffer2.Height := Height;
               Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
               XCnt := Width div Buffer2.Width;
               for X := 0 to XCnt do
                 C.Draw(X * Buffer2.Width, 0, Buffer2);
               Buffer2.Free;
             end;
          end;
        end
      else
      if (Width > 0) and (Height > 0)
      then
        begin
          XCnt := Width div TabSheetBG.Width;
          YCnt := Height div TabSheetBG.Height;
          for X := 0 to XCnt do
          for Y := 0 to YCnt do
          C.Draw(X * TabSheetBG.Width, Y * TabSheetBG.Height, TabSheetBG);
        end;
      C.Free;
      Exit;
    end;
 
  w1 := Width;
  h1 := Height;

  if PC.FIndex <> -1
  then
    with PC do
    begin
      TabSheetBG := TBitMap.Create;
      TabSheetBG.Width := RectWidth(ClRect);
      TabSheetBG.Height := RectHeight(ClRect);
      TabSheetBG.Canvas.CopyRect(Rect(0, 0, TabSheetBG.Width, TabSheetBG.Height),
        PC.Picture.Canvas,
          Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
               SkinRect.Left + ClRect.Right,
               SkinRect.Top + ClRect.Bottom));

     if PC.StretchEffect and (Width > 0) and (Height > 0)
      then
        begin
          case PC.StretchType of
            bsstFull:
              begin
                C.StretchDraw(Rect(0, 0, Width, Height), TabSheetBG);
              end;
            bsstVert:
              begin
                Buffer2 := TBitMap.Create;
                Buffer2.Width := Width;
                Buffer2.Height := TabSheetBG.Height;
                Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
                YCnt := Height div Buffer2.Height;
                for Y := 0 to YCnt do
                  C.Draw(0, Y * Buffer2.Height, Buffer2);
                Buffer2.Free;
              end;
           bsstHorz:
             begin
               Buffer2 := TBitMap.Create;
               Buffer2.Width := TabSheetBG.Width;
               Buffer2.Height := Height;
               Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
               XCnt := Width div Buffer2.Width;
               for X := 0 to XCnt do
                 C.Draw(X * Buffer2.Width, 0, Buffer2);
               Buffer2.Free;
             end;
          end;
        end
      else
        begin
          w := RectWidth(ClRect);
          h := RectHeight(ClRect);
          XCnt := w1 div w;
          YCnt := h1 div h;
          for X := 0 to XCnt do
          for Y := 0 to YCnt do
          C.Draw(X * w, Y * h, TabSheetBG);
        end;
      TabSheetBG.Free;
    end
  else
  with C do
  begin
    Brush.Color := clbtnface;
    FillRect(Rect(0, 0, w1, h1));
  end;
  C.Free;
end;


{TTabSheetes}
constructor TbsSkinTabSheet.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
end;

destructor TbsSkinTabSheet.Destroy;
begin
  inherited Destroy;
end;

procedure TbsSkinTabSheet.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
end;

{ TbsSkinPageControl }

constructor TbsSkinPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTabsBGTransparent := False;
  Ctl3D := False;
  FIndex := -1;
  Picture := nil;
  Font.Name := 'Arial';
  Font.Style := [];
  Font.Color := clBtnText;
  Font.Height := 14;
  FSkinUpDown := nil;
  FSkinDataName := 'tab';
  FDefaultFont := TFont.Create;
  FDefaultFont.Name := 'Arial';
  FDefaultFont.Style := [];
  FDefaultFont.Color := clBtnText;
  FDefaultFont.Height := 14;
  FDefaultItemHeight := 20;
  FActiveTab := -1;
  FOldActiveTab := -1;
  FActiveTabIndex := -1;
  FOldActiveTabIndex := -1;
  FUseSkinFont := True;
end;

destructor TbsSkinPageControl.Destroy;
begin
  FDefaultFont.Free;
  inherited Destroy;
end;

procedure TbsSkinPageControl.WMCHECKPARENTBG;
begin
  if TabsBGTransparent then RePaint;
end;

procedure TbsSkinPageControl.DrawEmptyBackGround(DC: HDC);
var
  C: TCanvas;
  TabSheetBG, Buffer2: TBitMap;
  X, Y, XCnt, YCnt, w, h, w1, h1: Integer;
begin
  if (Width <= 0) or (Height <=0) then Exit;

  C := TCanvas.Create;
  C.Handle := DC;

  if BGPictureIndex <> -1
  then
    begin
      TabSheetBG := TBitMap(FSD.FActivePictures.Items[BGPictureIndex]);

      if StretchEffect and (Width > 0) and (Height > 0)
      then
        begin
          case StretchType of
            bsstFull:
              begin
                C.StretchDraw(Rect(0, 0, Width, Height), TabSheetBG);
              end;
            bsstVert:
              begin
                Buffer2 := TBitMap.Create;
                Buffer2.Width := Width;
                Buffer2.Height := TabSheetBG.Height;
                Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
                YCnt := Height div Buffer2.Height;
                for Y := 0 to YCnt do
                  C.Draw(0, Y * Buffer2.Height, Buffer2);
                Buffer2.Free;
              end;
           bsstHorz:
             begin
               Buffer2 := TBitMap.Create;
               Buffer2.Width := TabSheetBG.Width;
               Buffer2.Height := Height;
               Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
               XCnt := Width div Buffer2.Width;
               for X := 0 to XCnt do
                 C.Draw(X * Buffer2.Width, 0, Buffer2);
               Buffer2.Free;
             end;
          end;
        end
      else
      if (Width > 0) and (Height > 0)
      then
        begin
          XCnt := Width div TabSheetBG.Width;
          YCnt := Height div TabSheetBG.Height;
          for X := 0 to XCnt do
          for Y := 0 to YCnt do
            C.Draw(X * TabSheetBG.Width, Y * TabSheetBG.Height, TabSheetBG);
        end;
    end
 else
   begin
     w1 := Width;
     h1 := Height;
     TabSheetBG := TBitMap.Create;
     TabSheetBG.Width := RectWidth(ClRect);
     TabSheetBG.Height := RectHeight(ClRect);
     TabSheetBG.Canvas.CopyRect(Rect(0, 0, TabSheetBG.Width, TabSheetBG.Height),
       Picture.Canvas,
        Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
             SkinRect.Left + ClRect.Right,
             SkinRect.Top + ClRect.Bottom));

      if StretchEffect and (Width > 0) and (Height > 0)
      then
        begin
          case StretchType of
            bsstFull:
              begin
                C.StretchDraw(Rect(0, 0, Width, Height), TabSheetBG);
              end;
            bsstVert:
              begin
                Buffer2 := TBitMap.Create;
                Buffer2.Width := Width;
                Buffer2.Height := TabSheetBG.Height;
                Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
                YCnt := Height div Buffer2.Height;
                for Y := 0 to YCnt do
                  C.Draw(0, Y * Buffer2.Height, Buffer2);
                Buffer2.Free;
              end;
           bsstHorz:
             begin
               Buffer2 := TBitMap.Create;
               Buffer2.Width := TabSheetBG.Width;
               Buffer2.Height := Height;
               Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
               XCnt := Width div Buffer2.Width;
               for X := 0 to XCnt do
                 C.Draw(X * Buffer2.Width, 0, Buffer2);
               Buffer2.Free;
             end;
          end;
        end
      else
        begin
          w := RectWidth(ClRect);
          h := RectHeight(ClRect);
          XCnt := w1 div w;
          YCnt := h1 div h;
          for X := 0 to XCnt do
          for Y := 0 to YCnt do
            C.Draw(X * w, Y * h, TabSheetBG);
        end;
      TabSheetBG.Free;
   end;
  C.Free;
end;


procedure TbsSkinPageControl.SetTabsBGTransparent(Value: Boolean);
begin
  if FTabsBGTransparent <> Value
  then
    begin
      FTabsBGTransparent := Value;
      Invalidate;
    end;
end;

procedure TbsSkinPageControl.UpDateTabs;
begin
  if FIndex <> -1
  then
    begin
      if TabHeight <= 0
      then
        SetItemSize(TabWidth, RectHeight(TabRect))
      else
        SetItemSize(TabWidth, TabHeight);
    end
  else
    begin
      if TabHeight <= 0
      then
        SetItemSize(TabWidth, FDefaultItemHeight)
      else
        SetItemSize(TabWidth, TabHeight);
    end;
  if MultiLine and (FSkinUpDown <> nil)
  then
    HideSkinUpDown;
  ReAlign;
end;

procedure TbsSkinPageControl.CMMouseLeave;
var
  R: TRect;
begin
  if (FOldActiveTabIndex <> - 1) and (FOldActiveTabIndex <> TabIndex) and
     (FOldActiveTabIndex < PageCount)
  then
    begin
      R := GetItemRect(FOldActiveTabIndex);
      DrawTab(FOldActiveTab, R, False, False, Canvas);
      FOldActiveTabIndex := -1;
      FOldActiveTab := -1;
    end;

  if (FActiveTabIndex <> - 1) and (FActiveTabIndex <> TabIndex) and
     (FActiveTabIndex < PageCount)
  then
    begin
      R := GetItemRect(FActiveTabIndex);
      DrawTab(FActiveTab, R, False, False, Canvas);
      FActiveTabIndex := -1;
      FActiveTab := -1;
    end;
end;

procedure TbsSkinPageControl.MouseDown;
begin
  inherited;
  if (Button = mbLeft) and not (csDesigning in ComponentState)
  then
    TestActive(X, Y);
end;

procedure TbsSkinPageControl.MouseMove;
begin
 inherited;
 if  not (csDesigning in ComponentState)
 then
   TestActive(X, Y);
end;

procedure TbsSkinPageControl.SetDefaultItemHeight;
begin
  FDefaultItemHeight := Value;
  if FIndex = -1
  then
    begin
      SetItemSize(TabWidth, FDefaultItemHeight);
      Change2;
      ReAlign;
    end;
end;


procedure TbsSkinPageControl.SetDefaultFont;
begin
  FDefaultFont.Assign(Value);
end;

procedure TbsSkinPageControl.OnUpDownChange(Sender: TObject);
begin
  FSkinUpDown.Max := GetInVisibleItemCount;
  SendMessage(Handle, WM_HSCROLL,
    MakeWParam(SB_THUMBPOSITION, FSkinUpDown.Position), 0);
end;

function TbsSkinPageControl.GetPosition: Integer;
var
  i, j, k: Integer;
  R: TRect;
begin
  j := 0;
  k := -1;
  for i := 0 to PageCount - 1 do
  if Pages[i].TabVisible then
  begin
    inc(k);
    R := GetItemRect(k);
    if R.Right <= 0 then inc(j);
  end;
  Result := j;
end;

function TbsSkinPageControl.GetInVisibleItemCount;
var
  i, j, k: Integer;
  R: TRect;
  Limit: Integer;
begin
  if FSkinUpDown = nil
  then
    Limit := Width - 3
  else
    Limit := Width - FSkinUpDown.Width - 3;
  j := 0;
  k := -1;
  for i := 0 to PageCount - 1 do
  if Pages[i].TabVisible
  then
  begin
    inc(k);
    R := GetItemRect(k);
    if (R.Right > Limit) or (R.Right <= 0)
    then inc(j);
  end;
  Result := j;
end;

procedure TbsSkinPageControl.CheckScroll;
var
  Wnd: HWND;
  InVCount: Integer;
begin
  Wnd := FindWindowEx(Handle, 0, 'msctls_updown32', nil);
  if Wnd <> 0 then DestroyWindow(Wnd);
  InVCount := GetInVisibleItemCount;