bsskintabs.pas

一套及时通讯的原码

          TBGOffY := R.Bottom;
          rh := Height - R.Bottom;
          rw := Width;
        end;
      w := RectWidth(TabsBGRect);
      h := RectHeight(TabsBGRect);
      XCnt := rw div w;
      YCnt := rh div h;
      for X := 0 to XCnt do
      for Y := 0 to YCnt do
      begin
        if X * w + w > rw then XO := X * w + w - rw else XO := 0;
        if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
        Cnvs.CopyRect(Rect(TBGOffX + X * w, TBGOffY + Y * h,
                           TBGOffX + X * w + w - XO, TBGOffY + Y * h + h - YO),
                      Picture.Canvas,
                      Rect(TabsBGRect.Left, TabsBGRect.Top,
                           TabsBGRect.Right - XO, TabsBGRect.Bottom - YO));
      end;
    end;
  // Draw frame around displayrect
    // draw lines
  w := RTPoint.X - LTPoint.X;
  XCnt := (NewRTPoint.X - NewLTPoint.X) div w;
  for X := 0 to XCnt do
  begin
    if NewLTPoint.X + X * w + w > NewRTPoint.X
    then XO := NewLTPoint.X + X * w + w - NewRTPoint.X else XO := 0;
    Cnvs.CopyRect(Rect(R.Left + NewLTPoint.X + X * w, R.Top,
                  R.Left + NewLTPoint.X + X * w + w - XO, R.Top + TOff),
             Picture.Canvas,
             Rect(SkinRect.Left + LTPoint.X, SkinRect.Top,
                  SkinRect.Left + RTPoint.X - XO, SkinRect.Top + TOff));
  end;

  w := RBPoint.X - LBPoint.X;
  XCnt := (NewRBPoint.X - NewLBPoint.X) div w;
  for X := 0 to XCnt do
  begin
    if NewLBPoint.X + X * w + w > NewRBPoint.X
    then XO := NewLBPoint.X + X * w + w - NewRBPoint.X else XO := 0;
    Cnvs.CopyRect(Rect(R.Left + NewLBPoint.X + X * w, R.Bottom - BOff,
                  R.Left + NewLBPoint.X + X * w + w - XO, R.Bottom),
             Picture.Canvas,
             Rect(SkinRect.Left + LBPoint.X, SkinRect.Bottom - BOff,
                  SkinRect.Left + RBPoint.X - XO, SkinRect.Bottom));
  end;

  w := LOff;
  h := LBPoint.Y - LTPoint.Y;
  YCnt := (NewLBPoint.Y - NewLTPoint.Y) div h;
  for Y := 0 to YCnt do
  begin
    if NewLTPoint.Y + Y * h + h > NewLBPoint.Y
    then YO := NewLTPoint.Y + Y * h + h - NewLBPoint.Y else YO := 0;
    Cnvs.CopyRect(Rect(R.Left, R.Top + NewLTPoint.Y + Y * h,
                       R.Left + w, R.Top + NewLTPoint.Y + Y * h + h - YO),
                  Picture.Canvas,
                  Rect(SkinRect.Left, SkinRect.Top + LTPoint.Y,
                       SkinRect.Left + w, SkinRect.Top + LBPoint.Y - YO));
  end;
  w := ROff;
  h := RBPoint.Y - RTPoint.Y;
  YCnt := (NewRBPoint.Y - NewRTPoint.Y) div h;
  for Y := 0 to YCnt do
  begin
    if NewRTPoint.Y + Y * h + h > NewRBPoint.Y
    then YO := NewRTPoint.Y + Y * h + h - NewRBPoint.Y else YO := 0;
    Cnvs.CopyRect(Rect(R.Right - w, R.Top + NewRTPoint.Y + Y * h,
                       R.Right, R.Top + NewRTPoint.Y + Y * h + h - YO),
                  Picture.Canvas,
                  Rect(SkinRect.Right - w, SkinRect.Top + RTPoint.Y,
                       SkinRect.Right, SkinRect.Top + RBPoint.Y - YO));
  end;
    // draw corners
  Cnvs.CopyRect(Rect(R.Left, R.Top, R.Left + LTPoint.X, R.Top + LTPoint.Y),
                Picture.Canvas,
                Rect(SkinRect.Left, SkinRect.Top,
                     SkinRect.Left + NewLTPoint.X, SkinRect.Top + NewLTPoint.Y));
  Cnvs.CopyRect(Rect(R.Left + NewRTPoint.X, R.Top,
                     R.Right, R.Top + NewRTPoint.Y),
                Picture.Canvas,
                Rect(SkinRect.Left + RTPoint.X, SkinRect.Top,
                     SkinRect.Right, SkinRect.Top + RTPoint.Y));
  Cnvs.CopyRect(Rect(R.Left, R.Top + NewLBPoint.Y,
                     R.Left + NewLBPoint.X, R.Bottom),
                Picture.Canvas,
                Rect(SkinRect.Left, SkinRect.Top + LBPoint.Y,
                     SkinRect.Left + LBPoint.X, SkinRect.Bottom));
  Cnvs.CopyRect(Rect(R.Left + NewRBPoint.X, R.Top + NewRBPoint.Y,
                     R.Right, R.Bottom),
                Picture.Canvas,
                Rect(SkinRect.Left + RBPoint.X, SkinRect.Top + RBPoint.Y,
                     SkinRect.Right, SkinRect.Bottom));
end;

procedure TbsSkinTabControl.Loaded;
begin
  inherited Loaded;
  if FIndex = -1
  then
    begin
      SetItemSize(0, FDefaultItemHeight);
      Change;
      ReAlign;
    end;
end;

procedure TbsSkinTabControl.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
  Msg.Result := 1;
end;

procedure TbsSkinTabControl.WndProc(var Message:TMessage);
var
  TOff, LOff, Roff, BOff: Integer;
begin
  if Message.Msg = TCM_ADJUSTRECT
  then
    begin
      inherited WndProc(Message);
      TOff := 0;
      LOff := 0;
      ROff := 0;
      BOff := 0;
      if (FIndex <> -1) and (BGPictureIndex = -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;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
               PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
             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;
             end;
        tpRight:
           if FIndex <> -1
           then
             begin
               PRect(Message.LParam)^.Left := LOff;
               PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - ROff + 4;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
               PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
             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;
             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;
             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;
             end;
        tpBottom:
          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 := PRect(Message.LParam)^.Bottom + 4 - BOff;
            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)
  then
    begin
      CheckScroll;
    end;
end;

function TbsSkinTabControl.GetItemRect(index: integer): TRect;
var
  R: TRect;
begin
  SendMessage(Handle, TCM_GETITEMRECT, index, Integer(@R));
  Result := R;
end;

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

procedure TbsSkinTabControl.PaintWindow(DC: HDC);
var
  SaveIndex: Integer;
  RealPicture: TBitMap;
begin
  GetSkinData;
  SaveIndex := SaveDC(DC);
  try
    RealPicture := TBitMap.Create;
    Canvas.Handle := DC;
    RealPicture.Width := Width;
    RealPicture.Height := Height;
    if FIndex = -1
    then
      PaintDefaultWindow(RealPicture.Canvas)
    else
      PaintSkinWindow(RealPicture.Canvas);
    DrawTabs(RealPicture.Canvas);
    Canvas.Draw(0, 0, RealPicture);
    Canvas.Handle := 0;
    RealPicture.Free;
  finally
    RestoreDC(DC, SaveIndex);
  end;
end;

procedure TbsSkinTabControl.DrawTabs;
var
  i: integer;
  R: TRect;
begin
  for i := 0 to Tabs.Count-1 do
  begin
    R := GetItemRect(i);
    DrawTab(i, R, i = TabIndex, i = FActiveTab, Cnvs);
  end;
end;

procedure TbsSkinTabControl.UpDateTabs;
begin
  if FIndex <> -1
  then
    SetItemSize(0, RectHeight(TabRect))
  else
    SetItemSize(0, FDefaultItemHeight);

  if MultiLine and (FSkinUpDown <> nil)
  then
    HideSkinUpDown;
  ReAlign;
end;

procedure TbsSkinTabControl.DrawTab;
var
  R: TRect;
  S: String;
  TB: TBitMap;
  DrawGlyph: Boolean;
  W, H: Integer;
begin
  DrawGlyph := (Images <> nil) and (TI < Images.Count);
  S := Tabs[TI];
  TB := TBitMap.Create;
  if (TabPosition = tpTop) or (TabPosition = tpBottom)
  then
    begin
      W := RectWidth(Rct);
      H := RectHeight(Rct);
    end
  else
    begin
      H := RectWidth(Rct);
      W := RectHeight(Rct);
    end;
  R := Rect(0, 0, W, H);  
  if FIndex <> -1
  then
    begin
      if MouseIn and not Active and not IsNullRect(MouseInTabRect)
      then
        CreateHSkinImage(TabLeftOffset, TabRightOffset,
          TB, Picture, MouseInTabRect, W, H)
      else
      if Active and Focused
      then
        CreateHSkinImage(TabLeftOffset, TabRightOffset,
          TB, Picture, FocusTabRect, W, H)
      else
      if Active
      then
         CreateHSkinImage(TabLeftOffset, TabRightOffset,
          TB, Picture, ActiveTabRect, W, H)
      else
        CreateHSkinImage(TabLeftOffset, TabRightOffset,
          TB, Picture, TabRect, W, H);
      with TB.Canvas do
      begin
        Brush.Style := bsClear;
        if FUseSkinFont
        then
          begin
            Font.Name := FontName;
            Font.Style := FontStyle;
            Font.Height := FontHeight;
            Font.CharSet := Self.Font.CharSet;
          end
        else
           Font.Assign(Self.Font);
        if MouseIn and not Active
        then
          Font.Color := MouseInFontColor
        else
        if Active and Focused
        then
          Font.Color := FocusFontColor
        else
          if Active
          then Font.Color := ActiveFontColor
          else Font.Color := FontColor;
      end;
    end
  else
    begin
      TB.Width := W;
      TB.Height := H;
      if MouseIn and not Active
      then
        begin
          TB.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
          TB.Canvas.FillRect(R);
        end
      else
      if Active and Focused
      then
        begin
          Frame3D(TB.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
          TB.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
          TB.Canvas.FillRect(R);
        end
      else
      if Active
      then
        begin
          Frame3D(TB.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
          TB.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
          TB.Canvas.FillRect(R);
        end
      else
        begin
          TB.Canvas.Brush.Color := clBtnFace;
          TB.Canvas.FillRect(R);
        end;
      with TB.Canvas do
      begin
        Brush.Style := bsClear;
        Font.Assign(Self.Font);
      end;
    end;
  //
  if DrawGlyph
  then
    DrawTabGlyphAndText(TB.Canvas, TB.Width, TB.Height, S,
                        Images, TI, True)
  else
    DrawText(TB.Canvas.Handle, PChar(S), Length(S), R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
  if TabPosition = tpLeft
  then
    DrawRotate90_1(Cnvs, TB, Rct.Left, Rct.Top)
  else
  if TabPosition = tpRight
  then
    DrawRotate90_2(Cnvs, TB, Rct.Left, Rct.Top)
  else
    Cnvs.Draw(Rct.Left, Rct.Top, TB);
  TB.Free;
end;


end.