bsskintabs.pas

一个用Delpi写的视频聊天的SDK

      then
        SetItemSize(TabWidth, FDefaultItemHeight)
      else
        SetItemSize(TabWidth, TabHeight);
    end;
  //
  Change2;
  ReAlign;
  RePaint;
  if FSkinUpDown <> nil
  then
    begin
      HideSkinUpDown;
      CheckScroll;
    end;
end;

procedure TbsSkinTabControl.SetSkinData;
begin
  FSD := Value;
  if (FSD <> nil) then
  if not FSD.Empty and not (csDesigning in ComponentState)
  then
    ChangeSkinData;
end;

procedure TbsSkinTabControl.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;

procedure TbsSkinTabControl.PaintDefaultWindow;
var
  R: TRect;
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 TbsSkinTabControl.PaintSkinWindow;
var
  TOff, LOff, Roff, BOff: Integer;
  DR, R: TRect;
  TBGOffX, TBGOffY, X, Y, XCnt, YCnt, w, h, w1, h1, rw, rh, XO, YO: Integer;
  NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  B: TBitMap;
begin
  TOff := ClRect.Top;
  LOff := ClRect.Left;
  ROff := RectWidth(SkinRect) - ClRect.Right;
  BOff := RectHeight(SkinRect) - ClRect.Bottom;
  DR := 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);
  // DrawBG

  if BGPictureIndex <> -1
  then
    begin
      B := TBitMap(FSD.FActivePictures.Items[BGPictureIndex]);
      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 := RectWidth(R);
  h1 := RectHeight(R);
  XCnt := w1 div w;
  YCnt := h1 div h;
  for X := 0 to XCnt do
  for Y := 0 to YCnt do
  begin
    if X * w + w > w1 then XO := X * w + w - w1 else XO := 0;
    if Y * h + h > h1 then YO := Y * h + h - h1 else YO := 0;
     Cnvs.CopyRect(Rect(R.Left + X * w, R.Top + Y * h,
                        R.Left + X * w + w - XO, R.Top + Y * h + h - YO),
              Picture.Canvas,
              Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
                   SkinRect.Left + ClRect.Right - XO,
                   SkinRect.Top + ClRect.Bottom - YO));
  end;            
  // Draw tabs BG
  if not IsNullRect(TabsBGRect)
  then
    begin
      if TabPosition = tpLeft
      then
        begin
          TBGOffY := 0;
          TBGOffX := 0;
          rw := R.Left;
          rh := Height;
        end
      else
      if TabPosition = tpRight
      then
        begin
          TBGOffY := 0;
          TBGOffX := R.Right;
          rw := Width - R.Right;
          rh := Height;
        end
      else
      if TabPosition = tpTop
      then
        begin
          TBGOffX := 0;
          TBGOffY := 0;
          rh := R.Top;
          rw := Width;
        end
      else
        begin
          TBGOffX := 0;
          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
      if TabHeight <= 0
      then
        SetItemSize(TabWidth, FDefaultItemHeight)
      else
        SetItemSize(TabWidth, TabHeight);
      Change2;
      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;
               {$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;
             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;
               {$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;
             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;
              {$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;
            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;
be