Archivado/Componentes.Terceros.TB2k-TBX
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
cd664460a2
Componentes.Terceros.TB2k-TBX/official/2.1.6+2.1.beta1/Source/_tb2k_2.1.6_patch.diff.txt

1749 lines
60 KiB
Plaintext
Raw Blame History

--- TB2Common.pas 2005-06-29 15:10:10.000000000 +-0400
+++ TB2Common.pas 2005-08-12 08:33:58.000000000 +-0400
@@ -882,46 +882,88 @@
Result := CreateFontIndirect(LogFont);
end;
procedure DrawRotatedText(const DC: HDC; AText: String; const ARect: TRect;
const AFormat: Cardinal);
{ Like DrawText, but draws the text at a 270 degree angle.
- The only format flag this function respects is DT_HIDEPREFIX. Text is always
- drawn centered. }
+ The format flag this function respects are
+ DT_NOPREFIX, DT_HIDEPREFIX, DT_CENTER, DT_END_ELLIPSIS, DT_NOCLIP }
var
RotatedFont, SaveFont: HFONT;
TextMetrics: TTextMetric;
- X, Y, P, I, SU, FU: Integer;
+ X, Y, P, I, SU, FU, W: Integer;
SaveAlign: UINT;
SavePen, Pen: HPEN;
+ Clip: Boolean;
+
+ function GetSize(DC: HDC; const S: string): Integer;
+ var
+ Size: TSize;
+ begin
+ GetTextExtentPoint32(DC, PChar(S), Length(S), Size);
+ Result := Size.cx;
+ end;
+
begin
+ if Length(AText) = 0 then Exit;
+
RotatedFont := CreateRotatedFont(DC);
SaveFont := SelectObject(DC, RotatedFont);
GetTextMetrics(DC, TextMetrics);
X := ARect.Left + ((ARect.Right - ARect.Left) - TextMetrics.tmHeight) div 2;
- Y := ARect.Top + ((ARect.Bottom - ARect.Top) - GetTextWidth(DC, AText, True)) div 2;
+
+ Clip := (AFormat and DT_NOCLIP) <> DT_NOCLIP;
{ Find the index of the character that should be underlined. Delete '&'
characters from the string. Like DrawText, only the last prefixed character
will be underlined. }
P := 0;
I := 1;
- while I <= Length(AText) do begin
- if AText[I] in LeadBytes then
- Inc(I)
- else if AText[I] = '&' then begin
- Delete(AText, I, 1);
- { Note: PChar cast is so that if Delete deleted the last character in
- the string, we don't step past the end of the string (which would cause
- an AV if AText is now empty), but rather look at the null character
- and treat it as an accelerator key like DrawText. }
- if PChar(AText)[I-1] <> '&' then
- P := I;
- end;
- Inc(I);
+ if (AFormat and DT_NOPREFIX) <> DT_NOPREFIX then
+ while I <= Length(AText) do begin
+ if AText[I] in LeadBytes then
+ Inc(I)
+ else if AText[I] = '&' then begin
+ Delete(AText, I, 1);
+ { Note: PChar cast is so that if Delete deleted the last character in
+ the string, we don't step past the end of the string (which would cause
+ an AV if AText is now empty), but rather look at the null character
+ and treat it as an accelerator key like DrawText. }
+ if PChar(AText)[I-1] <> '&' then
+ P := I;
+ end;
+ Inc(I);
+ end;
+
+ if (AFormat and DT_END_ELLIPSIS) = DT_END_ELLIPSIS then
+ begin
+ if (Length(AText) > 1) and (GetSize(DC, AText) > ARect.Bottom - ARect.Top) then
+ begin
+ W := ARect.Bottom - ARect.Top;
+ if W > 2 then
+ begin
+ Delete(AText, Length(AText), 1);
+ while (Length(AText) > 1) and (GetSize(DC, AText + '...') > W) do
+ Delete(AText, Length(AText), 1);
+ end
+ else AText := AText[1];
+ if P > Length(AText) then P := 0;
+ AText := AText + '...';
+ end;
+ end;
+
+ if (AFormat and DT_CENTER) = DT_CENTER then
+ Y := ARect.Top + ((ARect.Bottom - ARect.Top) - GetSize(DC, AText)) div 2
+ else
+ Y := ARect.Top;
+
+ if Clip then
+ begin
+ SaveDC(DC);
+ with ARect do IntersectClipRect(DC, Left, Top, Right, Bottom);
end;
SaveAlign := SetTextAlign(DC, TA_BOTTOM);
TextOut(DC, X, Y, PChar(AText), Length(AText));
SetTextAlign(DC, SaveAlign);
{ Underline }
@@ -933,12 +975,14 @@
SavePen := SelectObject(DC, Pen);
MoveToEx(DC, X, Y + SU, nil);
LineTo(DC, X, Y + FU);
SelectObject(DC, SavePen);
DeleteObject(Pen);
end;
+
+ if Clip then RestoreDC(DC, -1);
SelectObject(DC, SaveFont);
DeleteObject(RotatedFont);
end;
function NeedToPlaySound(const Alias: String): Boolean;
--- TB2Dock.pas 2005-07-15 14:35:04.000000000 +-0400
+++ TB2Dock.pas 2005-08-11 10:16:22.000000000 +-0400
@@ -76,15 +76,12 @@
{$ENDIF}
{ Internal }
FDisableArrangeToolbars: Integer; { Increment to disable ArrangeToolbars }
FArrangeToolbarsNeeded: Boolean;
FNonClientWidth, FNonClientHeight: Integer;
- DockList: TList; { List of the toolbars docked, and those floating and have LastDock
- pointing to the dock. Items are casted in TTBCustomDockableWindow's. }
- DockVisibleList: TList; { Similar to DockList, but lists only docked and visible toolbars }
{ Property access methods }
//function GetVersion: TToolbar97Version;
procedure SetAllowDrag(Value: Boolean);
procedure SetBackground(Value: TTBBasicBackground);
procedure SetBackgroundOnToolbars(Value: Boolean);
@@ -96,20 +93,17 @@
function GetToolbarCount: Integer;
function GetToolbars(Index: Integer): TTBCustomDockableWindow;
{ Internal }
procedure BackgroundChanged(Sender: TObject);
procedure ChangeDockList(const Insert: Boolean; const Bar: TTBCustomDockableWindow);
- procedure ChangeWidthHeight(const NewWidth, NewHeight: Integer);
procedure CommitPositions;
procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC;
const Clip: HRGN);
function GetDesignModeRowOf(const XY: Integer): Integer;
- function HasVisibleToolbars: Boolean;
procedure RelayMsgToFloatingBars(var Message: TMessage);
- function ToolbarVisibleOnDock(const AToolbar: TTBCustomDockableWindow): Boolean;
procedure ToolbarVisibilityChanged(const Bar: TTBCustomDockableWindow;
const ForceRemove: Boolean);
{ Messages }
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
@@ -122,27 +116,36 @@
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
procedure WMPrint(var Message: TMessage); message WM_PRINT;
procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT;
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
protected
+ DockList: TList; { List of the toolbars docked, and those floating and have LastDock
+ pointing to the dock. Items are casted in TTBCustomDockableWindow's. }
+ DockVisibleList: TList; { Similar to DockList, but lists only docked and visible toolbars }
+ function Accepts(ADockableWindow: TTBCustomDockableWindow): Boolean; virtual;
procedure AlignControls(AControl: TControl; var Rect: TRect); override;
+ procedure ChangeWidthHeight(const NewWidth, NewHeight: Integer);
procedure DrawBackground(DC: HDC; const DrawRect: TRect); virtual;
function GetPalette: HPALETTE; override;
+ function HasVisibleToolbars: Boolean;
procedure InvalidateBackgrounds;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetParent(AParent: TWinControl); override;
+ function ToolbarVisibleOnDock(const AToolbar: TTBCustomDockableWindow): Boolean;
procedure Paint; override;
function UsingBackground: Boolean; virtual;
+ property ArrangeToolbarsNeeded: Boolean read FArrangeToolbarsNeeded write FArrangeToolbarsNeeded;
+ property DisableArrangeToolbars: Integer read FDisableArrangeToolbars write FDisableArrangeToolbars;
public
constructor Create(AOwner: TComponent); override;
procedure CreateParams(var Params: TCreateParams); override;
destructor Destroy; override;
- procedure ArrangeToolbars;
+ procedure ArrangeToolbars; virtual;
procedure BeginUpdate;
procedure EndUpdate;
function GetCurrentRowSize(const Row: Integer; var AFullSize: Boolean): Integer;
function GetHighestRow(const HighestEffective: Boolean): Integer;
function GetMinRowSize(const Row: Integer;
const ExcludeControl: TTBCustomDockableWindow): Integer;
@@ -257,12 +260,13 @@
TTBShrinkMode = (tbsmNone, tbsmWrap, tbsmChevron);
TTBCustomDockableWindow = class(TCustomControl)
private
{ Property variables }
FAutoResize: Boolean;
+ FDblClickUndock: Boolean;
FDockPos, FDockRow, FEffectiveDockPos, FEffectiveDockRow: Integer;
FDocked: Boolean;
FCurrentDock, FDefaultDock, FLastDock: TTBDock;
FCurrentSize: Integer;
FFloating: Boolean;
FOnClose, FOnDockChanged, FOnMove, FOnRecreated,
@@ -419,12 +423,13 @@
function PaletteChanged(Foreground: Boolean): Boolean; override;
procedure SetParent(AParent: TWinControl); override;
{ Methods accessible to descendants }
procedure Arrange;
function CalcNCSizes: TPoint; virtual;
+ function CanDockTo(ADock: TTBDock): Boolean; virtual;
procedure ChangeSize(AWidth, AHeight: Integer);
function ChildControlTransparent(Ctl: TControl): Boolean; dynamic;
procedure Close;
procedure ControlExistsAtPos(const P: TPoint; var ControlExists: Boolean); virtual;
function DoArrange(CanMoveControls: Boolean; PreviousDockType: TTBDockType;
NewFloating: Boolean; NewDock: TTBDock): TPoint; virtual; abstract;
@@ -443,13 +448,16 @@
function IsAutoResized: Boolean;
procedure ResizeBegin(SizeHandle: TTBSizeHandle); dynamic;
procedure ResizeEnd; dynamic;
procedure ResizeTrack(var Rect: TRect; const OrigRect: TRect); dynamic;
procedure ResizeTrackAccept; dynamic;
procedure SizeChanging(const AWidth, AHeight: Integer); virtual;
+ property EffectiveDockPosAccess: Integer read FEffectiveDockPos write FEffectiveDockPos;
+ property EffectiveDockRowAccess: Integer read FEffectiveDockRow write FEffectiveDockRow;
public
+ property DblClickUndock: Boolean read FDblClickUndock write FDblClickUndock default True;
property Docked: Boolean read FDocked;
property Canvas;
property CurrentDock: TTBDock read FCurrentDock write SetCurrentDock stored False;
property CurrentSize: Integer read FCurrentSize write FCurrentSize;
property DockPos: Integer read FDockPos write SetDockPos default -1;
property DockRow: Integer read FDockRow write SetDockRow default 0;
@@ -1011,12 +1019,17 @@
SetBounds(Left, Top-NewHeight+Height, NewWidth, NewHeight);
alRight:
SetBounds(Left-NewWidth+Width, Top, NewWidth, NewHeight);
end;
end;
+function TTBDock.Accepts(ADockableWindow: TTBCustomDockableWindow): Boolean;
+begin
+ Result := AllowDrag;
+end;
+
procedure TTBDock.AlignControls(AControl: TControl; var Rect: TRect);
begin
ArrangeToolbars;
end;
function CompareDockRowPos(const Item1, Item2, ExtraData: Pointer): Integer; far;
@@ -2523,12 +2536,13 @@
[csAcceptsControls, csClickEvents, csDoubleClicks, csSetCaption] -
[csCaptureMouse{capturing is done manually}, csOpaque];
FAutoResize := True;
FActivateParent := True;
FBorderStyle := bsSingle;
FCloseButton := True;
+ FDblClickUndock := True;
FDockableTo := [dpTop, dpBottom, dpLeft, dpRight];
FDockableWindowStyles := [tbdsResizeEightCorner, tbdsResizeClipCursor];
FDockPos := -1;
FDragHandleStyle := dhSingle;
FEffectiveDockRow := -1;
FHideWhenInactive := True;
@@ -3020,12 +3034,17 @@
procedure TTBCustomDockableWindow.RemoveDockForm(const Form: TTBCustomForm);
begin
RemoveFromList(FDockForms, Form);
end;
+function TTBCustomDockableWindow.CanDockTo(ADock: TTBDock): Boolean;
+begin
+ Result := ADock.Position in DockableTo;
+end;
+
function TTBCustomDockableWindow.IsAutoResized: Boolean;
begin
Result := AutoResize or Assigned(CurrentDock) or Floating;
end;
procedure TTBCustomDockableWindow.ChangeSize(AWidth, AHeight: Integer);
@@ -3912,13 +3931,14 @@
if FDragSplitting then
MouseOverDock := CurrentDock
else begin
{ Check if it can dock }
MouseOverDock := nil;
if StartDocking and not PreventDocking then
- for I := 0 to DockList.Count-1 do begin
+ {for I := 0 to DockList.Count-1 do begin} {rl-}
+ for I := DockList.Count-1 downto 0 do begin {rl+} // Robert Lee: CurrentDock should not have the priority
Dock := DockList[I];
if CheckIfCanDockTo(Dock, FindDockedSize(Dock).BoundsRect) then begin
MouseOverDock := Dock;
Accept := True;
if Assigned(MouseOverDock.FOnRequestDock) then
MouseOverDock.FOnRequestDock(MouseOverDock, Self, Accept);
@@ -3988,17 +4008,12 @@
if not IsRectEmpty(MoveRect) then
Dropped;
end;
procedure BuildDockList;
- function AcceptableDock(const D: TTBDock): Boolean;
- begin
- Result := D.FAllowDrag and (D.Position in DockableTo);
- end;
-
procedure Recurse(const ParentCtl: TWinControl);
var
D: TTBDockPosition;
I: Integer;
begin
if ContainsControl(ParentCtl) or not ParentCtl.Showing then
@@ -4009,25 +4024,25 @@
if (Controls[I] is TTBDock) and (TTBDock(Controls[I]).Position = D) then
Recurse(TWinControl(Controls[I]));
for I := 0 to ParentCtl.ControlCount-1 do
if (Controls[I] is TWinControl) and not(Controls[I] is TTBDock) then
Recurse(TWinControl(Controls[I]));
end;
- if (ParentCtl is TTBDock) and AcceptableDock(TTBDock(ParentCtl)) and
+ if (ParentCtl is TTBDock) and TTBDock(ParentCtl).Accepts(Self) and CanDockTo(TTBDock(ParentCtl)) and
(DockList.IndexOf(ParentCtl) = -1) then
DockList.Add(ParentCtl);
end;
var
ParentForm: TTBCustomForm;
DockFormsList: TList;
I, J: Integer;
begin
{ Manually add CurrentDock to the DockList first so that it gets priority
over other docks }
- if Assigned(CurrentDock) and AcceptableDock(CurrentDock) then
+ if Assigned(CurrentDock) and CurrentDock.Accepts(Self) and CanDockTo(CurrentDock) then
DockList.Add(CurrentDock);
ParentForm := TBGetToolWindowParentForm(Self);
DockFormsList := TList.Create;
try
if Assigned(FDockForms) then begin
for I := 0 to Screen.{$IFDEF JR_D3}CustomFormCount{$ELSE}FormCount{$ENDIF}-1 do begin
@@ -4313,25 +4328,26 @@
end;
end;
procedure TTBCustomDockableWindow.DoubleClick;
begin
if Docked then begin
- if DockMode = dmCanFloat then begin
+ if DblClickUndock and (DockMode = dmCanFloat) then begin
Floating := True;
MoveOnScreen(True);
end;
end
- else
- if Assigned(LastDock) then
- Parent := LastDock
- else
- if Assigned(DefaultDock) then begin
- FDockRow := ForceDockAtTopRow;
- FDockPos := ForceDockAtLeftPos;
- Parent := DefaultDock;
+ else if Floating then begin
+ if Assigned(LastDock) then
+ Parent := LastDock
+ else
+ if Assigned(DefaultDock) then begin
+ FDockRow := ForceDockAtTopRow;
+ FDockPos := ForceDockAtLeftPos;
+ Parent := DefaultDock;
+ end;
end;
end;
function TTBCustomDockableWindow.IsMovable: Boolean;
begin
Result := (Docked and CurrentDock.FAllowDrag) or Floating;
--- TB2DsgnItemEditor.pas 2005-01-27 00:48:54.000000000 +-0400
+++ TB2DsgnItemEditor.pas 2005-05-17 19:26:48.000000000 +-0400
@@ -149,12 +149,18 @@
function GetValue: String; override;
end;
procedure TBRegisterItemClass(AClass: TTBCustomItemClass;
const ACaption: String; ResInstance: HINST);
+type
+ TTBDsgnEditorHook = procedure(Sender: TTBItemEditForm) of object;
+
+procedure TBRegisterDsgnEditorHook(Hook: TTBDsgnEditorHook);
+procedure TBUnregisterDsgnEditorHook(Hook: TTBDsgnEditorHook);
+
implementation
{$R *.DFM}
uses
TypInfo, CommCtrl, TB2Version, TB2Common, TB2DsgnConverter;
@@ -176,12 +182,13 @@
ImageIndex: Integer;
end;
var
ItemClasses: TList;
ItemImageList: TImageList;
+ EditFormHooks: TList;
{$IFNDEF JR_D6}
function CreateSelectionList: TDesignerSelectionList;
begin
Result := TDesignerSelectionList.Create;
end;
@@ -237,13 +244,24 @@
end;
procedure TBRegisterItemClass(AClass: TTBCustomItemClass;
const ACaption: String; ResInstance: HINST);
var
Info: PItemClassInfo;
+ I: Integer;
begin
+ if ItemClasses <> nil then
+ for I := ItemClasses.Count - 1 downto 0 do
+ begin
+ Info := ItemClasses[I];
+ if Info.ItemClass = AClass then
+ begin
+ Dispose(Info);
+ ItemClasses.Delete(I);
+ end;
+ end;
New(Info);
Info.ItemClass := AClass;
Info.Caption := ACaption;
Info.ImageIndex := LoadItemImage(ResInstance, Uppercase(AClass.ClassName));
ItemClasses.Add(Info);
end;
@@ -357,12 +375,17 @@
Item.Caption := Info.Caption;
Item.ImageIndex := GetItemClassImage(Info.ItemClass);
Item.Tag := Integer(Info.ItemClass);
Item.OnClick := MoreItemClick;
MoreMenu.Add(Item);
end;
+ { Run the hooks }
+
+ if EditFormHooks <> nil then
+ for I := 0 to EditFormHooks.Count - 1 do
+ TTBDsgnEditorHook(EditFormHooks[I]^)(Self);
end;
destructor TTBItemEditForm.Destroy;
begin
inherited;
if Assigned(FNotifyItemList) then begin
@@ -1332,17 +1355,47 @@
function TTBItemsPropertyEditor.GetValue: String;
begin
Result := '(TB2000 Items)';
end;
+
+procedure TBRegisterDsgnEditorHook(Hook: TTBDsgnEditorHook);
+var
+ H: ^TTBDsgnEditorHook;
+begin
+ New(H);
+ H^ := Hook;
+ EditFormHooks.Add(H);
+end;
+
+procedure TBUnregisterDsgnEditorHook(Hook: TTBDsgnEditorHook);
+var
+ H: ^TTBDsgnEditorHook;
+ I: Integer;
+begin
+ for I := EditFormHooks.Count - 1 downto 0 do
+ begin
+ H := EditFormHooks[I];
+ if (TMethod(H^).Code = TMethod(Hook).Code) and
+ (TMethod(H^).Data = TMethod(Hook).Data) then
+ begin
+ Dispose(H);
+ EditFormHooks.Delete(I);
+// Break;
+ end;
+ end;
+end;
+
initialization
ItemImageList := TImageList.Create(nil);
ItemImageList.Handle := ImageList_LoadImage(HInstance, 'TB2_DSGNEDITORIMAGES',
16, 0, clFuchsia, IMAGE_BITMAP, 0);
ItemClasses := TList.Create;
+ EditFormHooks := TList.Create;
AddModuleUnloadProc(UnregisterModuleItemClasses);
finalization
RemoveModuleUnloadProc(UnregisterModuleItemClasses);
FreeItemClasses;
FreeAndNil(ItemImageList);
+ FreeAndNil(EditFormHooks);
end.
--- TB2ExtItems.pas 2005-07-03 21:49:52.000000000 +-0400
+++ TB2ExtItems.pas 2005-07-11 04:36:00.000000000 +-0400
@@ -40,12 +40,17 @@
TTBEditItemOptions = set of TTBEditItemOption;
const
EditItemDefaultEditOptions = [];
EditItemDefaultEditWidth = 64;
+{ Change reasons for TTBEditItem.Text property }
+ tcrSetProperty = 0; // direct assignment to TTBEditItem.Text property
+ tcrActionLink = 1; // change comes from an action link
+ tcrEditControl = 2; // change is caused by typing in edit area
+
type
TTBEditItem = class;
TTBEditItemViewer = class;
TTBAcceptTextEvent = procedure(Sender: TObject; var NewText: String;
var Accept: Boolean) of object;
@@ -93,12 +98,13 @@
TTBEditItem = class(TTBCustomItem)
private
FCharCase: TEditCharCase;
FEditCaption: String;
FEditOptions: TTBEditItemOptions;
FEditWidth: Integer;
+ FExtendedAccept: Boolean;
FMaxLength: Integer;
FOnAcceptText: TTBAcceptTextEvent;
FOnBeginEdit: TTBBeginEditEvent;
FText: String;
function IsEditCaptionStored: Boolean;
function IsEditOptionsStored: Boolean;
@@ -109,16 +115,21 @@
procedure SetEditOptions(Value: TTBEditItemOptions);
procedure SetEditWidth(Value: Integer);
procedure SetMaxLength(Value: Integer);
procedure SetText(Value: String);
protected
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ function DoAcceptText(var NewText: string): Boolean; virtual;
procedure DoBeginEdit(Viewer: TTBEditItemViewer); virtual;
+ procedure DoTextChanging(const OldText: String; var NewText: String; Reason: Integer); virtual;
+ procedure DoTextChanged(Reason: Integer); virtual;
function GetActionLinkClass: TTBCustomItemActionLinkClass; override;
function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
function NeedToRecreateViewer(AViewer: TTBItemViewer): Boolean; override;
+ property ExtendedAccept: Boolean read FExtendedAccept write FExtendedAccept default False;
+ procedure SetTextEx(Value: String; Reason: Integer);
public
constructor Create(AOwner: TComponent); override;
procedure Clear;
procedure Click; override;
published
property Action;
@@ -143,12 +154,14 @@
property OnAcceptText: TTBAcceptTextEvent read FOnAcceptText write FOnAcceptText;
property OnBeginEdit: TTBBeginEditEvent read FOnBeginEdit write FOnBeginEdit;
property OnClick;
property OnSelect;
end;
+
+ TEditClass = class of TEdit;
TTBEditItemViewer = class(TTBItemViewer)
private
FEditControl: TEdit;
FEditControlStatus: set of (ecsContinueLoop, ecsAccept, ecsClose);
function EditLoop(const CapHandle: HWND): Boolean;
@@ -160,12 +173,13 @@
function CaptionShown: Boolean; override;
function DoExecute: Boolean; override;
function GetAccRole: Integer; override;
function GetAccValue(var Value: WideString): Boolean; override;
function GetCaptionText: String; override;
procedure GetCursor(const Pt: TPoint; var ACursor: HCURSOR); override;
+ function GetEditControlClass: TEditClass; virtual;
procedure GetEditRect(var R: TRect); virtual;
procedure MouseDown(Shift: TShiftState; X, Y: Integer;
var MouseDownOnMenu: Boolean); override;
procedure MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean); override;
procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect;
IsSelected, IsPushed, UseDisabledShadow: Boolean); override;
@@ -363,13 +377,13 @@
begin
if IsOnAcceptTextLinked then TTBEditItem(FClient).OnAcceptText := Value;
end;
procedure TTBEditItemActionLink.SetText(const Value: String);
begin
- if IsTextLinked then TTBEditItem(FClient).Text := Value;
+ if IsTextLinked then TTBEditItem(FClient).SetTextEx(Value , tcrActionLink);
end;
{ TTBEditItem }
constructor TTBEditItem.Create(AOwner: TComponent);
@@ -387,13 +401,13 @@
begin
if not CheckDefaults or (Self.EditCaption = '') then
Self.EditCaption := EditCaption;
if not CheckDefaults or (Self.EditOptions = []) then
Self.EditOptions := EditOptions;
if not CheckDefaults or (Self.Text = '') then
- Self.Text := Text;
+ Self.SetTextEx(Text, tcrActionLink);
if not CheckDefaults or not Assigned(Self.OnAcceptText) then
Self.OnAcceptText := OnAcceptText;
end;
end;
function TTBEditItem.GetActionLinkClass: TTBCustomItemActionLinkClass;
@@ -494,21 +508,47 @@
if FMaxLength <> Value then begin
FMaxLength := Value;
Change(False);
end;
end;
+function TTBEditItem.DoAcceptText(var NewText: string): Boolean;
+begin
+ Result := True;
+ if Assigned(FOnAcceptText) then FOnAcceptText(Self, NewText, Result);
+end;
+
+procedure TTBEditItem.DoTextChanging(const OldText: String; var NewText: String; Reason: Integer);
+begin
+ case FCharCase of
+ ecUpperCase: NewText := AnsiUpperCase(NewText);
+ ecLowerCase: NewText := AnsiLowerCase(NewText);
+ end;
+end;
+
+procedure TTBEditItem.DoTextChanged(Reason: Integer);
+begin
+end;
+
procedure TTBEditItem.SetText(Value: String);
begin
- case FCharCase of
- ecUpperCase: Value := AnsiUpperCase(Value);
- ecLowerCase: Value := AnsiLowerCase(Value);
- end;
+ DoTextChanging(FText, Value, tcrSetProperty);
+ if FText <> Value then begin
+ FText := Value;
+ Change(False);
+ DoTextChanged(tcrSetProperty);
+ end;
+end;
+
+procedure TTBEditItem.SetTextEx(Value: String; Reason: Integer);
+begin
+ DoTextChanging(FText, Value, Reason);
if FText <> Value then begin
FText := Value;
Change(False);
+ DoTextChanged(Reason);
end;
end;
{ TTBEditItemViewer }
@@ -516,20 +556,15 @@
var
Item: TTBEditItem;
procedure AcceptText;
var
S: String;
- Accept: Boolean;
begin
S := FEditControl.Text;
- Accept := True;
- if Assigned(Item.FOnAcceptText) then
- Item.FOnAcceptText(Self, S, Accept);
- if Accept then
- Item.Text := S;
+ if Item.DoAcceptText(S) then Item.SetTextEx(S, tcrEditControl);
end;
begin
Item := TTBEditItem(Self.Item);
if FEditControl = nil then
Exit;
@@ -555,12 +590,17 @@
{ Someone has stolen the focus from us, so 'cancel mode'. (We have to
handle WM_KILLFOCUS in addition to the upstream WM_CANCELMODE handling
since we don't always hold the mouse capture.) }
View.CancelMode;
FEditControlStatus := [ecsClose];
end;
+end;
+
+function TTBEditItemViewer.GetEditControlClass: TEditClass;
+begin
+ Result := TEdit;
end;
procedure TTBEditItemViewer.GetEditRect(var R: TRect);
var
Item: TTBEditItem;
DC: HDC;
@@ -785,12 +825,13 @@
end;
var
Item: TTBEditItem;
R: TRect;
ActiveWnd, FocusWnd: HWND;
+ S: string;
begin
Item := TTBEditItem(Self.Item);
GetEditRect(R);
if IsRectEmpty(R) then begin
Result := False;
Exit;
@@ -798,14 +839,14 @@
ActiveWnd := GetActiveWindow;
FocusWnd := GetFocus;
{ Create the edit control }
InflateRect(R, -3, -3);
- //View.FreeNotification(Self);
- FEditControl := TEdit.Create(nil);
+ //View.FreeNotification (Self);
+ FEditControl := GetEditControlClass.Create(nil);
try
FEditControl.Name := Format('%s_edit_control_%p', [ClassName,
Pointer(FEditControl)]);
FEditControl.Visible := False;
FEditControl.BorderStyle := bsNone;
FEditControl.AutoSize := False;
@@ -826,14 +867,19 @@
else
ActiveWnd := 0;
FEditControlStatus := [ecsContinueLoop];
ControlMessageLoop;
finally
+ S := FEditControl.Text;
FreeAndNil(FEditControl);
end;
+
+ with TTBEditItem(Item) do
+ if (FEditControlStatus = [ecsContinueLoop]) and ExtendedAccept then
+ if DoAcceptText(S) then SetTextEx(S, tcrEditControl);
{ ensure the area underneath the edit control is repainted immediately }
View.Window.Update;
{ If app is still active, set focus to previous control and restore capture
to CapHandle if another control hasn't taken it }
if GetActiveWindow <> 0 then begin
--- TB2Item.pas 2005-06-23 16:55:44.000000000 +-0400
+++ TB2Item.pas 2005-08-12 08:32:48.000000000 +-0400
@@ -38,12 +38,20 @@
XP with themes enabled. }
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, CommCtrl, Menus, ActnList, ImgList, TB2Anim;
+const
+ WM_TB2K_POPUPSHOWING = WM_USER + 554;
+
+ { Parameter in LParam of WM_TB2K_POPUPSHOWING }
+ TPS_ANIMSTART = 1; // animation query: if Result <> 0, do not animate!
+ TPS_ANIMFINISHED = 2; // only fired when animation thread is done
+ TPS_NOANIM = 3; // fired when animation is done, or if showing with no animation
+
type
TTBCustomItem = class;
TTBCustomItemClass = class of TTBCustomItem;
TTBCustomItemActionLink = class;
TTBCustomItemActionLinkClass = class of TTBCustomItemActionLink;
TTBItemViewer = class;
@@ -79,13 +87,13 @@
tboLongHintInMenuOnly, tboNoAutoHint, tboNoRotation, tboSameWidth,
tboShowHint, tboToolbarStyle, tboToolbarSize);
TTBItemOptions = set of TTBItemOption;
TTBItemStyle = set of (tbisSubmenu, tbisSelectable, tbisSeparator,
tbisEmbeddedGroup, tbisClicksTransparent, tbisCombo, tbisNoAutoOpen,
tbisSubitemsEditable, tbisNoLineBreak, tbisRightAlign, tbisDontSelectFirst,
- tbisRedrawOnSelChange, tbisRedrawOnMouseOverChange);
+ tbisRedrawOnSelChange, tbisRedrawOnMouseOverChange, tbisStretch);
TTBPopupAlignment = (tbpaLeft, tbpaRight, tbpaCenter);
TTBPopupEvent = procedure(Sender: TTBCustomItem; FromLink: Boolean) of object;
TTBSelectEvent = procedure(Sender: TTBCustomItem; Viewer: TTBItemViewer;
Selecting: Boolean) of object;
ETBItemError = class(Exception);
@@ -94,12 +102,24 @@
private
FLastWidth, FLastHeight: Integer;
end;
{$IFNDEF JR_D5}
TImageIndex = type Integer;
{$ENDIF}
+ TTBPopupPositionRec = record
+ PositionAsSubmenu: Boolean;
+ Alignment: TTBPopupAlignment;
+ Opposite: Boolean;
+ MonitorRect: TRect;
+ ParentItemRect: TRect;
+ NCSizeX: Integer;
+ NCSizeY: Integer;
+ X, Y, W, H: Integer;
+ AnimDir: TTBAnimationDirection;
+ PlaySound: Boolean;
+ end;
TTBCustomItem = class(TComponent)
private
FActionLink: TTBCustomItemActionLink;
FAutoCheck: Boolean;
FCaption: String;
@@ -185,12 +205,14 @@
procedure DoPopup(Sender: TTBCustomItem; FromLink: Boolean); virtual;
procedure EnabledChanged; virtual;
function GetActionLinkClass: TTBCustomItemActionLinkClass; dynamic;
function GetChevronParentView: TTBView; virtual;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; virtual;
+ procedure GetPopupPosition(ParentView: TTBView;
+ PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec); virtual;
function GetPopupWindowClass: TTBPopupWindowClass; virtual;
procedure IndexError;
procedure Loaded; override;
function NeedToRecreateViewer(AViewer: TTBItemViewer): Boolean; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
function OpenPopup(const SelectFirstItem, TrackRightButton: Boolean;
@@ -317,21 +339,21 @@
procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer);
virtual;
function CaptionShown: Boolean; dynamic;
function DoExecute: Boolean; virtual;
procedure DrawItemCaption(const Canvas: TCanvas; ARect: TRect;
const ACaption: String; ADrawDisabledShadow: Boolean; AFormat: UINT); virtual;
- procedure Entering; virtual;
+ procedure Entering(OldSelected: TTBItemViewer); virtual;
function GetAccRole: Integer; virtual;
function GetAccValue(var Value: WideString): Boolean; virtual;
function GetCaptionText: String; virtual;
procedure GetCursor(const Pt: TPoint; var ACursor: HCURSOR); virtual;
function GetImageList: TCustomImageList;
function ImageShown: Boolean;
function IsRotated: Boolean;
- function IsToolbarSize: Boolean;
+ function IsToolbarSize: Boolean; virtual;
function IsPtInButtonPart(X, Y: Integer): Boolean; virtual;
procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
procedure Leaving; virtual;
procedure LosingCapture; virtual;
procedure MouseDown(Shift: TShiftState; X, Y: Integer;
var MouseDownOnMenu: Boolean); virtual;
@@ -354,13 +376,13 @@
constructor Create(AView: TTBView; AItem: TTBCustomItem; AGroupLevel: Integer); virtual;
destructor Destroy; override;
procedure Execute(AGivePriority: Boolean);
function GetAccObject: IDispatch;
function GetHintText: String;
function IsAccessible: Boolean;
- function IsToolbarStyle: Boolean;
+ function IsToolbarStyle: Boolean; virtual;
function ScreenToClient(const P: TPoint): TPoint;
end;
PTBItemViewerArray = ^TTBItemViewerArray;
TTBItemViewerArray = array[0..$7FFFFFFF div SizeOf(TTBItemViewer)-1] of TTBItemViewer;
TTBViewOrientation = (tbvoHorizontal, tbvoVertical, tbvoFloating);
TTBEnterToolbarLoopOptions = set of (tbetMouseDown, tbetExecuteSelected,
@@ -452,12 +474,16 @@
function GetRootView: TTBView;
function HandleWMGetObject(var Message: TMessage): Boolean;
procedure InitiateActions;
procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetAccelsVisibility(AShowAccels: Boolean);
+ procedure SetState(AState: TTBViewState);
+ property DoneActionData: TTBDoneActionData read FDoneActionData write FDoneActionData;
+ property ShowDownArrow: Boolean read FShowDownArrow; {vb+}
+ property ShowUpArrow: Boolean read FShowUpArrow; {vb+}
public
constructor CreateView(AOwner: TComponent; AParentView: TTBView;
AParentItem: TTBCustomItem; AWindow: TWinControl;
AIsToolbar, ACustomizing, AUsePriorityList: Boolean); virtual;
destructor Destroy; override;
procedure BeginUpdate;
@@ -663,19 +689,22 @@
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMPrint(var Message: TMessage); message WM_PRINT;
procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT;
procedure WMTB2kStepAnimation(var Message: TMessage); message WM_TB2K_STEPANIMATION;
+ procedure WMTB2kAnimationEnded (var Message: TMessage); message WM_TB2K_ANIMATIONENDED;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWindowHandle; override;
+ function GetNCSize: TPoint; dynamic;
function GetViewClass: TTBViewClass; dynamic;
procedure Paint; override;
procedure PaintScrollArrows; virtual;
+ property AnimationDirection: TTBAnimationDirection read FAnimationDirection;
public
constructor CreatePopupWindow(AOwner: TComponent; const AParentView: TTBView;
const AItem: TTBCustomItem; const ACustomizing: Boolean); virtual;
destructor Destroy; override;
procedure BeforeDestruction; override;
@@ -811,26 +840,12 @@
procedure TBInitToolbarSystemFont;
var
ToolbarFont: TFont;
-
-implementation
-
-uses
- MMSYSTEM, TB2Consts, TB2Common, IMM, TB2Acc;
-
-var
- LastPos: TPoint;
-
-threadvar
- ClickWndRefCount: Integer;
- ClickWnd: HWND;
- ClickList: TList;
-
type
TTBModalHandler = class
private
FCreatedWnd: Boolean;
FInited: Boolean;
FWnd: HWND;
@@ -842,12 +857,29 @@
procedure Loop(const RootView: TTBView; const AMouseDown, AExecuteSelected,
AFromMSAA, TrackRightButton: Boolean);
property RootPopup: TTBPopupWindow read FRootPopup write FRootPopup;
property Wnd: HWND read FWnd;
end;
+function ProcessDoneAction(const DoneActionData: TTBDoneActionData;
+ const ReturnClickedItemOnly: Boolean): TTBCustomItem;
+
+implementation
+
+uses
+ MMSYSTEM, TB2Consts, TB2Common, IMM, TB2Acc;
+
+var
+ LastPos: TPoint;
+
+threadvar
+ ClickWndRefCount: Integer;
+ ClickWnd: HWND;
+ ClickList: TList;
+
+type
PItemChangedNotificationData = ^TItemChangedNotificationData;
TItemChangedNotificationData = record
Proc: TTBItemChangedProc;
RefCount: Integer;
end;
@@ -1678,16 +1710,17 @@
Click;
end;
var
PlayedSound: Boolean = False;
-function TTBCustomItem.CreatePopup(const ParentView: TTBView;
- const ParentViewer: TTBItemViewer; const PositionAsSubmenu, SelectFirstItem,
- Customizing: Boolean; const APopupPoint: TPoint;
- const Alignment: TTBPopupAlignment): TTBPopupWindow;
+procedure TTBCustomItem.GetPopupPosition(ParentView: TTBView;
+ PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec);
+var
+ X2, Y2: Integer;
+ RepeatCalcX: Boolean;
function CountObscured(X, Y, W, H: Integer): Integer;
var
I: Integer;
P: TPoint;
V: TTBItemViewer;
@@ -1705,129 +1738,24 @@
if V.Show and (V.BoundsRect.Left >= X) and (V.BoundsRect.Right <= W) and
(V.BoundsRect.Top >= Y) and (V.BoundsRect.Bottom <= H) then
Inc(Result);
end;
end;
-var
- EventItem, ParentItem: TTBCustomItem;
- Opposite: Boolean;
- ChevronParentView: TTBView;
- X, X2, Y, Y2, W, H: Integer;
- P: TPoint;
- RepeatCalcX: Boolean;
- ParentItemRect: TRect;
- MonitorRect: TRect;
- AnimDir: TTBAnimationDirection;
begin
- EventItem := ItemContainingItems(Self);
- if EventItem <> Self then
- EventItem.DoPopup(Self, True);
- DoPopup(Self, False);
-
- ChevronParentView := GetChevronParentView;
- if ChevronParentView = nil then
- ParentItem := Self
- else
- ParentItem := ChevronParentView.FParentItem;
-
- Opposite := Assigned(ParentView) and (vsOppositePopup in ParentView.FState);
- Result := GetPopupWindowClass.CreatePopupWindow(nil, ParentView, ParentItem,
- Customizing);
- try
- if Assigned(ChevronParentView) then begin
- ChevronParentView.FreeNotification(Result.View);
- Result.View.FChevronParentView := ChevronParentView;
- Result.View.FIsToolbar := True;
- Result.View.Style := Result.View.Style +
- (ChevronParentView.Style * [vsAlwaysShowHints]);
- Result.Color := clBtnFace;
- end;
-
- { Calculate ParentItemRect, and MonitorRect (the rectangle of the monitor
- that the popup window will be confined to) }
- if Assigned(ParentView) then begin
- ParentView.ValidatePositions;
- ParentItemRect := ParentViewer.BoundsRect;
- P := ParentView.FWindow.ClientToScreen(Point(0, 0));
- OffsetRect(ParentItemRect, P.X, P.Y);
- if not IsRectEmpty(ParentView.FMonitorRect) then
- MonitorRect := ParentView.FMonitorRect
- else
- MonitorRect := GetRectOfMonitorContainingRect(ParentItemRect, False);
- end
- else begin
- ParentItemRect.TopLeft := APopupPoint;
- ParentItemRect.BottomRight := APopupPoint;
- MonitorRect := GetRectOfMonitorContainingPoint(APopupPoint, False);
- end;
- Result.View.FMonitorRect := MonitorRect;
-
- { Initialize item positions and size of the popup window }
- if ChevronParentView = nil then
- Result.View.FMaxHeight := (MonitorRect.Bottom - MonitorRect.Top) -
- (PopupMenuWindowNCSize * 2)
- else
- Result.View.WrapOffset := (MonitorRect.Right - MonitorRect.Left) -
- (PopupMenuWindowNCSize * 2);
- if SelectFirstItem then
- Result.View.Selected := Result.View.FirstSelectable;
- Result.View.UpdatePositions;
- W := Result.Width;
- H := Result.Height;
-
- { Calculate initial X,Y position of the popup window }
- if Assigned(ParentView) then begin
- if not PositionAsSubmenu then begin
- if ChevronParentView = nil then begin
- if (ParentView = nil) or (ParentView.FOrientation <> tbvoVertical) then begin
- if GetSystemMetrics(SM_MENUDROPALIGNMENT) = 0 then
- X := ParentItemRect.Left
- else
- X := ParentItemRect.Right - W;
- Y := ParentItemRect.Bottom;
- end
- else begin
- X := ParentItemRect.Left - W;
- Y := ParentItemRect.Top;
- end;
- end
- else begin
- if ChevronParentView.FOrientation <> tbvoVertical then begin
- X := ParentItemRect.Right - W;
- Y := ParentItemRect.Bottom;
- end
- else begin
- X := ParentItemRect.Left - W;
- Y := ParentItemRect.Top;
- end;
- end;
- end
- else begin
- X := ParentItemRect.Right - PopupMenuWindowNCSize;
- Y := ParentItemRect.Top - PopupMenuWindowNCSize;
- end;
- end
- else begin
- X := APopupPoint.X;
- Y := APopupPoint.Y;
- case Alignment of
- tbpaRight: Dec(X, W);
- tbpaCenter: Dec(X, W div 2);
- end;
- end;
-
+ with PopupPositionRec do
+ begin
{ Adjust the Y position of the popup window }
{ If the window is going off the bottom of the monitor, try placing it
above the parent item }
if (Y + H > MonitorRect.Bottom) and
((ParentView = nil) or (ParentView.FOrientation <> tbvoVertical)) then begin
if not PositionAsSubmenu then
Y2 := ParentItemRect.Top
else
- Y2 := ParentItemRect.Bottom + PopupMenuWindowNCSize;
+ Y2 := ParentItemRect.Bottom + NCSizeY;
Dec(Y2, H);
{ Only place it above the parent item if it isn't going to go off the
top of the monitor }
if Y2 >= MonitorRect.Top then
Y := Y2;
end;
@@ -1897,23 +1825,23 @@
runs out of space on the screen, switch directions }
repeat
RepeatCalcX := False;
X2 := X;
if Opposite or (X2 + W > MonitorRect.Right) then begin
if Assigned(ParentView) then
- X2 := ParentItemRect.Left + PopupMenuWindowNCSize;
+ X2 := ParentItemRect.Left + NCSizeX;
Dec(X2, W);
if not Opposite then
- Include(Result.View.FState, vsOppositePopup)
+ Include(PopupWindow.View.FState, vsOppositePopup)
else begin
if X2 < MonitorRect.Left then begin
Opposite := False;
RepeatCalcX := True;
end
else
- Include(Result.View.FState, vsOppositePopup);
+ Include(PopupWindow.View.FState, vsOppositePopup);
end;
end;
until not RepeatCalcX;
X := X2;
if X < MonitorRect.Left then
X := MonitorRect.Left;
@@ -1934,14 +1862,149 @@
else begin
if X + W div 2 >= ParentItemRect.Left + (ParentItemRect.Right - ParentItemRect.Left) div 2 then
Include(AnimDir, tbadRight)
else
Include(AnimDir, tbadLeft);
end;
- Result.FAnimationDirection := AnimDir;
+ end;
+end;
+
+function TTBCustomItem.CreatePopup(const ParentView: TTBView;
+ const ParentViewer: TTBItemViewer; const PositionAsSubmenu, SelectFirstItem,
+ Customizing: Boolean; const APopupPoint: TPoint;
+ const Alignment: TTBPopupAlignment): TTBPopupWindow;
+var
+ EventItem, ParentItem: TTBCustomItem;
+ Opposite: Boolean;
+ ChevronParentView: TTBView;
+ X, Y, W, H: Integer;
+ P: TPoint;
+ ParentItemRect: TRect;
+ MonitorRect: TRect;
+ PopupRec: TTBPopupPositionRec;
+ NCSize: TPoint;
+begin
+ EventItem := ItemContainingItems(Self);
+ if EventItem <> Self then
+ EventItem.DoPopup(Self, True);
+ DoPopup(Self, False);
+
+ ChevronParentView := GetChevronParentView;
+ if ChevronParentView = nil then
+ ParentItem := Self
+ else
+ ParentItem := ChevronParentView.FParentItem;
+
+ Opposite := Assigned(ParentView) and (vsOppositePopup in ParentView.FState);
+ Result := GetPopupWindowClass.CreatePopupWindow(nil, ParentView, ParentItem,
+ Customizing);
+ try
+ if Assigned(ChevronParentView) then begin
+ ChevronParentView.FreeNotification(Result.View);
+ Result.View.FChevronParentView := ChevronParentView;
+ Result.View.FIsToolbar := True;
+ Result.View.Style := Result.View.Style +
+ (ChevronParentView.Style * [vsAlwaysShowHints]);
+ Result.Color := clBtnFace;
+ end;
+ { Calculate ParentItemRect, and MonitorRect (the rectangle of the monitor
+ that the popup window will be confined to) }
+ if Assigned(ParentView) then begin
+ ParentView.ValidatePositions;
+ ParentItemRect := ParentViewer.BoundsRect;
+ P := ParentView.FWindow.ClientToScreen(Point(0, 0));
+ OffsetRect(ParentItemRect, P.X, P.Y);
+ if not IsRectEmpty(ParentView.FMonitorRect) then
+ MonitorRect := ParentView.FMonitorRect
+ else
+ {MonitorRect := GetRectOfMonitorContainingPoint(APopupPoint, False);} {vb-}
+ MonitorRect := GetRectOfMonitorContainingPoint(APopupPoint, True); {vb+}
+ end
+ else begin
+ ParentItemRect.TopLeft := APopupPoint;
+ ParentItemRect.BottomRight := APopupPoint;
+ {MonitorRect := GetRectOfMonitorContainingPoint(APopupPoint, False);} {vb-}
+ MonitorRect := GetRectOfMonitorContainingPoint(APopupPoint, True); {vb+}
+ end;
+ Result.View.FMonitorRect := MonitorRect;
+
+ { Initialize item positions and size of the popup window }
+ NCSize := Result.GetNCSize;
+ if ChevronParentView = nil then
+ Result.View.FMaxHeight := (MonitorRect.Bottom - MonitorRect.Top) -
+ (NCSize.Y * 2)
+ else
+ Result.View.WrapOffset := (MonitorRect.Right - MonitorRect.Left) -
+ (NCSize.X * 2);
+ if SelectFirstItem then
+ Result.View.Selected := Result.View.FirstSelectable;
+ Result.View.UpdatePositions;
+ W := Result.Width;
+ H := Result.Height;
+
+ { Calculate initial X,Y position of the popup window }
+ if Assigned(ParentView) then begin
+ if not PositionAsSubmenu then begin
+ if ChevronParentView = nil then begin
+ if (ParentView = nil) or (ParentView.FOrientation <> tbvoVertical) then begin
+ if GetSystemMetrics(SM_MENUDROPALIGNMENT) = 0 then
+ X := ParentItemRect.Left
+ else
+ X := ParentItemRect.Right - W;
+ Y := ParentItemRect.Bottom;
+ end
+ else begin
+ X := ParentItemRect.Left - W;
+ Y := ParentItemRect.Top;
+ end;
+ end
+ else begin
+ if ChevronParentView.FOrientation <> tbvoVertical then begin
+ X := ParentItemRect.Right - W;
+ Y := ParentItemRect.Bottom;
+ end
+ else begin
+ X := ParentItemRect.Left - W;
+ Y := ParentItemRect.Top;
+ end;
+ end;
+ end
+ else begin
+ X := ParentItemRect.Right - NCSize.X;
+ Y := ParentItemRect.Top - NCSize.Y;
+ end;
+ end
+ else begin
+ X := APopupPoint.X;
+ Y := APopupPoint.Y;
+ case Alignment of
+ tbpaRight: Dec(X, W);
+ tbpaCenter: Dec(X, W div 2);
+ end;
+ end;
+
+ PopupRec.PositionAsSubmenu := PositionAsSubmenu;
+ PopupRec.Alignment := Alignment;
+ PopupRec.Opposite := Opposite;
+ PopupRec.MonitorRect := MonitorRect;
+ PopupRec.ParentItemRect := ParentItemRect;
+ PopupRec.NCSizeX := NCSize.X;
+ PopupRec.NCSizeY := NCSize.Y;
+ PopupRec.X := X;
+ PopupRec.Y := Y;
+ PopupRec.W := W;
+ PopupRec.H := H;
+ PopupRec.AnimDir := [];
+ PopupRec.PlaySound := True;
+ GetPopupPosition(ParentView, Result, PopupRec);
+ X := PopupRec.X;
+ Y := PopupRec.Y;
+ W := PopupRec.W;
+ H := PopupRec.H;
+ Result.FAnimationDirection := PopupRec.AnimDir;
Result.SetBounds(X, Y, W, H);
if Assigned(ParentView) then begin
Result.FreeNotification(ParentView);
ParentView.FOpenViewerWindow := Result;
ParentView.FOpenViewerView := Result.View;
ParentView.FOpenViewer := ParentViewer;
@@ -1949,13 +2012,13 @@
Include(ParentView.FState, vsDropDownMenus);
ParentView.Invalidate(ParentViewer);
ParentView.FWindow.Update;
end;
end;
Include(Result.View.FState, vsDrawInOrder);
- if not NeedToPlaySound('MenuPopup') then begin
+ if not PopupRec.PlaySound or not NeedToPlaySound('MenuPopup') then begin
{ Don't call PlaySound if we don't have to }
Result.Visible := True;
end
else begin
if not PlayedSound then begin
{ Work around Windows 2000 "bug" where there's a 1/3 second delay upon the
@@ -2626,12 +2689,13 @@
P := Pos(#9, Result);
if P <> 0 then
SetLength(Result, P-1);
end;
function TTBItemViewer.GetHintText: String;
+var P: Integer;
begin
Result := GetShortHint(Item.Hint);
{ If there is no short hint, use the caption for the hint. Like Office,
strip any trailing colon or ellipsis. }
if (Result = '') and not(tboNoAutoHint in Item.EffectiveOptions) and
(not(tbisSubmenu in Item.ItemStyle) or (tbisCombo in Item.ItemStyle) or
@@ -2643,15 +2707,22 @@
if not TCustomAction(Item.ActionLink.Action).DoHint(Result) then
Result := '';
{ Note: TControlActionLink.DoShowHint actually misinterprets the result
of DoHint, but we get it right... }
end;
{ Add shortcut text }
- if (Result <> '') and Application.HintShortCuts and
- (Item.ShortCut <> scNone) then
- Result := Format('%s (%s)', [Result, ShortCutToText(Item.ShortCut)]);
+ if (Result <> '') and Application.HintShortCuts then
+ begin
+ { Custom shortcut }
+ P := Pos(#9, Item.Caption);
+ if (P <> 0) and (P < Length(Item.Caption)) then
+ Result := Format('%s (%s)', [Result, Copy(Item.Caption, P+ 1, MaxInt)])
+ else
+ if (Item.ShortCut <> scNone) then
+ Result := Format('%s (%s)', [Result, ShortCutToText(Item.ShortCut)]);
+ end;
end;
function TTBItemViewer.CaptionShown: Boolean;
begin
Result := (GetCaptionText <> '') and (not IsToolbarSize or
(Item.ImageIndex < 0) or (Item.DisplayMode in [nbdmTextOnly, nbdmImageAndText])) or
@@ -3283,13 +3354,13 @@
procedure TTBItemViewer.LosingCapture;
begin
View.Invalidate(Self);
end;
-procedure TTBItemViewer.Entering;
+procedure TTBItemViewer.Entering(OldSelected: TTBItemViewer);
begin
if Assigned(Item.FOnSelect) then
Item.FOnSelect(Item, Self, True);
end;
procedure TTBItemViewer.Leaving;
@@ -4086,13 +4157,13 @@
FMouseOverSelected := NewMouseOverSelected;
if Assigned(OldSelected) and (tbisRedrawOnSelChange in OldSelected.Item.ItemStyle) then
Invalidate(OldSelected);
if Assigned(Value) then begin
if tbisRedrawOnSelChange in Value.Item.ItemStyle then
Invalidate(Value);
- Value.Entering;
+ Value.Entering(OldSelected);
end;
NotifyFocusEvent;
{ Handle automatic opening of a child popup }
if vsModal in FState then begin
{ If the view is a toolbar, immediately open any child popup }
@@ -4379,13 +4450,13 @@
if LastLine and not DidWrap and (AOrientation <> tbvoFloating) then begin
{ In case the toolbar is docked next to a taller/wider toolbar... }
HighestWidthOnLine := TotalSize.X;
HighestHeightOnLine := TotalSize.Y;
end;
{ Make separators on toolbars as tall/wide as the tallest/widest item }
- if tbisSeparator in Item.ItemStyle then begin
+ if [tbisSeparator, tbisStretch] * Item.ItemStyle <> [] then begin
if AOrientation <> tbvoVertical then
Pos.BoundsRect.Bottom := Pos.BoundsRect.Top + HighestHeightOnLine
else
Pos.BoundsRect.Right := Pos.BoundsRect.Left + HighestWidthOnLine;
end
else begin
@@ -5692,12 +5763,16 @@
{ Note: This doesn't remove the selection from a top-level toolbar item.
Unfortunately, we can't do 'Selected := nil' because it would destroy
child popups and that must'nt happen for the reason stated above. }
end;
+procedure TTBView.SetState(AState: TTBViewState);
+begin
+ FState := AState;
+end;
{ TTBModalHandler }
const
LSFW_LOCK = 1;
LSFW_UNLOCK = 2;
@@ -6181,15 +6256,16 @@
{ TTBPopupView }
procedure TTBPopupView.AutoSize(AWidth, AHeight: Integer);
begin
- with FWindow do
- SetBounds(Left, Top, AWidth + (PopupMenuWindowNCSize * 2),
- AHeight + (PopupMenuWindowNCSize * 2));
+ with TTBPopupWindow(FWindow) do
+ with GetNCSize do
+ SetBounds(Left, Top, AWidth + (X * 2),
+ AHeight + (Y * 2));
end;
function TTBPopupView.GetFont: TFont;
begin
Result := (Owner as TTBPopupWindow).Font;
end;
@@ -6260,12 +6336,18 @@
restored without generating a WM_PAINT message. }
if Assigned(FView) then
FView.CloseChildPopups;
inherited;
end;
+function TTBPopupWindow.GetNCSize: TPoint;
+begin
+ Result.X := PopupMenuWindowNCSize;
+ Result.Y := PopupMenuWindowNCSize;
+end;
+
function TTBPopupWindow.GetViewClass: TTBViewClass;
begin
Result := TTBPopupView;
end;
procedure TTBPopupWindow.CreateParams(var Params: TCreateParams);
@@ -6343,26 +6425,36 @@
{$IFNDEF TB2K_NO_ANIMATION}
if ((FView.ParentView = nil) or not(vsNoAnimation in FView.FParentView.FState)) and
Showing and (FView.Selected = nil) and not IsWindowVisible(WindowHandle) and
SystemParametersInfo(SPI_GETMENUANIMATION, 0, @Animate, 0) and Animate then begin
Blend := SystemParametersInfo(SPI_GETMENUFADE, 0, @Animate, 0) and Animate;
if Blend or (FAnimationDirection <> []) then begin
- TBStartAnimation(WindowHandle, Blend, FAnimationDirection);
- Exit;
+ if SendMessage(WindowHandle, WM_TB2K_POPUPSHOWING, TPS_ANIMSTART, 0) = 0 then
+ begin
+ { Start animation only if WM_TB2K_POPUPSHOWING returns zero (or not handled) }
+ TBStartAnimation(WindowHandle, Blend, FAnimationDirection);
+ Exit;
+ end;
end;
end;
{$ENDIF}
{ No animation... }
if not Showing then begin
{ Call TBEndAnimation to ensure WS_EX_LAYERED style is removed before
hiding, otherwise windows under the popup window aren't repainted
properly. }
TBEndAnimation(WindowHandle);
end;
SetWindowPos(WindowHandle, 0, 0, 0, 0, 0, ShowFlags[Showing]);
+ if Showing then SendNotifyMessage(WindowHandle, WM_TB2K_POPUPSHOWING, TPS_NOANIM, 0);
+end;
+
+procedure TTBPopupWindow.WMTB2kAnimationEnded(var Message: TMessage);
+begin
+ SendNotifyMessage(WindowHandle, WM_TB2K_POPUPSHOWING, TPS_ANIMFINISHED, 0);
end;
procedure TTBPopupWindow.WMTB2kStepAnimation(var Message: TMessage);
begin
TBStepAnimation(Message);
end;
@@ -6426,14 +6518,14 @@
begin
{ do nothing -- ignore Alt+F4 keypresses }
end;
procedure TTBPopupWindow.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
- InflateRect(Message.CalcSize_Params^.rgrc[0],
- -PopupMenuWindowNCSize, -PopupMenuWindowNCSize);
+ with GetNCSize do
+ InflateRect(Message.CalcSize_Params^.rgrc[0], -X, -Y);
inherited;
end;
procedure PopupWindowNCPaintProc(Wnd: HWND; DC: HDC; AppData: Longint);
var
R: TRect;
--- TB2MRU.pas 2005-01-05 21:56:50.000000000 +-0400
+++ TB2MRU.pas 2005-08-02 18:38:34.000000000 +-0400
@@ -50,12 +50,13 @@
procedure ClickHandler(Sender: TObject);
procedure SetHidePathExtension(Value: Boolean);
procedure SetList(Value: TStrings);
procedure SetMaxItems(Value: Integer);
protected
property Container: TTBCustomItem read FContainer;
+ function GetFirstKey: Integer; virtual;
function GetItemClass: TTBCustomItemClass; virtual;
procedure SetItemCaptions; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Add(Filename: String);
@@ -293,37 +294,39 @@
Ini.DeleteKey(Section, FPrefix + IntToStr(I));
end;
end;
procedure TTBMRUList.SetItemCaptions;
var
- I, J: Integer;
+ I, J, N: Integer;
Key: Char;
S: String;
Buf: array[0..MAX_PATH-1] of Char;
begin
while FList.Count > FMaxItems do
FList.Delete(FList.Count-1);
+ N := GetFirstKey;
for I := 0 to FContainer.Count-1 do begin
Key := #0;
- if I < 9 then
- Key := Chr(Ord('1') + I)
+ if N < 9 then
+ Key := Chr(Ord('1') + N)
else begin
{ No more numbers; try letters }
- J := I - 9;
+ J := N - 9;
if J < 26 then
Key := Chr(Ord('A') + J);
end;
S := FList[I];
if HidePathExtension and (GetFileTitle(PChar(S), Buf, SizeOf(Buf)) = 0) then
S := Buf;
S := EscapeAmpersands(S);
if Key <> #0 then
FContainer[I].Caption := Format('&%s %s', [Key, S])
else
FContainer[I].Caption := S;
+ Inc(N);
end;
end;
procedure TTBMRUList.ClickHandler(Sender: TObject);
var
I: Integer;
@@ -358,12 +361,17 @@
function TTBMRUList.GetItemClass: TTBCustomItemClass;
begin
Result := TTBCustomItem;
end;
+function TTBMRUList.GetFirstKey: Integer;
+begin
+ Result := 0;
+end;
+
{ TTBMRUListItem }
constructor TTBMRUListItem.Create(AOwner: TComponent);
begin
inherited;
--- TB2Reg.pas 2005-01-05 21:56:50.000000000 +-0400
+++ TB2Reg.pas 2005-06-07 04:59:48.000000000 +-0400
@@ -33,19 +33,12 @@
uses
Windows, SysUtils, Classes, Graphics, Controls, Dialogs, ActnList, ImgList,
{$IFDEF JR_D6} DesignIntf, DesignEditors, VCLEditors, {$ELSE} DsgnIntf, {$ENDIF}
TB2Toolbar, TB2ToolWindow, TB2Dock, TB2Item, TB2ExtItems, TB2MRU, TB2MDI,
TB2DsgnItemEditor;
-procedure Register;
-
-implementation
-
-uses
- ImgEdit;
-
{$IFDEF JR_D5}
{ TTBImageIndexPropertyEditor }
{ Unfortunately TComponentImageIndexPropertyEditor seems to be gone in
Delphi 6, so we have to use our own image index property editor class }
@@ -64,12 +57,31 @@
procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
var AWidth: Integer); {$IFNDEF JR_D6} override; {$ENDIF}
procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
const ARect: TRect; ASelected: Boolean); {$IFNDEF JR_D6} override; {$ENDIF}
end;
+{ TTBItemImageIndexPropertyEditor }
+
+type
+ TTBItemImageIndexPropertyEditor = class(TTBImageIndexPropertyEditor)
+ public
+ function GetImageListAt (Index: Integer): TCustomImageList; override;
+ end;
+
+{$ENDIF}
+
+procedure Register;
+
+implementation
+
+uses
+ ImgEdit;
+
+{$IFDEF JR_D5}
+
function TTBImageIndexPropertyEditor.GetAttributes: TPropertyAttributes;
begin
Result := [paMultiSelect, paValueList, paRevertable];
end;
function TTBImageIndexPropertyEditor.GetImageListAt(Index: Integer): TCustomImageList;
@@ -125,18 +137,12 @@
if Assigned(ImgList) then
Inc(AWidth, ImgList.Width);
end;
{ TTBItemImageIndexPropertyEditor }
-type
- TTBItemImageIndexPropertyEditor = class(TTBImageIndexPropertyEditor)
- protected
- function GetImageListAt(Index: Integer): TCustomImageList; override;
- end;
-
function TTBItemImageIndexPropertyEditor.GetImageListAt(Index: Integer): TCustomImageList;
var
C: TPersistent;
Item: TTBCustomItem;
begin
Result := nil;
--- TB2Toolbar.pas 2005-07-30 13:17:20.000000000 +-0400
+++ TB2Toolbar.pas 2005-08-01 11:16:18.000000000 +-0400
@@ -891,12 +891,17 @@
if Assigned(FView.Selected) then begin
Item := FView.Selected.Item;
if not(tboLongHintInMenuOnly in Item.EffectiveOptions) then
Hint := Item.Hint
else
Hint := '';
+
+ with TTBItemViewerAccess(FView.Find(Item)) do
+ begin
+ MouseMove(X - BoundsRect.Left, Y - BoundsRect.Top);
+ end;
end
else
Hint := '';
end;
{ Call TrackMouseEvent to be sure that we are notified when the mouse leaves
the window. We won't get a CM_MOUSELEAVE message if the mouse moves
--- TB2ToolWindow.pas 2005-01-05 21:56:50.000000000 +-0400
+++ TB2ToolWindow.pas 2005-02-23 04:57:58.000000000 +-0400
@@ -192,20 +192,30 @@
end;
function TTBToolWindow.CalcSize(ADock: TTBDock): TPoint;
begin
Result.X := FBarWidth;
Result.Y := FBarHeight;
- if Assigned(ADock) and (FullSize or Stretch) then begin
- { If docked and stretching, return the minimum size so that the toolbar
- can shrink below FBarWidth/FBarHeight }
- if not(ADock.Position in [dpLeft, dpRight]) then
- Result.X := FMinClientWidth
- else
- Result.Y := FMinClientHeight;
- end;
+ if Assigned(ADock) then
+ if FullSize then
+ begin
+ { If docked and full size, return the size corresponding to docked size }
+ if not(ADock.Position in [dpLeft, dpRight]) then
+ Result.X := ADock.ClientWidth - (Width - ClientWidth)
+ else
+ Result.Y := ADock.ClientHeight - (Height - ClientHeight);
+ end
+ else if Stretch then
+ begin
+ { If docked and stretching, return the minimum size so that the toolbar
+ can shrink below FBarWidth/FBarHeight }
+ if not(ADock.Position in [dpLeft, dpRight]) then
+ Result.X := FMinClientWidth
+ else
+ Result.Y := FMinClientHeight;
+ end;
end;
procedure TTBToolWindow.GetBaseSize(var ASize: TPoint);
begin
ASize := CalcSize(CurrentDock);
end;
Reference in New Issue View Git Blame Copy Permalink