?? tb2item.pas
字號:
published
property Images: TCustomImageList read GetImages write SetImages;
property Items: TTBRootItem read FItem;
property LinkSubitems: TTBCustomItem read GetLinkSubitems write SetLinkSubitems;
property Options: TTBItemOptions read GetOptions write SetOptions default [];
end;
TTBCustomImageList = class(TImageList)
private
FCheckedImages: TCustomImageList;
FCheckedImagesChangeLink: TChangeLink;
FDisabledImages: TCustomImageList;
FDisabledImagesChangeLink: TChangeLink;
FHotImages: TCustomImageList;
FHotImagesChangeLink: TChangeLink;
FImagesBitmap: TBitmap;
FImagesBitmapMaskColor: TColor;
procedure ChangeImages(var AImageList: TCustomImageList;
Value: TCustomImageList; AChangeLink: TChangeLink);
procedure ImageListChanged(Sender: TObject);
procedure ImagesBitmapChanged(Sender: TObject);
procedure SetCheckedImages(Value: TCustomImageList);
procedure SetDisabledImages(Value: TCustomImageList);
procedure SetHotImages(Value: TCustomImageList);
procedure SetImagesBitmap(Value: TBitmap);
procedure SetImagesBitmapMaskColor(Value: TColor);
protected
procedure DefineProperties(Filer: TFiler); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property CheckedImages: TCustomImageList read FCheckedImages write SetCheckedImages;
property DisabledImages: TCustomImageList read FDisabledImages write SetDisabledImages;
property HotImages: TCustomImageList read FHotImages write SetHotImages;
property ImagesBitmap: TBitmap read FImagesBitmap write SetImagesBitmap;
property ImagesBitmapMaskColor: TColor read FImagesBitmapMaskColor
write SetImagesBitmapMaskColor default clFuchsia;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawState(Canvas: TCanvas; X, Y, Index: Integer;
Enabled, Selected, Checked: Boolean); virtual;
end;
TTBImageList = class(TTBCustomImageList)
published
property CheckedImages;
property DisabledImages;
property HotImages;
property ImagesBitmap;
property ImagesBitmapMaskColor;
end;
const
{$IFNDEF TB2K_USE_STRICT_O2K_MENU_STYLE}
tbMenuBkColor = clMenu;
tbMenuTextColor = clMenuText;
{$ELSE}
tbMenuBkColor = clBtnFace;
tbMenuTextColor = clBtnText;
{$ENDIF}
tbMenuVerticalMargin = 4;
tbMenuImageTextSpace = 1;
tbMenuLeftTextMargin = 2;
tbMenuRightTextMargin = 3;
tbMenuSeparatorOffset = 12;
tbMenuScrollArrowHeight = 19;
tbDropdownArrowWidth = 8;
tbDropdownArrowMargin = 3;
tbDropdownComboArrowWidth = 11;
tbDropdownComboMargin = 2;
tbLineSpacing = 6;
tbLineSepOffset = 1;
tbDockedLineSepOffset = 4;
WM_TB2K_CLICKITEM = WM_USER + $100;
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;
FRootPopup: TTBPopupWindow;
procedure WndProc(var Msg: TMessage);
public
constructor Create(AExistingWnd: HWND);
destructor Destroy; override;
procedure Loop(const RootView: TTBView; const AMouseDown, AExecuteSelected,
AFromMSAA, TrackRightButton: Boolean);
property RootPopup: TTBPopupWindow read FRootPopup write FRootPopup;
property Wnd: HWND read FWnd;
end;
PItemChangedNotificationData = ^TItemChangedNotificationData;
TItemChangedNotificationData = record
Proc: TTBItemChangedProc;
RefCount: Integer;
end;
TComponentAccess = class(TComponent);
TControlAccess = class(TControl);
const
ViewTimerBaseID = 9000;
MaxGroupLevel = 10;
{ Misc. }
procedure DestroyClickWnd;
begin
if ClickWnd <> 0 then begin
{$IFDEF JR_D6}Classes.{$ENDIF} DeallocateHWnd(ClickWnd);
ClickWnd := 0;
end;
FreeAndNil(ClickList);
end;
procedure ReferenceClickWnd;
begin
Inc(ClickWndRefCount);
end;
procedure ReleaseClickWnd;
begin
Dec(ClickWndRefCount);
if ClickWndRefCount = 0 then
DestroyClickWnd;
end;
procedure QueueClick(const AItem: TObject; const AArg: Integer);
{ Adds an item to ClickList and posts a message to handle it. AItem must be
either a TTBCustomItem or TTBItemViewer. }
var
I: Integer;
begin
if ClickWnd = 0 then
ClickWnd := {$IFDEF JR_D6}Classes.{$ENDIF} AllocateHWnd(TTBCustomItem.ClickWndProc);
if ClickList = nil then
ClickList := TList.Create;
{ Add a new item to ClickList or replace an empty one }
I := ClickList.IndexOf(nil);
if I = -1 then
I := ClickList.Add(AItem)
else
ClickList[I] := AItem;
PostMessage(ClickWnd, WM_TB2K_CLICKITEM, AArg, I);
end;
procedure RemoveFromClickList(const AItem: TObject);
{ Any class that potentially calls QueueClick needs to call RemoveFromClickList
before an instance is destroyed to ensure that any references to the
instance still in ClickList are removed. }
var
I: Integer;
begin
if Assigned(ClickList) and Assigned(AItem) then
for I := 0 to ClickList.Count-1 do
if ClickList[I] = AItem then
ClickList[I] := Pointer(1);
{ ^ The special value of Pointer(1) is assigned to the item instead of
of nil because we want the index to stay reserved until the
WM_TB2K_CLICKITEM message for the index is processed. We don't want
the WM_TB2K_CLICKITEM message that's still in the queue to later
refer to a different item; this would result in queued clicks being
processed in the wrong order in a case like this:
A.PostClick; B.PostClick; A.Free; C.PostClick;
C's click would end up being processed before A's, because C would
get A's index. }
end;
function ProcessDoneAction(const DoneActionData: TTBDoneActionData;
const ReturnClickedItemOnly: Boolean): TTBCustomItem;
begin
Result := nil;
case DoneActionData.DoneAction of
tbdaNone: ;
tbdaClickItem: begin
if DoneActionData.Sound and NeedToPlaySound('MenuCommand') then
PlaySound('MenuCommand', 0, SND_ALIAS or SND_ASYNC or SND_NODEFAULT or SND_NOSTOP);
Result := DoneActionData.ClickItem;
if not ReturnClickedItemOnly then
Result.PostClick;
end;
tbdaOpenSystemMenu: begin
SendMessage(DoneActionData.Wnd, WM_SYSCOMMAND, SC_KEYMENU, DoneActionData.Key);
end;
tbdaHelpContext: begin
{ Based on code in TPopupList.WndProc: }
if Assigned(Screen.ActiveForm) and
(biHelp in Screen.ActiveForm.BorderIcons) then
Application.HelpCommand(HELP_CONTEXTPOPUP, DoneActionData.ContextID)
else
Application.HelpContext(DoneActionData.ContextID);
end;
end;
end;
{ TTBItemDataArray routines }
procedure InsertIntoItemArray(var AItems: PTBItemDataArray;
var AItemCount: Integer; NewIndex: Integer; AItem: TTBCustomItem);
begin
ReallocMem(AItems, (AItemCount+1) * SizeOf(AItems[0]));
if NewIndex < AItemCount then
System.Move(AItems[NewIndex], AItems[NewIndex+1],
(AItemCount-NewIndex) * SizeOf(AItems[0]));
AItems[NewIndex].Item := AItem;
Inc(AItemCount);
end;
procedure DeleteFromItemArray(var AItems: PTBItemDataArray;
var AItemCount: Integer; Index: Integer);
begin
Dec(AItemCount);
if Index < AItemCount then
System.Move(AItems[Index+1], AItems[Index],
(AItemCount-Index) * SizeOf(AItems[0]));
ReallocMem(AItems, AItemCount * SizeOf(AItems[0]));
end;
procedure InsertIntoViewerArray(var AItems: PTBItemViewerArray;
var AItemCount: Integer; NewIndex: Integer; AItem: TTBItemViewer);
begin
ReallocMem(AItems, (AItemCount+1) * SizeOf(AItems[0]));
if NewIndex < AItemCount then
System.Move(AItems[NewIndex], AItems[NewIndex+1],
(AItemCount-NewIndex) * SizeOf(AItems[0]));
AItems[NewIndex] := AItem;
Inc(AItemCount);
end;
procedure DeleteFromViewerArray(var AItems: PTBItemViewerArray;
var AItemCount: Integer; Index: Integer);
begin
Dec(AItemCount);
if Index < AItemCount then
System.Move(AItems[Index+1], AItems[Index],
(AItemCount-Index) * SizeOf(AItems[0]));
ReallocMem(AItems, AItemCount * SizeOf(AItems[0]));
end;
{ TTBCustomItemActionLink }
procedure TTBCustomItemActionLink.AssignClient(AClient: TObject);
begin
FClient := AClient as TTBCustomItem;
end;
{$IFDEF JR_D6}
function TTBCustomItemActionLink.IsAutoCheckLinked: Boolean;
begin
Result := (FClient.AutoCheck = (Action as TCustomAction).AutoCheck);
end;
{$ENDIF}
function TTBCustomItemActionLink.IsCaptionLinked: Boolean;
begin
Result := inherited IsCaptionLinked and
(FClient.Caption = (Action as TCustomAction).Caption);
end;
function TTBCustomItemActionLink.IsCheckedLinked: Boolean;
begin
Result := inherited IsCheckedLinked and
(FClient.Checked = (Action as TCustomAction).Checked);
end;
function TTBCustomItemActionLink.IsEnabledLinked: Boolean;
begin
Result := inherited IsEnabledLinked and
(FClient.Enabled = (Action as TCustomAction).Enabled);
end;
function TTBCustomItemActionLink.IsHelpContextLinked: Boolean;
begin
Result := inherited IsHelpContextLinked and
(FClient.HelpContext = (Action as TCustomAction).HelpContext);
end;
function TTBCustomItemActionLink.IsHintLinked: Boolean;
begin
Result := inherited IsHintLinked and
(FClient.Hint = (Action as TCustomAction).Hint);
end;
function TTBCustomItemActionLink.IsImageIndexLinked: Boolean;
begin
Result := inherited IsImageIndexLinked and
(FClient.ImageIndex = (Action as TCustomAction).ImageIndex);
end;
function TTBCustomItemActionLink.IsShortCutLinked: Boolean;
begin
Result := inherited IsShortCutLinked and
(FClient.ShortCut = (Action as TCustomAction).ShortCut);
end;
function TTBCustomItemActionLink.IsVisibleLinked: Boolean;
begin
Result := inherited IsVisibleLinked and
(FClient.Visible = (Action as TCustomAction).Visible);
end;
function TTBCustomItemActionLink.IsOnExecuteLinked: Boolean;
begin
Result := inherited IsOnExecuteLinked and
MethodsEqual(TMethod(FClient.OnClick), TMethod(Action.OnExecute));
end;
{$IFDEF JR_D6}
procedure TTBCustomItemActionLink.SetAutoCheck(Value: Boolean);
begin
if IsAutoCheckLinked then FClient.AutoCheck := Value;
end;
{$ENDIF}
procedure TTBCustomItemActionLink.SetCaption(const Value: string);
begin
if IsCaptionLinked then FClient.Caption := Value;
end;
procedure TTBCustomItemActionLink.SetChecked(Value: Boolean);
begin
if IsCheckedLinked then FClient.Checked := Value;
end;
procedure TTBCustomItemActionLink.SetEnabled(Value: Boolean);
begin
if IsEnabledLinked then FClient.Enabled := Value;
end;
procedure TTBCustomItemActionLink.SetHelpContext(Value: THelpContext);
begin
if IsHelpContextLinked then FClient.HelpContext := Value;
end;
procedure TTBCustomItemActionLink.SetHint(const Value: string);
begin
if IsHintLinked then FClient.Hint := Value;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -