bsskintabs.~pas

一套非常好用的delphi控件,方便程序员工作

end;

procedure TbsSkinPageControl.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;
             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) and
     not (csDesigning in ComponentState)
  then
    begin
      CheckScroll;
    end;
end;

function TbsSkinPageControl.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 TbsSkinPageControl.SetItemSize;
begin
  SendMessage(Handle, TCM_SETITEMSIZE, 0, MakeLParam(AWidth, AHeight));
end;

procedure TbsSkinPageControl.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 TbsSkinPageControl.TestActive(X, Y: Integer);
var
  i, j, k: Integer;
  R: TRect;
begin
  FOldActiveTab := FActiveTab;
  FOldActiveTabIndex := FActiveTabIndex;
  k := -1;
  j := -1;
  for i := 0 to PageCount - 1 do
  if Pages[i].TabVisible then
  begin
    Inc(k);
    R := GetItemRect(k);
    if PtInRect(R, Point(X, Y))
    then
      begin
        j := k;
        Break;
      end;
  end;

  FActiveTab := i;
  FActiveTabIndex := j;

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

procedure TbsSkinPageControl.DrawTabs;
var
  i, j: integer;
  IR: TRect;
  w, h, XCnt, YCnt, X, Y, TOff, LOff, Roff, BOff: Integer;
  R, DR: TRect;
  Buffer, Buffer2: TBitMap;
  ATabIndex: Integer;
begin
  //
  if PageCount = 0 then Exit;
  if FIndex = -1
  then
    begin
      j := -1;
      for i := 0 to PageCount-1 do
      if Pages[i].TabVisible then
      begin
        inc(j);
        R := GetItemRect(j);
        DrawTab(i, R, (j = TabIndex), j = FActiveTabIndex, Cnvs);
      end;
      Exit;
    end;
  //
  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);
  Buffer := TBitMap.Create;
  case TabPosition of
    tpTop:
      begin
        Buffer.Width := Width;
        Buffer.Height := R.Top;
      end;
    tpBottom:
      begin
        Buffer.Width := Width;
        Buffer.Height := Height - R.Bottom;
      end;
    tpRight:
      begin
        Buffer.Width := Width - R.Right;
        Buffer.Height := Height;
      end;
    tpLeft:
      begin
        Buffer.Width := R.Left;
        Buffer.Height := Height;
      end;
  end;
  // draw tabsbg
  w := RectWidth(TabsBGRect);
  h := RectHeight(TabsBGRect);
  XCnt := Buffer.Width div w;
  YCnt := Buffer.Height div h;
  Buffer2 := TBitMap.Create;
  Buffer2.Width := w;
  Buffer2.Height := h;
  Buffer2.Canvas.CopyRect(Rect(0, 0, w, h), Picture.Canvas, TabsBGRect);
  for X := 0 to XCnt do
  for Y := 0 to YCnt do
  begin
    Buffer.Canvas.Draw(X * w, Y * h, Buffer2);
  end;
  Buffer2.Free;
  //
  j := -1;
  ATabIndex := 0;
  for i := 0 to PageCount-1 do
  if Pages[I].TabVisible then
  begin
    inc(j);
    IR := GetItemRect(j);
    case TabPosition of
    tpTop:
      begin
      end;
    tpBottom:
      begin
        OffsetRect(IR, 0, -R.Bottom);
      end;
    tpRight:
      begin
        OffsetRect(IR, - R.Right, 0);
      end;
    tpLeft:
      begin
                            
      end;
     end;
    DrawTab(i, IR, (j = TabIndex), j = FActiveTabIndex, Buffer.Canvas);
    if j = TabIndex then ATabIndex := i;
  end;
 case TabPosition of
    tpTop:
      begin
        Cnvs.Draw(0, 0, Buffer);
      end;
    tpBottom:
      begin
        Cnvs.Draw(0, Height - Buffer.Height, Buffer);
      end;
    tpRight:
      begin
        Cnvs.Draw(Width - Buffer.Width, 0, Buffer);
      end;
    tpLeft:
      begin
        Cnvs.Draw(0, 0, Buffer);
      end;
  end;
  Buffer.Free;
  if (ATabIndex <> -1) and (TabIndex <> -1) and (TabIndex >= 0) and (TabIndex < PageCount)
  then
    begin
      IR := GetItemRect(TabIndex);
      DrawTab(ATabIndex, IR, True, TabIndex = FActiveTabIndex, Cnvs);
    end;
end;

procedure TbsSkinPageControl.DrawTab;
var
  R, R1: TRect;
  S: String;
  TB, BufferTB: TBitMap;
  DrawGlyph: Boolean;
  W, H: Integer;
begin
  if TI > PageCount - 1 then Exit;
  DrawGlyph := (Images <> nil) and (TI < Images.Count);
  S := Pages[TI].Caption;
  if (TabPosition = tpTop) or (TabPosition = tpBottom)
  then
    begin
      W := RectWidth(Rct);
      H := RectHeight(Rct);
    end
  else
    begin
      H := RectWidth(Rct);
      W := RectHeight(Rct);
    end;
  if (W <= 0) or (H <= 0) then Exit;
  TB := TBitMap.Create;
  TB.Width := W;
  TB.Height := H;
  R := Rect(0, 0, W, H);
  if FIndex <> -1
  then
    begin
      if TabHeight <= 0
      then
        begin
          if MouseIn and not Active and not IsNullRect(MouseInTabRect)
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             TB, Picture, MouseInTabRect, W, H, TabStretchEffect)
          else
            if Active and Focused
          then
           CreateHSkinImage(TabLeftOffset, TabRightOffset,
            TB, Picture, FocusTabRect, W, H, TabStretchEffect)
          else
          if Active
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
              TB, Picture, ActiveTabRect, W, H, TabStretchEffect)
          else
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             TB, Picture, TabRect, W, H, TabStretchEffect); 
       end
     else
       begin
         BufferTB := TBitMap.Create;
         BufferTB.Width := W;
         BufferTB.Height := RectHeight(TabRect);
         if MouseIn and not Active and not IsNullRect(MouseInTabRect)
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             BufferTB, Picture, MouseInTabRect, W, H, TabStretchEffect)
          else
            if Active and Focused
          then
           CreateHSkinImage(TabLeftOffset, TabRightOffset,
            BufferTB, Picture, FocusTabRect, W, H, TabStretchEffect)
          else
          if Active
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
              BufferTB, Picture, ActiveTabRect, W, H, TabStretchEffect)
          else
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             BufferTB, Picture, TabRect, W, H, TabStretchEffect);
         TB.Width := W;
         TB.Height := H;
         TB.Canvas.StretchDraw(R, BufferTB);
         BufferTB.Free;
       end;
      if TabPosition = tpBottom then DrawFlipVert(TB);
      with TB.Canvas do
      begin
        Brush.Style := bsClear;
        if FUseSkinFont
        then
          begin
            Font.Name := FontName;
            Font.Style := FontStyle;
            Font.Height := FontHeight;
          end
        else
           Font.Assign(Self.Font);
        if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
        then
          Font.Charset := SkinData.ResourceStrData.CharSet
        else
          Font.CharSet := Self.Font.CharSet;
        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