spagecontrol.pas

Alpha Controls 界面控件包

            case TabPosition of
              tpTop : BitBlt(DC, R.Left, R.Bottom, WidthOf(R), 4, FCommonData.FCacheBmp.Canvas.Handle, R.Left, R.Bottom, SRCCOPY);
              tpLeft : BitBlt(DC, R.Left, R.Top, 4, HeightOf(R), FCommonData.FCacheBmp.Canvas.Handle, R.Left, R.Top, SRCCOPY);
              tpBottom : BitBlt(DC, R.Left, R.Top - 4, WidthOf(R), 4, FCommonData.FCacheBmp.Canvas.Handle, R.Left, R.Top - 4, SRCCOPY);
              tpRight : BitBlt(DC, R.Left - 4, R.Top, 4, HeightOf(R), FCommonData.FCacheBmp.Canvas.Handle, R.Left - 4, R.Top, SRCCOPY);
            end;
          finally
            RestoreDC(DC, SavedDC);
            ReleaseDC(Handle, DC);
          end;
        end;
        TabsChanging := False;
      end;
    end;
  end
  else case Message.Msg of
    WM_WINDOWPOSCHANGING, CM_INVALIDATE : ArrangeButtons;
  end;
end;

procedure TsPageControl.UpdateUpDownRgn;
var
  Bmp : TBitmap;
  mi : integer;
  rgn : hrgn;
begin
  if (UpDown <> nil) and (UpDown.ButtonSkin = s_Button) then begin
    mi := SkinData.SkinManager.GetMaskIndex(UpDown.ButtonSkin, s_BordersMask);
    if SkinData.SkinManager.IsValidImgIndex(mi) then begin
      Bmp := CreateBmp24(UpDown.Width div 2, UpDown.Height);
      FillDC(Bmp.Canvas.Handle, Rect(0, 0, Bmp.Width, Bmp.Height), clFuchsia + 1);
      CtrlParentColor := clFuchsia + 1;
      UpDown.DrawBtn(Bmp, sbkLeft);
      CtrlParentColor := clFuchsia;
      Bmp.Width := UpDown.Width;
      BitBlt(Bmp.Canvas.Handle, UpDown.Width div 2, 0, UpDown.Width div 2, UpDown.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
      GetRgnFromBmp(rgn, Bmp, clFuchsia + 1);
      if Rgn <> 0 then SetWindowRgn(UpDown.Handle, Rgn, Repaint);
      FreeAndNil(Bmp);
    end;
  end;
end;

procedure TsPageControl.ArrangeButtons;
var
  i : integer;
  Page : TsTabSheet;
  rTab : TRect;
  function TabHeight : integer; begin
    case TabPosition of
      tpTop, tpBottom : Result := HeightOf(rTab)
      else Result := WidthOf(rTab);
    end;
  end;
begin
  if FShowCloseBtns and not SkinData.Skinned then begin
    for i := 0 to PageCount - 1 do begin
      Page := TsTabSheet(Pages[i]);
      if not Page.TabVisible or not Page.UseCloseBtn then Continue;
      rTab := TabRect(i);
      if Page.Btn = nil then begin
        Page.Btn := TsTabBtn.Create(Self);
        Page.Btn.OnClick := CloseClick;
        Page.Btn.Page := Page;
        Page.Btn.Visible := False;
        Page.Btn.Height := iBtnHeight;
        Page.Btn.Width := iBtnWidth;
        Page.Btn.Parent := Self;
      end;
      case TabPosition of
        tpTop, tpBottom : begin
          Page.Btn.Left := rTab.Right - Page.Btn.Width - BtnOffs;
          Page.Btn.Top := rTab.Top + BtnOffs;
        end;
        tpLeft : begin
          Page.Btn.Left := rTab.Left + BtnOffs;
          Page.Btn.Top := rTab.Top + BtnOffs;
        end
        else begin
          Page.Btn.Left := rTab.Right - Page.Btn.Width - BtnOffs;
          Page.Btn.Top := rTab.Top + BtnOffs;
        end
      end;
      Page.Btn.Visible := True;
    end;
  end
  else for i := 0 to PageCount - 1 do begin
    if TsTabSheet(Pages[i]).Btn <> nil then FreeAndNil(TsTabSheet(Pages[i]).Btn);
  end;
end;

procedure TsPageControl.SetShowCloseBtns(const Value: boolean);
begin
  if FShowCloseBtns <> Value then begin
    FShowCloseBtns := Value;
    if SkinData.Skinned and Value then begin
      UpdateBtnData;
    end;
    ArrangeButtons;
    if SkinData.Skinned then begin
      FCommonData.Invalidate;
    end;
  end;
end;

procedure TsPageControl.CloseClick(Sender: TObject);
var
  ToClose : boolean;
  Act : TacCloseAction;
begin
  ToClose := True;
  Act := acaFree;
  if Assigned(OnCloseBtnClick) then OnCloseBtnClick(Self, TsTabBtn(Sender).Page.TabIndex, ToClose, Act);
  if ToClose then begin
    if Act = acaFree then FreeAndNil(TsTabBtn(Sender).Page) else TsTabBtn(Sender).Page.TabVisible := False;
    TsTabBtn(Sender).Visible := False;
    ArrangeButtons;
    RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_UPDATENOW);
  end;
end;

procedure TsPageControl.PaintButton(DC: hdc; TabRect: TRect; State: integer; BG : hdc = 0);
Const
  sx = 'X';
var
  BtnRect : TRect;
  TmpBmp : TBitmap;
  x, y : integer;
begin
  if BtnIndex < 0 then Exit;
  BtnRect.Left := TabRect.Right - BtnWidth - BtnOffs;
  BtnRect.Top := TabRect.Top + BtnOffs;
  BtnRect.Right := TabRect.Right - BtnOffs;
  BtnRect.Bottom := TabRect.Top + BtnHeight + BtnOffs;

  TmpBmp := CreateBmp24(BtnWidth, BtnHeight);
  if BG = 0
    then BitBlt(TmpBmp.Canvas.Handle, 0, 0, BtnWidth, BtnHeight, FCommonData.FCacheBmp.Canvas.Handle, BtnRect.Left, BtnRect.Top, SRCCOPY)
    else BitBlt(TmpBmp.Canvas.Handle, 0, 0, BtnWidth, BtnHeight, BG, WidthOf(TabRect) - BtnWidth - BtnOffs, BtnOffs, SRCCOPY);

  if CloseBtnSkin = '' then DrawSkinGlyph(TmpBmp, Point(0, 0), State, 1, FCommonData.SkinManager.ma[BtnIndex]) else begin
    GlobalCacheInfo := MakeCacheInfo(FCommonData.FCacheBmp, BtnRect.Left, BtnRect.Top);

    PaintItem(BtnIndex, CloseBtnSkin, GlobalCacheInfo, True, State, Rect(0, 0, TmpBmp.Width, TmpBmp.Height),
      Point(0, 0), TmpBmp, SkinData.SkinManager);

    TmpBmp.Canvas.Brush.Style := bsClear;
    TmpBmp.Canvas.Font.Style := [fsBold];
    TmpBmp.Canvas.Font.Color := clRed;
    x := (iBtnWidth - TmpBmp.Canvas.TextWidth(sx)) div 2;
    y := (iBtnHeight - TmpBmp.Canvas.TextHeight(sx)) div 2;
    TmpBmp.Canvas.TextOut(x + integer(State = 2), y + integer(State = 2), 'X');
  end;

  BitBlt(DC, BtnRect.Left, BtnRect.Top, BtnWidth, BtnHeight, TmpBmp.Canvas.Handle, 0, 0, SRCCOPY);
  FreeAndNil(TmpBmp);
end;

procedure TsPageControl.PaintButtons(DC: hdc);
var
  i : integer;
begin
  if not FShowCloseBtns then Exit;
  for i := 0 to PageCount - 1 do if Pages[i].TabVisible and TsTabSheet(Pages[i]).UseCloseBtn then begin
    PaintButton(DC, SkinTabRect(i, Pages[i] = ActivePage), 2 * integer(Pages[i] = ActivePage));
  end;
end;

procedure TsPageControl.UpdateBtnData;
begin
  if CloseBtnSkin <> '' then begin
    BtnIndex := FCommonData.SkinManager.GetSkinIndex(CloseBtnSkin);
    if BtnIndex > -1 then begin
      BtnWidth := iBtnWidth;
      BtnHeight := iBtnWidth;
    end;
  end
  else begin
    BtnIndex := FCommonData.SkinManager.GetMaskIndex(FCommonData.SkinManager.ConstData.IndexGlobalInfo, s_GlobalInfo, s_SmallIconClose);
    if BtnIndex < 0 then BtnIndex := FCommonData.SkinManager.GetMaskIndex(FCommonData.SkinManager.ConstData.IndexGlobalInfo, s_GlobalInfo, s_BorderIconClose);
    if BtnIndex > -1 then begin
      BtnWidth := WidthOf(FCommonData.SkinManager.ma[BtnIndex].R) div FCommonData.SkinManager.ma[BtnIndex].ImageCount;
      BtnHeight := HeightOf(FCommonData.SkinManager.ma[BtnIndex].R) div (1 + FCommonData.SkinManager.ma[BtnIndex].MaskType);
    end;
  end;
end;

function TsPageControl.BtnRect(TabIndex: integer): TRect;
var
  R : TRect;
begin
  if SkinData.Skinned or (TabIndex < 0) then begin
    R := SkinTabRect(TabIndex, Pages[TabIndex] = ActivePage);
    Result := Rect(R.Right - BtnWidth - BtnOffs, R.Top + BtnOffs, R.Right - BtnOffs, R.Top + BtnHeight + BtnOffs);
  end
  else Result := Rect(0, 0, 0, 0)
end;

procedure TsPageControl.PaintButtonEx(TabIndex : integer; BtnState: integer; TabState : integer);
var
  DC : hdc;
  R : TRect;
  TmpBmp : TBitmap;
begin
  if (TabIndex < 0) or not FShowCloseBtns or not TsTabSheet(Pages[TabIndex]).UseCloseBtn then Exit;
  R := SkinTabRect(TabIndex, Pages[TabIndex] = ActivePage);
  TmpBmp := CreateBmp24(WidthOf(R), HeightOf(R));

  DrawSkinTab(TabIndex, TabState, TmpBmp, Point(-R.Left, -R.Top));
  if TabState <> 2 then begin
    BitBlt(TmpBmp.Canvas.Handle, 0, TmpBmp.Height - 5, TmpBmp.Width, 5, FCommonData.FCacheBmp.Canvas.Handle, R.Left, R.Bottom - 5, SRCCOPY);
  end;

  DC := GetDC(Handle);
  PaintButton(DC, R, BtnState, TmpBmp.Canvas.Handle);
  ReleaseDC(Handle, DC);

  FreeAndNil(TmpBmp);
end;

procedure TsPageControl.SetCloseBtnSkin(const Value: TsSkinSection);
begin
  if FCloseBtnSkin <> Value then begin
    FCloseBtnSkin := Value;
    FCommonData.Invalidate;
  end;
end;

{ TsTabSheet }

constructor TsTabSheet.Create(AOwner: TComponent);
begin
  inherited;
  FCommonData := TsTabSkinData.Create;
  Btn := nil;
  FUseCloseBtn := True;
end;

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

destructor TsTabSheet.Destroy;
begin
  FreeAndNil(FCommonData);
  inherited;
end;

procedure TsTabSheet.SetButtonSkin(const Value: TsSkinSection);
begin
  if FButtonSkin <> Value then begin
    FButtonSkin := Value;
    if PageControl <> nil then TsPageControl(PageControl).SkinData.Invalidate;
  end;
end;

procedure TsTabSheet.SetTabSkin(const Value: TsSkinSection);
begin
  if FTabSkin <> Value then begin
    FTabSkin := Value;
    if PageControl <> nil then TsPageControl(PageControl).SkinData.Invalidate;
  end;
end;

procedure TsTabSheet.SetUseCloseBtn(const Value: boolean);
begin
  if FUseCloseBtn <> Value then begin
    FUseCloseBtn := Value;
    if PageControl <> nil then TsPageControl(PageControl).SkinData.Invalidate;
  end;
end;

procedure TsTabSheet.WMPaint(var Message: TWMPaint);
var
  DC, SavedDC : hdc;
  PS : TPaintStruct;
begin
  if not (csDestroying in ComponentState) and TsPageControl(PageControl).SkinData.Skinned {v4.84} and Showing then begin
    BeginPaint(Handle, PS);
    try
      TsPageControl(PageControl).SkinData.Updating := TsPageControl(PageControl).SkinData.Updating;
      if not TsPageControl(PageControl).SkinData.Updating then begin // v4.31
        SavedDC := 0;
        if Message.DC = 0 then begin
          DC := GetDC(Handle);
          SavedDC := SaveDC(DC);
        end
        else DC := Message.DC;
        try
          CopyWinControlCache(Self, TsPageControl(PageControl).SkinData, Rect(Left, Top, 0, 0), Rect(0, 0, Width, Height), DC, False);
          sVCLUtils.PaintControls(DC, Self, True, Point(0, 0));
          SetParentUpdated(Self);
        finally
          if Message.DC = 0 then begin
            RestoreDC(DC, SavedDC);
            ReleaseDC(Handle, DC);
          end;
          EndPaint(Handle, PS);
        end;
      end
    finally
      EndPaint(Handle, PS);
    end;
  end
  else inherited;
end;

procedure TsTabSheet.WndProc(var Message: TMessage);
begin
{$IFDEF D_LOGGED}
//  AddToLog(Message);
{$ENDIF}
  if PageControl <> nil then begin
    if (Message.Msg = SM_ALPHACMD) then case Message.WParamHi of
      AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
      AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
      AC_REMOVESKIN : begin
        if Message.LParam = LongInt(TsPageControl(PageControl).SkinData.SkinManager) then begin
          Repaint;
        end;
        AlphaBroadCast(Self, Message);
      end;
      AC_SETNEWSKIN : {if Message.LParam = LongWord(TsPageControl(PageControl).SkinData.SkinManager) then} begin
        AlphaBroadCast(Self, Message);
      end;
      AC_REFRESH : begin
        if Message.LParam = LongInt(TsPageControl(PageControl).SkinData.SkinManager) then begin
          if Visible then Repaint;
        end;
        AlphaBroadCast(Self, Message);
      end;
      AC_GETCACHE : if TsPageControl(PageControl).SkinData.Skinned then begin
        SendAMessage(PageControl, AC_GETCACHE);
        GlobalCacheInfo.X := Left;
        GlobalCacheInfo.Y := Top;
      end;
      AC_GETCONTROLCOLOR : if TsPageControl(PageControl).SkinData.Skinned then begin
        SendMessage(PageControl.Handle, SM_ALPHACMD, MakeWParam(0, AC_GETCONTROLCOLOR), 0)
      end;
      AC_PREPARING : if TsPageControl(PageControl).SkinData.Skinned then begin
        Message.LParam := integer(GetBoolMsg(PageControl, AC_PREPARING));
        Exit;
      end;
      AC_CHILDCHANGED : if TsPageControl(PageControl).SkinData.Skinned then begin
        Message.LParam := integer((TsPageControl(PageControl).SkinData.SkinManager.gd[TsPageControl(PageControl).SkinData.SkinIndex].GradientPercent + TsPageControl(PageControl).SkinData.SkinManager.gd[TsPageControl(PageControl).SkinData.SkinIndex].ImagePercent > 0) or TsPageControl(PageControl).SkinData.RepaintIfMoved);
        Message.Result := Message.LParam;
        Exit;
      end;
    end
    else if TsPageControl(PageControl).SkinData.Skinned then case Message.Msg of
{      WM_PRINT : begin
        SavedDC := SaveDC(TWMPaint(Message).DC);
//        MoveWindowOrg(TWMPaint(Message).DC, Left, Top);
//        SendMessage(Handle, WM_PAINT, longint(TWMPaint(Message).DC), 1);
        sVCLUtils.PaintControls(TWMPaint(Message).DC, Self, True, Point(0, 0));
        RestoreDC(TWMPaint(Message).DC, SavedDC);
//        if ActivePage <> nil then SendMessage(ActivePage.Handle, WM_PRINT, longint(TWMPaint(Message).DC), 0);
        Exit;
      end;}
      WM_ERASEBKGND : Exit
    end;
  end;
  inherited;
end;

{ TsTabSkinData }

procedure TsTabSkinData.SetCustomColor(const Value: boolean);
begin
  FCustomColor := Value;
end;

procedure TsTabSkinData.SetCustomFont(const Value: boolean);
begin
  FCustomFont := Value;
end;

procedure TsTabSkinData.SetSkinSection(const Value: string);
begin
  FSkinSection := Value;
end;

{ TsTabBtn }

constructor TsTabBtn.Create(AOwner: TComponent);
begin
  inherited;
  Flat := True;
  UpdateGlyph;
end;

procedure TsTabBtn.UpdateGlyph;
begin
  Caption := 'X';
  Font.Style := [fsBold];
  Font.Color := clRed;
end;

end.