我怎么能为TPageControl等人的TTTabsheet执行一个紧密的纽子?
Edit:
Delphi Version: Delphi 2010
OS: Windows XP and up
现在得到主题支持(包括<条码>、Windows UxTheme、Themes单位!)
type
TFormMain = class(TForm)
{...}
private
FCloseButtonsRect: array of TRect;
FCloseButtonMouseDownIndex: Integer;
FCloseButtonShowPushed: Boolean;
{...}
end;
{...}
procedure TFormMain.FormCreate(Sender: TObject);
var
I: Integer;
begin
PageControlCloseButton.TabWidth := 150;
PageControlCloseButton.OwnerDraw := True;
//should be done on every change of the page count
SetLength(FCloseButtonsRect, PageControlCloseButton.PageCount);
FCloseButtonMouseDownIndex := -1;
for I := 0 to Length(FCloseButtonsRect) - 1 do
begin
FCloseButtonsRect[I] := Rect(0, 0, 0, 0);
end;
end;
procedure TFormMain.PageControlCloseButtonDrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
CloseBtnSize: Integer;
PageControl: TPageControl;
TabCaption: TPoint;
CloseBtnRect: TRect;
CloseBtnDrawState: Cardinal;
CloseBtnDrawDetails: TThemedElementDetails;
begin
PageControl := Control as TPageControl;
if InRange(TabIndex, 0, Length(FCloseButtonsRect) - 1) then
begin
CloseBtnSize := 14;
TabCaption.Y := Rect.Top + 3;
if Active then
begin
CloseBtnRect.Top := Rect.Top + 4;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 6;
end
else
begin
CloseBtnRect.Top := Rect.Top + 3;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 3;
end;
CloseBtnRect.Bottom := CloseBtnRect.Top + CloseBtnSize;
CloseBtnRect.Left := CloseBtnRect.Right - CloseBtnSize;
FCloseButtonsRect[TabIndex] := CloseBtnRect;
PageControl.Canvas.FillRect(Rect);
PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y, PageControl.Pages[TabIndex].Caption);
if not UseThemes then
begin
if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
CloseBtnDrawState := DFCS_CAPTIONCLOSE + DFCS_PUSHED
else
CloseBtnDrawState := DFCS_CAPTIONCLOSE;
Windows.DrawFrameControl(PageControl.Canvas.Handle,
FCloseButtonsRect[TabIndex], DFC_CAPTION, CloseBtnDrawState);
end
else
begin
Dec(FCloseButtonsRect[TabIndex].Left);
if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonPushed)
else
CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonNormal);
ThemeServices.DrawElement(PageControl.Canvas.Handle, CloseBtnDrawDetails,
FCloseButtonsRect[TabIndex]);
end;
end;
end;
procedure TFormMain.PageControlCloseButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
I: Integer;
PageControl: TPageControl;
begin
PageControl := Sender as TPageControl;
if Button = mbLeft then
begin
for I := 0 to Length(FCloseButtonsRect) - 1 do
begin
if PtInRect(FCloseButtonsRect[I], Point(X, Y)) then
begin
FCloseButtonMouseDownIndex := I;
FCloseButtonShowPushed := True;
PageControl.Repaint;
end;
end;
end;
end;
procedure TFormMain.PageControlCloseButtonMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
PageControl: TPageControl;
Inside: Boolean;
begin
PageControl := Sender as TPageControl;
if (ssLeft in Shift) and (FCloseButtonMouseDownIndex >= 0) then
begin
Inside := PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y));
if FCloseButtonShowPushed <> Inside then
begin
FCloseButtonShowPushed := Inside;
PageControl.Repaint;
end;
end;
end;
procedure TFormMain.PageControlCloseButtonMouseLeave(Sender: TObject);
var
PageControl: TPageControl;
begin
PageControl := Sender as TPageControl;
FCloseButtonShowPushed := False;
PageControl.Repaint;
end;
procedure TFormMain.PageControlCloseButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
PageControl: TPageControl;
begin
PageControl := Sender as TPageControl;
if (Button = mbLeft) and (FCloseButtonMouseDownIndex >= 0) then
begin
if PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y)) then
begin
ShowMessage( Button + IntToStr(FCloseButtonMouseDownIndex + 1) + pressed! );
FCloseButtonMouseDownIndex := -1;
PageControl.Repaint;
end;
end;
end;
类似:
正如其他答复所建议的那样,它常常是执行这一设想的良好想法。 就在你已经使用Raize Parts,但这一特征得到了“箱子外”的支持。 Just set TRzPageControl.ShowCloseButtonOnActiveTab:= real, 并处理
[调整快乐客户]
我过去所做的只是把TBitBtn放在TPageControl右上角的图象上。 TBitBtn的双亲与TPageControl相同,因此实际上在一张表格上就没有。 然后点击该纽子:
PageControl1.ActivePage.Free;
现行《关税及贸易法》一旦解除,就通知拥有《关税及贸易法》。
I have changed a little this example: - created class TCloseTabSheet - this class has property OnClose: TNotifyEvent, which will be called if assigned - if TabSheet of of TPageControl isn t that class then there is no close button - if it is then Button showed. When you press close button it calls OnClose - now you dont need to control the array FCloseButtonsRect, cause this Rects stored at TCloseTabSheet
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Themes, Math, ExtCtrls, StdCtrls;
type TCloseTabSheet=class(TTabSheet)
private
protected
FCloseButtonRect: TRect;
FOnClose: TNotifyEvent;
procedure DoClose; virtual;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
property OnClose:TNotifyEvent read FOnClose write FOnClose;
end;
type
TMainForm = class(TForm)
PageControlCloseButton: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
procedure FormCreate(Sender: TObject);
procedure PageControlCloseButtonDrawTab(Control: TCustomTabControl; TabIndex: Integer;
const Rect: TRect; Active: Boolean);
procedure PageControlCloseButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PageControlCloseButtonMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
procedure PageControlCloseButtonMouseLeave(Sender: TObject);
procedure PageControlCloseButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure CloseTabeProc(Sender: TObject);
private
FCloseButtonMouseDownTab: TCloseTabSheet;
FCloseButtonShowPushed: Boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
constructor TCloseTabSheet.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FCloseButtonRect:=Rect(0, 0, 0, 0);
end;
destructor TCloseTabSheet.Destroy;
begin
inherited Destroy;
end;
procedure TCloseTabSheet.DoClose;
begin
if Assigned(FOnClose) then FOnClose(Self);
Free;
end;
procedure TMainForm.CloseTabeProc(Sender: TObject);
begin
ShowMessage( close );
end;
procedure TMainForm.FormCreate(Sender: TObject);
var I: Integer;
NT:TCloseTabSheet;
begin
PageControlCloseButton.TabWidth := 150;
PageControlCloseButton.OwnerDraw := True;
NT:=TCloseTabSheet.Create(PageControlCloseButton);
NT.Caption:= TabSheet4 ;
NT.PageControl:=PageControlCloseButton;
NT.OnClose:=CloseTabeProc;
FCloseButtonMouseDownTab := nil;
end;
procedure TMainForm.PageControlCloseButtonDrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
CloseBtnSize: Integer;
PageControl: TPageControl;
TabSheet:TCloseTabSheet;
TabCaption: TPoint;
CloseBtnRect: TRect;
CloseBtnDrawState: Cardinal;
CloseBtnDrawDetails: TThemedElementDetails;
begin
PageControl := Control as TPageControl;
TabCaption.Y := Rect.Top + 3;
if Active then
begin
CloseBtnRect.Top := Rect.Top + 4;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 6;
end
else
begin
CloseBtnRect.Top := Rect.Top + 3;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 3;
end;
if PageControl.Pages[TabIndex] is TCloseTabSheet then
begin
TabSheet:=PageControl.Pages[TabIndex] as TCloseTabSheet;
CloseBtnSize := 14;
CloseBtnRect.Bottom := CloseBtnRect.Top + CloseBtnSize;
CloseBtnRect.Left := CloseBtnRect.Right - CloseBtnSize;
TabSheet.FCloseButtonRect := CloseBtnRect;
PageControl.Canvas.FillRect(Rect);
PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y,
PageControl.Pages[TabIndex].Caption);
if not ThemeServices.ThemesEnabled then
begin
if (FCloseButtonMouseDownTab = TabSheet) and FCloseButtonShowPushed then
CloseBtnDrawState := DFCS_CAPTIONCLOSE + DFCS_PUSHED
else
CloseBtnDrawState := DFCS_CAPTIONCLOSE;
Windows.DrawFrameControl(PageControl.Canvas.Handle,
TabSheet.FCloseButtonRect, DFC_CAPTION, CloseBtnDrawState);
end
else
begin
Dec(TabSheet.FCloseButtonRect.Left);
if (FCloseButtonMouseDownTab = TabSheet) and FCloseButtonShowPushed then
CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonPushed)
else
CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonNormal);
ThemeServices.DrawElement(PageControl.Canvas.Handle, CloseBtnDrawDetails,
TabSheet.FCloseButtonRect);
end;
end else begin
PageControl.Canvas.FillRect(Rect);
PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y,
PageControl.Pages[TabIndex].Caption);
end;
end;
procedure TMainForm.PageControlCloseButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
I: Integer;
PageControl: TPageControl;
TabSheet:TCloseTabSheet;
begin
PageControl := Sender as TPageControl;
if Button = mbLeft then
begin
for I := 0 to PageControl.PageCount - 1 do
begin
if not (PageControl.Pages[i] is TCloseTabSheet) then Continue;
TabSheet:=PageControl.Pages[i] as TCloseTabSheet;
if PtInRect(TabSheet.FCloseButtonRect, Point(X, Y)) then
begin
FCloseButtonMouseDownTab := TabSheet;
FCloseButtonShowPushed := True;
PageControl.Repaint;
end;
end;
end;
end;
procedure TMainForm.PageControlCloseButtonMouseLeave(Sender: TObject);
var
PageControl: TPageControl;
begin
PageControl := Sender as TPageControl;
FCloseButtonShowPushed := False;
PageControl.Repaint;
end;
procedure TMainForm.PageControlCloseButtonMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
PageControl: TPageControl;
Inside: Boolean;
begin
PageControl := Sender as TPageControl;
if (ssLeft in Shift) and Assigned(FCloseButtonMouseDownTab) then
begin
Inside := PtInRect(FCloseButtonMouseDownTab.FCloseButtonRect, Point(X, Y));
if FCloseButtonShowPushed <> Inside then
begin
FCloseButtonShowPushed := Inside;
PageControl.Repaint;
end;
end;
end;
procedure TMainForm.PageControlCloseButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
PageControl: TPageControl;
begin
PageControl := Sender as TPageControl;
if (Button = mbLeft) and Assigned(FCloseButtonMouseDownTab) then
begin
if PtInRect(FCloseButtonMouseDownTab.FCloseButtonRect, Point(X, Y)) then
begin
FCloseButtonMouseDownTab.DoClose;
FCloseButtonMouseDownTab := nil;
PageControl.Repaint;
end;
end;
end;
end.
my delphi 2009 app has a basic translation system that uses GNUGetText. i had used some win API calls to prepare the fonts. i thought it was working correctly until recently when someone from Malta ...
Ok, I m going nuts here. For the last (almost) four years, I ve been putting up with some extremely bad behavior from my Delphi 5 IDE. Problems include: Seemingly random errors in coride50.bpl ...
i would like to know if there are any solution to do this. Does anyone? The big picture: I want to access data over the web, using my delphi thin clients. But i´would like to keep my server/service ...
In Delphi, there is a function StrToInt() that converts a string to an integer value; there is also IntToStr(), which does the reverse. These functions doesn t appear to be part of Oxygene, and I can ...
What is the equivalent of SetLength using Oxygene? I m trying to size an integer array. var listIndexes: array of integer; begin setLength(listIndexes,5); // doesn t work end;
How can I monitor or visualize memory fragmentation of a delphi application?
I have consistently had IDE problems in Delphi/C++Builder for years, with every version. I usually just reboot, recompile, etc. and move on. However, I keep seeing others say that the IDE is rock ...
I was trying to speed up a certain routine in an application, and my profiler, AQTime, identified one method in particular as a bottleneck. The method has been with us for years, and is part of a "...