skintabs.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

begin
  with Cnvs do
  begin
    Brush.Color := clBtnFace;
    FillRect(ClientRect);
    R := Self.DisplayRect;
    InflateRect(R, 1, 1);
    Frame3D(Cnvs, R, clBtnShadow, clBtnShadow, 1);
  end;
end;

procedure TspSkinPageControl.PaintSkinWindow;
var
  TOff, LOff, Roff, BOff: Integer;
  NewClRect, DR, R, IR: TRect;
  TBGOffX, TBGOffY, X, Y, XCnt, YCnt, w, h, rw, rh, XO, YO, w1, h1: Integer;
  NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  B, LB, RB, TB, BB, ClB, Buffer, Buffer2: TBitMap;
  SaveIndex: Integer;
begin
  GetSkinData;
  TOff := ClRect.Top;
  LOff := ClRect.Left;
  ROff := RectWidth(SkinRect) - ClRect.Right;
  BOff := RectHeight(SkinRect) - ClRect.Bottom;
  DR := Self.DisplayRect;
  R := Rect(DR.Left - LOff, DR.Top - TOff, DR.Right + ROff, DR.Bottom + BOff);
  XO := RectWidth(R) - RectWidth(SkinRect);
  YO := RectHeight(R) - RectHeight(SkinRect);
  NewLTPoint := LTPoint;
  NewRTPoint := Point(RTPoint.X + XO, RTPoint.Y);
  NewLBPoint := Point(LBPoint.X, LBPoint.Y + YO);
  NewRBPoint := Point(RBPoint.X + XO, RBPoint.Y + YO);
  NewCLRect := Rect(ClRect.Left, ClRect.Top, ClRect.Right + XO, ClRect.Bottom + YO);
  // DrawBG
  if BGPictureIndex <> -1
  then
    begin
      B := TBitMap(FSD.FActivePictures.Items[BGPictureIndex]);
      if StretchEffect and (Width > 0) and (Height > 0)
      then
        begin
          case StretchType of
            spstFull:
              begin
                Cnvs.StretchDraw(Rect(0, 0, Width, Height), B);
              end;
            spstVert:
              begin
                Buffer2 := TBitMap.Create;
                Buffer2.Width := Width;
                Buffer2.Height := B.Height;
                Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), B);
                YCnt := Height div Buffer2.Height;
                for Y := 0 to YCnt do
                  Cnvs.Draw(0, Y * Buffer2.Height, Buffer2);
                Buffer2.Free;
              end;
           spstHorz:
             begin
               Buffer2 := TBitMap.Create;
               Buffer2.Width := B.Width;
               Buffer2.Height := Height;
               Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), B);
               XCnt := Width div Buffer2.Width;
               for X := 0 to XCnt do
                 Cnvs.Draw(X * Buffer2.Width, 0, Buffer2);
               Buffer2.Free;
             end;
          end;
        end
      else
      if (Width > 0) and (Height > 0)
      then
        begin
          XCnt := Width div B.Width;
          YCnt := Height div B.Height;
          for X := 0 to XCnt do
          for Y := 0 to YCnt do
          Cnvs.Draw(X * B.Width, Y * B.Height, B);
        end;
      Exit;
    end;
  w := RectWidth(ClRect);
  h := RectHeight(ClRect);
  w1 := Width;
  h1 := Height;
  XCnt := w1 div w;
  YCnt := h1 div h;
  Clb := TBitMap.Create;
  Clb.Width := w;
  Clb.Height := h;
  Clb.Canvas.CopyRect(Rect(0, 0, w, h), Picture.Canvas,
  Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
       SkinRect.Left + ClRect.Right,
      SkinRect.Top + ClRect.Bottom));

  SaveIndex := SaveDC(Cnvs.Handle);
  IntersectClipRect(Cnvs.Handle, DR.Left, DR.Top, DR.Right, DR.Bottom);
  //
  if StretchEffect and (Width > 0) and (Height > 0)
   then
     begin
       case StretchType of
         spstFull:
           begin
             Cnvs.StretchDraw(Rect(0, 0, Width, Height), Clb);
           end;
         spstVert:
            begin
              Buffer2 := TBitMap.Create;
              Buffer2.Width := Width;
              Buffer2.Height := Clb.Height;
              Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Clb);
              YCnt := Height div Buffer2.Height;
              for Y := 0 to YCnt do
                Cnvs.Draw(0, Y * Buffer2.Height, Buffer2);
              Buffer2.Free;
           end;
         spstHorz:
           begin
             Buffer2 := TBitMap.Create;
             Buffer2.Width := Clb.Width;
             Buffer2.Height := Height;
             Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Clb);
             XCnt := Width div Buffer2.Width;
             for X := 0 to XCnt do
               Cnvs.Draw(X * Buffer2.Width, 0, Buffer2);
             Buffer2.Free;
          end;
        end;
      end
  else
    begin
      for X := 0 to XCnt do
      for Y := 0 to YCnt do
      begin
        Cnvs.Draw(X * w, Y * h, Clb);
      end;
    end;
  //
  RestoreDC(Cnvs.Handle, SaveIndex);
  Clb.Free;
  // Draw frame around displayrect
  LB := TBitMap.Create;
  TB := TBitMap.Create;
  RB := TBitMap.Create;
  BB := TBitMap.Create;
  CreateSkinBorderImages(LtPoint, RTPoint, LBPoint, RBPoint, ClRect,
     NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewClRect,
     LB, TB, RB, BB, Picture, SkinRect, RectWidth(R), RectHeight(R),
     LeftStretch, TopStretch, RightStretch, BottomStretch);
   //
  SaveIndex := -1;
  IR := GetActiveTabRect;
  if not IsNullRect(IR)
  then
    begin
      SaveIndex := SaveDC(Cnvs.Handle);
      ExcludeClipRect(Cnvs.Handle, IR.Left, IR.Top, IR.Right, IR.Bottom);
    end;
  //
  Cnvs.Draw(R.Left, R.Top, TB);
  Cnvs.Draw(R.Left, R.Top + TB.Height, LB);
  Cnvs.Draw(R.Left + RectWidth(R) - RB.Width, R.Top + TB.Height, RB);
  Cnvs.Draw(R.Left, R.Top + RectHeight(R) - BB.Height, BB);
  //
  if SaveIndex <> -1 then RestoreDC(Cnvs.Handle, SaveIndex);
  //
  LB.Free;
  TB.Free;
  RB.Free;
  BB.Free;
end;


procedure TspSkinPageControl.Loaded;
begin
  inherited Loaded;
  if FIndex = -1
  then
    begin
      if TabHeight <= 0
      then
        SetItemSize(TabWidth, FDefaultItemHeight)
      else
        SetItemSize(TabWidth, TabHeight);
      Change2;
      ReAlign;
    end;
end;

procedure TspSkinPageControl.WMPaint(var Msg: TWMPaint);
begin
  if PageCount = 0
  then
    begin
      PaintHandler(Msg);
    end
  else
    inherited;
end;

procedure TspSkinPageControl.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
  if (PageCount = 0) or (not CheckVisibleTabs)
  then
    begin
      GetSkinData;
      if FIndex = -1
      then
        inherited
      else
        DrawEmptyBackGround(Msg.DC);
    end
  else
    begin
      Msg.Result := 1;
    end;
end;


procedure TspSkinPageControl.WndProc(var Message:TMessage);
var
  TOff, LOff, Roff, BOff: Integer;
begin
  if Message.Msg = TCM_ADJUSTRECT
  then
    begin
      inherited WndProc(Message);
      if FIndex <> -1
      then
        begin
          TOff := ClRect.Top;
          LOff := ClRect.Left;
          ROff := RectWidth(SkinRect) - ClRect.Right;
          BOff := RectHeight(SkinRect) - ClRect.Bottom;
        end;
      case TabPosition of
        tpLeft:
           if FIndex <> -1
           then
             begin
               PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left + LOff - 4;
               PRect(Message.LParam)^.Right := ClientWidth - ROff;
               {$IFNDEF VER130}
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 4 + TOff;
               {$ELSE}
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
               {$ENDIF}
               PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
               if FHideTabs then PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 1;
             end
           else
             begin
               PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 3;
               PRect(Message.LParam)^.Right := ClientWidth - 1;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
               PRect(Message.LParam)^.Bottom := ClientHeight - 1;
               if FHideTabs then PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 1;
             end;
        tpRight:
           if FIndex <> -1
           then
             begin
               PRect(Message.LParam)^.Left := LOff;
               PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - ROff + 4;
               {$IFNDEF VER130}
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 4 + TOff;
               {$ELSE}
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
               {$ENDIF}
               PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
               if FHideTabs then PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right + 1;
             end
           else
             begin
               PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 3;
               PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right + 3;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
               PRect(Message.LParam)^.Bottom := ClientHeight - 1;
               if FHideTabs then PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right + 1;
             end;
        tpTop:
           if FIndex <> -1
           then
             begin
               PRect(Message.LParam)^.Left := LOff;
               PRect(Message.LParam)^.Right := ClientWidth - ROff;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
               PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
               if FHideTabs then PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 1;
             end
           else
             begin
               PRect(Message.LParam)^.Left := 1;
               PRect(Message.LParam)^.Right := ClientWidth - 1;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
               PRect(Message.LParam)^.Bottom := ClientHeight - 1;
               if FHideTabs then PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 1;
             end;
        tpBottom:
          if FIndex <> -1
          then
            begin
              PRect(Message.LParam)^.Left := LOff;
              PRect(Message.LParam)^.Right := ClientWidth - ROff;
              {$IFNDEF VER130}
              PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 4 + TOff;
              {$ELSE}
              PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
              {$ENDIF}
              PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 4 - BOff;
              if FHideTabs then PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 1;
            end
          else
            begin
              PRect(Message.LParam)^.Left := 1;
              PRect(Message.LParam)^.Right := ClientWidth - 1;
              PRect(Message.LParam)^.Top := 1;
              PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 3;
            end;

      end;
    end
  else
    if Message.Msg = TCM_GETITEMRECT
    then
      begin
        inherited WndProc(Message);
        if Style = tsTabs
        then
          case TabPosition of
            tpLeft:
                begin
                  PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
                  PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
                end;
            tpRight:
                begin
                  PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left + 2;
                  PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right + 2;
                end;

            tpTop:
                begin
                  if not MultiLine
                  then
                    begin
                      PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
                      PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
                    end;
                  PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 2;
                  PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom - 2;
                end;
            tpBottom:
                begin
                  if not MultiLine
                  then
                    begin
                      PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
                      PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
                    end;
                  PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top + 2;
                  PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 2;
                end;
          end;
      end
  else
  inherited WndProc(Message);
  if (Message.Msg = WM_SIZE) and (not MultiLine) and
     not (csDesigning in ComponentState)
  then
    begin
      CheckScroll;
    end;
end;

function TspSkinPageControl.GetItemRect(index: integer): TRect;
var
  R: TRect;
begin
  SendMessage(Handle, TCM_GETITEMRECT, index, Integer(@R));
  Result := R;
  if (Index = 0) and not MultiLine then Result.Left := Result.Left + 1;
end;

procedure TspSkinPageControl.SetItemSize;
begin
  SendMessage(Handle, TCM_SETITEMSIZE, 0, MakeLParam(AWidth, AHeight));
end;

procedure TspSkinPageControl.PaintWindow(DC: HDC);
var
  SaveIndex: Integer;
begin
  if (Width <= 0) or (Height <=0) then Exit;
  GetSkinData;
  SaveIndex := SaveDC(DC);
  try
    Canvas.Handle := DC;
    if FIndex = -1
    then
      PaintDefaultWindow(Canvas)
    else
      PaintSkinWindow(Canvas);
    DrawTabs(Canvas);
    Canvas.Handle := 0;
  finally
    RestoreDC(DC, SaveIndex);
  end;
end;

procedure TspSkinPageControl.TestActive(X, Y: Integer);
var
  i, j, k: Integer;
  R: TRect;
  BR: TRect;
begin
  if FHideTabs then Exit;

  FOldActiveTab := FActiveTab;
  FOldActiveTabIndex := FActiveTabIndex;
  FActiveTab := -1;
  FActiveTabIndex := -1;
  k := -1;
  j := -1;
  for i := 0 to PageCount - 1 do
  if Pages[i].TabVisible then
  begin
    Inc(k);
    R := GetItemRect(k);
    if PtIn