Форум: "Начинающим";
Текущий архив: 2006.07.30;
Скачать: [xml.tar.bz2];
ВнизTreeView Найти похожие ветки
← →
Diksa (2006-07-07 12:54) [0]Как работать с компонентом TreeView, а точнее как загрезить в него дерево винчестера???? Заранее благодарю!!!
← →
Плохиш © (2006-07-07 12:57) [1]
> а точнее как загрезить в него дерево винчестера?
Куда уж точнее. Надо вызвать метод Zagrezit и передать в него параметром дерево винчестера. Хм, а винчестеры оказывается на деревьях растут 8-O Попасть бы в сад с такими деревьями :-))
← →
PSPF2003 © (2006-07-07 12:57) [2]А Help посмотреть лень?
LoadFromFile
← →
PSPF2003 © (2006-07-07 12:58) [3]
> Плохиш © (07.07.06 12:57) [1]
> > а точнее как загрезить в него дерево винчестера?Куда уж
> точнее. Надо вызвать метод Zagrezit и передать в него параметром
> дерево винчестера. Хм, а винчестеры оказывается на деревьях
> растут 8-O Попасть бы в сад с такими деревьями :-))
5+ :)))
← →
Diksa © (2006-07-07 13:12) [4]Удалено модератором
← →
PSPF2003 © (2006-07-07 13:13) [5]Удалено модератором
← →
PSPF2003 © (2006-07-07 13:16) [6]TreeView.LoadFromFile();
← →
ancot (2006-07-07 13:23) [7]Писал года 4 назад, вроде сносно работает.
interface
uses
Windows ,SysUtils, Classes, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Types, Menus, Messages;
type
TWndPanel = class(TCustomControl)
private
CanDraw: Boolean;
FAutoHide: Boolean;
FChildCount: Integer;
FActiveForm: Integer;
FIcon: TIcon;
FBmp: TBitmap;
FImage: TImageList;
FImageIndex: Integer;
function BtnRect(Index: Integer): TRect;
function GetChild(Index: Integer): TForm;
procedure SetAutoHide(Value: Boolean);
procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
procedure FormChange(Sender: TObject);
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
procedure Loaded; override;
published
property Visible;
property Color;
property Image: TImageList read FImage write FImage;
property ImageIndex: Integer read FImageIndex write FImageIndex;
property AutoHide: Boolean read FAutoHide write SetAutoHide;
property PopupMenu;
end;
procedure Register;
implementation
{$R ICO.RES}
uses Math;
constructor TWndPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBmp := TBitmap.Create;
Align := alBottom;
Color := clBtnFace;
FIcon := TIcon.Create;
FIcon.Transparent := true;
FIcon.Width := 16;
FIcon.Height := 16;
end;
destructor TWndPanel.Destroy;
begin
FBmp.Free;
FIcon.Free;
inherited Destroy;
end;
procedure TWndPanel.Paint;
var R: TRect;
n, i: Integer;
Cap: String;
Ico: TIcon;
Frm: TComponent;
begin
with Canvas, Application do
begin
Brush.Color := clBtnFace;
FillRect(BoundsRect);
R := Rect(0, Height - 1, Width + 1, Height - 1);
Frame3D(Canvas, R, clWhite, clBtnShadow, 1);
if (csDesigning in componentstate) or (FChildCount = 0) or (not CanDraw) then Exit;
n:= 0;
for i := 0 to ComponentCount - 1 do
begin
Frm := Components[i];
if (Frm is TForm) and (TForm(Frm).FormStyle = fsMDIChild) then
begin
Frm := Components[i] as TForm;
R := BtnRect(n);
FillRect(R);
if Frm = MainForm.ActiveMDIChild then
begin
Font.Style := [fsBold];
Frame3D(Canvas, R, cl3DDkShadow, clWhite, 1);
Frame3D(Canvas, R, clBtnShadow, clBtnFace, 1);
FActiveForm := n;
R.Right := R.Left + 16;
end else
begin
Font.Style := [];
Frame3D(Canvas, R, clWhite, cl3DDkShadow, 1);
Frame3D(Canvas, R, clBtnFace, clBtnShadow, 1);
R.Right := R.Left + 16;
OffsetRect(R, -1, -1);
end;
Brush.Color := clBtnFace;
Ico := TForm(Frm).Icon;
if Ico.Empty then
begin
if Image <> nil then
Image.GetIcon(ImageIndex, FIcon);
end else
begin
if Assigned(Ico) then FIcon.Assign(Ico);
end;
Draw(R.Left, R.Top, FIcon);
R := BtnRect(n);
Inc(R.Left, 21);
Inc(R.Top, 3);
Dec(R.Right, 2);
Cap := TForm(Frm).Caption;
DrawText(Canvas.Handle, PChar(Cap), Length(Cap), R, DT_LEFT or DT_END_ELLIPSIS);
Inc(n);
end;
end;
end;
end;
procedure TWndPanel.Loaded;
begin
inherited Loaded;
Height := 24;
if not (csDesigning in Componentstate) then
Screen.OnActiveFormChange := FormChange;
end;
procedure TWndPanel.SetAutoHide(Value: Boolean);
begin
FAutoHide := Value;
if FAutoHide then Height := 6
else Height := 24;
CanDraw := not Value;
end;
function TWndPanel.GetChild(Index: Integer): TForm;
var n, i: Integer;
begin
n := 0;
Result := nil;
for i := 0 to Application.ComponentCount - 1 do
if Application.Components[i] is TForm then
if (Application.Components[i] as TForm).FormStyle = fsMDIChild
then begin
if n = Index then
begin
Result := TForm(Application.Components[i]);
Exit;
end;
Inc(n);
end;
end;
function TWndPanel.BtnRect(Index: Integer): TRect;
var BtnWidth: Integer;
begin
BtnWidth := Min(170, Width div FChildCount);
Result := Rect(Index * BtnWidth, 1, Index * BtnWidth + BtnWidth - 3, Height - 3)
end;
procedure TWndPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var i: Integer;
R: TRect;
begin
inherited;
if not (ssLeft in Shift) then Exit;
for i := 0 to Application.MainForm.MDIChildCount - 1 do
begin
R := BtnRect(i);
if (X >= R.Left) and (X <= R.Right)
and (Y >= R.Top) and (Y <= R.Bottom) then GetChild(i).Show;
end;
end;
procedure TWndPanel.FormChange(Sender: TObject);
begin
with Application do
begin
if (Terminated or not Visible) or (MainForm = nil) then Exit;
FChildCount := MainForm.MDIChildCount;
end;
Invalidate;
end;
procedure TWndPanel.CMMouseEnter (var Message: TMessage);
begin
inherited;
if csDesigning in ComponentState then Exit;
if (GetActiveWindow <> 0) then
if FAutoHide then
begin
CanDraw := true;
Height := 24;
end;
end;
procedure TWndPanel.CMMouseLeave (var Message: TMessage);
begin
inherited;
if csDesigning in componentstate then Exit;
if FAutoHide then
begin
CanDraw := False;
Height := 6;
Repaint;
end;
end;
procedure Register;
begin
RegisterComponents("1C Controls", [TWndPanel]);
end;
end.
← →
ancot (2006-07-07 13:24) [8]Блин, не в ту ветку..
← →
PSPF2003 © (2006-07-07 13:28) [9]
> Блин, не в ту ветку..
Бывает :)
← →
Diksa © (2006-07-07 13:31) [10]И что мне с файла загружать??
Я просто хочу чтоб видно было например диск D или С
← →
PSPF2003 © (2006-07-07 13:46) [11]Ща поищи
← →
PSPF2003 © (2006-07-07 13:48) [12]ShellTreeView не подходит?
← →
Diksa © (2006-07-07 13:50) [13]Удалено модератором
← →
PSPF2003 © (2006-07-07 13:54) [14]Удалено модератором
← →
Diksa © (2006-07-07 13:59) [15]
> Так подходит или нет?
ты о ShellTreeView?
может и подходит но я незнаю как его использовать
← →
nfr (2006-07-07 14:05) [16]Var
Node, NN : TTreeNode;
procedure LoadTree(Dir : String);
var
sr : TSearchRec;
begin
if FindFirst(Dir + "*.*", faAnyFile - faVolumeID, sr) = 0 then
repeat
if (sr.Name = ".") or (sr.Name = "..") then continue;
if (sr.Attr and faDirectory) = 0 then Continue;
NN := TV.Items.AddChild(NN, sr.Name);
LoadTree(Dir + sr.name + "\");
until (FindNext(sr) <> 0);
Node := NN;
if NN <> nil then NN := NN.Parent;
FindClose(sr); {}
if FindFirst(Dir + "*.*", faAnyFile - faVolumeID - faDirectory, sr) = 0 then
repeat
if (sr.Name = ".") or (sr.Name = "..") then Continue;
TV.Items.AddChild(Node, sr.Name);
until (FindNext(sr) <> 0);
FindClose(sr); {}
end;
← →
easy © (2006-07-07 16:15) [17]http://dfc.com.ru/?sid=2&id=7&itemid=3
← →
Diksa © (2006-07-07 19:19) [18]Во это то что надо Спасибо easy!!!
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2006.07.30;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.01 c