Текущий архив: 2006.07.30;
Скачать: CL | DM;

Вниз

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;
Скачать: CL | DM;

Наверх

Память: 0.52 MB
Время: 0.03 c