jvcllaz: Add new component TComboListBox.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6864 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-04-24 14:29:10 +00:00
parent 5187f068ad
commit 7b27af735d
12 changed files with 3370 additions and 3 deletions

View File

@ -25,3 +25,4 @@ tjvgroupheader_200.png
tjvrollout.png
tjvrollout_150.png
tjvrollout_200.png
tjvcombolistbox.bmp

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.6 KiB

View File

@ -16,14 +16,14 @@ implementation
uses
Classes, ActnList, JvDsgnConsts,
JvMovableBevel, JvRuler, JvGroupHeader, JvRollOut,
JvHtControls, {JvDBHTLabel,} JvHint, JvHTHintForm,
JvHtControls, {JvDBHTLabel,} JvHint, JvHTHintForm, JvComboListBox,
PropEdits, Controls;
procedure Register;
begin
RegisterComponents(RsPaletteJvcl, [
TJvMovableBevel, TJvMovablePanel, TJvRuler, TJvGroupHeader, TJvRollOut,
TJvHint, TJvHTLabel, TJvHTListbox, TJvHTCombobox
TJvHint, TJvHTLabel, TJvHTListbox, TJvHTCombobox, TJvComboListBox
]);
RegisterPropertyEditor(TypeInfo(TCaption), TJvHTLabel, 'Caption', TJvHintProperty);
RegisterActions(RsJVCLActionsCategory, [TJvRollOutAction], nil);

View File

@ -0,0 +1,93 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="JvComboListBoxDemo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="JvCtrlsLazR"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="JvComboListBoxDemo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="jvcombolistboxdemoform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="JvComboListBoxDemoFrm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="JvComboListBoxDemoForm"/>
</Unit1>
<Unit2>
<Filename Value="dropfrm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmDrop"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="DropFrm"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\bin\JvComboListBoxDemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,19 @@
program JvComboListBoxDemo;
{$mode objfpc}{$H+}
uses
Interfaces,
Forms,
JvComboListBoxDemoForm in 'JvComboListBoxDemoForm.pas' {JvComboListBoxDemoFrm},
DropFrm in 'DropFrm.pas' {frmDrop};
{$R *.res}
begin
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TJvComboListBoxDemoFrm, JvComboListBoxDemoFrm);
Application.Run;
end.

View File

@ -0,0 +1,149 @@
object frmDrop: TfrmDrop
Left = 667
Height = 287
Top = 373
Width = 290
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Select folder'
ClientHeight = 287
ClientWidth = 290
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Shell Dlg 2'
FormStyle = fsStayOnTop
OnClose = FormClose
OnShow = FormShow
LCLVersion = '2.1.0.0'
object Label1: TLabel
Left = 11
Height = 13
Top = 8
Width = 64
Caption = 'Select folder:'
ParentColor = False
end
object PathLabel: TLabel
Left = 14
Height = 13
Top = 232
Width = 261
Anchors = [akLeft, akRight, akBottom]
AutoSize = False
ParentColor = False
end
object btnCancel: TButton
Left = 202
Height = 25
Top = 253
Width = 75
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
ModalResult = 2
OnClick = btnCancelClick
TabOrder = 0
end
object btnOK: TButton
Left = 120
Height = 25
Top = 253
Width = 75
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
ModalResult = 1
OnClick = btnOKClick
TabOrder = 1
end
object tvFolders: TShellTreeView
Left = 8
Height = 201
Top = 24
Width = 266
FileSortType = fstNone
HideSelection = False
Images = ilSmallIcons
ReadOnly = True
TabOrder = 2
OnChange = tvFoldersChange
OnDblClick = tvFoldersDblClick
OnGetImageIndex = tvFoldersGetImageIndex
OnGetSelectedIndex = tvFoldersGetSelectedIndex
Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
ObjectTypes = [otFolders]
end
object ilSmallIcons: TImageList
ShareImages = True
left = 104
top = 72
Bitmap = {
4C69020000001000000010000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000070A8FF0070A8FF0070
A8FF0070A8FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000070A8FFF8F8F8FF88F8F8FF88F8
F8FF88F8F8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0000
00000000000000000000000000000070A8FFF8F8F8FF88F8F8FF88F8F8FF88F8
F8FF88F8F8FF88F8F8FF88F8F8FF88F8F8FF88F8F8FF88F8F8FF88F8F8FF0068
A0FF0000000000000000000000000070A8FF80F0F8FF80F0F8FF80F0F8FF80F0
F8FF80F0F8FF80F0F8FF80F0F8FF80F0F8FF80F0F8FF80F0F8FF80F0F8FF0068
A0FF0000000000000000000000000070A8FF78E8F8FF0070A8FF0070A8FF0070
A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070
A8FF0070A8FF0070A8FF000000000070A8FF70E0F8FF0070A8FFF8F8F8FFB8F0
F8FFB8F0F8FFB8F0F8FFB8F0F8FFB8F0F8FFB8F0F8FFB8F0F8FFB8F0F8FF80C8
E0FFD0F0F8FF0070A8FF000000000070A8FF68D8F8FF0070A8FFA0E8F8FF70E0
F8FF70E0F8FF70E0F8FF70E0F8FF70E0F8FF70E0F8FF70E0F8FF70E0F8FF30A8
C8FFA8F0F0FF0070A8FF000000000070A8FF58D0F8FF0070A8FFA0E8F8FF68D8
F8FF68D8F8FF68D8F8FF68D8F8FF68D8F8FF68D8F8FF68D8F8FF68D8F8FF28A0
C8FFA8E8F0FF0070A8FF000000000070A8FF50C8F8FF0070A8FF98E0F8FF58D0
F8FF58D0F8FF58D0F8FF58D0F8FF58D0F8FF58D0F8FF58D0F8FF58D0F8FF28A0
C8FFA0E8F0FF0070A8FF000000000070A8FF48C0F0FF0070A8FF90D8F8FF50C0
F8FF50C0F0FF50C0F8FF50C0F0FF50C0F8FF50C0F8FF50C0F8FF50C0F0FF2098
C8FF98E0F0FF0070A8FF000000000070A8FF48B8F0FF0070A8FF88D8F8FF48B8
F0FF48B8F0FF48B8F0FF48B8F0FF48B8F0FF48B8F0FF48B8F0FF48B8F0FF2098
C8FF90E0F0FF0070A8FF00000000000000000070A8FF0070A8FF0070A8FF0070
A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070
A8FF0070A8FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000070A8FF0070A8FF0070
A8FF0070A8FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000070A8FFF8F8F8FF88F8F8FF88F8
F8FF88F8F8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0000
00000000000000000000000000000070A8FFF8F8F8FF88F8F8FF88F8F8FF88F8
F8FF88F8F8FF88F8F8FF88F8F8FF88F8F8FF88F8F8FF88F8F8FF88F8F8FF0068
A0FF0000000000000000000000000070A8FF80F0F8FF80F0F8FF80F0F8FF80F0
F8FF80F0F8FF80F0F8FF80F0F8FF80F0F8FF80F0F8FF80F0F8FF80F0F8FF0068
A0FF0000000000000000000000000070A8FF78E8F8FF78E8F8FF0878B0FF0070
A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070
A8FF0070A8FF0070A8FF0070A8FF0070A8FF70E0F8FF58D0E8FF1080B0FFF8F8
F8FFB8F0F8FFB8F0F8FFB8F0F8FFB8F0F8FFB8F0F8FFB8F0F8FFB8F0F8FF80C8
D8FFE0F8F8FFC0E8F0FF0070A8FF0070A8FF68D8F8FF28A0D0FF48B0D0FF90E8
F8FF70E0F8FF70E0F8FF70E0F8FF70E0F8FF70E0F8FF70E0F8FF70E0F8FF30A8
C8FFB8E8E8FFB8E8E8FF0070A8FF0070A8FF58D0F8FF0880B0FF80D0E8FF78E0
F8FF68D8F8FF68D8F8FF68D8F8FF68D8F8FF68D8F8FF68D8F8FF68D8F8FF28A0
C8FFB8E8E8FF0878B0FF000000000070A8FF50C8F8FF0070A8FF98E0F8FF58D0
F8FF58D0F8FF58D0F8FF58D0F8FF58D0F8FF58D0F8FF58D0F8FF58D0F8FF28A0
C8FFB8E8E8FF0070A8FF000000000070A8FF30A8E0FF2090C0FF88D8F8FF50C0
F8FF50C0F0FF50C0F8FF50C0F0FF50C0F8FF50C0F8FF50C0F8FF50C0F0FF2098
C8FFB8E8E8FF0070A8FF000000000070A8FF1088C0FF50B0E0FF68C8F8FF48B8
F0FF48B8F0FF48B8F0FF48B8F0FF48B8F0FF48B8F0FF48B8F0FF48C0F0FF2098
C8FF0880B8FF0000000000000000000000000070A8FF0070A8FF0070A8FF0070
A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070A8FF0070
A8FF000000000000000000000000
}
end
end

View File

@ -0,0 +1,163 @@
{******************************************************************
JEDI-VCL Demo
Copyright (C) 2002 Project JEDI
Original author:
Contributor(s):
You may retrieve the latest version of this file at the JEDI-JVCL
home page, located at http://jvcl.delphi-jedi.org
The contents of this file are used with permission, subject to
the Mozilla Public License Version 1.1 (the "License"); you may
not use this file except in compliance with the License. You may
obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1_1Final.html
Software distributed under the License is distributed on an
"AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
implied. See the License for the specific language governing
rights and limitations under the License.
******************************************************************}
unit DropFrm;
{$mode objfpc}{$H+}
interface
uses
LCLIntf, LCLType, //LMessages, Types,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ImgList, ShellCtrls;
type
TDropFrmAcceptEvent = procedure(Sender: TObject; Index: integer; const Value: string) of object;
{ TfrmDrop }
TfrmDrop = class(TForm)
Label1: TLabel;
btnCancel: TButton;
tvFolders: TShellTreeView;
ilSmallIcons: TImageList;
btnOK: TButton;
PathLabel: TLabel;
procedure tvFoldersDblClick(Sender: TObject);
procedure tvFoldersGetImageIndex(Sender: TObject; Node: TTreeNode);
{
procedure tvFolders_1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
}
procedure FormClose(Sender: TObject; var TheAction: TCloseAction);
procedure btnCancelClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure tvFoldersChange(Sender: TObject; Node: TTreeNode);
procedure tvFoldersGetSelectedIndex(Sender: TObject; Node: TTreeNode);
private
FOnAccept: TDropFrmAcceptEvent;
FIncludeFiles: boolean;
procedure SetIncludeFiles(AValue: Boolean);
protected
procedure CreateParams(var Params: TCreateParams); override;
// procedure WMActivate(var Message: TLMActivate); message LM_ACTIVATE;
public
property IncludeFiles: boolean read FIncludeFiles write SetIncludeFiles;
property OnAccept: TDropFrmAcceptEvent read FOnAccept write FOnAccept;
end;
var
frmDrop: TfrmDrop = nil;
implementation
uses
JvJCLUtils;
{$R *.lfm}
{ TfrmDrop }
procedure TfrmDrop.btnCancelClick(Sender: TObject);
begin
if not (fsModal in FormState) then
Close;
end;
procedure TfrmDrop.btnOKClick(Sender: TObject);
begin
if not (fsModal in FormState) then
Close;
end;
procedure TfrmDrop.CreateParams(var Params: TCreateParams);
begin
inherited;
if BorderStyle = bsDialog then
Params.Style := Params.Style and not WS_BORDER;
end;
procedure TfrmDrop.FormClose(Sender: TObject; var TheAction: TCloseAction);
begin
if (ModalResult = mrOK) and Assigned(FOnAccept) then
FOnAccept(self, -1, (tvFolders.Selected as TShellTreeNode).FullFilename);
end;
procedure TfrmDrop.FormShow(Sender: TObject);
begin
if tvFolders.CanFocus then tvFolders.SetFocus;
end;
procedure TfrmDrop.SetIncludeFiles(AValue: Boolean);
begin
if AValue then
tvFolders.ObjectTypes := tvFolders.ObjectTypes + [otNonFolders]
else
tvFolders.ObjectTypes := tvFolders.ObjectTypes - [otNonFolders];
end;
procedure TfrmDrop.tvFoldersChange(Sender: TObject; Node: TTreeNode);
begin
PathLabel.Caption := MinimizeFileName((Node as TShellTreeNode).FullFileName, Canvas, PathLabel.Width);
end;
procedure TfrmDrop.tvFoldersDblClick(Sender: TObject);
begin
if (tvFolders.Selected <> nil) and (not tvFolders.Selected.HasChildren) then
btnOK.Click;
end;
procedure TfrmDrop.tvFoldersGetImageIndex(Sender: TObject;
Node: TTreeNode);
begin
if not (Node as TShellTreeNode).IsDirectory then
Node.ImageIndex := -1
else
if Node = tvFolders.Selected then
Node.ImageIndex := 1
else
Node.ImageIndex := 0;
end;
procedure TfrmDrop.tvFoldersGetSelectedIndex(Sender: TObject;
Node: TTreeNode);
begin
if not (Node as TShellTreeNode).IsDirectory then
Node.SelectedIndex := -1
else
if Node = tvFolders.Selected then
Node.SelectedIndex := 1
else
Node.SelectedIndex := 0;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,390 @@
{******************************************************************
JEDI-VCL Demo
Copyright (C) 2002 Project JEDI
Original author:
Contributor(s):
You may retrieve the latest version of this file at the JEDI-JVCL
home page, located at http://jvcl.delphi-jedi.org
The contents of this file are used with permission, subject to
the Mozilla Public License Version 1.1 (the "License"); you may
not use this file except in compliance with the License. You may
obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1_1Final.html
Software distributed under the License is distributed on an
"AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
implied. See the License for the specific language governing
rights and limitations under the License.
******************************************************************}
unit JvComboListBoxDemoForm;
{$mode objfpc}{$H+}
interface
uses
//Windows, Messages,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,
//JvComponent, JvClipboardViewer,
ExtCtrls, ExtDlgs,
ComCtrls, Menus, JvComboListBox;
//, JvExForms;
type
{ TJvComboListBoxDemoFrm }
TJvComboListBoxDemoFrm = class(TForm)
// JvClipboardViewer1: TJvClipboardViewer;
Splitter1: TSplitter;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Memo1: TMemo;
pnlImage: TPanel;
Image1: TImage;
btnLoadImage: TButton;
btnCopyImage: TButton;
btnCopyText: TButton;
edItemHeight: TEdit;
udItemHeight: TUpDown;
cbDrawStyle: TComboBox;
edButtonWidth: TEdit;
udButtonWidth: TUpDown;
btnLoadText: TButton;
OpenPictureDialog1: TOpenPictureDialog;
PopupMenu1: TPopupMenu;
mnuPaste: TMenuItem;
mnuDelete: TMenuItem;
N1: TMenuItem;
mnuOriginal: TMenuItem;
mnuStretch: TMenuItem;
mnuProportional: TMenuItem;
OpenDialog1: TOpenDialog;
chkHotTrackCombo: TCheckBox;
edColumns: TEdit;
Label5: TLabel;
udColumns: TUpDown;
chkInsert: TCheckBox;
cbPopupAlign: TComboBox;
Label6: TLabel;
chkCustomDrop: TCheckBox;
chkIncludeFiles: TCheckBox;
{
procedure JvClipboardViewer1Image(Sender: TObject; Image: TBitmap);
procedure JvClipboardViewer1Text(Sender: TObject; Text: string);
}
procedure btnCopyTextClick(Sender: TObject);
procedure btnCopyImageClick(Sender: TObject);
procedure btnLoadImageClick(Sender: TObject);
procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure udItemHeightClick(Sender: TObject; Button: TUDBtnType);
procedure FormCreate(Sender: TObject);
procedure mnuPasteClick(Sender: TObject);
procedure mnuDeleteClick(Sender: TObject);
procedure cbDrawStyleChange(Sender: TObject);
procedure mnuProportionalClick(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure udButtonWidthClick(Sender: TObject; Button: TUDBtnType);
procedure btnLoadTextClick(Sender: TObject);
procedure chkHotTrackComboClick(Sender: TObject);
procedure udColumnsClick(Sender: TObject; Button: TUDBtnType);
procedure cbPopupAlignChange(Sender: TObject);
procedure chkIncludeFilesClick(Sender: TObject);
private
LB: TJvComboListBox;
procedure DoDropDown(Sender: TObject; AIndex, X, Y: integer; var AllowDrop:boolean);
procedure DoAccept(Sender: TObject; Index: integer; const Value: string);
public
procedure UpdateFromClipboardText;
procedure UpdateFromClipboardImage;
end;
var
JvComboListBoxDemoFrm: TJvComboListBoxDemoFrm;
implementation
uses
Math, Clipbrd, DropFrm;
{$R *.lfm}
function Max(Values: array of integer): integer;
var
i: integer;
begin
Result := Values[Low(Values)];
for i := Low(Values) + 1 to High(Values) do
if Values[i] > Result then
Result := Values[i];
end;
(*
procedure TJvComboListBoxDemoFrm.JvClipboardViewer1Image(Sender: TObject; Image: TBitmap);
var
P: TPicture;
begin
P := TPicture.Create;
try
P.Assign(Image);
if chkInsert.Checked then
LB.InsertImage(0, P)
else
LB.AddImage(P);
finally
P.Free; // AddImage creates a copy, so we can free this instance
end;
// LB.ItemHeight := Max(LB.ItemHeight, B.Height + 8);
udItemHeight.Position := LB.ItemHeight;
Caption := Format('Count: %d', [LB.Items.Count]);
end;
procedure TJvComboListBoxDemoFrm.JvClipboardViewer1Text(Sender: TObject; Text: string);
begin
if chkInsert.Checked then
LB.InsertText(0, StringReplace(Text, #13#10, ' ', [rfReplaceAll]))
else
LB.AddText(StringReplace(Text, #13#10, ' ', [rfReplaceAll]));
Caption := Format('Clipboard count: %d', [LB.Items.Count]);
end;
*)
procedure TJvComboListboxDemoFrm.UpdateFromClipboardText;
var
txt: String;
begin
txt := Clipboard.AsText;
if chkInsert.Checked then
LB.InsertText(0, StringReplace(txt, LineEnding, ' ', [rfReplaceAll]))
else
LB.AddText(StringReplace(txt, LineEnding, ' ', [rfReplaceAll]));
Caption := Format('Clipboard count: %d', [LB.Items.Count]);
end;
procedure TJvComboListBoxDemoFrm.UpdateFromClipboardImage;
var
P: TPicture;
begin
P := TPicture.Create;
try
P.LoadFromClipboardFormat(CF_BITMAP);
if chkInsert.Checked then
LB.InsertImage(0, P)
else
LB.AddImage(P);
finally
P.Free; // AddImage creates a copy, so we can free this instance
end;
udItemHeight.Position := LB.ItemHeight;
Caption := Format('Clipboard count: %d', [LB.Items.Count]);
end;
procedure TJvComboListBoxDemoFrm.btnCopyTextClick(Sender: TObject);
begin
if Memo1.SelLength = 0 then
Memo1.SelectAll;
Memo1.CopyToClipboard;
end;
procedure TJvComboListBoxDemoFrm.btnCopyImageClick(Sender: TObject);
var
// AFormat: Word;
// AData: Cardinal;
// APalette: HPALETTE;
il: TImageList;
begin
(*
if Image1.Picture.Graphic is TIcon then
begin
// convert ico to bmp
il := TImageList.CreateSize(Image1.Picture.Width, Image1.Picture.Height);
try
il.AddIcon(Image1.Picture.Icon);
il.GetBitmap(0, Image1.Picture.Bitmap);
finally
il.Free;
end;
end;
*)
Image1.Picture.SaveToClipboardFormat(CF_BITMAP);
UpdateFromClipboardImage;
{ original:
Image1.Picture.SaveToClipboardFormat(AFormat, AData, APalette);
Clipboard.SetAsHandle(AFormat, AData);
}
end;
procedure TJvComboListBoxDemoFrm.btnLoadImageClick(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;
procedure TJvComboListBoxDemoFrm.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (ssCtrl in Shift) then begin
if (Key = ord('C')) or (Key = ord('c')) then begin
Memo1.CopyToClipboard;
JvComboListboxDemoFrm.UpdateFromClipboardText;
end else
if (Key = ord('X')) or (Key = ord('x')) then begin
Memo1.CutToClipboard;
JvComboListboxDemoFrm.UpdateFromClipboardText;
end;
end;
end;
procedure TJvComboListBoxDemoFrm.udItemHeightClick(Sender: TObject; Button: TUDBtnType);
begin
LB.ItemHeight := udItemHeight.Position;
end;
procedure TJvComboListBoxDemoFrm.DoAccept(Sender:TObject;Index:integer; const Value:string);
begin
if Index < 0 then Index := LB.ItemIndex;
if Index >= 0 then
begin
LB.Items.Objects[Index].Free;
LB.Items.Objects[Index] := nil;
LB.Items[Index] := Value;
end;
end;
procedure TJvComboListBoxDemoFrm.DoDropDown(Sender: TObject; AIndex, X,Y:integer;
var AllowDrop:boolean);
var
R:TRect;
P:TPoint;
begin
AllowDrop := not chkCustomDrop.Checked;
mnuOriginal.Enabled := Lb.Items.Objects[AIndex] <> nil;
mnuStretch.enabled := LB.Items.Objects[AIndex] <> nil;
mnuProportional.Enabled := LB.Items.Objects[AIndex] <> nil;
if not AllowDrop then
begin
R := LB.ItemRect(AIndex);
P := LB.ClientToScreen(Point(R.Right, R.Top));
if frmDrop = nil then
frmDrop := TfrmDrop.Create(Application);
with frmDrop do
begin
IncludeFiles := chkIncludeFiles.Checked;
Top := P.Y + LB.ItemHeight;
Left := P.X - Width;
// notify dialog when the user clicks outside the form
OnAccept := @DoAccept;
Show;
end;
end;
end;
procedure TJvComboListBoxDemoFrm.FormCreate(Sender: TObject);
begin
LB := TJvComboListBox.Create(Self);
LB.Align := alClient;
LB.Width := 200;
LB.Parent := Self;
LB.DropDownMenu := PopupMenu1;
LB.OnDropDown := @DoDropDown;
// LB.ScrollBars := ssBoth;
// LB.HotTrack := true;
Splitter1.Left := LB.Left - 10;
cbDrawStyle.ItemIndex := Ord(LB.DrawStyle);
cbPopupAlign.ItemIndex := Ord(PopupMenu1.Alignment);
LB.ItemHeight := udItemHeight.Position;
udButtonWidth.Position := LB.ButtonWidth;
udColumns.Position := LB.Columns;
end;
procedure TJvComboListBoxDemoFrm.mnuPasteClick(Sender: TObject);
begin
with LB do
begin
if Items.Objects[ItemIndex] <> nil then
Image1.Picture.Assign(TPicture(Items.Objects[ItemIndex]))
else
Memo1.Lines.Text := Items[ItemIndex];
end;
end;
procedure TJvComboListBoxDemoFrm.mnuDeleteClick(Sender: TObject);
begin
with LB do
if ItemIndex >= 0 then
Delete(ItemIndex);
Caption := Format('Clipboard count: %d', [LB.Items.Count]);
end;
procedure TJvComboListBoxDemoFrm.cbDrawStyleChange(Sender: TObject);
begin
LB.DrawStyle := TJvComboListBoxDrawStyle(cbDrawStyle.ItemIndex);
end;
procedure TJvComboListBoxDemoFrm.mnuProportionalClick(Sender: TObject);
begin
cbDrawStyle.ItemIndex := (Sender as TMenuItem).Tag;
LB.DrawStyle := TJvComboListBoxDrawStyle(cbDrawStyle.ItemIndex);
(Sender as TMenuItem).Checked := true;
end;
procedure TJvComboListBoxDemoFrm.PopupMenu1Popup(Sender: TObject);
var
i: integer;
begin
for i := 0 to PopupMenu1.Items.Count - 1 do
if PopupMenu1.Items[i].GroupIndex = 1 then
PopupMenu1.Items[i].Checked := PopupMenu1.Items[i].Tag = cbDrawStyle.ItemIndex;
end;
procedure TJvComboListBoxDemoFrm.udButtonWidthClick(Sender: TObject; Button: TUDBtnType);
begin
LB.ButtonWidth := udButtonWidth.Position;
end;
procedure TJvComboListBoxDemoFrm.btnLoadTextClick(Sender: TObject);
begin
if OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;
procedure TJvComboListBoxDemoFrm.chkHotTrackComboClick(Sender: TObject);
begin
LB.HotTrackCombo := chkHotTrackCombo.Checked;
end;
procedure TJvComboListBoxDemoFrm.udColumnsClick(Sender: TObject; Button: TUDBtnType);
begin
LB.Columns := udColumns.Position;
end;
procedure TJvComboListBoxDemoFrm.cbPopupAlignChange(Sender: TObject);
begin
PopupMenu1.Alignment := TPopupAlignment(cbPopupAlign.ItemIndex);
end;
procedure TJvComboListBoxDemoFrm.chkIncludeFilesClick(Sender: TObject);
begin
if frmDrop <> nil then //recreate form
begin
frmDrop.Release;
frmDrop := nil;
end;
end;
end.

View File

@ -17,7 +17,7 @@ Movable bevel and panel, ruler, exandable panel (RollOut), group header, hyperte
"/>
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
<Version Major="1" Release="4"/>
<Files Count="6">
<Files Count="7">
<Item1>
<Filename Value="..\run\JvCtrls\jvhint.pas"/>
<UnitName Value="JvHint"/>
@ -42,6 +42,10 @@ Movable bevel and panel, ruler, exandable panel (RollOut), group header, hyperte
<Filename Value="..\run\JvCtrls\jvrollout.pas"/>
<UnitName Value="JvRollOut"/>
</Item6>
<Item7>
<Filename Value="..\run\JvCtrls\jvcombolistbox.pas"/>
<UnitName Value="JvComboListBox"/>
</Item7>
</Files>
<RequiredPkgs Count="2">
<Item1>

View File

@ -0,0 +1,675 @@
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvComboListBox.PAS, released on 2003-10-07.
The Initial Developer of the Original Code is Peter Thornqvist <peter3 at sourceforge.net>
Portions created by S�bastien Buysse are Copyright (C) 2003 Peter Thornqvist .
All Rights Reserved.
Contributor(s):
dejoy(dejoy att ynl dott gov dott cn)
tsoyran(tsoyran att otenet dott gr), Jan Verhoeven, Kyriakos Tasos,
Andreas Hausladen <ahuser at users dot sourceforge dot net>.
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Known Issues:
Description:
A listbox that displays a combo box overlay on the selected item. Assign a
TPopupMenu to the DropdownMenu property and it will be shown when the user clicks the
combobox button.
History:
2004-07-23: Added TJvCheckedComboBox.
--------------------------------------------------------------------------------
Documentation from the original demo:
TJvCustomListBox is a listbox that can display a combobox overlaying the
selected or "highlighted" item. Assign a TPopupMenu to the
DropdownMenu property and it will be shown when the combo button is
clicked. You can also handle the OnDropDown event for custom
handling when the button is clicked, or example, displaying a drop down
form.
Note that the location of the dropdown is controlled using the
TPopupMenu.Alignment property.
Apart from the combobox overlay, the listbox also handles data in its
Items.Objects property specially. If you put a TPicture into the
Objects list, the picture will be drawn by the control instead of the text.
Note that if you use the Objects property, TJvComboListBox
automatically frees the object when an item is deleted, so don't free the
object yourself. To be able to free the object yourself, set
Objects[Index] to nil before deleting the item, clearing the listor destroying
the control.
If you use AddImage and InsertImage, an internal copy of the object is
created and you then need to free the original object yourself.
-----------------------------------------------------------------------------}
// $Id$
unit JvComboListBox;
{$mode objfpc}{$H+}
interface
uses
LCLIntf, LCLType,
Classes, Graphics, Controls, Forms, StdCtrls,
Menus;
type
// (p3) these types should *not* be moved to JvTypes (they are only used here)!
TJvComboListBoxDrawStyle = (dsOriginal, dsStretch, dsProportional);
TJvComboListDropDownEvent = procedure(Sender: TObject; Index: Integer;
X, Y: Integer; var AllowDrop: Boolean) of object;
TJvComboListDrawTextEvent = procedure(Sender: TObject; Index: Integer;
const AText: string; R: TRect; var DefaultDraw: Boolean) of object;
TJvComboListDrawImageEvent = procedure(Sender: TObject; Index: Integer;
const APicture: TPicture; R: TRect; var DefaultDraw: Boolean) of object;
// wp: copied from JvListbox
TJvListBoxDataEvent = procedure(Sender: TWinControl; AIndex: Integer;
var AText: string) of object;
TJvComboListBox = class(TCustomListbox) //TJvCustomListBox)
private
FMouseOver: Boolean;
FPushed: Boolean;
FDropdownMenu: TPopupMenu;
FDrawStyle: TJvComboListBoxDrawStyle;
FOnDrawImage: TJvComboListDrawImageEvent;
FOnDrawText: TJvComboListDrawTextEvent;
FButtonWidth: Integer;
FHotTrackCombo: Boolean;
FLastHotTrack: Integer;
FOnDropDown: TJvComboListDropDownEvent;
FOnGetText: TJvListBoxDataEvent;
procedure SetDrawStyle(const Value: TJvComboListBoxDrawStyle);
function DestRect(Picture: TPicture; ARect: TRect): TRect;
function GetOffset(OrigRect, ImageRect: TRect): TRect;
procedure SetButtonWidth(const Value: Integer);
procedure SetDropdownMenu(const Value: TPopupMenu);
procedure SetHotTrackCombo(const Value: Boolean);
protected
procedure InvalidateItem(Index: Integer);
procedure DrawComboArrow(ACanvas: TCanvas; R: TRect; Highlight, Pushed: Boolean);
procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
procedure Resize; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseLeave; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
function DoDrawImage(Index: Integer; APicture: TPicture; R: TRect): Boolean; virtual;
function DoDrawText(Index: Integer; const AText: string; R: TRect): Boolean; virtual;
function DoDropDown(Index, X, Y: Integer): Boolean; virtual;
procedure DoGetText(Index: Integer; var AText: string); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function AddText(const S: string): Integer;
procedure InsertText(AIndex: Integer; const S: string);
// helper functions: makes sure the internal TPicture object is created and freed as necessary
function AddImage(P: TPicture): Integer;
procedure InsertImage(AIndex: Integer; P: TPicture);
procedure Clear; override;
procedure Delete(AIndex: Integer);
published
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 20;
property HotTrackCombo: Boolean read FHotTrackCombo write SetHotTrackCombo default False;
property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu;
property DrawStyle: TJvComboListBoxDrawStyle read FDrawStyle write SetDrawStyle default dsOriginal;
property OnDrawText: TJvComboListDrawTextEvent read FOnDrawText write FOnDrawText;
property OnDrawImage: TJvComboListDrawImageEvent read FOnDrawImage write FOnDrawImage;
property OnDropDown: TJvComboListDropDownEvent read FOnDropDown write FOnDropDown;
property Align;
property Anchors;
property BiDiMode;
property DragCursor;
property DragKind;
// property ImeMode;
// property ImeName;
property IntegralHeight;
property ParentBiDiMode;
property OnEndDock;
property OnStartDock;
// property HotTrack;
// property ScrollBars;
// property TabWidth;
property OnGetText: TJvListBoxDataEvent read FOnGetText write FOnGetText;
// property OnSelectCancel;
// property OnVerticalScroll;
// property OnHorizontalScroll;
property BorderStyle;
property Color;
property Columns;
property Constraints;
property DragMode;
property Enabled;
property ExtendedSelect;
property Font;
// property HintColor;
property ItemHeight default 21;
property ItemIndex default -1;
property Items;
property MultiSelect;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property OnMouseEnter;
property OnMouseLeave;
// property OnParentColorChange;
end;
implementation
uses
Math, Themes, JvJVCLUtils;
constructor TJvComboListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := lbOwnerDrawFixed;
//ScrollBars := ssVertical;
FDrawStyle := dsOriginal;
FButtonWidth := 20;
FLastHotTrack := -1;
ItemHeight := 21;
// ControlStyle := ControlStyle + [csCaptureMouse];
end;
destructor TJvComboListBox.Destroy;
begin
Clear;
inherited;
end;
function TJvComboListBox.AddImage(P: TPicture): Integer;
begin
Result := Items.Count;
InsertImage(Result, P);
end;
function TJvComboListBox.AddText(const S: string): Integer;
begin
Result := Items.Add(S);
end;
procedure TJvComboListBox.Clear;
var
i: Integer;
P: TPicture;
begin
for i := Items.Count - 1 downto 0 do begin
P := TPicture(Items.Objects[i]);
P.Free;
Items.Delete(i);
end;
inherited Clear;
end;
procedure TJvComboListBox.MouseLeave;
begin
if csDesigning in ComponentState then
Exit;
inherited MouseLeave;
if FMouseOver then
begin
InvalidateItem(ItemIndex);
FMouseOver := False;
end;
if HotTrackCombo and (FLastHotTrack > -1) then
begin
InvalidateItem(FLastHotTrack);
FLastHotTrack := -1;
end;
end;
procedure TJvComboListBox.Delete(AIndex: Integer);
var
P: TPicture;
begin
P := TPicture(Items.Objects[AIndex]);
Items.Delete(AIndex);
P.Free;
end;
function TJvComboListBox.DestRect(Picture: TPicture; ARect: TRect): TRect;
var
W, H, CW, CH: Integer;
XYAspect: Double;
begin
W := Picture.Width;
H := Picture.Height;
CW := ARect.Right - ARect.Left;
CH := ARect.Bottom - ARect.Top;
if (DrawStyle = dsStretch) or ((DrawStyle = dsProportional) and ((W > CW) or (H > CH))) then
begin
if (DrawStyle = dsProportional) and (W > 0) and (H > 0) then
begin
XYAspect := W / H;
if W > H then
begin
W := CW;
H := Trunc(CW / XYAspect);
if H > CH then // woops, too big
begin
H := CH;
W := Trunc(CH * XYAspect);
end;
end
else
begin
H := CH;
W := Trunc(CH * XYAspect);
if W > CW then // woops, too big
begin
W := CW;
H := Trunc(CW / XYAspect);
end;
end;
end
else
begin
W := CW;
H := CH;
end;
end;
Result.Left := 0;
Result.Top := 0;
Result.Right := W;
Result.Bottom := H;
OffsetRect(Result, (CW - W) div 2, (CH - H) div 2);
end;
function TJvComboListBox.DoDrawImage(Index: Integer; APicture: TPicture; R: TRect): Boolean;
begin
Result := True;
if Assigned(FOnDrawImage) then
FOnDrawImage(Self, Index, APicture, R, Result);
end;
function TJvComboListBox.DoDrawText(Index: Integer; const AText: string; R: TRect): Boolean;
begin
Result := True;
if Assigned(FOnDrawText) then
FOnDrawText(Self, Index, AText, R, Result);
end;
function TJvComboListBox.DoDropDown(Index, X, Y: Integer): Boolean;
begin
Result := True;
if Assigned(FOnDropDown) then
FOnDropDown(Self, Index, X, Y, Result);
end;
procedure TJvComboListBox.DoGetText(Index: Integer; var AText: string);
begin
if Assigned(FOnGetText) then
FOnGetText(Self, Index, AText);
end;
procedure TJvComboListBox.DrawComboArrow(ACanvas: TCanvas; R: TRect; Highlight, Pushed: Boolean);
const // highlight pushed
DROPDOWN_DETAILS: array[boolean, boolean] of TThemedCombobox = (
// Pushed = false // Pushed = true
(tcDropDownButtonNormal, tcDropDownButtonPressed), // Highlight = false
(tcDropDownButtonHot, tcDropDownButtonPressed) // Highlight = true
);
var
uState: Cardinal;
details: TThemedElementDetails;
begin
if ThemeServices.ThemesEnabled then begin
details := ThemeServices.GetElementDetails(DROPDOWN_DETAILS[Highlight, Pushed]);
ThemeServices.DrawElement(ACanvas.Handle, details, R, nil)
end else
begin
uState := DFCS_SCROLLDOWN;
if not Highlight then
Inc(uState, DFCS_FLAT);
if Pushed then
Inc(uState, DFCS_PUSHED);
DrawFrameControl(ACanvas.Handle, R, DFC_SCROLL, uState or DFCS_ADJUSTRECT);
end;
end;
procedure TJvComboListBox.DrawItem(Index: Integer; ARect: TRect;
State: TOwnerDrawState);
var
P: TPicture;
B: TBitmap;
Points: array[0..4] of TPoint;
TmpRect: TRect;
Pt: TPoint =(X:0; Y:0); // wp: to silence the compiler...
I: Integer;
AText: string;
begin
if (Index < 0) or (Index >= Items.Count) or Assigned(OnDrawItem) then
Exit;
Canvas.Lock;
try
if State * [odSelected, odFocused] <> [] then
begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText;
end;
if Items.Objects[Index] is TPicture then
P := TPicture(Items.Objects[Index])
else
P := nil;
if (P = nil) or (DrawStyle <> dsStretch) then
Canvas.FillRect(ARect);
if (P <> nil) and (P.Graphic <> nil) then
begin
TmpRect := Rect(0, 0, P.Graphic.Width, P.Graphic.Height);
if DoDrawImage(Index, P, ARect) then
begin
case DrawStyle of
dsOriginal:
begin
B := TBitmap.Create;
try
tmpRect := GetOffset(ARect, Rect(0, 0, P.Width, P.Height));
B.Width := Min(P.Width, tmpRect.Right - tmpRect.Left);
B.Height := Min(P.Height, tmpRect.Bottom - tmpRect.Top);
B.Canvas.Draw(0, 0, P.Bitmap);
Canvas.Draw(tmpRect.Left, tmpRect.Top, B);
finally
B.Free;
end;
end;
dsStretch, dsProportional:
begin
tmpRect := DestRect(P, ARect);
OffsetRect(TmpRect, ARect.Left, ARect.Top);
Canvas.StretchDraw(TmpRect, P.Graphic);
end;
end;
end;
end
else
begin
TmpRect := ARect;
InflateRect(TmpRect, -2, -2);
if DoDrawText(Index, Items[Index], TmpRect) then
begin
AText := Items[Index];
DoGetText(Index, AText);
DrawText(Canvas.Handle, PChar(AText), Length(AText),
TmpRect, DT_WORDBREAK or DT_LEFT or DT_TOP or DT_EDITCONTROL or DT_NOPREFIX or DT_END_ELLIPSIS);
end;
end;
// draw the combo button
GetCursorPos(Pt);
Pt := ScreenToClient(Pt);
I := ItemAtPos(Pt, True);
if (not HotTrackCombo and (State * [odSelected, odFocused] <> [])) or (HotTrackCombo and (I = Index)) then
begin
// draw frame
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clHighlight;
Canvas.Pen.Width := 1 + Ord(not HotTrackCombo);
Points[0] := Point(ARect.Left, ARect.Top);
Points[1] := Point(ARect.Right - 2, ARect.Top);
Points[2] := Point(ARect.Right - 2, ARect.Bottom - 2);
Points[3] := Point(ARect.Left, ARect.Bottom - 2);
Points[4] := Point(ARect.Left, ARect.Top);
Canvas.Polygon(Points);
// draw button body
if ButtonWidth > 2 then // 2 because Pen.Width is 2
begin
TmpRect := Rect(ARect.Right - ButtonWidth - 1,
ARect.Top + 1, ARect.Right - 2 - Ord(FPushed), ARect.Bottom - 2 - Ord(FPushed));
DrawComboArrow(Canvas, TmpRect, FMouseOver and Focused, FPushed);
end;
Canvas.Brush.Style := bsSolid;
end
else
if odFocused in State then
Canvas.DrawFocusRect(ARect);
Canvas.Pen.Color := clBtnShadow;
Canvas.Pen.Width := 1;
Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
Canvas.MoveTo(ARect.Right - 1, ARect.Top);
Canvas.LineTo(ARect.Right - 1, ARect.Bottom - 1);
finally
Canvas.Unlock;
end;
end;
function TJvComboListBox.GetOffset(OrigRect, ImageRect: TRect): TRect;
var
W, H, W2, H2: Integer;
begin
Result := OrigRect;
W := ImageRect.Right - ImageRect.Left;
H := ImageRect.Bottom - ImageRect.Top;
W2 := OrigRect.Right - OrigRect.Left;
H2 := OrigRect.Bottom - OrigRect.Top;
if W2 > W then
OffsetRect(Result, (W2 - W) div 2, 0);
if H2 > H then
OffsetRect(Result, 0, (H2 - H) div 2);
end;
procedure TJvComboListBox.InsertImage(AIndex: Integer; P: TPicture);
var
P2: TPicture;
begin
P2 := TPicture.Create;
P2.Assign(P);
Items.InsertObject(AIndex, '', P2);
end;
procedure TJvComboListBox.InsertText(AIndex: Integer; const S: string);
begin
Items.Insert(AIndex, S);
end;
procedure TJvComboListBox.InvalidateItem(Index: Integer);
var
R, R2: TRect;
begin
if Index < 0 then
Index := ItemIndex;
R := ItemRect(Index);
R2 := R;
// we only want to redraw the combo button
if not IsRectEmpty(R) then
begin
R.Right := R.Right - ButtonWidth;
// don't redraw content, just button
ExcludeClipRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
InvalidateRect(Handle, @R2, False);
end;
end;
procedure TJvComboListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
I: Integer;
R: TRect;
P: TPoint;
// Msg: TMsg; // wp: removed along with PeekMessage below...
begin
inherited MouseDown(Button, Shift, X, Y);
if ItemIndex > -1 then
begin
P := Point(X, Y);
I := ItemAtPos(P, True);
R := ItemRect(I);
if (I = ItemIndex) and (X >= R.Right - ButtonWidth) and (X <= R.Right) then
begin
FMouseOver := True;
FPushed := True;
InvalidateItem(I);
if (DropdownMenu <> nil) and DoDropDown(I, X, Y) then
begin
case DropdownMenu.Alignment of
paRight:
P.X := R.Right;
paLeft:
P.X := R.Left;
paCenter:
P.X := R.Left + (R.Right - R.Left) div 2;
end;
P.Y := R.Top + ItemHeight;
P := ClientToScreen(P);
DropdownMenu.PopupComponent := Self;
DropdownMenu.Popup(P.X, P.Y);
{ wp: removed - seems to work without it...
// wait for popup to disappear
while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
;
}
end;
MouseUp(Button, Shift, X, Y);
end;
end;
end;
procedure TJvComboListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
I: Integer;
R: TRect;
begin
if (DropdownMenu <> nil) or HotTrackCombo then
begin
P := Point(X, Y);
I := ItemAtPos(P, True);
R := ItemRect(I);
if HotTrackCombo and (I <> FLastHotTrack) then
begin
if FLastHotTrack > -1 then
InvalidateItem(FLastHotTrack);
FLastHotTrack := I;
if FLastHotTrack > -1 then
InvalidateItem(FLastHotTrack);
end;
if ((I = ItemIndex) or HotTrackCombo) and (X >= R.Right - ButtonWidth) and (X <= R.Right) then
begin
if not FMouseOver then
begin
FMouseOver := True;
InvalidateItem(I);
end;
end
else
if FMouseOver then
begin
FMouseOver := False;
InvalidateItem(I);
end;
end;
inherited MouseMove(Shift, X, Y);
end;
procedure TJvComboListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if FPushed then
begin
FPushed := False;
InvalidateItem(ItemIndex);
end;
end;
procedure TJvComboListBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = DropdownMenu) then
DropdownMenu := nil;
end;
procedure TJvComboListBox.SetButtonWidth(const Value: Integer);
begin
if FButtonWidth <> Value then
begin
FButtonWidth := Value;
Invalidate;
end;
end;
procedure TJvComboListBox.SetDrawStyle(const Value: TJvComboListBoxDrawStyle);
begin
if FDrawStyle <> Value then
begin
FDrawStyle := Value;
Invalidate;
end;
end;
procedure TJvComboListBox.SetHotTrackCombo(const Value: Boolean);
begin
if FHotTrackCombo <> Value then
begin
FHotTrackCombo := Value;
Invalidate;
end;
end;
procedure TJvComboListBox.Resize;
begin
inherited Resize;
Invalidate;
end;
procedure TJvComboListBox.SetDropdownMenu(const Value: TPopupMenu);
begin
ReplaceComponentReference(Self, Value, TComponent(FDropdownMenu));
end;
end.