skintabs.pas

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

  B2.Draw(Cnvs.Handle, X, Y);
  B1.Free;
  B2.Free;
end;

procedure DrawTabGlyphAndText(Cnvs: TCanvas; W, H: Integer; S: String;
                              IM: TCustomImageList; IMIndex: Integer;
                              AEnabled: Boolean; TopOffset: Integer);

var
  R, TR: TRect;
  GX, GY, GW, GH, TW, TH: Integer;
begin
  R := Rect(0, 0, 0, 0);
  DrawText(Cnvs.Handle, PChar(S), Length(S), R, DT_CALCRECT);
  TW := RectWidth(R) + 2;
  TH := RectHeight(R);
  GW := IM.Width;
  GH := IM.Height;
  GX := (W) div 2 - (GW + TW + 2) div 2;
  GY := H div 2 - GH div 2 + TopOffset;
  TR.Left := GX + GW + 2;
  TR.Top := H div 2 - TH div 2 + TopOffset;
  TR.Right := TR.Left + TW;
  TR.Bottom := TR.Top + TH;
  DrawText(Cnvs.Handle, PChar(S), Length(S), TR, DT_CENTER);
  IM.Draw(Cnvs, GX, GY, IMIndex, AEnabled);
end;

constructor TspSkinCustomTabSheet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alClient;
  ControlStyle := ControlStyle + [csAcceptsControls, csNoDesignVisible];
  Visible := False;
  FWallPaper := TBitMap.Create;
  ButtonMouseIn := False;
  ButtonMouseDown := False;
end;

procedure TspSkinCustomTabSheet.CMSENCPaint(var Message: TMessage);
begin
  Message.Result := SE_RESULT;
end;

procedure TspSkinCustomTabSheet.CheckControlsBackground;
var
  i: Integer;
begin
  for i := 0 to ControlCount - 1 do
  begin
    if Controls[i] is TWinControl
    then
      SendMessage(TWinControl(Controls[i]).Handle, WM_CHECKPARENTBG, 0, 0);
  end;
end;

procedure TspSkinCustomTabSheet.SetWallPaper(Value: TBitmap);
begin
  FWallPaper.Assign(Value);
  if (csDesigning in ComponentState) then RePaint;
end;


procedure TspSkinCustomTabSheet.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
    with Params.WindowClass do
      Style := Style and not (CS_HREDRAW or CS_VREDRAW);
end;

destructor TspSkinCustomTabSheet.Destroy;
begin
  PageControl := nil;
  FWallPaper.Free;
  inherited Destroy;
end;

procedure TspSkinCustomTabSheet.WMEraseBkGnd;
begin
  PaintBG(Msg.DC);
end;

procedure TspSkinCustomTabSheet.WMSize;
var
  PC: TspSkinPageControl;
begin
  inherited;
  RePaint;
  PC := TspSkinPageControl(Parent);
  if (PC <> nil) and (PC.SkinData <>  nil) and
  (not PC.SkinData.Empty) and (PC.StretchEffect)
  then
    CheckControlsBackground;
end;

procedure TspSkinCustomTabSheet.PaintBG;
var
  C: TCanvas;
  TabSheetBG, Buffer2: TBitMap;
  PC: TspSkinPageControl;
  X, Y, XCnt, YCnt, w, h, w1, h1: Integer;
begin
  if (Width <= 0) or (Height <=0) then Exit;
  PC := TspSkinPageControl(Parent);
  if PC = nil then Exit;
  PC.GetSkinData;
  C := TCanvas.Create;
  C.Handle := DC;

  if not FWallPaper.Empty
  then
    begin
      if (Width > 0) and (Height > 0)
      then
        begin
          XCnt := Width div FWallPaper.Width;
          YCnt := Height div FWallPaper.Height;
          for X := 0 to XCnt do
          for Y := 0 to YCnt do
          C.Draw(X * FWallPaper.Width, Y * FWallPaper.Height, FWallPaper);
        end;
      C.Free;
      Exit;
    end;

  if (PC.FSD <> nil) and (not PC.FSD.Empty) and
     (PC.FIndex <> -1) and (PC.BGPictureIndex <> -1)
  then
    begin
      TabSheetBG := TBitMap(PC.FSD.FActivePictures.Items[PC.BGPictureIndex]);

      if PC.StretchEffect and (Width > 0) and (Height > 0)
      then
        begin
          case PC.StretchType of
            spstFull:
              begin
                C.StretchDraw(Rect(0, 0, Width, Height), TabSheetBG);
              end;
            spstVert:
              begin
                Buffer2 := TBitMap.Create;
                Buffer2.Width := Width;
                Buffer2.Height := TabSheetBG.Height;
                Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
                YCnt := Height div Buffer2.Height;
                for Y := 0 to YCnt do
                  C.Draw(0, Y * Buffer2.Height, Buffer2);
                Buffer2.Free;
              end;
           spstHorz:
             begin
               Buffer2 := TBitMap.Create;
               Buffer2.Width := TabSheetBG.Width;
               Buffer2.Height := Height;
               Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
               XCnt := Width div Buffer2.Width;
               for X := 0 to XCnt do
                 C.Draw(X * Buffer2.Width, 0, Buffer2);
               Buffer2.Free;
             end;
          end;
        end
      else
      if (Width > 0) and (Height > 0)
      then
        begin
          XCnt := Width div TabSheetBG.Width;
          YCnt := Height div TabSheetBG.Height;
          for X := 0 to XCnt do
          for Y := 0 to YCnt do
          C.Draw(X * TabSheetBG.Width, Y * TabSheetBG.Height, TabSheetBG);
        end;
      C.Free;
      Exit;
    end;
 
  w1 := Width;
  h1 := Height;

  if PC.FIndex <> -1
  then
    with PC do
    begin
      TabSheetBG := TBitMap.Create;
      TabSheetBG.Width := RectWidth(ClRect);
      TabSheetBG.Height := RectHeight(ClRect);
      TabSheetBG.Canvas.CopyRect(Rect(0, 0, TabSheetBG.Width, TabSheetBG.Height),
        PC.Picture.Canvas,
          Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
               SkinRect.Left + ClRect.Right,
               SkinRect.Top + ClRect.Bottom));

     if PC.StretchEffect and (Width > 0) and (Height > 0)
      then
        begin
          case PC.StretchType of
            spstFull:
              begin
                C.StretchDraw(Rect(0, 0, Width, Height), TabSheetBG);
              end;
            spstVert:
              begin
                Buffer2 := TBitMap.Create;
                Buffer2.Width := Width;
                Buffer2.Height := TabSheetBG.Height;
                Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
                YCnt := Height div Buffer2.Height;
                for Y := 0 to YCnt do
                  C.Draw(0, Y * Buffer2.Height, Buffer2);
                Buffer2.Free;
              end;
           spstHorz:
             begin
               Buffer2 := TBitMap.Create;
               Buffer2.Width := TabSheetBG.Width;
               Buffer2.Height := Height;
               Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
               XCnt := Width div Buffer2.Width;
               for X := 0 to XCnt do
                 C.Draw(X * Buffer2.Width, 0, Buffer2);
               Buffer2.Free;
             end;
          end;
        end
      else
        begin
          w := RectWidth(ClRect);
          h := RectHeight(ClRect);
          XCnt := w1 div w;
          YCnt := h1 div h;
          for X := 0 to XCnt do
          for Y := 0 to YCnt do
          C.Draw(X * w, Y * h, TabSheetBG);
        end;
      TabSheetBG.Free;
    end
  else
  with C do
  begin
    Brush.Color := clbtnface;
    FillRect(Rect(0, 0, w1, h1));
  end;
  C.Free;
end;


{TTabSheetes}
constructor TspSkinTabSheet.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
end;

destructor TspSkinTabSheet.Destroy;
begin
  inherited Destroy;
end;

procedure TspSkinTabSheet.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
end;

{ TspSkinPageControl }

constructor TspSkinPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //
  FHideTabs := False;
  FOldTabHeight := -1;
  FFreeOnClose := False;
  FIsVistaOS := IsVistaOS;
  FImages := nil;
  FTempImages := TCustomImageList.Create(self);
  FTempImages.Width := 1;
  FTempImages.Height := 1;
  inherited Images := FTempImages;
  //
  FTabsBGTransparent := False;
  Ctl3D := False;
  FIndex := -1;
  Picture := nil;
  Font.Name := 'Arial';
  Font.Style := [];
  Font.Color := clBtnText;
  Font.Height := 14;
  FSkinUpDown := nil;
  FSkinDataName := 'tab';
  FDefaultFont := TFont.Create;
  FDefaultFont.Name := 'Arial';
  FDefaultFont.Style := [];
  FDefaultFont.Color := clBtnText;
  FDefaultFont.Height := 14;
  FDefaultItemHeight := 20;
  FActiveTab := -1;
  FOldActiveTab := -1;
  FActiveTabIndex := -1;
  FOldActiveTabIndex := -1;
  FUseSkinFont := True;
  FCloseSize := CLOSE_SIZE;
end;

destructor TspSkinPageControl.Destroy;
begin
  FTempImages.Free;
  FDefaultFont.Free;
  inherited Destroy;
end;

function TspSkinPageControl.CheckVisibleTabs: Boolean;
var
  i: Integer;
begin
  Result := False;
  if PageCount = 0
  then
    Result := False
  else
    begin
      for i := 0 to PageCount - 1 do
      begin
        if Pages[i].TabVisible
        then
          begin
            Result := True;
            Break;
          end;
      end;
    end;
end;

function TspSkinPageControl.GetActiveTabRect: TRect;
var
  IR: TRect;
  YO: Integer;
begin
  IR := NullRect;
  YO := RectHeight(ActiveTabRect) - RectHeight(TabRect);
  if (TabIndex <> -1) and (TabIndex >= 0) and (TabIndex < PageCount) and
     (PageCount > 0) and (CheckVisibleTabs) and (ActivePage <> nil)
  then
    begin
      IR := GetItemRect(TabIndex);
      case TabPosition of
        tpTop: Inc(IR.Bottom, YO);
        tpLeft: Inc(IR.Right, YO);
        tpRight: Dec(IR.Left, YO);
        tpBottom: Dec(IR.Top, YO);
      end;
    end;
  Result := IR;
end;

procedure TspSkinPageControl.CMSENCPaint(var Message: TMessage);
begin
  Message.Result := SE_RESULT;
end;

procedure TspSkinPageControl.HideTabs;

function CanHide: Boolean;
var
  i: Integer;
begin
  Result := False;
  if PageCount = 0
  then
    Result := False
  else
    begin
      for i := 0 to PageCount - 1 do
      begin
        if Pages[i].TabVisible
        then
          begin
            Result := True;
            Break;
          end;
      end;
    end;
end;

begin
  if (FOldTabHeight = -1) and CanHide
  then
    begin
      FHideTabs := True;
      FOldTabPosition := TabPosition;
      FOldMultiLine := Multiline;
      if (TabPosition = tpLeft) or (TabPosition = tpRight)
      then
        TabPosition := tpTop;
      if MultiLine = True then MultiLine := False;
      FOldTabHeight := TabHeight;
      TabHeight := 1;
      if FSkinUpDown <> nil then HideSkinUpDown;
    end;
end;

procedure TspSkinPageControl.ShowTabs;
begin
  if FOldTabHeight <> -1
  then
    begin
      TabPosition := FOldTabPosition;
      MultiLine := FOldMultiline;
      FHideTabs := False;
      TabHeight := FOldTabHeight;
      if (TabHeight <= 0) and (FIndex <> -1)
      then
        SetItemSize(TabWidth, RectHeight(TabRect));
      FOldTabHeight := -1;
      if not MultiLine then CheckScroll;
    end;
end;

function TspSkinPageControl.GetCloseSize;
begin
  if (FIndex <> -1) and not IsNullRect(CloseButtonRect)
  then
    Result := RectWidth(CloseButtonRect)
  else
    Result := CLOSE_SIZE;
end;

procedure TspSkinPageControl.DoClose;
var
  I: TTabSheet;
  CanClose: Boolean;
  P: TPoint;
begin
  I := ActivePage;
  CanClose := True;
  if Assigned(FOnClose) then FOnClose(I, CanClose);