我做过一个在OpenDialog控件，在上面加了一个TreeView和Guage，不知道是否符合你的要求：）
主要的处理函数就是在Create和DoShow
unit DlgDict;
interface
uses
Messages, Windows, SysUtils, Classes, Controls, StdCtrls, Graphics,
ExtCtrls, Dialogs, ComCtrls, Forms, CommDlg, Dlgs, Gauges, CommCtrl;
type
TOpenDictDialog = class(TOpenDialog)
private
FPanelDict: TPanel;
FPanelGauge: TPanel;
FGauge: TGauge;
FDictTree: TTreeView;
OldFileName: String;
procedure ImportTree(DataList: TStringList);
protected
procedure DoShow; override;
procedure DoClose; override;
procedure DoSelectionChange; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Execute: Boolean; override;
end;
implementation
{ TOpenDictDialog }
constructor TOpenDictDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OldFileName := '';
Filter := '字典文件|*.zdt'+'|文本文件|*.txt'+'|所有文件|*.*';
Options := [ofHideReadOnly,ofPathMustExist, ofFileMustExist];
Title := '选择字典文件';
FPanelDict := TPanel.Create(Self);
FDictTree := TTreeView.Create(Self);
FDictTree.Ctl3D := true;
with FPanelDict do
begin
Name := 'DictPanel';
with Font do
begin
Charset := DEFAULT_CHARSET;
Color := clWindowText;
Height := -15;
Name := '宋体';
Pitch := fpDefault;
Size := 9;
Style := [];
end;
Caption := '';
SetBounds(204, 5, 169, 200);
BevelInner := bvNone;
BevelOuter := bvNone;
BorderWidth := 6;
TabOrder := 1;
FPanelGauge := TPanel.Create(Self);
with FPanelGauge do
begin
Name := 'GaugePanel';
Caption := '';
Height := 20;
BevelInner := bvNone;
BevelOuter := bvNone;
BorderWidth := 0;
TabOrder := 1;
Align := alBottom;
Parent := FPanelDict;
FGauge := TGauge.Create(Self);
with FGauge do
begin
Name := 'Gauge1';
BackColor := $00fdc6e9;
ForeColor := clBlue;
Taborder := 0;
Align := alClient;
Parent := FPanelGauge;
end;
end;
end;
end;
destructor TOpenDictDialog.Destroy;
begin
FDictTree.Free;
FGauge.Free;
FPanelGauge.Free;
FPanelDict.Free;
inherited Destroy;
end;
procedure TOpenDictDialog.DoClose;
begin
inherited DoClose;
Application.HideHint;
end;
procedure TOpenDictDialog.DoSelectionChange;
var
TreeList: TStringList;
begin
TreeList := TStringList.Create;
if (FileExists(FileName)) and (FileName<>OldFileName) then begin
TreeList.LoadFromFile(FileName);
OldFileName := FileName;
if TreeList.Count>0 then
begin
ImportTree(TreeList);
if FDictTree.Items[0].Text='' then FDictTree.Items.Clear;
end;
end;
TreeList.Free;
inherited;
end;
procedure TOpenDictDialog.DoShow;
var
PreviewRect, StaticRect: TRect;
begin
GetClientRect(Handle, PreviewRect);
StaticRect := GetStaticRect;
PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
Inc(PreviewRect.Top, 4);
//Dec(PreviewRect.Bottom, 15);
FPanelDict.BoundsRect := PreviewRect;
FPanelDict.ParentWindow := Handle;
FDictTree.Align := alClient;
FDictTree.Parent := FPanelDict;
FDictTree.Color := $00C0FEFD;
inherited DoShow;
end;
function TOpenDictDialog.Execute: Boolean;
begin
if NewStyleControls and not (ofOldStyleDialog in Options) then
Template := 'DLGTEMPLATE' else
Template := nil;
Result := inherited Execute;
end;
procedure TOpenDictDialog.ImportTree(DataList: TStringList);
function GetBufStart(Buffer: PChar; var Level: Integer): PChar;
begin
Level := 0;
while Buffer^ in [' ', #9] do
begin
Inc(Buffer);
Inc(Level);
end;
Result := Buffer;
end;
function Compose(str: string; fgf: string; Num: Integer): string;
var
TempI: Integer;
ResultNum: Integer;
begin
ResultNum := 0;
if Num = 0 then begin
while True do begin
TempI := Pos(fgf, Str);
if TempI <> 0 then begin
Inc(ResultNum);
Str := Copy(Str, TempI + Length(fgf), Length(Str));
end
else Break;
end;
Result := IntToStr(ResultNum + 1);
end
else begin
for TempI := 2 to Num do begin
ResultNum := Pos(fgf, str {Result});
if ResultNum = 0 then str := ''
else str := Copy(str, ResultNum + Length(fgf), Length(str));
end;
Result := Str;
ResultNum := Pos(fgf, str);
if ResultNum <> 0 then
Result := Copy(str, 1, ResultNum - 1);
end;
end;
var
ANode, NextNode: TTreeNode;
ALevel, i: Integer;
CurrStr, str: string;
begin
FDictTree.Items.BeginUpdate;
FDictTree.Items.Clear;
FGauge.MaxValue := DataList.Count - 1;
ANode := nil;
for i := 0 to DataList.Count - 1 do
begin
CurrStr := GetBufStart(PChar(DataList), ALevel);
ALevel := ALevel + 1;
FGauge.Progress := i;
str := compose(compose(currstr, '|', 1), '=', 2);
if (pos('[', DataList) <> 0) and (pos(']', DataList) <> 0) then begin
str := compose(compose(currstr, ',', 1), '=', 2);
ANode := FDictTree.Items.AddChild(nil, str);
end
else if ANode = nil then
ANode := FDictTree.Items.AddChild(nil, str)
else if ANode.Level = ALevel then
ANode := FDictTree.Items.AddChild(ANode.Parent, Str)
else if ANode.Level = (ALevel - 1) then
ANode := FDictTree.Items.AddChild(ANode, Str)
else if ANode.Level > ALevel then
begin
NextNode := ANode.Parent;
while NextNode.Level > ALevel do
NextNode := NextNode.Parent;
ANode := FDictTree.Items.AddChild(NextNode.Parent, Str);
end;
end;
FDictTree.Items.EndUpdate;
FDictTree.Items[0].Expanded := true;
FGauge.Progress := 0;
end;
end.
