TBXExtItems.pas 52 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757
  1. {MP}
  2. unit TBXExtItems;
  3. // TBX Package
  4. // Copyright 2001-2004 Alex A. Denisov. All Rights Reserved
  5. // See TBX.chm for license and installation instructions
  6. //
  7. // Id: TBXExtItems.pas 16 2004-05-26 02:02:55Z Alex@ZEISS
  8. interface
  9. {$I TB2Ver.inc}
  10. uses
  11. Windows, Messages, Classes, SysUtils, Graphics, Controls, StdCtrls, ExtCtrls,
  12. TBX, TBXThemes, TB2Item, TB2Toolbar, TB2ExtItems, TBXLists;
  13. const
  14. tcrNumericProperty = 3;
  15. tcrSpinButton = 4;
  16. tcrList = 5;
  17. type
  18. TTBXEditItemViewer = class;
  19. TTBXEditChange = procedure(Sender: TObject; const Text: string) of object;
  20. { TTBXEditItem }
  21. { Extends standard TTBEditItem, providing additional features and some
  22. combo box functionality, which is used in descendants }
  23. TTBXEditItem = class(TTBEditItem)
  24. private
  25. FAlignment: TAlignment;
  26. FAutoCompleteCounter: Integer;
  27. FEditorFontSettings: TFontSettings;
  28. FFontSettings: TFontSettings;
  29. FIsChanging: Boolean;
  30. FLastEditChange: string;
  31. FPasswordChar: Char;
  32. FReadOnly: Boolean;
  33. FShowImage: Boolean;
  34. FOnChange: TTBXEditChange;
  35. procedure FontSettingsChanged(Sender: TObject);
  36. procedure SetAlignment(Value: TAlignment);
  37. procedure SetPasswordChar(Value: Char);
  38. procedure SetShowImage(const Value: Boolean);
  39. procedure SetFontSettings(Value: TFontSettings);
  40. protected
  41. function DoAcceptText(var NewText: string): Boolean; override;
  42. function DoAutoComplete(var AText: string): Boolean; virtual;
  43. procedure DoBeginEdit(Viewer: TTBEditItemViewer); override;
  44. procedure DoChange(const AText: string); virtual;
  45. procedure DoTextChanged(Reason: Integer); override;
  46. function GetImageIndex: Integer; virtual;
  47. function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
  48. procedure GetPopupPosition(ParentView: TTBView; PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec); override;
  49. function GetPopupWindowClass: TTBPopupWindowClass; override;
  50. procedure HandleEditChange(Edit: TEdit); virtual;
  51. public
  52. function StartEditing(AView: TTBView): Boolean;
  53. constructor Create(AOwner: TComponent); override;
  54. destructor Destroy; override;
  55. published
  56. property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  57. property EditorFontSettings: TFontSettings read FEditorFontSettings write FEditorFontSettings;
  58. property ExtendedAccept;
  59. property FontSettings: TFontSettings read FFontSettings write SetFontSettings;
  60. property ImageIndex;
  61. property Images;
  62. property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0;
  63. property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
  64. property ShowImage: Boolean read FShowImage write SetShowImage default False;
  65. property OnChange: TTBXEditChange read FOnChange write FOnChange;
  66. property OnSelect;
  67. end;
  68. TTBXEditItemViewer = class(TTBEditItemViewer)
  69. private
  70. procedure EditChangeHandler(Sender: TObject);
  71. function MeasureEditCaption: TSize;
  72. function MeasureTextHeight: Integer;
  73. procedure HandleEditChange(Edit: TEdit);
  74. protected
  75. OldWndProc: TWndMethod;
  76. procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override;
  77. function DoExecute: Boolean; override;
  78. function HandleEditMessage(var Message: TMessage): Boolean; virtual;
  79. function GetAccRole: Integer; override;
  80. procedure GetItemInfo(const Canvas: TCanvas; out ItemInfo: TTBXItemInfo; IsHoverItem, IsPushed, UseMenuColor: Boolean); virtual;
  81. function GetEditControlClass: TEditClass; override;
  82. procedure GetEditInfo(out EditInfo: TTBXEditInfo; const ItemInfo: TTBXItemInfo); virtual;
  83. function GetIndentBefore: Integer; virtual;
  84. function GetIndentAfter: Integer; virtual;
  85. procedure GetEditRect(var R: TRect); override;
  86. function IsToolbarSize: Boolean; override;
  87. procedure NewEditWndProc(var Message: TMessage);
  88. procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsHoverItem, IsPushed, UseDisabledShadow: Boolean); override;
  89. function ShowImage: Boolean; virtual;
  90. {MP}
  91. function StripTextHotkey: Boolean; virtual;
  92. public
  93. function IsToolbarStyle: Boolean; override;
  94. end;
  95. { TTBXCustomDropDownItem }
  96. { An extended edit item tb2k with a button. The dropdown list support is
  97. implemented in descendants, such as TTBXComboBoxItem }
  98. TTBXCustomDropDownItem = class(TTBXEditItem)
  99. private
  100. FAlwaysSelectFirst: Boolean;
  101. FDropDownList: Boolean;
  102. {MP}
  103. FOnCancel: TNotifyEvent;
  104. protected
  105. function CreatePopup(const ParentView: TTBView; const ParentViewer: TTBItemViewer;
  106. const PositionAsSubmenu, SelectFirstItem, Customizing: Boolean;
  107. const APopupPoint: TPoint; const Alignment: TTBPopupAlignment): TTBPopupWindow; override;
  108. function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
  109. function GetPopupWindowClass: TTBPopupWindowClass; override;
  110. procedure DoCancel;
  111. public
  112. constructor Create(AOwner: TComponent); override;
  113. property AlwaysSelectFirst: Boolean read FAlwaysSelectFirst write FAlwaysSelectFirst default True;
  114. property DropDownList: Boolean read FDropDownList write FDropDownList default False;
  115. {MP}
  116. property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
  117. end;
  118. TTBXDropDownItem = class(TTBXCustomDropDownItem)
  119. published
  120. property AlwaysSelectFirst;
  121. property DropDownList;
  122. property LinkSubitems;
  123. property SubMenuImages;
  124. end;
  125. TTBXDropDownItemViewer = class(TTBXEditItemViewer)
  126. protected
  127. procedure GetCursor(const Pt: TPoint; var ACursor: HCURSOR); override;
  128. procedure GetEditInfo(out EditInfo: TTBXEditInfo; const ItemInfo: TTBXItemInfo); override;
  129. function GetIndentAfter: Integer; override;
  130. function HandleEditMessage(var Message: TMessage): Boolean; override;
  131. function IsPtInButtonPart(X, Y: Integer): Boolean; override;
  132. procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  133. end;
  134. { TTBXComboBoxItem }
  135. { A combination of dropdown combo with a stringlist subitem }
  136. TTBXComboBoxItem = class;
  137. TTBXCAdjustImageIndex = procedure(Sender: TTBXComboBoxItem; const AText: string;
  138. AIndex: Integer; var ImageIndex: Integer) of object;
  139. TTBXComboBoxItem = class(TTBXCustomDropDownItem)
  140. private
  141. FAutoComplete: Boolean;
  142. FList: TTBXStringList;
  143. FOnItemClick: TNotifyEvent;
  144. FOnAdjustImageIndex: TTBXCAdjustImageIndex;
  145. procedure AdjustImageIndexHandler(Sender: TTBXCustomList; AItemIndex: Integer; var ImageIndex: Integer);
  146. function GetItemIndex: Integer;
  147. function GetMaxVisibleItems: Integer;
  148. function GetMaxWidth: Integer;
  149. function GetMinWidth: Integer;
  150. function GetStrings: TStrings;
  151. function GetShowListImages: Boolean;
  152. function GetOnClearItem: TTBXLPaintEvent;
  153. function GetOnDrawItem: TTBXLPaintEvent;
  154. function GetOnMeasureHeight: TTBXLMeasureHeight;
  155. function GetOnMeasureWidth: TTBXLMeasureWidth;
  156. procedure ListChangeHandler(Sender: TObject);
  157. procedure ListClickHandler(Sender: TObject);
  158. procedure SetItemIndex(Value: Integer);
  159. procedure SetMaxVisibleItems(Value: Integer);
  160. procedure SetMaxWidth(Value: Integer);
  161. procedure SetMinWidth(Value: Integer);
  162. procedure SetOnClearItem(Value: TTBXLPaintEvent);
  163. procedure SetOnDrawItem(Value: TTBXLPaintEvent);
  164. procedure SetOnMeasureHeight(Value: TTBXLMeasureHeight);
  165. procedure SetOnMeasureWidth(Value: TTBXLMeasureWidth);
  166. procedure SetStrings(Value: TStrings);
  167. procedure SetShowListImages(Value: Boolean);
  168. protected
  169. CachedImageIndex: Integer;
  170. CacheValid: Boolean;
  171. IsChanging: Boolean;
  172. procedure AdjustImageIndex(const AText: string; AIndex: Integer; var ImageIndex: Integer); virtual;
  173. function DoAutoComplete(var AText: string): Boolean; override;
  174. procedure DoListChange; virtual;
  175. procedure DoListClick; virtual;
  176. procedure DoPopup(Sender: TTBCustomItem; FromLink: Boolean); override;
  177. function GetImageIndex: Integer; override;
  178. function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
  179. function GetStringListClass: TTBXStringListClass; virtual;
  180. procedure HandleEditChange(Edit: TEdit); override;
  181. public
  182. constructor Create(AOwner: TComponent); override;
  183. procedure Loaded; override;
  184. property ItemIndex: Integer read GetItemIndex write SetItemIndex default -1;
  185. procedure ChangeScale(M, D: Integer); override;
  186. published
  187. property AutoComplete: Boolean read FAutoComplete write FAutoComplete default True;
  188. property DropDownList;
  189. property MaxListWidth: Integer read GetMaxWidth write SetMaxWidth default 0;
  190. property MaxVisibleItems: Integer read GetMaxVisibleItems write SetMaxVisibleItems default 8;
  191. property MinListWidth: Integer read GetMinWidth write SetMinWidth default 64;
  192. property ShowListImages: Boolean read GetShowListImages write SetShowListImages default False;
  193. property Strings: TStrings read GetStrings write SetStrings;
  194. property SubMenuImages;
  195. property OnChange;
  196. property OnAdjustImageIndex: TTBXCAdjustImageIndex read FOnAdjustImageIndex write FOnAdjustImageIndex;
  197. property OnClearItem: TTBXLPaintEvent read GetOnClearItem write SetOnClearItem;
  198. property OnDrawItem: TTBXLPaintEvent read GetOnDrawItem write SetOnDrawItem;
  199. property OnItemClick: TNotifyEvent read FOnItemClick write FOnItemClick;
  200. property OnMeasureHeight: TTBXLMeasureHeight read GetOnMeasureHeight write SetOnMeasureHeight;
  201. property OnMeasureWidth: TTBXLMeasureWidth read GetOnMeasureWidth write SetOnMeasureWidth;
  202. property OnPopup;
  203. {MP}
  204. property OnCancel;
  205. end;
  206. TTBXComboBoxItemViewer = class(TTBXDropDownItemViewer)
  207. protected
  208. function HandleEditMessage(var Message: TMessage): Boolean; override;
  209. {MP}
  210. function StripTextHotkey: Boolean; override;
  211. end;
  212. { TTBXLabelItem }
  213. TTBXLabelOrientation = (tbxoAuto, tbxoHorizontal, tbxoVertical);
  214. TNonNegativeInt = 0..MaxInt;
  215. TTBXLabelItem = class(TTBCustomItem)
  216. private
  217. FCaption: TCaption;
  218. FFontSettings: TFontSettings;
  219. FMargin: Integer;
  220. FShowAccelChar: Boolean;
  221. FOrientation: TTBXLabelOrientation;
  222. {MP}
  223. FFixedSize: Integer;
  224. FSectionHeader: Boolean;
  225. FOnAdjustFont: TAdjustFontEvent;
  226. procedure FontSettingsChanged(Sender: TObject);
  227. procedure SetMargin(Value: Integer);
  228. procedure SetOrientation(Value: TTBXLabelOrientation);
  229. procedure SetCaption(const Value: TCaption);
  230. procedure SetFontSettings(Value: TFontSettings);
  231. procedure SetShowAccelChar(Value: Boolean);
  232. {MP}
  233. procedure SetFixedSize(Value: Integer);
  234. procedure SetSectionHeader(Value: Boolean);
  235. protected
  236. function GetItemViewerClass (AView: TTBView): TTBItemViewerClass; override;
  237. public
  238. constructor Create(AOwner: TComponent); override;
  239. destructor Destroy; override;
  240. procedure UpdateCaption(const Value: TCaption);
  241. published
  242. property Caption: TCaption read FCaption write SetCaption;
  243. property Enabled;
  244. property FontSettings: TFontSettings read FFontSettings write SetFontSettings;
  245. property Margin: Integer read FMargin write SetMargin default 0;
  246. property Orientation: TTBXLabelOrientation read FOrientation write SetOrientation default tbxoAuto;
  247. property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
  248. {MP}
  249. property FixedSize: Integer read FFixedSize write SetFixedSize default 0;
  250. property SectionHeader: Boolean read FSectionHeader write SetSectionHeader default False;
  251. property Visible;
  252. property OnAdjustFont: TAdjustFontEvent read FOnAdjustFont write FOnAdjustFont;
  253. end;
  254. TTBXLabelItemViewer = class(TTBItemViewer)
  255. protected
  256. function GetCaptionText: string; override;
  257. function GetIsHoriz: Boolean; virtual;
  258. procedure DoAdjustFont(AFont: TFont; StateFlags: Integer); virtual;
  259. procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override;
  260. procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect;
  261. IsHoverItem, IsPushed, UseDisabledShadow: Boolean); override;
  262. function IsToolbarSize: Boolean; override;
  263. public
  264. function IsToolbarStyle: Boolean; override;
  265. end;
  266. { TTBXColorItem }
  267. TTBXColorItem = class(TTBXCustomItem)
  268. private
  269. FColor: TColor;
  270. procedure SetColor(Value: TColor);
  271. protected
  272. function GetItemViewerClass (AView: TTBView): TTBItemViewerClass; override;
  273. public
  274. constructor Create(AOwner: TComponent); override;
  275. published
  276. property Action;
  277. property AutoCheck;
  278. property Caption;
  279. property Checked;
  280. property Color: TColor read FColor write SetColor default clWhite;
  281. property DisplayMode;
  282. property Enabled;
  283. property FontSettings;
  284. property GroupIndex;
  285. property HelpContext;
  286. { MP }
  287. property HelpKeyword;
  288. property Hint;
  289. property InheritOptions;
  290. property MaskOptions;
  291. property MinHeight;
  292. property MinWidth;
  293. property Options;
  294. { MP }
  295. property RadioItem;
  296. property ShortCut;
  297. property Visible;
  298. property OnAdjustFont;
  299. property OnClick;
  300. end;
  301. TTBXColorItemViewer = class(TTBXItemViewer)
  302. protected
  303. procedure DoPaintCaption(Canvas: TCanvas; const ClientAreaRect: TRect;
  304. var CaptionRect: TRect; IsTextRotated: Boolean; var PaintDefault: Boolean); override;
  305. function GetImageShown: Boolean; override;
  306. function GetImageSize: TSize; override;
  307. procedure DrawItemImage(Canvas: TCanvas; ARect: TRect; ItemInfo: TTBXItemInfo); override;
  308. public
  309. constructor Create(AView: TTBView; AItem: TTBCustomItem; AGroupLevel: Integer); override;
  310. end;
  311. implementation
  312. uses TBXUtils, TB2Common, TB2Consts, TypInfo, Math, ImgList, {MP}Menus, Forms, PasTools;
  313. const
  314. { Repeat intervals for spin edit items }
  315. SE_FIRSTINTERVAL = 400;
  316. SE_INTERVAL = 100;
  317. type
  318. TTBViewAccess = class(TTBView);
  319. TTBItemAccess = class(TTBCustomItem);
  320. TCustomEditAccess = class(TCustomEdit);
  321. TFontSettingsAccess = class(TFontSettings);
  322. { Misc. functions }
  323. function StartsText(const ASubText, AText: string): Boolean;
  324. var
  325. P: PChar;
  326. L, L2: Integer;
  327. begin
  328. P := PChar(AText);
  329. L := Length(ASubText);
  330. L2 := Length(AText);
  331. if L > L2 then Result := False
  332. else Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
  333. P, L, PChar(ASubText), L) = 2;
  334. end;
  335. //============================================================================//
  336. { TTBXEdit }
  337. type
  338. TTBXEdit = class(TEdit)
  339. private
  340. FAlignment: TAlignment;
  341. procedure SetAlignment(Value: TAlignment);
  342. protected
  343. procedure CreateParams(var Params: TCreateParams); override;
  344. public
  345. property Alignment: TAlignment read FAlignment write SetAlignment;
  346. end;
  347. procedure TTBXEdit.CreateParams(var Params: TCreateParams);
  348. const
  349. Alignments: array[TAlignment] of Cardinal = (ES_LEFT, ES_RIGHT, ES_CENTER);
  350. begin
  351. inherited CreateParams(Params);
  352. Params.Style := Params.Style or Alignments[FAlignment];
  353. end;
  354. procedure TTBXEdit.SetAlignment(Value: TAlignment);
  355. begin
  356. if Value <> FAlignment then
  357. begin
  358. FAlignment := Value;
  359. RecreateWnd;
  360. end;
  361. end;
  362. //============================================================================//
  363. { TTBXEditItem }
  364. constructor TTBXEditItem.Create(AOwner: TComponent);
  365. begin
  366. inherited;
  367. FEditorFontSettings := TFontSettings.Create;
  368. FFontSettings := TFontSettings.Create;
  369. TFontSettingsAccess(FEditorFontSettings).OnChange := FontSettingsChanged;
  370. TFontSettingsAccess(FFontSettings).OnChange := FontSettingsChanged;
  371. end;
  372. destructor TTBXEditItem.Destroy;
  373. begin
  374. FFontSettings.Free;
  375. FEditorFontSettings.Free;
  376. inherited;
  377. end;
  378. function TTBXEditItem.DoAcceptText(var NewText: string): Boolean;
  379. begin
  380. Result := inherited DoAcceptText(NewText);
  381. // if not Result then DoChange(Text);
  382. end;
  383. function TTBXEditItem.DoAutoComplete(var AText: string): Boolean;
  384. begin
  385. Result := False;
  386. end;
  387. procedure TTBXEditItem.DoBeginEdit(Viewer: TTBEditItemViewer);
  388. begin
  389. with Viewer do
  390. begin
  391. TTBXEdit(EditControl).Alignment := Alignment;
  392. EditControl.PasswordChar := PasswordChar;
  393. EditControl.SelectAll;
  394. EditControl.ReadOnly := ReadOnly;
  395. EditorFontSettings.Apply(EditControl.Font);
  396. FAutoCompleteCounter := 0;
  397. inherited;
  398. if Viewer is TTBXEditItemViewer then
  399. begin
  400. EditControl.OnChange := TTBXEditItemViewer(Viewer).EditChangeHandler;
  401. TTBXEditItemViewer(Viewer).OldWndProc := EditControl.WindowProc;
  402. EditControl.WindowProc := TTBXEditItemViewer(Viewer).NewEditWndProc;
  403. end;
  404. end;
  405. end;
  406. procedure TTBXEditItem.DoChange(const AText: string);
  407. begin
  408. if Assigned(FOnChange) then FOnChange(Self, AText);
  409. end;
  410. procedure TTBXEditItem.DoTextChanged(Reason: Integer);
  411. begin
  412. if not ((Reason = tcrEditControl) and (Text = FLastEditChange)) then
  413. DoChange(Text);
  414. end;
  415. procedure TTBXEditItem.FontSettingsChanged(Sender: TObject);
  416. begin
  417. Change(True);
  418. end;
  419. function TTBXEditItem.GetImageIndex: Integer;
  420. begin
  421. Result := ImageIndex;
  422. end;
  423. function TTBXEditItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
  424. begin
  425. if not (tboUseEditWhenVertical in EditOptions) and
  426. (AView.Orientation = tbvoVertical) then
  427. Result := TTBXItemViewer
  428. else
  429. Result := TTBXEditItemViewer;
  430. end;
  431. procedure TTBXEditItem.GetPopupPosition(ParentView: TTBView;
  432. PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec);
  433. var
  434. VT: Integer;
  435. begin
  436. inherited;
  437. VT := GetWinViewType(PopupWindow);
  438. PopupPositionRec.PlaySound := not (VT and PVT_LISTBOX = PVT_LISTBOX);
  439. end;
  440. function TTBXEditItem.GetPopupWindowClass: TTBPopupWindowClass;
  441. begin
  442. Result := TTBXPopupWindow;
  443. end;
  444. procedure TTBXEditItem.HandleEditChange(Edit: TEdit);
  445. var
  446. S, S2: string;
  447. begin
  448. if not FIsChanging then
  449. begin
  450. FIsChanging := True;
  451. try
  452. S := Edit.Text;
  453. S2 := S;
  454. if (Length(S) > 0) and (FAutoCompleteCounter > 0) and DoAutoComplete(S2) then
  455. begin
  456. Edit.Text := S2;
  457. Edit.SelStart := Length(S);
  458. Edit.SelLength := Length(S2) - Length(S);
  459. S := S2;
  460. end;
  461. if AnsiCompareText(S, FLastEditChange) <> 0 then
  462. begin
  463. DoChange(S); // note, Edit.Text may be different from Self.Text
  464. FLastEditChange := S;
  465. end;
  466. finally
  467. FIsChanging := False;
  468. end;
  469. end;
  470. end;
  471. procedure TTBXEditItem.SetAlignment(Value: TAlignment);
  472. begin
  473. if Value <> FAlignment then
  474. begin
  475. FAlignment := Value;
  476. Change(True);
  477. end;
  478. end;
  479. procedure TTBXEditItem.SetFontSettings(Value: TFontSettings);
  480. begin
  481. FFontSettings.Assign(Value);
  482. end;
  483. procedure TTBXEditItem.SetPasswordChar(Value: Char);
  484. begin
  485. if Value <> FPasswordChar then
  486. begin
  487. FPasswordChar := Value;
  488. Change(True);
  489. end;
  490. end;
  491. procedure TTBXEditItem.SetShowImage(const Value: Boolean);
  492. begin
  493. FShowImage := Value;
  494. Change(True);
  495. end;
  496. function TTBXEditItem.StartEditing(AView: TTBView): Boolean;
  497. var
  498. V: TTBItemViewer;
  499. SaveText: string;
  500. begin
  501. Result := False;
  502. V := AView.Find(Self);
  503. if V is TTBXEditItemViewer then
  504. begin
  505. SaveText := Text;
  506. TTBXEditItemViewer(V).DoExecute;
  507. Result := Text <> SaveText;
  508. end;
  509. end;
  510. //============================================================================//
  511. { TTBXEditItemViewer }
  512. procedure TTBXEditItemViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer);
  513. var
  514. W, B: Integer;
  515. EditBoxHeight: Integer;
  516. EditCaptionSize: TSize;
  517. begin
  518. if Self.Item is TTBXEditItem then with CurrentTheme do
  519. begin
  520. B := GetIntegerMetrics(Self, TMI_EDIT_FRAMEWIDTH);
  521. AWidth := TTBXEditItem(Item).EditWidth;
  522. if not IsToolbarStyle then
  523. begin
  524. EditCaptionSize := MeasureEditCaption;
  525. W := EditCaptionSize.CX;
  526. if W > 0 then
  527. begin
  528. Inc(W,
  529. GetIntegerMetrics(Self, TMI_MENU_LCAPTIONMARGIN) + GetIntegerMetrics(Self, TMI_MENU_RCAPTIONMARGIN) +
  530. GetIntegerMetrics(Self, TMI_MENU_IMGTEXTSPACE));
  531. end;
  532. Inc(AWidth,
  533. GetPopupMargin(Self) + GetIntegerMetrics(Self, TMI_MENU_IMGTEXTSPACE) + W +
  534. GetIntegerMetrics(Self, TMI_EDIT_MENURIGHTINDENT));
  535. end
  536. else
  537. begin
  538. EditCaptionSize.CX := 0;
  539. EditCaptionSize.CY := 0;
  540. end;
  541. EditBoxHeight := MeasureTextHeight + 1;
  542. Inc(EditBoxHeight, GetIntegerMetrics(Self, TMI_EDIT_TEXTMARGINVERT) * 2 + B * 2);
  543. AHeight := Max(EditBoxHeight, EditCaptionSize.CY);
  544. if not IsToolbarStyle then AHeight := AHeight;
  545. if EditHeightEven then AHeight := (AHeight + 1) and not $01
  546. else AHeight := AHeight or $01;
  547. end
  548. else inherited;
  549. end;
  550. procedure TTBXEditItemViewer.EditChangeHandler(Sender: TObject);
  551. begin
  552. HandleEditChange((Sender as TEdit));
  553. end;
  554. procedure TTBXEditItemViewer.HandleEditChange(Edit: TEdit);
  555. begin
  556. TTBXEditItem(Item).HandleEditChange(Edit);
  557. end;
  558. procedure TTBXEditItemViewer.GetEditInfo(out EditInfo: TTBXEditInfo; const ItemInfo: TTBXItemInfo);
  559. begin
  560. FillChar(EditInfo, SizeOf(EditInfo), 0);
  561. EditInfo.LeftBtnWidth := GetIndentBefore;
  562. EditInfo.RightBtnWidth := GetIndentAfter;
  563. end;
  564. function TTBXEditItemViewer.GetAccRole: Integer;
  565. const
  566. ROLE_SYSTEM_SPINBUTTON = $34;
  567. ROLE_SYSTEM_COMBOBOX = $2E;
  568. begin
  569. Result := inherited GetAccRole;
  570. if Self is TTBXDropDownItemViewer then Result := ROLE_SYSTEM_COMBOBOX;
  571. end;
  572. procedure TTBXEditItemViewer.GetItemInfo(const Canvas: TCanvas; out ItemInfo: TTBXItemInfo; IsHoverItem, IsPushed, UseMenuColor: Boolean);
  573. const
  574. CToolbarStyle: array [Boolean] of Integer = (0, IO_TOOLBARSTYLE);
  575. CDesigning: array [Boolean] of Integer = (0, IO_DESIGNING);
  576. var
  577. Item: TTBXEditItem;
  578. begin
  579. Item := TTBXEditItem(Self.Item);
  580. FillChar(ItemInfo, SizeOf(TTBXItemInfo), 0);
  581. ItemInfo.Control := View.Window;
  582. ItemInfo.ViewType := GetViewType(View);
  583. ItemInfo.ItemOptions := CToolbarStyle[IsToolbarStyle]
  584. or CDesigning[csDesigning in Item.ComponentState];
  585. ItemInfo.Enabled := Item.Enabled or View.Customizing;
  586. ItemInfo.Pushed := IsPushed;
  587. ItemInfo.Selected := Item.Checked;
  588. if IsHoverItem then
  589. begin
  590. if not ItemInfo.Enabled and not View.MouseOverSelected then
  591. ItemInfo.HoverKind := hkKeyboardHover
  592. else
  593. if ItemInfo.Enabled then ItemInfo.HoverKind := hkMouseHover;
  594. end
  595. else ItemInfo.HoverKind := hkNone;
  596. if not IsToolbarStyle then ItemInfo.PopupMargin := GetPopupMargin(Self);
  597. end;
  598. procedure TTBXEditItemViewer.GetEditRect(var R: TRect);
  599. const
  600. TB2K_EDIT_BORDER = 3;
  601. var
  602. W, B: Integer;
  603. begin
  604. if Item is TTBXEditItem then with CurrentTheme do
  605. begin
  606. R := BoundsRect;
  607. if not IsToolbarStyle then
  608. begin
  609. W := MeasureEditCaption.CX;
  610. if W > 0 then
  611. begin
  612. Inc(W,
  613. GetIntegerMetrics(Self, TMI_MENU_LCAPTIONMARGIN) + GetIntegerMetrics(Self, TMI_MENU_RCAPTIONMARGIN) +
  614. GetIntegerMetrics(Self, TMI_MENU_IMGTEXTSPACE));
  615. end;
  616. Inc(R.Left, GetPopupMargin(Self) + GetIntegerMetrics(Self, TMI_MENU_IMGTEXTSPACE) + W);
  617. Dec(R.Right, GetIntegerMetrics(Self, TMI_EDIT_MENURIGHTINDENT));
  618. end;
  619. B := GetIntegerMetrics(Self, TMI_EDIT_FRAMEWIDTH) - TB2K_EDIT_BORDER;
  620. InflateRect(
  621. R, -B - GetIntegerMetrics(Self, TMI_EDIT_TEXTMARGINHORZ) , -B - GetIntegerMetrics(Self, TMI_EDIT_TEXTMARGINVERT));
  622. Inc(R.Left, GetIndentBefore);
  623. Dec(R.Right, GetIndentAfter);
  624. end
  625. else inherited;
  626. end;
  627. function TTBXEditItemViewer.GetIndentAfter: Integer;
  628. begin
  629. Result := 0;
  630. end;
  631. function TTBXEditItemViewer.GetIndentBefore: Integer;
  632. var
  633. ImgList: TCustomImageList;
  634. begin
  635. if ShowImage then
  636. begin
  637. ImgList := GetImageList;
  638. if ImgList <> nil then Result := ImgList.Width + 2
  639. else Result := 0;
  640. end
  641. else Result := 0;
  642. end;
  643. function TTBXEditItemViewer.HandleEditMessage(var Message: TMessage): Boolean;
  644. const
  645. CharKeys = [VK_SPACE, $30..$5A, VK_NUMPAD0..VK_DIVIDE, $BA..$F5];
  646. begin
  647. if Message.Msg = WM_KEYDOWN then
  648. begin
  649. if Message.WParam in CharKeys then Inc(TTBXEditItem(Item).FAutoCompleteCounter)
  650. end
  651. else if Message.Msg = WM_KEYUP then
  652. begin
  653. if Message.WParam in CharKeys then Dec(TTBXEditItem(Item).FAutoCompleteCounter);
  654. end;
  655. Result := False;
  656. end;
  657. procedure TTBXEditItemViewer.NewEditWndProc(var Message: TMessage);
  658. begin
  659. if Assigned(OldWndProc) and not HandleEditMessage(Message) then OldWndProc(Message);
  660. end;
  661. {MP}
  662. function TTBXEditItemViewer.StripTextHotkey: Boolean;
  663. begin
  664. Result := False;
  665. end;
  666. procedure TTBXEditItemViewer.Paint(const Canvas: TCanvas;
  667. const ClientAreaRect: TRect; IsHoverItem, IsPushed, UseDisabledShadow: Boolean);
  668. const
  669. FillColors: array [Boolean] of Integer = (COLOR_BTNFACE, COLOR_WINDOW);
  670. TextColors: array [Boolean] of Integer = (COLOR_GRAYTEXT, COLOR_WINDOWTEXT);
  671. Alignments: array [TAlignment] of Integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
  672. var
  673. DC: HDC;
  674. Item: TTBXEditItem;
  675. S: string;
  676. R, R2: TRect;
  677. M, W: Integer;
  678. ItemInfo: TTBXItemInfo;
  679. EditInfo: TTBXEditInfo;
  680. ImgList: TCustomImageList;
  681. ImgIndex: Integer;
  682. Fnt, OldFnt: HFont;
  683. C, OldColor: TColor;
  684. begin
  685. DC := Canvas.Handle;
  686. Item := TTBXEditItem(Self.Item);
  687. GetItemInfo(Canvas, ItemInfo, IsHoverItem, IsPushed, UseDisabledShadow);
  688. GetEditInfo(EditInfo, ItemInfo);
  689. R := ClientAreaRect;
  690. if not IsToolbarStyle then with CurrentTheme do
  691. begin
  692. S := Item.EditCaption;
  693. if Length(S) > 0 then
  694. begin
  695. { measure EditCaption }
  696. Fnt := TTBXEditItem(Item).FontSettings.CreateTransformedFont(TTBViewAccess(View).GetFont.Handle, C);
  697. OldFnt := SelectObject(DC, Fnt);
  698. W :=
  699. GetTextWidth(DC, S, True) +
  700. GetIntegerMetrics(Self, TMI_MENU_IMGTEXTSPACE) +
  701. GetIntegerMetrics(Self, TMI_MENU_LCAPTIONMARGIN) +
  702. GetIntegerMetrics(Self, TMI_MENU_RCAPTIONMARGIN);
  703. SelectObject(DC, OldFnt);
  704. end
  705. else
  706. begin
  707. Fnt := 0; // to suppress compiler warning
  708. W := 0;
  709. end;
  710. M := GetPopupMargin(Self);
  711. if not EditMenuFullSelect then R.Right := M + W
  712. else Dec(R.Right, GetIntegerMetrics(Self, TMI_EDIT_MENURIGHTINDENT));
  713. PaintMenuItemFrame(Canvas, R, ItemInfo);
  714. Inc(R.Left, M + GetIntegerMetrics(Self, TMI_MENU_IMGTEXTSPACE));
  715. R.Right := ClientAreaRect.Right - GetIntegerMetrics(Self, TMI_EDIT_MENURIGHTINDENT);
  716. if Length(S) > 0 then
  717. begin
  718. Inc(R.Left, GetIntegerMetrics(Self, TMI_MENU_LCAPTIONMARGIN));
  719. C := ColorToRGB(GetItemTextColor(ItemInfo));
  720. OldFnt := SelectObject(DC, Fnt);
  721. OldColor := SetTextColor(DC, C);
  722. PaintCaption(Canvas, R, ItemInfo, S, DT_SINGLELINE or DT_LEFT or DT_VCENTER, False);
  723. SetTextColor(DC, OldColor);
  724. W := GetTextWidth(DC, S, True);
  725. SelectObject(DC, OldFnt);
  726. DeleteObject(Fnt);
  727. Inc(R.Left,
  728. W + GetIntegerMetrics(Self, TMI_MENU_RCAPTIONMARGIN) + GetIntegerMetrics(Self, TMI_MENU_IMGTEXTSPACE));
  729. end;
  730. end;
  731. CurrentTheme.PaintEditFrame(View.GetMonitor, Canvas, R, ItemInfo, EditInfo);
  732. W := CurrentTheme.GetIntegerMetrics(Self, TMI_EDIT_FRAMEWIDTH);
  733. InflateRect(
  734. R, -W - CurrentTheme.GetIntegerMetrics(Self, TMI_EDIT_TEXTMARGINHORZ),
  735. -W - CurrentTheme.GetIntegerMetrics(Self, TMI_EDIT_TEXTMARGINVERT));
  736. if ShowImage then
  737. begin
  738. ImgList := GetImageList;
  739. if ImgList <> nil then
  740. begin
  741. R2.Left := R.Left;
  742. R2.Right := R.Left + ImgList.Width;
  743. R2.Top := (R.Top + R.Bottom + 1 - ImgList.Height) div 2;
  744. R2.Bottom := R2.Top + ImgList.Height;
  745. ImgIndex := TTBXEditItem(Item).GetImageIndex;
  746. if Item.Enabled then ImgList.Draw(Canvas, R.Left, R2.Top, ImgIndex)
  747. else DrawTBXImage(Canvas, R2, ImgList, ImgIndex, ISF_DISABLED);
  748. end;
  749. end;
  750. Inc(R.Left, EditInfo.LeftBtnWidth);
  751. Dec(R.Right, EditInfo.RightBtnWidth + 1);
  752. if Item.Text <> '' then
  753. begin
  754. S := Item.Text;
  755. if StripTextHotkey then S := StripHotkey(S);
  756. if TTBXEditItem(Item).PasswordChar <> #0 then S := StringOfChar(TTBXEditItem(Item).PasswordChar, Length(S));
  757. Fnt := Item.EditorFontSettings.CreateTransformedFont(TTBViewAccess(View).GetFont.Handle, C);
  758. OldFnt := SelectObject(DC, Fnt);
  759. SetBkMode(DC, TRANSPARENT);
  760. SetBkColor(DC, CurrentTheme.GetSysColor(FillColors[Item.Enabled]));
  761. SetTextColor(DC, CurrentTheme.GetSysColor(TextColors[Item.Enabled]));
  762. // WinSCP: Align edit text with toolbar labels
  763. InflateRect(R, 0, -1);
  764. DrawText(DC, PChar(S), Length(S), R, DT_SINGLELINE or DT_NOPREFIX or Alignments[Item.Alignment]);
  765. SelectObject(DC, OldFnt);
  766. DeleteObject(Fnt);
  767. end;
  768. { if not IsToolbarStyle then
  769. begin
  770. R := ClientAreaRect;
  771. Self.GetEditRect(R);
  772. OffsetRect(R, -BoundsRect.Left, -BoundsRect.Top);
  773. Canvas.FrameRect(R);
  774. end; }
  775. end;
  776. function TTBXEditItemViewer.GetEditControlClass: TEditClass;
  777. begin
  778. Result := TTBXEdit;
  779. end;
  780. function TTBXEditItemViewer.ShowImage: Boolean;
  781. begin
  782. Result := TTBXEditItem(Item).ShowImage;
  783. end;
  784. function TTBXEditItemViewer.IsToolbarSize: Boolean;
  785. begin
  786. Result := inherited IsToolbarSize;
  787. Result := Result or ((GetViewType(View) and PVT_TOOLBOX) = PVT_TOOLBOX);
  788. end;
  789. function TTBXEditItemViewer.IsToolbarStyle: Boolean;
  790. begin
  791. Result := inherited IsToolbarStyle;
  792. Result := Result or ((GetViewType(View) and PVT_TOOLBOX) = PVT_TOOLBOX);
  793. end;
  794. function TTBXEditItemViewer.MeasureEditCaption: TSize;
  795. var
  796. DC: HDC;
  797. Fnt, OldFnt: HFont;
  798. DummyColor: TColor;
  799. TextMetric: TTextMetric;
  800. S: string;
  801. begin
  802. Result.cx := 0;
  803. Result.cy := 0;
  804. if Item is TTBXEditItem then
  805. begin
  806. S := StripAccelChars(TTBXEditItem(Item).EditCaption);
  807. if Length(S) > 0 then
  808. begin
  809. DummyColor := clWhite;
  810. DC := GetDC(0);
  811. Fnt := TTBXEditItem(Item).FontSettings.CreateTransformedFont(TTBViewAccess(View).GetFont.Handle, DummyColor);
  812. OldFnt := SelectObject(DC, Fnt);
  813. GetTextExtentPoint32(DC, PChar(S), Length(S), Result);
  814. GetTextMetrics(DC, TextMetric);
  815. Inc(Result.cy, TextMetric.tmExternalLeading);
  816. SelectObject(DC, OldFnt);
  817. DeleteObject(Fnt);
  818. ReleaseDC(0, DC);
  819. end;
  820. end;
  821. end;
  822. function TTBXEditItemViewer.MeasureTextHeight: Integer;
  823. var
  824. DC: HDC;
  825. Fnt, OldFnt: HFont;
  826. DummyColor: TColor;
  827. TextMetric: TTextMetric;
  828. begin
  829. Result := 0;
  830. if Item is TTBXEditItem then
  831. begin
  832. DummyColor := clWhite;
  833. DC := GetDC(0);
  834. Fnt := TTBXEditItem(Item).EditorFontSettings.CreateTransformedFont(TTBViewAccess(View).GetFont.Handle, DummyColor);
  835. OldFnt := SelectObject(DC, Fnt);
  836. Result := GetTextHeight(DC);
  837. GetTextMetrics(DC, TextMetric);
  838. Inc(Result, TextMetric.tmExternalLeading);
  839. SelectObject(DC, OldFnt);
  840. DeleteObject(Fnt);
  841. ReleaseDC(0, DC);
  842. end;
  843. end;
  844. function TTBXEditItemViewer.DoExecute: Boolean;
  845. begin
  846. if Item is TTBXEditItem then
  847. begin
  848. TTBXEditItem(Item).FLastEditChange := '';
  849. Result := inherited DoExecute;
  850. with TTBXEditItem(Item) do
  851. begin
  852. if FLastEditChange <> Text then DoChange(Text);
  853. FLastEditChange := '';
  854. end;
  855. end
  856. else Result := inherited DoExecute;
  857. end;
  858. //============================================================================//
  859. {MP}
  860. type
  861. TTBXDropDownWindow = class(TTBXPopupWindow)
  862. protected
  863. procedure Cancel; override;
  864. public
  865. Owner: TTBXCustomDropDownItem;
  866. end;
  867. procedure TTBXDropDownWindow.Cancel;
  868. begin
  869. inherited;
  870. Owner.DoCancel;
  871. end;
  872. {/MP}
  873. //============================================================================//
  874. { TTBXCustomDropDownItem }
  875. constructor TTBXCustomDropDownItem.Create(AOwner: TComponent);
  876. begin
  877. inherited;
  878. ItemStyle := ItemStyle + [tbisCombo, tbisSubmenu, tbisSubitemsEditable] - [tbisDontSelectFirst];
  879. FAlwaysSelectFirst := True;
  880. end;
  881. function TTBXCustomDropDownItem.CreatePopup(const ParentView: TTBView;
  882. const ParentViewer: TTBItemViewer; const PositionAsSubmenu,
  883. SelectFirstItem, Customizing: Boolean; const APopupPoint: TPoint;
  884. const Alignment: TTBPopupAlignment): TTBPopupWindow;
  885. var
  886. SelectFirst: Boolean;
  887. begin
  888. if AlwaysSelectFirst then SelectFirst := True
  889. else SelectFirst := SelectFirstItem;
  890. Result := inherited CreatePopup(ParentView, ParentViewer, PositionAsSubmenu,
  891. SelectFirst, Customizing, APopupPoint, Alignment);
  892. {MP}
  893. (Result as TTBXDropDownWindow).Owner := Self;
  894. end;
  895. {MP}
  896. procedure TTBXCustomDropDownItem.DoCancel;
  897. begin
  898. if Assigned(OnCancel) then
  899. OnCancel(Self);
  900. end;
  901. function TTBXCustomDropDownItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
  902. begin
  903. if not (tboUseEditWhenVertical in EditOptions) and (AView.Orientation = tbvoVertical) then
  904. Result := TTBXItemViewer
  905. else
  906. Result := TTBXDropDownItemViewer;
  907. end;
  908. {MP}
  909. function TTBXCustomDropDownItem.GetPopupWindowClass: TTBPopupWindowClass;
  910. begin
  911. Result := TTBXDropDownWindow;
  912. end;
  913. //----------------------------------------------------------------------------//
  914. { TTBXDropDownItemViewer }
  915. procedure TTBXDropDownItemViewer.GetCursor(const Pt: TPoint; var ACursor: HCURSOR);
  916. begin
  917. if not TTBXCustomDropDownItem(Item).DropDownList then inherited;
  918. end;
  919. procedure TTBXDropDownItemViewer.GetEditInfo(out EditInfo: TTBXEditInfo; const ItemInfo: TTBXItemInfo);
  920. const
  921. CDisabled: array [Boolean] of Integer = (EBDS_DISABLED, 0);
  922. CHot: array [Boolean] of Integer = (0, EBDS_HOT);
  923. CPressed: array [Boolean] of Integer = (0, EBDS_PRESSED);
  924. begin
  925. inherited GetEditInfo(EditInfo, ItemInfo);
  926. EditInfo.RightBtnInfo.ButtonType := EBT_DROPDOWN;
  927. EditInfo.RightBtnInfo.ButtonState := CDisabled[ItemInfo.Enabled] or
  928. CHot[ItemInfo.HoverKind = hkMouseHover] or CPressed[ItemInfo.Pushed];
  929. end;
  930. function TTBXDropDownItemViewer.GetIndentAfter: Integer;
  931. begin
  932. if IsToolbarStyle then Result := CurrentTheme.GetIntegerMetrics(Self, TMI_EDIT_BTNWIDTH)
  933. else Result := GetSystemMetricsForControl(View.Window, SM_CXMENUCHECK) + 2;
  934. end;
  935. function TTBXDropDownItemViewer.HandleEditMessage(var Message: TMessage): Boolean;
  936. begin
  937. if Message.Msg = WM_KEYDOWN then
  938. begin
  939. if TWMKeyDown(Message).CharCode = VK_F4 then
  940. begin
  941. if (View.OpenViewer = Self) // WasAlreadyOpen
  942. then View.CloseChildPopups
  943. else View.OpenChildPopup(True);
  944. Result := True;
  945. Exit;
  946. end;
  947. end;
  948. Result := inherited HandleEditMessage(Message);
  949. end;
  950. function TTBXDropDownItemViewer.IsPtInButtonPart(X, Y: Integer): Boolean;
  951. begin
  952. Result := not (tbisSubmenu in TTBXCustomDropDownItem(Item).ItemStyle);
  953. if TTBXCustomDropDownItem(Item).DropDownList then Result := False
  954. else if (tbisCombo in TTBXCustomDropDownItem(Item).ItemStyle) then
  955. Result := X < (BoundsRect.Right - BoundsRect.Left) - GetIndentAfter;
  956. end;
  957. procedure TTBXDropDownItemViewer.KeyDown(var Key: Word; Shift: TShiftState);
  958. begin
  959. if not TTBXCustomDropDownItem(Item).DropDownList then inherited;
  960. end;
  961. //============================================================================//
  962. { TTBXComboBoxItem }
  963. procedure TTBXComboBoxItem.AdjustImageIndex(const AText: string;
  964. AIndex: Integer; var ImageIndex: Integer);
  965. begin
  966. if Assigned(FOnAdjustImageIndex) then FOnAdjustImageIndex(Self, AText, AIndex, ImageIndex);
  967. end;
  968. procedure TTBXComboBoxItem.AdjustImageIndexHandler(Sender: TTBXCustomList;
  969. AItemIndex: Integer; var ImageIndex: Integer);
  970. begin
  971. AdjustImageIndex(FList.Strings[AItemIndex], AItemIndex, ImageIndex);
  972. end;
  973. constructor TTBXComboBoxItem.Create(AOwner: TComponent);
  974. begin
  975. inherited;
  976. ItemStyle := ItemStyle - [tbisSubItemsEditable];
  977. FAutoComplete := True;
  978. FList := GetStringListClass.Create(Self);
  979. FList.OnChange := ListChangeHandler;
  980. FList.OnClick := ListClickHandler;
  981. FList.OnAdjustImageIndex := AdjustImageIndexHandler;
  982. MinListWidth := 64;
  983. end;
  984. function TTBXComboBoxItem.DoAutoComplete(var AText: string): Boolean;
  985. var
  986. I: Integer;
  987. S, R: string;
  988. TemplateL, MinL, L: Integer;
  989. begin
  990. Result := False;
  991. if Length(AText) > 0 then
  992. begin
  993. { choose the shortest matching string from items }
  994. TemplateL := Length(AText);
  995. MinL := MaxInt;
  996. SetLength(R, 0);
  997. for I := 0 to FList.Strings.Count - 1 do
  998. begin
  999. S := FList.Strings[I];
  1000. L := Length(S);
  1001. if (L >= TemplateL) and (L < MinL) and StartsText(AText, S) then
  1002. begin
  1003. R := S;
  1004. MinL := L;
  1005. if MinL = TemplateL then Break;
  1006. end;
  1007. end;
  1008. Result := Length(R) > 0;
  1009. if Result then AText := R;
  1010. end;
  1011. end;
  1012. procedure TTBXComboBoxItem.DoListChange;
  1013. begin
  1014. { Update text in edit item. This will call OnChange automatically }
  1015. if (FList.ItemIndex >= 0) and (FList.ItemIndex < FList.Strings.Count) then
  1016. begin
  1017. IsChanging := True;
  1018. try
  1019. if Text <> FList.Strings[Flist.ItemIndex] then
  1020. begin
  1021. SetTextEx(FList.Strings[FList.ItemIndex], tcrList);
  1022. end;
  1023. finally
  1024. IsChanging := False;
  1025. end;
  1026. end;
  1027. end;
  1028. procedure TTBXComboBoxItem.DoListClick;
  1029. begin
  1030. if Assigned(FOnItemClick) then FOnItemClick(Self);
  1031. end;
  1032. procedure TTBXComboBoxItem.DoPopup(Sender: TTBCustomItem; FromLink: Boolean);
  1033. begin
  1034. inherited;
  1035. FList.ItemIndex := FList.Strings.IndexOf(Text);
  1036. end;
  1037. function TTBXComboBoxItem.GetImageIndex: Integer;
  1038. begin
  1039. if not CacheValid then
  1040. begin
  1041. CachedImageIndex := ImageIndex;
  1042. if ItemIndex >= 0 then CachedImageIndex := ItemIndex;
  1043. AdjustImageIndex(Text, -1, CachedImageIndex);
  1044. CacheValid := True;
  1045. end;
  1046. Result := CachedImageIndex;
  1047. end;
  1048. function TTBXComboBoxItem.GetItemIndex: Integer;
  1049. begin
  1050. Result := FList.ItemIndex;
  1051. end;
  1052. function TTBXComboBoxItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
  1053. begin
  1054. if not (tboUseEditWhenVertical in EditOptions) and
  1055. (AView.Orientation = tbvoVertical) then
  1056. Result := TTBXItemViewer
  1057. else
  1058. Result := TTBXComboBoxItemViewer;
  1059. end;
  1060. function TTBXComboBoxItem.GetMaxVisibleItems: Integer;
  1061. begin
  1062. Result := FList.MaxVisibleItems;
  1063. end;
  1064. function TTBXComboBoxItem.GetMaxWidth: Integer;
  1065. begin
  1066. Result := FList.MaxWidth;
  1067. end;
  1068. function TTBXComboBoxItem.GetMinWidth: Integer;
  1069. begin
  1070. Result := FList.MinWidth;
  1071. end;
  1072. function TTBXComboBoxItem.GetOnClearItem: TTBXLPaintEvent;
  1073. begin
  1074. Result := FList.OnClearItem;
  1075. end;
  1076. function TTBXComboBoxItem.GetOnDrawItem: TTBXLPaintEvent;
  1077. begin
  1078. Result := FList.OnDrawItem;
  1079. end;
  1080. function TTBXComboBoxItem.GetOnMeasureHeight: TTBXLMeasureHeight;
  1081. begin
  1082. Result := FList.OnMeasureHeight;
  1083. end;
  1084. function TTBXComboBoxItem.GetOnMeasureWidth: TTBXLMeasureWidth;
  1085. begin
  1086. Result := FList.OnMeasureWidth;
  1087. end;
  1088. function TTBXComboBoxItem.GetShowListImages: Boolean;
  1089. begin
  1090. Result := FList.ShowImages;
  1091. end;
  1092. function TTBXComboBoxItem.GetStringListClass: TTBXStringListClass;
  1093. begin
  1094. Result := TTBXStringList;
  1095. end;
  1096. function TTBXComboBoxItem.GetStrings: TStrings;
  1097. begin
  1098. Result := FList.Strings;
  1099. end;
  1100. procedure TTBXComboBoxItem.HandleEditChange(Edit: TEdit);
  1101. begin
  1102. CacheValid := False;
  1103. inherited;
  1104. end;
  1105. procedure TTBXComboBoxItem.ListChangeHandler(Sender: TObject);
  1106. begin
  1107. CacheValid := False;
  1108. DoListChange;
  1109. end;
  1110. procedure TTBXComboBoxItem.ListClickHandler(Sender: TObject);
  1111. begin
  1112. CacheValid := False;
  1113. DoListClick;
  1114. end;
  1115. procedure TTBXComboBoxItem.Loaded;
  1116. begin
  1117. inherited;
  1118. if FList.Strings.IndexOf(Text) >= 0 then
  1119. begin
  1120. IsChanging := True;
  1121. try
  1122. FList.ItemIndex := FList.Strings.IndexOf(Text);
  1123. finally
  1124. IsChanging := False;
  1125. end;
  1126. end;
  1127. { MP Do not re-add on re-load (locale change) }
  1128. if not Assigned(FList.Parent) then
  1129. if not (csDesigning in ComponentState) then Add(FList);
  1130. end;
  1131. procedure TTBXComboBoxItem.SetItemIndex(Value: Integer);
  1132. begin
  1133. FList.ItemIndex := Value;
  1134. end;
  1135. procedure TTBXComboBoxItem.SetMaxVisibleItems(Value: Integer);
  1136. begin
  1137. FList.MaxVisibleItems := Value;
  1138. end;
  1139. procedure TTBXComboBoxItem.SetMaxWidth(Value: Integer);
  1140. begin
  1141. FList.MaxWidth := Value;
  1142. end;
  1143. procedure TTBXComboBoxItem.SetMinWidth(Value: Integer);
  1144. begin
  1145. FList.MinWidth := Value;
  1146. end;
  1147. procedure TTBXComboBoxItem.SetOnClearItem(Value: TTBXLPaintEvent);
  1148. begin
  1149. FList.OnClearItem := Value;
  1150. end;
  1151. procedure TTBXComboBoxItem.SetOnDrawItem(Value: TTBXLPaintEvent);
  1152. begin
  1153. FList.OnDrawItem := Value;
  1154. end;
  1155. procedure TTBXComboBoxItem.SetOnMeasureHeight(Value: TTBXLMeasureHeight);
  1156. begin
  1157. FList.OnMeasureHeight := Value;
  1158. end;
  1159. procedure TTBXComboBoxItem.SetOnMeasureWidth(Value: TTBXLMeasureWidth);
  1160. begin
  1161. FList.OnMeasureWidth := Value;
  1162. end;
  1163. procedure TTBXComboBoxItem.SetShowListImages(Value: Boolean);
  1164. begin
  1165. FList.ShowImages := Value;
  1166. end;
  1167. procedure TTBXComboBoxItem.SetStrings(Value: TStrings);
  1168. begin
  1169. FList.Strings := Value;
  1170. end;
  1171. procedure TTBXComboBoxItem.ChangeScale(M, D: Integer);
  1172. begin
  1173. inherited;
  1174. MinListWidth := MulDiv(MinListWidth, M, D);
  1175. MaxListWidth := MulDiv(MaxListWidth, M, D);
  1176. end;
  1177. //============================================================================//
  1178. { TTBXComboBoxItemViewer }
  1179. function TTBXComboBoxItemViewer.HandleEditMessage(var Message: TMessage): Boolean;
  1180. begin
  1181. if (Message.Msg = WM_KEYDOWN) then with TTBXComboBoxItem(Item) do
  1182. begin
  1183. case Message.wParam of
  1184. VK_UP:
  1185. begin
  1186. if ItemIndex > 0 then
  1187. ItemIndex := ItemIndex- 1;
  1188. EditControl.Text := Text;
  1189. EditControl.SelectAll;
  1190. Result := True;
  1191. end;
  1192. VK_DOWN:
  1193. begin
  1194. if ItemIndex < Strings.Count- 1 then
  1195. ItemIndex := ItemIndex+ 1;
  1196. EditControl.Text := Text;
  1197. EditControl.SelectAll;
  1198. Result := True;
  1199. end;
  1200. else
  1201. Result := inherited HandleEditMessage(Message);
  1202. end
  1203. end
  1204. else Result := inherited HandleEditMessage(Message);
  1205. end;
  1206. {MP}
  1207. function TTBXComboBoxItemViewer.StripTextHotkey: Boolean;
  1208. begin
  1209. Result := TTBXComboBoxItem(Item).DropDownList;
  1210. end;
  1211. //============================================================================//
  1212. { TTBXLabelItem }
  1213. constructor TTBXLabelItem.Create(AOwner: TComponent);
  1214. begin
  1215. inherited;
  1216. FFontSettings := TFontSettings.Create;
  1217. TFontSettingsAccess(FFontSettings).OnChange := FontSettingsChanged;
  1218. FShowAccelChar := True;
  1219. ItemStyle := ItemStyle - [tbisSelectable] + [tbisClicksTransparent, tbisStretch];
  1220. FSectionHeader := False;
  1221. end;
  1222. destructor TTBXLabelItem.Destroy;
  1223. begin
  1224. FFontSettings.Free;
  1225. inherited;
  1226. end;
  1227. procedure TTBXLabelItem.FontSettingsChanged(Sender: TObject);
  1228. begin
  1229. Change(True);
  1230. end;
  1231. function TTBXLabelItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
  1232. begin
  1233. Result := TTBXLabelItemViewer;
  1234. end;
  1235. procedure TTBXLabelItem.SetCaption(const Value: TCaption);
  1236. begin
  1237. FCaption := Value;
  1238. Change(True);
  1239. end;
  1240. procedure TTBXLabelItem.SetFontSettings(Value: TFontSettings);
  1241. begin
  1242. FFontSettings := Value;
  1243. end;
  1244. {procedure TTBXLabelItem.SetFontSize(Value: TTBXFontSize);
  1245. begin
  1246. FFontSize := Value;
  1247. Change(True);
  1248. end; }
  1249. procedure TTBXLabelItem.SetMargin(Value: Integer);
  1250. begin
  1251. FMargin := Value;
  1252. Change(True);
  1253. end;
  1254. procedure TTBXLabelItem.SetOrientation(Value: TTBXLabelOrientation);
  1255. begin
  1256. FOrientation := Value;
  1257. Change(True);
  1258. end;
  1259. procedure TTBXLabelItem.SetShowAccelChar(Value: Boolean);
  1260. begin
  1261. FShowAccelChar := Value;
  1262. Change(True);
  1263. end;
  1264. {MP}
  1265. procedure TTBXLabelItem.SetFixedSize(Value: Integer);
  1266. begin
  1267. FFixedSize := Value;
  1268. Change(True);
  1269. end;
  1270. procedure TTBXLabelItem.SetSectionHeader(Value: Boolean);
  1271. begin
  1272. FSectionHeader := Value;
  1273. Change(True);
  1274. end;
  1275. procedure TTBXLabelItem.UpdateCaption(const Value: TCaption);
  1276. begin
  1277. FCaption := Value;
  1278. Change(False);
  1279. end;
  1280. //============================================================================//
  1281. { TTBXLabelItemViewer }
  1282. procedure TTBXLabelItemViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer);
  1283. var
  1284. DC: HDC;
  1285. S: string;
  1286. TextMetrics: TTextMetric;
  1287. RotatedFont, SaveFont: HFont;
  1288. Margins: TTBXMargins;
  1289. ImgList: TCustomImageList;
  1290. ImgHeight: Integer;
  1291. begin
  1292. Canvas.Font := TTBViewAccess(View).GetFont;
  1293. DoAdjustFont(Canvas.Font, 0);
  1294. S := GetCaptionText;
  1295. if Length(S) = 0 then S := '0';
  1296. DC := Canvas.Handle;
  1297. if IsToolbarStyle then
  1298. begin
  1299. AWidth := TTBXLabelItem(Item).Margin;
  1300. AHeight := AWidth;
  1301. if Length(S) > 0 then
  1302. begin
  1303. if GetIsHoriz then
  1304. begin
  1305. GetTextMetrics(DC, TextMetrics);
  1306. Inc(AHeight, TextMetrics.tmHeight);
  1307. Inc(AWidth, GetTextWidth(DC, S, TTBXLabelItem(Item).ShowAccelChar));
  1308. end
  1309. else
  1310. begin
  1311. RotatedFont := CreateRotatedFont(DC);
  1312. SaveFont := SelectObject(DC, RotatedFont);
  1313. GetTextMetrics(DC, TextMetrics);
  1314. Inc(AWidth, TextMetrics.tmHeight);
  1315. Inc(AHeight, GetTextWidth(DC, S, TTBXLabelItem(Item).ShowAccelChar));
  1316. SelectObject(DC, SaveFont);
  1317. DeleteObject(RotatedFont);
  1318. end;
  1319. end;
  1320. {MP}
  1321. with TTBXLabelItem(Item) do
  1322. if FFixedSize > 0 then
  1323. if GetIsHoriz then
  1324. AWidth := FFixedSize
  1325. else
  1326. AHeight := FFixedSize
  1327. end
  1328. else
  1329. begin
  1330. if Length(S) > 0 then
  1331. begin
  1332. GetTextMetrics(DC, TextMetrics);
  1333. AHeight := TextMetrics.tmHeight;
  1334. AWidth := GetTextWidth(DC, S, TTBXLabelItem(Item).ShowAccelChar);
  1335. end;
  1336. {MP}
  1337. with TTBXLabelItem(Item) do
  1338. begin
  1339. if FFixedSize > 0 then
  1340. AWidth := FFixedSize;
  1341. if SectionHeader then
  1342. begin
  1343. // the same as regular menu item
  1344. CurrentTheme.GetMargins(MID_MENUITEM, Margins);
  1345. Inc(AWidth, Margins.LeftWidth + Margins.RightWidth);
  1346. Inc(AWidth,
  1347. GetPopupMargin(Self) + CurrentTheme.GetIntegerMetrics(Self, TMI_MENU_IMGTEXTSPACE) +
  1348. CurrentTheme.GetIntegerMetrics(Self, TMI_MENU_LCAPTIONMARGIN) +
  1349. CurrentTheme.GetIntegerMetrics(Self, TMI_MENU_RCAPTIONMARGIN));
  1350. // + make sure it's always bit indented compared to menu items
  1351. Inc(AWidth, 2 * 8);
  1352. ImgHeight := 16;
  1353. ImgList := GetImageList;
  1354. if ImgList <> nil then ImgHeight := ImgList.Height;
  1355. if AHeight < ImgHeight then AHeight := ImgHeight;
  1356. Inc(AHeight, Margins.TopHeight + Margins.BottomHeight);
  1357. Inc(AWidth, AHeight); { Note: maybe this should be controlled by the theme }
  1358. end;
  1359. end;
  1360. end;
  1361. if AWidth < 6 then AWidth := 6;
  1362. if AHeight < 6 then AHeight := 6;
  1363. with TTBXLabelItem(Item) do
  1364. begin
  1365. Inc(AWidth, Margin shl 1 + 1);
  1366. Inc(AHeight, Margin shl 1 + 1);
  1367. end;
  1368. end;
  1369. procedure TTBXLabelItemViewer.DoAdjustFont(AFont: TFont; StateFlags: Integer);
  1370. begin
  1371. if Item is TTBXLabelItem then
  1372. with TTBXLabelItem(Item) do
  1373. begin
  1374. FontSettings.Apply(AFont);
  1375. if Assigned(FOnAdjustFont) then FOnAdjustFont(Item, Self, AFont, StateFlags);
  1376. end;
  1377. end;
  1378. function TTBXLabelItemViewer.GetCaptionText: string;
  1379. var
  1380. P: Integer;
  1381. begin
  1382. Result := TTBXLabelItem(Item).Caption;
  1383. P := Pos(#9, Result);
  1384. if P <> 0 then SetLength(Result, P - 1);
  1385. end;
  1386. function TTBXLabelItemViewer.GetIsHoriz: Boolean;
  1387. begin
  1388. with TTBXLabelItem(Item) do
  1389. case Orientation of
  1390. tbxoHorizontal: Result := True;
  1391. tbxoVertical: Result := False;
  1392. else // tbxoAuto
  1393. Result := View.Orientation <> tbvoVertical;
  1394. end;
  1395. end;
  1396. function TTBXLabelItemViewer.IsToolbarSize: Boolean;
  1397. begin
  1398. Result := inherited IsToolbarSize;
  1399. Result := Result or ((GetViewType(View) and PVT_TOOLBOX) = PVT_TOOLBOX);
  1400. end;
  1401. function TTBXLabelItemViewer.IsToolbarStyle: Boolean;
  1402. begin
  1403. Result := inherited IsToolbarStyle;
  1404. Result := Result or ((GetViewType(View) and PVT_TOOLBOX) = PVT_TOOLBOX);
  1405. end;
  1406. procedure TTBXLabelItemViewer.Paint(const Canvas: TCanvas;
  1407. const ClientAreaRect: TRect; IsHoverItem, IsPushed, UseDisabledShadow: Boolean);
  1408. const
  1409. CEnabledStates: array [Boolean] of Integer = (ISF_DISABLED, 0);
  1410. CDesigning: array [Boolean] of Integer = (0, IO_DESIGNING);
  1411. CPrefixes: array [Boolean] of Integer = (DT_NOPREFIX, 0);
  1412. var
  1413. Fmt: Cardinal;
  1414. ItemInfo: TTBXItemInfo;
  1415. R: TRect;
  1416. begin
  1417. FillChar(ItemInfo, SizeOf(ItemInfo), 0);
  1418. ItemInfo.Control := View.Window;
  1419. ItemInfo.ViewType := GetViewType(View);
  1420. ItemInfo.ItemOptions := IO_TOOLBARSTYLE or CDesigning[csDesigning in Item.ComponentState];
  1421. ItemInfo.Enabled := Item.Enabled or View.Customizing;
  1422. ItemInfo.Pushed := False;
  1423. ItemInfo.Selected := False;
  1424. ItemInfo.ImageShown := False;
  1425. ItemInfo.ImageWidth := 0;
  1426. ItemInfo.ImageHeight := 0;
  1427. ItemInfo.HoverKind := hkNone;
  1428. ItemInfo.IsPopupParent := False;
  1429. ItemInfo.IsVertical := not GetIsHoriz;
  1430. Canvas.Font := TTBViewAccess(View).GetFont;
  1431. Canvas.Font.Color := CurrentTheme.GetItemTextColor(ItemInfo);
  1432. DoAdjustFont(Canvas.Font, CEnabledStates[ItemInfo.Enabled]);
  1433. Fmt := DT_SINGLELINE or DT_CENTER or DT_VCENTER or CPrefixes[TTBXLabelItem(Item).ShowAccelChar];
  1434. R := ClientAreaRect;
  1435. if TTBXLabelItem(Item).SectionHeader and (not IsToolbarStyle) then
  1436. begin
  1437. ItemInfo.PopupMargin := GetPopupMargin(Self);
  1438. CurrentTheme.PaintMenuItem(Canvas, R, ItemInfo);
  1439. Inc(R.Left, ItemInfo.PopupMargin + CurrentTheme.GetIntegerMetrics(Self, TMI_MENU_LCAPTIONMARGIN) - 1);
  1440. Canvas.Brush.Color := CurrentTheme.GetViewColor(VT_SECTIONHEADER);
  1441. Canvas.FillRect(R);
  1442. Assert(not ItemInfo.IsVertical);
  1443. Windows.DrawText(Canvas.Handle, PChar(GetCaptionText), Length(GetCaptionText), R, Fmt)
  1444. end
  1445. else
  1446. begin
  1447. Canvas.Brush.Style := bsClear;
  1448. CurrentTheme.PaintCaption(Canvas, R, ItemInfo, GetCaptionText, Fmt, ItemInfo.IsVertical);
  1449. end;
  1450. Canvas.Brush.Style := bsSolid;
  1451. end;
  1452. //============================================================================//
  1453. { TTBXColorItem }
  1454. constructor TTBXColorItem.Create(AOwner: TComponent);
  1455. begin
  1456. inherited;
  1457. FColor := clWhite;
  1458. end;
  1459. function TTBXColorItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
  1460. begin
  1461. Result := TTBXColorItemViewer;
  1462. end;
  1463. procedure TTBXColorItem.SetColor(Value: TColor);
  1464. begin
  1465. if FColor <> Value then
  1466. begin
  1467. FColor := Value;
  1468. Change(False);
  1469. end;
  1470. end;
  1471. //============================================================================//
  1472. { TTBXColorItemViewer }
  1473. procedure TTBXColorItemViewer.DrawItemImage(Canvas: TCanvas; ARect: TRect; ItemInfo: TTBXItemInfo);
  1474. begin
  1475. with ItemInfo, Canvas do
  1476. begin
  1477. if TTBXColorItem(Item).Color <> clNone then
  1478. begin
  1479. if ((ItemOptions and IO_TOOLBARSTYLE) = 0) then InflateRect(ARect, -2, -2);
  1480. if Enabled then
  1481. begin
  1482. Brush.Color := clBtnShadow;
  1483. FrameRect(ARect);
  1484. InflateRect(ARect, -1, -1);
  1485. Brush.Color := TTBXColorItem(Item).Color;
  1486. FillRect(ARect);
  1487. end
  1488. else
  1489. begin
  1490. Inc(ARect.Right);
  1491. Inc(ARect.Bottom);
  1492. DrawEdge(Handle, ARect, BDR_SUNKENOUTER or BDR_RAISEDINNER, BF_RECT);
  1493. end;
  1494. end;
  1495. end;
  1496. end;
  1497. procedure TTBXColorItemViewer.DoPaintCaption(Canvas: TCanvas;
  1498. const ClientAreaRect: TRect; var CaptionRect: TRect;
  1499. IsTextRotated: Boolean; var PaintDefault: Boolean);
  1500. begin
  1501. if (GetViewType(View) and PVT_TOOLBOX) = PVT_TOOLBOX then
  1502. begin
  1503. { Center Caption }
  1504. OffsetRect(CaptionRect, -CaptionRect.Left, 0);
  1505. OffsetRect(CaptionRect, (ClientAreaRect.Right - CaptionRect.Right) div 2, 0);
  1506. end;
  1507. end;
  1508. function TTBXColorItemViewer.GetImageSize: TSize;
  1509. var
  1510. ImgList: TCustomImageList;
  1511. Size: Integer;
  1512. begin
  1513. ImgList := GetImageList;
  1514. if ImgList <> nil then
  1515. begin
  1516. Result.CX := ImgList.Width;
  1517. Result.CY := ImgList.Height;
  1518. if IsToolbarStyle then
  1519. begin
  1520. // we want to get 12x12 with 16x16 images,
  1521. // to match the imagelist-less branch below
  1522. Result.CX := MulDiv(Result.CX, 12, 16);
  1523. Result.CY := MulDiv(Result.CY, 12, 16);
  1524. end;
  1525. end
  1526. else
  1527. begin
  1528. // we do not want to get here
  1529. Assert(False);
  1530. if IsToolbarStyle then
  1531. begin
  1532. Size := 12;
  1533. end
  1534. else
  1535. begin
  1536. Size := 16;
  1537. end;
  1538. // do not have a canvas here to scale by text height
  1539. Size := ScaleByPixelsPerInch(Size, View.GetMonitor);
  1540. Result.CX := Size;
  1541. Result.CY := Size;
  1542. end;
  1543. end;
  1544. function TTBXColorItemViewer.GetImageShown: Boolean;
  1545. begin
  1546. Result := ((Item.DisplayMode in [nbdmDefault, nbdmImageAndText]) or
  1547. (IsToolbarStyle and (Item.DisplayMode = nbdmTextOnlyInMenus)));
  1548. end;
  1549. constructor TTBXColorItemViewer.Create(AView: TTBView; AItem: TTBCustomItem; AGroupLevel: Integer);
  1550. begin
  1551. inherited;
  1552. Wide := False;
  1553. end;
  1554. end.