bsskintabs.~pas

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

        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);
        if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
        then
          Font.Charset := SkinData.ResourceStrData.CharSet;
      end;
    end;
  //
  if (FIndex <> -1) and ShowFocus and Focused and Active
  then
    begin
      R1 := R;
      InflateRect(R1, -FocusOffsetX, -FocusOffsetY);
      TB.Canvas.Brush.Style := bsSolid;
      TB.Canvas.Brush.Color := FSD.SkinColors.cBtnFace;
      TB.Canvas.DrawFocusRect(R1);
      TB.Canvas.Brush.Style := bsClear;
    end;
  //
  if DrawGlyph
  then
    DrawTabGlyphAndText(TB.Canvas, TB.Width, TB.Height, S,
                        Images, Pages[TI].ImageIndex, Pages[TI].Enabled)
  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;


{ TbsSkinTabControl }

constructor TbsSkinTabControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FromWMPaint := False;
  Ctl3D := False;
  FIndex := -1;
  Picture := nil;
  Font.Name := 'Arial';
  Font.Style := [];
  Font.Color := clBtnText;
  Font.Height := 14;
  FOldTop := 0;
  FOldBottom := 0;
  FSkinUpDown := nil;
  FSkinDataName := 'tab';
  FDefaultFont := TFont.Create;
  FDefaultFont.Name := 'Arial';
  FDefaultFont.Style := [];
  FDefaultFont.Color := clBtnText;
  FDefaultFont.Height := 14;
  FDefaultItemHeight := 20;
  FUseSkinFont := True;
  TabStretchEffect := False;
end;

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

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

procedure TbsSkinTabControl.CMMouseLeave;
var
  R: TRect;
begin
  if (FOldActiveTab <> - 1) and (FOldActiveTab <> TabIndex) and
     (FOldActiveTab < Self.Tabs.Count)
  then
    begin
      R := GetItemRect(FOldActiveTab);
      DrawTab(FOldActiveTab, R, False, False, Canvas);
      FOldActiveTab := -1;
    end;

  if (FActiveTab <> - 1) and (FActiveTab <> TabIndex) and
     (FActiveTab < Self.Tabs.Count)
  then
    begin
      R := GetItemRect(FActiveTab);
      DrawTab(FActiveTab, R, False, False, Canvas);
      FActiveTab := -1;
    end;
end;

procedure TbsSkinTabControl.TestActive(X, Y: Integer);
var
  i, j: Integer;
  R: TRect;
begin
  FOldActiveTab := FActiveTab;
  j := -1;
  for i := 0 to Tabs.Count-1 do
  begin
    R := GetItemRect(i);
    if PtInRect(R, Point(X, Y))
    then
      begin
        j := i;
        Break;
      end;
  end;

  FActiveTab := j;

  if (FOldActiveTab <> FActiveTab)
  then
    begin
      if (FOldActiveTab <> - 1) and (FOldActiveTab <> TabIndex) and
         (FOldActiveTab < Self.Tabs.Count)
      then
        begin
          R := GetItemRect(FOldActiveTab);
          DrawTab(FOldActiveTab, R, False, False, Canvas);
        end;
      if (FActiveTab <> -1) and (FActiveTab <> TabIndex) and
         (FActiveTab < Self.Tabs.Count)
      then
        begin
          R := GetItemRect(FActiveTab);
          DrawTab(FActiveTab, R, False, True, Canvas );
        end;
    end;
end;

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


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

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

function TbsSkinTabControl.GetPosition: Integer;
var
  i, j: Integer;
  R: TRect;
begin
  j := 0;
  for i := 0 to Tabs.Count - 1 do
  begin
    R := GetItemRect(i);
    if R.Right <= 0 then inc(j);
  end;
  Result := j;
end;

function TbsSkinTabControl.GetInVisibleItemCount;
var
  i, j: Integer;
  R: TRect;
  Limit: Integer;
begin
  if FSkinUpDown = nil
  then
    Limit := Width - 3
  else
    Limit := Width - FSkinUpDown.Width - 3;
  j := 0;
  for i := 0 to Tabs.Count - 1 do
  begin
    R := GetItemRect(i);
    if (R.Right > Limit) or (R.Right <= 0)
    then inc(j);
  end;
  Result := j;
end;

procedure TbsSkinTabControl.CheckScroll;
var
  Wnd: HWND;
  InVCount: Integer;
begin
  Wnd := FindWindowEx(Handle, 0, 'msctls_updown32', nil);
  if Wnd <> 0 then DestroyWindow(Wnd);
  InVCount := GetInVisibleItemCount;
  if (InVCount = 0) and (FSkinUpDown <> nil)
  then
    HideSkinUpDown
  else
  if (InVCount > 0) and (FSkinUpDown = nil)
  then
    ShowSkinUpDown;
  if FSkinUpDown <> nil
  then
    begin
      FSkinUpDown.Max := InVCount;
      FSkinUpDown.Left := Width - FSkinUpDown.Width;
      if TabPosition = tpTop
      then
        FSkinUpDown.Top := 0
      else
       FSkinUpDown.Top := Height - FSkinUpDown.Height;
    end;
end;

procedure TbsSkinTabControl.ShowSkinUpDown;
begin
  FSkinUpDown := TbsSkinUpDown.Create(Self);
  FSkinUpDown.Parent := Self;
  FSkinUpDown.Width := 36;
  FSkinUpDown.Height := 18;
  FSkinUpDown.Min := 0;
  FSkinUpDown.Max := GetInVisibleItemCount;
  FSkinUpDown.Position := GetPosition;
  FSkinUpDown.Increment := 1;
  FSkinUpDown.OnChange := OnUpDownChange;
  FSkinUpDown.Left := Width - FSkinUpDown.Width;
  if TabPosition = tpTop
  then
    FSkinUpDown.Top := 0
  else
    FSkinUpDown.Top := Height - FSkinUpDown.Height;
  FSkinUpDown.SkinDataName := UpDown;
  FSkinUpDown.SkinData := SkinData;
  FSkinUpDown.Visible := True;
end;

procedure TbsSkinTabControl.HideSkinUpDown;
begin
  FSkinUpDown.Free;
  FSkinUpDown := nil;
end;

procedure TbsSkinTabControl.WMPaint;
begin
  FromWMPaint := True;
  if ControlCount = 0
  then
    PaintHandler(Msg)
  else
    inherited;
  FromWMPaint := False;
end;

procedure TbsSkinTabControl.WMHSCROLL;
begin
  inherited;
  RePaint;
end;

procedure TbsSkinTabControl.WMSize;
begin
  inherited;
end;

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

procedure TbsSkinTabControl.Change;
begin
  if FSkinUpDown <> nil
  then FSkinUpDown.Position := GetPosition;
  inherited;
  Invalidate;
end;

procedure TbsSkinTabControl.Change2;
begin
  if FSkinUpDown <> nil
  then FSkinUpDown.Position := GetPosition;
  Invalidate;
end;

procedure TbsSkinTabControl.GetSkinData;
begin
  BGPictureIndex := -1;
  if FSD = nil
  then
    begin
      FIndex := -1;
      Exit;
    end;
  if FSD.Empty
  then
    FIndex := -1
  else
    FIndex := FSD.GetControlIndex(FSkinDataName);
  //
  if FIndex <> -1
  then
    if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinTabControl
    then
      with TbsDataSkinTabControl(FSD.CtrlList.Items[FIndex]) do
      begin
        if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
        then
          Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
        else
          Picture := nil;
        Self.SkinRect := SkinRect;
        Self.ClRect := ClRect;
        Self.TabRect := TabRect;
        if IsNullRect(ActiveTabRect)
        then
          Self.ActiveTabRect := TabRect
        else
          Self.ActiveTabRect := ActiveTabRect;
        if IsNullRect(FocusTabRect)
        then
          Self.FocusTabRect := ActiveTabRect
        else
          Self.FocusTabRect := FocusTabRect;
        //
        Self.TabsBGRect := TabsBGRect; 
        Self.LTPoint := LTPoint;
        Self.RTPoint := RTPoint;
        Self.LBPoint := LBPoint;
        Self.RBPoint := RBPoint;
        Self.TabLeftOffset := TabLeftOffset;
        Self.TabRightOffset := TabRightOffset;
        //
        Self.FontName := FontName;
        Self.FontColor := FontColor;
        Self.ActiveFontColor := ActiveFontColor;
        Self.FocusFontColor := FocusFontColor;
        Self.FontStyle := FontStyle;
        Self.FontHeight := FontHeight;
        Self.UpDown := UpDown;
        Self.BGPictureIndex := BGPictureIndex;
        Self.MouseInFontColor := MouseInFontColor;
        Self.MouseInTabRect := MouseInTabRect;
        Self.TabStretchEffect := TabStretchEffect;
        Self.ShowFocus := ShowFocus;
        Self.FocusOffsetX := FocusOffsetX;
        Self.FocusOffsetY := FocusOffsetY;
      end;
end;

procedure TbsSkinTabControl.ChangeSkinData;
begin
  GetSkinData;
  //
  if FIndex <> -1
  then
    begin
      Font.Color := FontColor;
      if FUseSkinFont
      then
        begin
          Font.Name := FontName;
          Font.Height := FontHeight;
          Font.Style := FontStyle;
        end
      else
        Font.Assign(FDefaultFont);

      if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
      then
        Font.Charset := SkinData.ResourceStrData.CharSet
      else
        Font.CharSet := DefaultFont.CharSet;

      if TabHeight <= 0
      then
        SetItemSize(TabWidth, RectHeight(TabRect))
      else
        SetItemSize(TabWidth, TabHeight);
    end
  else
    begin
      Font.Assign(FDefaultFont);
      if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
      then
        Font.Charset := SkinData.ResourceStrData.CharSet;
      if TabHeight <= 0
      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