OpenDialog with combobox component for Borland Delphi 5,6,7
Name: TCBOpenDialog
Version: 1.01
Created: 22/2/2006
E-mail:
Copyright (C) 2006 Afan Tim
I wanted to search an Opendialog control with a combobox on the bottom
but cannot find any Delphi or VC control. So I wrote this one.
It's quite easy to place some controls on right side of the OpenDialog
but to the bottom it is not so easy. This component uses a resource file
template.res to add a label and a combobox.
If you have any suggestion or make any improvement, please mail me at
xxx@gmail.com. Thanks.
}
unit cbDlg;
interface
{$R Template.res}
uses
Windows, SysUtils, Classes, Dialogs, Messages, Controls, Forms;
type
TPR = record
x,
y,
cx,
cy: integer;
end;
{ Add a drop-down list to the bottom of Opendialog }
type
TCBSaveDialog = class(TSaveDialog)
private
hLabel,
hCombobox: THandle;
FItemString: String;
FDelimiter: char;
FLabelCaption: string;
Function ClientRect(const hwnd: THandle): TPR;
Function cbActiveText: String;
Function cbGetIndex(const s: string): integer;
Procedure cbSetIndex(const idx: integer);
Procedure cbSetText(const s: string);
Procedure cbInit;
Procedure cbClear;
protected
procedure DoShow; override;
procedure DoClose; override;
public
cbText: string;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Execute: Boolean; override;
Procedure cbAddItem(const s: string);
Procedure cbAddAllItems(const Items: string);
Published
Property ItemString: String Read FItemString Write FItemString; { e.g. AAA|BBB|CCC }
Property LabelCaption: String Read FLabelCaption Write FLabelCaption;
end;
Procedure Register;
implementation
const
LB_FILETYPES_ID = 1089; // "File types:" label
LB_FILENAME_ID = 1090; // "File name:" label
CB_FILETYPES_ID = 1136; // "File types:" Combobox
CB_FILENAME_ID = 1148; // "File name:" Combobox
stc32 = $045f;
{ Control id in template.res }
LB_ID = 1001; { Label ID }
CB_ID = 1000; { Combobox ID }
Procedure Register();
begin
RegisterComponents('Dialogs', [TCBSaveDialog]);
end;
{ get index of delimeter in s string }
Function EnumSubString(const s: string; const Delimeter: char; var dwIndex: integer): string;
var
i: integer;
begin
result:= '';
if dwIndex >= Length(s) then
exit;
for i:= dwIndex + 1 to Length(s) do begin
if s[I] <> Delimeter then
Result:= Result + s[I]
else
break;
end;
dwIndex:= I;
end;
{ TCBOpenDialog }
constructor TCBSaveDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDelimiter:= '|';
end;
procedure TCBSaveDialog.DoShow;
var
aRect,Rect2: TRect;
hdl,lh,ch: dword;
pr,pr2: TPR;
begin
inherited DoShow;
{ hLabel and hCombobox change every time OpenDialog pop up }
hLabel:= GetDlgItem(Handle, LB_ID);
hCombobox:= GetDlgItem(Handle, CB_ID);
{ Set combobox and lable's position and size. Do not use SetWindowPos }
hdl:= GetDlgItem(GetParent(Handle), LB_FILETYPES_ID);
pr:= ClientRect(hdl);
pr2:= ClientRect(hLabel);
GetWindowRect(hLabel, Rect2);
MoveWindow(hLabel, pr.x, pr2.y, Rect2.Right - Rect2.Left, Rect2.Bottom - Rect2.Top, false);
hdl:= GetDlgItem(GetParent(Handle), CB_FILETYPES_ID);
pr:= ClientRect(hdl);
pr2:= ClientRect(hCombobox);
GetWindowRect(hCombobox, Rect2);
MoveWindow(hCombobox, pr.x, pr2.y, Rect2.Right - Rect2.Left, Rect2.Bottom - Rect2.Top, false);
SetWindowText(hLabel, pchar(FLabelCaption));
cbInit;
end;
function TCBSaveDialog.Execute: Boolean;
var
hDlg,hdl: dword;
buf: array[0..256] of char;
begin
if NewStyleControls and not (ofOldStyleDialog in Options) then
Template := 'DLGTEMPLATE01' else
Template := nil;
Result := inherited Execute;
end;
procedure TCBSaveDialog.DoClose;
begin
{ Hide any hint windows left behind }
Application.HideHint;
cbText:= cbActiveText;
inherited DoClose;
end;
destructor TCBSaveDialog.Destroy;
begin
inherited destroy;
end;
{ Get left-top position that relative to parent window, and height, width }
function TCBSaveDialog.ClientRect(const hwnd: THandle): TPR;
var
dlgRect,aRect: TRect;
begin
GetWindowRect(handle, dlgRect);
GetWindowRect(hwnd, aRect);
with result do begin
x:= aRect.Left - dlgRect.Left;
y:= aRect.Top - dlgRect.Top;
cx:= aRect.Right - aRect.Left;
cy:= aRect.Bottom - aRect.Top;
end;
end;
{ Get current text in combobox }
Function TCBSaveDialog.cbActiveText: String;
var
buf: pchar;
idx: integer;
begin
result:= '';
GetMem(buf, 100);
GetWindowText(hCombobox, buf, 100);
result:= Trim(buf);
end;
{ select item in combobox }
procedure TCBSaveDialog.cbSetIndex(const idx: integer);
begin
SendMessage(hCombobox, CB_SETCURSEL, idx, 0);
end;
{ select item in combobox }
procedure TCBSaveDialog.cbSetText(const s: string);
var
idx: integer;
begin
idx:= cbGetIndex(s);
cbSetIndex(idx);
end;
{ get text index in list }
function TCBSaveDialog.cbGetIndex(const s: string): integer;
begin
result:= SendMessage(hCombobox, CB_FINDSTRINGEXACT, -1, Integer(pchar(s)));
end;
{ Add items to combobox }
procedure TCBSaveDialog.cbAddAllItems(const Items: string);
var
dwIndex: integer;
s: string;
begin
dwIndex:= 0;
while dwIndex < Length(Items) do begin
s:= EnumSubString(Items, FDelimiter, dwIndex);
cbAddItem(s);
end;
end;
{ Add item to combobox }
procedure TCBSaveDialog.cbAddItem(const s: string);
begin
SendMessage(hCombobox, CB_ADDSTRING, 0, Integer(pchar(s)));
end;
{ Initialize combobox }
procedure TCBSaveDialog.cbInit;
var
m: integer;
begin
//cbClear;
cbAddAllItems(FItemString);
if cbText <> '' then
cbSetText(cbText);
end;
{ Delete all string in list }
procedure TCBSaveDialog.cbClear;
var
m: integer;
begin
m:= 1;
while m > 0 do
m:= SendMessage(hCombobox, CB_DELETESTRING, 0, 0);
end;
end.
Demo和完整源代码的下载地址：
http://www.sjedu.net/test/dialog.torry.rar