HistoryComboBox.pas 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186
  1. unit HistoryComboBox;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5. StdCtrls;
  6. type
  7. THistorySaveOn = set of (soExit, soDropDown);
  8. const
  9. DefaultHistorySaveOn = [soExit, soDropDown];
  10. DefaultMaxHistorySize = 30;
  11. type
  12. THistoryComboBox = class;
  13. THistoryComboBoxGetData = procedure(Sender: THistoryComboBox; var Data: Pointer) of object;
  14. THistoryComboBoxSetData = procedure(Sender: THistoryComboBox; Data: Pointer) of object;
  15. THistoryComboBox = class(TComboBox)
  16. private
  17. { Private declarations }
  18. FSaveOn: THistorySaveOn;
  19. FMaxHistorySize: Integer;
  20. FOnGetData: THistoryComboBoxGetData;
  21. FOnSetData: THistoryComboBoxSetData;
  22. procedure SetMaxHistorySize(AMaxHistorySize: Integer);
  23. function StoreSaveOn: Boolean;
  24. function GetMaxItemWidth: Integer;
  25. protected
  26. { Protected declarations }
  27. procedure DoExit; override;
  28. procedure DropDown; override;
  29. procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  30. procedure Change; override;
  31. public
  32. { Public declarations }
  33. constructor Create(AOwner: TComponent); override;
  34. procedure SaveToHistory; virtual;
  35. published
  36. { Published declarations }
  37. property SaveOn: THistorySaveOn read FSaveOn write FSaveOn stored StoreSaveOn;
  38. property MaxHistorySize: Integer read FMaxHistorySize write SetMaxHistorySize default DefaultMaxHistorySize;
  39. property OnGetData: THistoryComboBoxGetData read FOnGetData write FOnGetData;
  40. property OnSetData: THistoryComboBoxSetData read FOnSetData write FOnSetData;
  41. end;
  42. procedure SaveToHistory(Strings: TStrings; T: string; Data: Pointer = nil; MaxHistorySize: Integer = DefaultMaxHistorySize);
  43. procedure Register;
  44. implementation
  45. uses
  46. PasTools;
  47. procedure Register;
  48. begin
  49. RegisterComponents('Martin', [THistoryComboBox]);
  50. end;
  51. procedure SaveToHistory(Strings: TStrings; T: string; Data: Pointer; MaxHistorySize: Integer);
  52. begin
  53. if T <> '' then
  54. begin
  55. while Strings.IndexOf(T) >= 0 do Strings.Delete(Strings.IndexOf(T));
  56. Strings.InsertObject(0, T, TObject(Data));
  57. end;
  58. while Strings.Count > MaxHistorySize do
  59. Strings.Delete(Strings.Count-1);
  60. end;
  61. { THistoryComboBox }
  62. constructor THistoryComboBox.Create(AOwner: TComponent);
  63. begin
  64. inherited;
  65. FSaveOn := DefaultHistorySaveOn;
  66. FMaxHistorySize := DefaultMaxHistorySize;
  67. FOnGetData := nil;
  68. FOnSetData := nil;
  69. end;
  70. procedure THistoryComboBox.KeyDown(var Key: Word; Shift: TShiftState);
  71. begin
  72. if ((Key = VK_DOWN) or (Key = VK_UP)) and
  73. (not (ssAlt in Shift)) and (soDropDown in SaveOn) then
  74. begin
  75. if Items.IndexOf(Text) < 0 then SaveToHistory;
  76. end;
  77. if DroppedDown and (Key = VK_DELETE) and (ssCtrl in Shift) then
  78. begin
  79. Items.Clear;
  80. Key := 0;
  81. end;
  82. inherited;
  83. end;
  84. procedure THistoryComboBox.SetMaxHistorySize(AMaxHistorySize: Integer);
  85. begin
  86. FMaxHistorySize := AMaxHistorySize;
  87. while Items.Count > FMaxHistorySize do
  88. Items.Delete(Items.Count-1);
  89. end;
  90. procedure THistoryComboBox.DoExit;
  91. begin
  92. inherited;
  93. if soExit in SaveOn then SaveToHistory;
  94. end;
  95. procedure THistoryComboBox.DropDown;
  96. var
  97. ItemWidth: Integer;
  98. begin
  99. inherited;
  100. if soDropDown in SaveOn then SaveToHistory;
  101. // taken from TIECustomComboBox:
  102. ItemWidth := GetMaxItemWidth + ScaleByPixelsPerInch(8, Self);
  103. if Items.Count > DropDownCount then
  104. Inc(ItemWidth, GetSystemMetricsForControl(Self, SM_CXVSCROLL));
  105. Self.Perform(CB_SETDROPPEDWIDTH, ItemWidth, 0);
  106. end;
  107. procedure THistoryComboBox.Change;
  108. var
  109. Index: Integer;
  110. begin
  111. inherited Change;
  112. if Assigned(OnSetData) then
  113. begin
  114. // note that ItemIndex is not reliable
  115. Index := Items.IndexOf(Text);
  116. if Index >= 0 then OnSetData(Self, Items.Objects[Index]);
  117. end;
  118. end;
  119. procedure THistoryComboBox.SaveToHistory;
  120. var
  121. Data: Pointer;
  122. begin
  123. if Text <> '' then
  124. begin
  125. Data := nil;
  126. if Assigned(OnGetData) then
  127. OnGetData(Self, Data);
  128. HistoryComboBox.SaveToHistory(Items, Text, Data, MaxHistorySize);
  129. ItemIndex := 0;
  130. end;
  131. end;
  132. function THistoryComboBox.StoreSaveOn: Boolean;
  133. begin
  134. Result := (SaveOn <> DefaultHistorySaveOn);
  135. end;
  136. // taken from TIECustomComboBox:
  137. function THistoryComboBox.GetMaxItemWidth: Integer;
  138. var
  139. DC: HDC;
  140. SaveFont: HFont;
  141. Size: TSize;
  142. Index: Integer;
  143. begin
  144. Result := 0;
  145. DC := GetDC(0);
  146. try
  147. SaveFont := SelectObject(DC, Font.Handle);
  148. for Index := 0 to Items.Count - 1 do
  149. begin
  150. GetTextExtentPoint32(DC, PChar(Items[Index]), Length(Items[Index]), Size);
  151. if Size.Cx > Result then Result := Size.Cx;
  152. end;
  153. SelectObject(DC, SaveFont);
  154. finally
  155. ReleaseDC(0, DC);
  156. end;
  157. end;
  158. initialization
  159. end.