1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354 |
- {$ifndef read_implementation}
- {$ifdef FPC} {$mode delphi} {$endif FPC}
- unit KOLDirDlgEx;
-
- interface
-
- uses Windows, Messages, KOL {$IFDEF USE_GRUSH}, ToGrush, KOLGRushControls {$ENDIF}
- {$ifdef FPC}{$if not defined(VER2_2_0) and defined(wince)},commctrl{$endif}{$endif};
-
- {$endif read_implementation}
-
- {$IFDEF EXTERNAL_DEFINES}
- {$INCLUDE EXTERNAL_DEFINES.INC}
- {$ENDIF EXTERNAL_DEFINES}
-
- //{$DEFINE NO_DEFAULT_FASTSCAN}
- { if you add such option, all icons for removable and remote drives
- are obtained by default accessing these drives, slow. }
- //{$DEFINE DIRDLGEX_NO_DBLCLK_ON_NODE_OK}
- { if this option is on, double clicks in the directories tree
- is used only to expand/collapse children nodes. By default,
- double click on a node w/o children selects it and
- finishes the dialog as in case when OK is clicked. }
-
- //{$DEFINE DIRDLGEX_LINKSPANEL}
- { if this option is on, links panel is available (on the left side).
- Also USE_MENU_CURCTL symbol must be added! }
- //{$DEFINE DIRDLGEX_STDFONT}
- { add this option to use standard font size in a links panel
- (otherwise Arial, 14 is used) }
- {$DEFINE DIRDLGEX_BIGGERPANEL}
- { a bit bigger links panel with bigger buttons on it }
-
- { ----------------------------------------------------------------------
-
- TOpenDirDialogEx
-
- ----------------------------------------------------------------------- }
- { TOpenDirDialogEx - àëüòåðíàòèâà ñòàíäàðòíîìó äèàëîãó âûáîðà ïàïêè.
- (c) by Vladimir Kladov, 2005, 14 Dec.
- Íåîáõîäèìîñòü: ñòàíäàðòíûé äèàëîã ðàáîòàåò ìåäëåííî, äëÿ êàæäîé îïåðàöèè
- âûáîðà ïàïêè ïîëüçîâàòåëåì îòêðûâàåòñÿ çàíîâî, ñòðîÿ çàíîâî
- äåðåâî ïàïîê, ïðè ýòîì ãëþ÷èò: ðåãóëÿðíî âîçíèêàåò ñèòóàöèÿ,
- êîãäà ðîäèòåëüñêèé óçåë äëÿ ïåðâîíà÷àëüíîé ïàïêè ìîæåò ïîêàçàòü
- òîëüêî òåêóùóþ âëîæåííóþ ïàïêó, õîòÿ òàì åñòü åùå ïàïêè.
- Íå ãîâîðÿ óæå î ìåëêèõ ãëóïîñòÿõ, âðîäå òîé, ÷òî òåêóùèé óçåë
- â ìîìåíò îòêðûòèÿ ìîæåò ïðîñòî îêàçàòüñÿ âíå ïîëÿ çðåíèÿ, èëè
- òîé, ÷òî â ñòàíäàðòíîì äèàëîãå àêòèâíûì îêàçûâàåòñÿ íå äåðåâî
- âûáîðà ïàïîê, à êíîïêà ÎÊ (èëè êòî-òî äóìàåò, ÷òî ïîëüçîâàòåëü
- îòêðûë äèàëîã äëÿ òîãî, ÷òîáû íàæàòü ÎÊ, íå âûáèðàÿ ïàïêó?).
- Îñîáåííîñòè TOpenDirDialogEx: ðàáîòàåò áûñòðî. Ïðè ïîâòîðíîì âûïîëíåíèè
- Execute ïåðåñêàíèðóåòñÿ òîëüêî òà ÷àñòü äåðåâà, êîòîðàÿ âûøå òåêóùåé ïàïêè
- (ò.å. ïîâòîðíîå îòêðûòèå âûïîëíÿåòñÿ ïðàêòè÷åñêè ìãíîâåííî). Ïåðâîíà÷àëüíî
- îòêðûâàåòñÿ òîëüêî ÷àñòü äåðåâà ïàïîê, êîòîðàÿ íåîáõîäèìà, ÷òîáû ïîëíîñòü
- îòêðûòü âñå ïàïêè íà ïóòè îò êîðíÿ äèñêà äî òåêóùåé ïàïêè. Ïðî÷èå ïàïêè
- îòêðûâàþòñÿ è ïåðåñêàíèðóþòñÿ ïðè èõ îòêðûòèè (ðàñïàõèâàíèè). Ïîâòîðíîå
- ðàñïàõèâàíèå ïàïêè ïåðåñêàíèðóåò åå (êàê àëüòåðíàòèâà àâòîìàòè÷åñêîìó
- îáíîâëåíèþ, êîòîðîå íå ðåàëèçîâàíî - õîòÿ è îñîáîé íåîáõîäèìîñòè â àâòîìàòèêå
- íà ïðàêòèêå íåò, è êðîìå äîïîëíèòåëüíîé íàãðóçêè íà ñèñòåìó òîëêó îò òàêîãî
- àâòîìàòà òîæå íå âèäíî).
-
- Äîïîëíèòåëüíûå âêóñíîñòè:
- Åñòü âîçìîæíîñòü ïîìåíÿòü íàäïèñè íà êíîïêàõ, çàãîëîâîê äèàëîãà.
- Åñòü âîçìîæíîñòü îòôèëüòðîâàòü äèðåêòîðèè ïî àòðèáóòàì (FilterAttrs), íàïðèìåð,
- åñëè ïðèñâîèòü FILE_ATTRIBUTE_HIDDEN, òî ñêðûòûå ïàïêè â äåðåâå ïîêàçàíû íå áóäóò.
- }
- const
- WM_USER_RESCANTREE = WM_USER;
-
- {$ifdef FPC}
- {$if not defined(UNICODE_CTRLS) and not defined(wince)}
- {$I fpc_unicode_add.inc}
- {$endif}
- {$endif FPC}
-
- {$ifdef wince}
- type
- TFindexInfoLevels = FINDEX_INFO_LEVELS;
- TFindexSearchOps = FINDEX_SEARCH_OPS;
- {$endif wince}
-
- type
- TFindFirstFileEx = function(lpFileName: PKOLChar; fInfoLevelId: TFindexInfoLevels;
- lpFindFileData: Pointer; fSearchOp: TFindexSearchOps; lpSearchFilter: Pointer;
- dwAdditionalFlags: DWORD): THandle; stdcall;
-
- POpenDirDialogEx = ^TOpenDirDialogEx;
- TOpenDirDialogEx = object( TObj )
- protected
- FFastScan: Boolean;
- DlgClient: PControl;
- DirTree: PControl;
- BtnPanel: PControl;
- RescanningNode, RescanningTree: Boolean;
- FPath, FRecycledName: KOLString;
- FRemoteIconSysIdx: Integer;
- FFindFirstFileEx: TFindFirstFileEx;
- k32: THandle;
- DialogForm: PControl;
- function GetFindFirstFileEx: TFindFirstFileEx;
- procedure SetPath(const Value: KOLString);
- function GetDialogForm: PControl;
- procedure DoOK( Sender: PObj );
- procedure DoCancel( Sender: PObj );
- procedure DoNotClose( Sender: PObj; var Accept: Boolean );
- procedure DoShow( Sender: PObj );
- function DoMsg( var Msg: TMsg; var Rslt: Integer ): Boolean;
- function DoExpanding( Sender: PControl; Item: THandle; Expand: Boolean )
- : Boolean;
- function DoFilterAttrs( Attrs: DWORD; const APath: KOLString ): Boolean;
- procedure Rescantree;
- procedure RescanNode( node: Integer );
- procedure RescanDisks;
- function RemoteIconSysIdx: Integer;
- procedure CheckNodeHasChildren( node: Integer );
- procedure CreateDialogForm;
- property _FindFirstFileEx: TFindFirstFileEx read GetFindFirstFileEx;
- procedure DeleteNode( node: Integer );
- procedure DestroyingForm( Sender: PObj );
- function GetNodePath(N: THandle): KOLString;
- public
- OKCaption, CancelCaption: KOLString;
- FilterAttrs: DWORD;
- FilterRecycled: Boolean;
- Title: KOLString;
- property Form: PControl read GetDialogForm;
- {* DialogForm object. Though it is possible to do anything since it is
- in public section, do this only if you understand possible consequences.
- E.g., use it to change DialogForm bounding rectangle on screen or to
- add your own controls, event handlers and so on. }
- destructor Destroy; virtual;
- function Execute: Boolean;
- property InitialPath: KOLString read FPath write SetPath;
- property Path: KOLString read FPath write SetPath;
- property FastScan: Boolean read FFastScan write FFastScan;
- procedure DoubleClick( Sender: PControl; var M: TMouseEventData );
- {$IFDEF DIRDLGEX_LINKSPANEL}
- protected
- LinksPanel, LinksBox, LinksTape: PControl;
- LinksUp, LinksDn, LinksAdd: PControl;
- LinksList: PStrListEx;
- LinksImgList: PImageList;
- LinksRollTimer: PTimer;
- LinksPopupMenu: PMenu;
- procedure CreateLinksPanel;
- function GetLinksPanelOn: Boolean;
- procedure SetLinksPanelOn( const Value: Boolean );
- function GetLinksCount: Integer;
- function GetLinks(idx: Integer): KOLString;
- procedure SetLinks(idx: Integer; const Value: KOLString);
- procedure SetupLinksTapeHeight;
- procedure SetUpTaborders;
- procedure LinksUpClick( Sender: PControl; var Mouse: TMouseEventData );
- procedure LinksDnClick( Sender: PControl; var Mouse: TMouseEventData );
- procedure LinksUpDnStop( Sender: PControl; var Mouse: TMouseEventData );
- procedure LinksAddClick( Sender: PObj );
- procedure LinkClick( Sender: PObj );
- procedure LinksRollTimerTimer( Sender: PObj );
- //procedure LinksPanelShowEvent( Sender: PObj );
- procedure RemoveLinkClick( Sender: PMenu; Item: Integer );
- public
- property LinksPanelOn: Boolean read GetLinksPanelOn write SetLinksPanelOn;
- property LinksCount: Integer read GetLinksCount;
- property Links[ idx: Integer ]: KOLString read GetLinks write SetLinks;
- procedure AddLinks( SL: PStrList );
- function CollectLinks: PStrList;
- function LinkPresent( const s: KOLString ): Boolean;
- procedure RemoveLink( const s: KOLString );
- procedure ClearLinks;
- {$ENDIF DIRDLGEX_LINKSPANEL}
- end;
-
- {$ifndef read_implementation}
- function NewOpenDirDialogEx: POpenDirDialogEx;
-
- {$IFDEF KOL_MCK}
- {$IFNDEF DIRDLGEX_OPTIONAL} { add this symbol if you want use
- both types of the open directory dialog in your application
- (and in such case, call a constructor of the TOpenDirDialogEx
- object manually). }
- type TKOLOpenDirDialog = POpenDirDialogEx;
- {$ENDIF}
- {$ENDIF}
-
- implementation
- {$endif read_implementation}
-
- function NewOpenDirDialogEx: POpenDirDialogEx;
- begin
- new( Result, Create );
- {$IFNDEF NO_DEFAULT_FASTSCAN}
- Result.FastScan := TRUE;
- {$ENDIF}
- end;
-
- procedure NewPanelWithSingleButtonToolbar( AParent: PControl; W, H: Integer;
- A: TControlAlign; Bmp: PBitmap; const C, T: KOLString; var Pn, Bar: PControl;
- const ClickEvent: TOnEvent; DownEvent, ReleaseEvent: TOnMouse;
- P: PMenu );
- var i: Integer;
- Buffer: PKOLChar;
- begin
- Pn := NewPanel( AParent, esNone ).SetSize( 0, H ).SetAlign( A );
- Pn.Border := 0;
- {$ifdef wince}
- pn.Color:=clBtnFace;
- pn.HasBorder:=True;
- {$endif wince}
- Bar := NewToolbar( Pn, caClient, [
- tboNoDivider, tboTextBottom {, tboFlat} ],
- Bmp.ReleaseHandle,
- [ PKOLChar( {$IFDEF TOOLBAR_DOT_NOAUTOSIZE_BUTTON} '.' + {$ENDIF} C ) ], [ 0 ] );
- Buffer := AllocMem( (Length( T ) + 1)*SizeOf(KOLChar) );
- if T <> '' then
- Move(T[1], Buffer^, Length( T )*SizeOf(KOLChar));
- {$IFDEF USE_GRUSH}
- i := 0;
- {$IFDEF TOGRUSH_OPTIONAL}
- if NoGrush then
- begin
- i := Bar.TBIndex2Item(0);
- Bar.Perform( TB_SETBITMAPSIZE, 0, MakeLong( Bmp.Width, Bmp.Height ) );
- end;
- if not NoGrush then
- {$ENDIF}
- begin
- PGRushControl( Bar.Children[0] ).All_GlyphVAlign := vaTop;
- if C = '' then
- begin
- PGRushControl( Bar.Children[0] ).All_GlyphVAlign := vaCenter;
- PGRushControl( Bar.Children[0] ).All_ContentOffsets := MakeRect( -4, -4, 4, 4 );
- end;
- PGRushControl( Bar.Children[0] ).All_GlyphHAlign := haCenter;
- PGRushControl( Bar.Children[0] ).All_GlyphWidth := Bmp.Width;
- PGRushControl( Bar.Children[0] ).All_Spacing := 2;
- PGRushControl( Bar.Children[0] ).Width := W;
- if not Assigned( DownEvent ) then
- PGRushControl( Bar.Children[0] ).OnClick := ClickEvent
- else
- begin
- PGRushControl( Bar.Children[0] ).OnMouseDown := DownEvent;
- PGRushControl( Bar.Children[0] ).OnMouseUp := ReleaseEvent;
- end;
- PGRushControl( Bar.Children[0] ).CustomData := Buffer;
- PGRushControl( Bar.Children[0] ).All_ColorOuter := AParent.Color;
- //PGRushControl( Bar ).All_ColorFrom := AParent.Color;
- //PGRushControl( Bar ).All_ColorTo := AParent.Color;
- end
- {$IFDEF TOGRUSH_OPTIONAL}
- else
- begin
- i := Bar.TBIndex2Item(0);
- Bar.TBButtonWidth[ i ] := W;
- Bar.Perform( TB_SETBITMAPSIZE, 0, MakeLong( Bmp.Width, Bmp.Height ) );
- if not Assigned( ReleaseEvent ) then
- Bar.OnClick := ClickEvent
- else
- begin
- Bar.OnMouseDown := DownEvent;
- Bar.OnMouseUp := ReleaseEvent;
- end;
- Bar.CustomData := Buffer;
- end
- {$ENDIF TOGRUSH_OPTIONAL}
- ;
- {$ELSE}
- i := Bar.TBIndex2Item(0);
- Bar.TBButtonWidth[ i ] := W;
- Bar.Perform( TB_SETBITMAPSIZE, 0, MakeLong( Bmp.Width, Bmp.Height ) );
- if not Assigned( ReleaseEvent ) then
- Bar.OnClick := ClickEvent
- else
- begin
- Bar.OnMouseDown := DownEvent;
- Bar.OnMouseUp := ReleaseEvent;
- end;
- Bar.CustomData := Buffer;
- {$ENDIF USE_GRUSH}
- ToolbarSetTooltips( Bar, i, [ PKOLChar( T ) ] );
- if P <> nil then
- begin
- Pn.SetAutoPopupMenu( P );
- end;
- Bmp.Free;
- end;
-
- { TOpenDirDialogEx }
-
- {$IFDEF DIRDLGEX_LINKSPANEL}
- procedure TOpenDirDialogEx.AddLinks(SL: PStrList);
- var i: Integer;
- begin
- for i := 0 to SL.Count-1 do
- if not LinkPresent( SL.Items[ i ] ) then
- Links[ LinksCount ] := SL.Items[ i ];
- end;
-
- {$ENDIF DIRDLGEX_LINKSPANEL}
-
- procedure TOpenDirDialogEx.CheckNodeHasChildren(node: Integer);
- var HasSubDirs: Boolean;
- {$ifndef wince}
- txt: KOLString;
- {$endif wince}
- F: THandle;
- Find32: TWin32FindData;
- ii, n: Integer;
- begin
- HasSubDirs := FALSE;
- {$ifndef wince}
- txt := DirTree.TVItemText[ node ];
- if (Length( txt ) = 2) then
- if (txt[ 2 ] = ':') then
- begin
- ii := GetDriveType( PKOLChar( txt + '\' ) );
- if IntIn( ii, [ DRIVE_REMOVABLE, DRIVE_REMOTE, DRIVE_CDROM ] ) then
- HasSubDirs := TRUE;
- end;
- if not HasSubDirs then
- begin
- if WinVer >= wvNT then
- begin
- {$endif wince}
- _FindFirstFileEx;
- F := FFindFirstFileEx( PKOLChar( GetNodePath( node ) + '\*.*' ),
- FindExInfoStandard, @ Find32, FindExSearchLimitToDirectories, nil, 0 );
- if F <> INVALID_HANDLE_VALUE then
- begin
- while TRUE do
- begin
- if Find32.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
- if (Find32.cFileName <> KOLString( '.' )) and (Find32.cFileName <> '..') then
- if DoFilterAttrs( Find32.dwFileAttributes, Find32.{$ifdef wince}cFileName{$else}cAlternateFileName{$endif} ) then
- begin
- HasSubDirs := TRUE;
- break;
- end;
- if not FindNextFile( F, Find32 ) then break;
- end;
- if not FindClose( F ) then
- {begin
- asm
- nop
- end;
- end};
- end;
- {$ifndef wince}
- end
- else
- begin
- F := FindFirstFile( PKOLChar( GetNodePath( node ) + '\*.*' ), Find32 );
- if F <> INVALID_HANDLE_VALUE then
- begin
- while TRUE do
- begin
- if Find32.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
- if (Find32.cFileName <> KOLString( '.' )) and (Find32.cFileName <> '..') then
- begin
- HasSubDirs := TRUE;
- break;
- end;
- if not FindNextFile( F, Find32 ) then break;
- end;
- FindClose( F );
- end;
- end;
- end;
- {$endif wince}
- if not HasSubDirs then
- begin
- DirTree.TVExpand( node, TVE_COLLAPSE );
- n := DirTree.TVItemChild[ node ];
- while n <> 0 do
- begin
- ii := n;
- n := DirTree.TVItemNext[ n ];
- //DirTree.TVDelete( ii );
- DeleteNode( ii );
- end;
- end;
- if DirTree.TVItemParent[ node ] = 0 then HasSubDirs := TRUE;
- DirTree.TVItemHasChildren[ node ] := HasSubDirs;
- end;
-
- {$IFDEF DIRDLGEX_LINKSPANEL}
- procedure TOpenDirDialogEx.ClearLinks;
- var i: Integer;
- begin
- if LinksList = nil then Exit;
- LinksList.Clear;
- for i := LinksTape.ChildCount-1 downto 0 do
- LinksTape.Children[ i ].Free;
- LinksTape.Height := 8;
- LinksTape.Top := 0;
- end;
-
- function TOpenDirDialogEx.CollectLinks: PStrList;
- var i: Integer;
- begin
- Result := NewStrList;
- for i := 0 to LinksCount-1 do
- Result.Add( Links[ i ] );
- end;
- {$ENDIF DIRDLGEX_LINKSPANEL}
-
- procedure TOpenDirDialogEx.CreateDialogForm;
- var Sysimages: PImageList;
- BtOk, BtCancel, DTSubPanel: PControl;
- s: KOLString;
- begin
- if not Assigned( DialogForm ) then
- begin
- if Title = '' then Title := 'Select folder' {$ifdef wince} + ':' {$endif};
- {$ifndef wince}
- OleInit;
- {$endif wince}
- DialogForm := NewForm( Applet, '' ){$ifndef wince}.SetSize( 324, 330 ).CenterOnParent{$endif};
- DialogForm.OnDestroy := DestroyingForm;
- DialogForm.OnClose := DoNotClose;
- DialogForm.Tabulate;
- {$ifdef wince}
- DialogForm.Border := 4;
- DialogForm.Font.FontName:='Tahoma';
- DialogForm.Font.FontHeight:=-11;
- {$else}
- DialogForm.Border := 6;
- DialogForm.MinWidth := 324;
- DialogForm.MinHeight := 330;
- DialogForm.ExStyle := DialogForm.ExStyle or
- WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE;
- DialogForm.Style := DialogForm.Style and
- not (WS_MINIMIZEBOX or WS_MAXIMIZEBOX);
- {$endif wince}
- Sysimages := NewImageList( DialogForm );
- Sysimages.LoadSystemIcons( TRUE );
- //DlgClient := NewPanel( DialogForm, esNone ).SetAlign(caClient);
- {$IFDEF USE_GRUSH}
- {$IFDEF TOGRUSH_OPTIONAL}
- if not NoGrush then
- {$ENDIF TOGRUSH_OPTIONAL}
- begin
- DialogForm.Color := clGRushLight;
- DlgClient := NewPanel( DialogForm, esNone ).SetAlign(caClient);
- //DlgClient.Border := 2;
- end
- {$IFDEF TOGRUSH_OPTIONAL}
- else DlgClient := DialogForm;
- {$ENDIF TOGRUSH_OPTIONAL}
- ;
- {$ELSE}
- DlgClient := DialogForm;
- {$ENDIF}
-
- {$IFDEF USE_GRUSH}
- {$IFDEF TOGRUSH_OPTIONAL}
- if not NoGrush then
- {$ENDIF TOGRUSH_OPTIONAL}
- begin
- DTSubPanel := KOL.NewPanel( DlgClient, esNone );
- DTSubPanel.Color := clWindow;
- DTSubPanel.Border := 2;
- BtnPanel := NewPanel( DlgClient, esTransparent )
- .SetSize( 0, 26 ).SetAlign(caBottom );
- //BtnPanel.Color := clGRushMedium;
- BtnPanel.Border := 2;
- DTSubPanel.SetAlign( caClient );
- DirTree := NewTreeView( DTSubPanel, [ tvoLinesRoot ], Sysimages, nil );
- {$IFNDEF DIRDLGEX_NO_DBLCLK_ON_NODE_OK}
- DirTree.OnMouseDblClk := DoubleClick;
- {$ENDIF}
- DirTree.Color := clWindow;
- DirTree.OnTVExpanding := DoExpanding;
- DirTree.SetAlign( caClient );
- end
- {$IFDEF TOGRUSH_OPTIONAL}
- else
- begin
- DTSubPanel := DlgClient;
- DirTree := NewTreeView( DTSubPanel, [ tvoLinesRoot ], Sysimages, nil );
- DirTree.Color := clWindow;
- DirTree.OnTVExpanding := DoExpanding;
- BtnPanel := NewPanel( DlgClient, esTransparent )
- .SetSize( 0, 26 ).SetAlign(caBottom );
- BtnPanel.Border := 2;
- DirTree.SetAlign( caClient );
- end
- {$ENDIF TOGRUSH_OPTIONAL}
- ;
- {$ELSE}
- {$ifdef wince}
- NewLabel(DlgClient, Title).AutoSize(True).SetAlign(caTop);
- {$endif wince}
- DTSubPanel := DlgClient;
- DirTree := NewTreeView( DTSubPanel, [ {$ifndef wince} tvoLinesRoot {$endif} ], Sysimages, nil );
- DirTree.Color := clWindow;
- DirTree.OnTVExpanding := DoExpanding;
- BtnPanel := NewPanel( DlgClient, esTransparent )
- .SetSize( 0, 26 ).SetAlign(caBottom );
- BtnPanel.Border := 2;
- DirTree.SetAlign( caClient );
- {$ENDIF}
- DTSubPanel.OnMessage := DoMsg;
- DlgClient := DTSubPanel; // !!!
- s := CancelCaption; if s = '' then s := 'Cancel';
- BtCancel := NewButton( BtnPanel, s );
- BtCancel.MinWidth := 75; BtCancel.OnClick := DoCancel;
- BtCancel.AutoSize( TRUE ).SetAlign( caRight );
- s := OKCaption; if s = '' then s := 'OK';
- BtOK := NewButton( BtnPanel, s );
- BtOK.MinWidth := 75; BtOK.OnClick := DoOK;
- BtOK.AutoSize( TRUE ).SetAlign( caRight );
- BtCancel.TabOrder := 1;
- BtOK.DefaultBtn := TRUE;
- BtCancel.CancelBtn := TRUE;
- DialogForm.OnShow := DoShow;
- {$IFDEF USE_GRUSH}
- {$IFDEF TOGRUSH_OPTIONAL}
- if not NoGrush then
- {$ENDIF TOGRUSH_OPTIONAL}
- begin
- BtOK.Transparent := TRUE;
- BtCancel.Transparent := TRUE;
- end;
- {$ENDIF USE_GRUSH}
- end;
- end;
-
- {$IFDEF DIRDLGEX_LINKSPANEL}
- procedure TOpenDirDialogEx.CreateLinksPanel;
- var BUp, BDn, BLt: PBitmap;
- {$IFDEF USE_GRUSH}
- cFrom: TColor;
- {$ENDIF USE_GRUSH}
-
- function NewArrowBitmap( const Pts: array of Integer ): PBitmap;
- begin
- Result := NewDibBitmap( 16, 8, pf32bit );
- Result.Canvas.Brush.Color := clBtnFace;
- Result.Canvas.FillRect( Result.BoundsRect );
- Result.Canvas.Brush.Color := clBlack;
- Result.Canvas.Polygon( [ MakePoint( Pts[ 0 ], Pts[ 1 ] ),
- MakePoint( Pts[ 2 ], Pts[ 3 ] ),
- MakePoint( Pts[ 4 ], Pts[ 5 ] ),
- MakePoint( Pts[ 6 ], Pts[ 7 ] ) ] );
- end;
-
- var PnUp, LUp, PnDn, LDn, PnLt, LLt: PControl;
- d: Integer;
- begin
- if LinksPanel <> nil then Exit;
- GetDialogForm;
-
- BUp := NewArrowBitmap( [ 2, 6, 7, 1, 8, 1, 13, 6 ] );
- BDn := NewArrowBitmap( [ 2, 1, 7, 6, 8, 6, 13, 1 ] );
- BLt := NewArrowBitmap( [ 11, 0, 4, 3, 4, 4, 11, 7 ] );
-
- LinksPanel := NewPanel( DlgClient, esLowered )
- .SetSize( {$IFDEF DIRDLGEX_BIGGERPANEL} 14 + {$ENDIF} 64, 0 )
- .SetAlign( caLeft );
- //LinksPanel.OnShow := LinksPanelShowEvent;
- LinksPanel.Border := 2;
- {$IFNDEF DIRDLGEX_STDFONT}
- {$ifndef wince}
- LinksPanel.Font.FontName := 'Arial';
- LinksPanel.Font.FontHeight := 14;
- {$endif wince}
- {$ENDIF DIRDLGEX_STDFONT}
-
- d := 0;
- {$IFDEF USE_GRUSH}
- {$IFDEF TOGRUSH_OPTIONAL}
- if not NoGrush then
- {$ENDIF TOGRUSH_OPTIONAL}
- d := 2;
- {$ENDIF USE_GRUSH}
- NewPanelWithSingleButtonToolbar( LinksPanel, LinksPanel.Width-6+d, 15, caTop,
- BUp, '', '', PnUp, LUp, nil, LinksUpClick, LinksUpDnStop, nil );
- NewPanelWithSingleButtonToolbar( LinksPanel, LinksPanel.Width-6+d, 15, caBottom,
- BDn, '', '', PnDn, LDn, nil, LinksDnClick, LinksUpDnStop, nil );
- NewPanelWithSingleButtonToolbar( BtnPanel, 20, 16, caNone,
- BLt, '', '', PnLt, LLt, LinksAddClick, nil, nil, nil ); PnLt.Width := 20;
- {$ifdef wince}
- PnLt.Align:=caLeft;
- {$else}
- PnLt.SetPosition( 68, 0 );
- PnLt.Transparent := TRUE;
- LLt.Transparent := TRUE;
- {$endif wince}
- LinksBox := NewPaintBox( LinksPanel ).SetAlign(caClient);
- LinksBox.Border := 0;
- LinksTape := NewPaintBox( LinksBox ).SetSize( LinksBox.Width, 0 );
- //LinksTape.DoubleBuffered := TRUE;
- {$IFDEF USE_GRUSH}
- {$IFDEF TOGRUSH_OPTIONAL}
- if not NoGrush then
- {$ENDIF TOGRUSH_OPTIONAL}
- begin
- LinksTape.Border := 2;
- LinksTape.MarginLeft := -2;
- LinksTape.MarginRight := -2;
- LinksTape.MarginTop := 2;
- LinksTape.MarginBottom := 2;
- //LinksPanel.Transparent := TRUE;
- PGRushControl( LinksPanel ).All_GradientStyle := gsHorizontal;
- cFrom := PGRushControl( LinksPanel ).Def_ColorFrom;
- PGRushControl( LinksPanel ).All_ColorTo := {
- PGRushControl( LinksPanel ).Def_ColorFrom;
- PGRushControl( LinksPanel ).All_ColorFrom :=} cFrom;
- LinksBox.Color := cFrom;
- //LinksAdd.Left := LinksAdd.Left + 6;
- end
- {$IFDEF TOGRUSH_OPTIONAL}
- else
- begin
- //LinksTape.Border := 0;
- end
- {$ENDIF TOGRUSH_OPTIONAL}
- ;
- {$ELSE not USE_GRUSH}
- //LinksTape.Border := 0;
- {$ENDIF USE_GRUSH}
- LinksPanel.Visible := FALSE;
- LinksRollTimer := NewTimer( 50 );
- //LinksRollTimer.Enabled := FALSE;
- LinksRollTimer.OnTimer := LinksRollTimerTimer;
- LinksPanel.Add2AutoFree( LinksRollTimer );
- end;
- {$ENDIF DIRDLGEX_LINKSPANEL}
-
- procedure TOpenDirDialogEx.DeleteNode(node: Integer);
- function NodeIsParentOf( node, parent: Integer ): Boolean;
- begin
- Result := TRUE;
- while node <> 0 do
- begin
- if node = parent then Exit;
- node := DirTree.TVItemParent[ node ];
- end;
- Result := FALSE;
- end;
- var sel, n: Integer;
- begin
- sel := DirTree.TVSelected;
- if (sel <> 0) and NodeIsParentOf( sel, node ) then
- begin
- n := DirTree.TVItemPrevious[ node ];
- if n = 0 then
- n := DirTree.TVItemNext[ node ];
- DirTree.TVSelected := n;
- end;
- DirTree.TVDelete( node );
- end;
-
- destructor TOpenDirDialogEx.Destroy;
- begin
- Free_And_Nil( DialogForm );
- FPath := '';
- FRecycledName := '';
- OKCaption := '';
- CancelCaption := '';
- Title := '';
- {$IFDEF DIRDLGEX_LINKSPANEL}
- LinksList.Free;
- {$ENDIF DIRDLGEX_LINKSPANEL}
- inherited;
- {$ifndef wince}
- OleUnInit;
- {$endif wince}
- end;
-
- procedure TOpenDirDialogEx.DestroyingForm(Sender: PObj);
- begin
- DialogForm := nil;
- end;
-
- procedure TOpenDirDialogEx.DoCancel(Sender: PObj);
- begin
- DialogForm.ModalResult := -1;
- end;
-
- function TOpenDirDialogEx.DoExpanding(Sender: PControl; Item: THandle;
- Expand: Boolean): Boolean;
- begin
- Result := FALSE;
- if RescanningNode or RescanningTree then Exit;
- if Expand then
- RescanNode( Item );
- end;
-
- function TOpenDirDialogEx.DoFilterAttrs(Attrs: DWORD; const APath: KOLString): Boolean;
- begin
- Result := (Attrs and FilterAttrs = 0);
- if not Result then Exit;
- if FilterRecycled then
- begin
- if (Attrs and (FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_HIDDEN) =
- (FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_HIDDEN))
- then
- //if StrEq( APath, 'RECYCLED' ) then
- Result := FALSE;
- end;
- end;
-
- function TOpenDirDialogEx.DoMsg(var Msg: TMsg; var Rslt: Integer): Boolean;
- var NMHdr: PNMHdr;
- NMCustomDraw: PNMCustomDraw;
- i: Integer;
- begin
- Result := FALSE;
- if DialogForm = nil then Exit;
- if Msg.message = WM_USER_RESCANTREE then
- begin
- Rescantree;
- DirTree.Focused := TRUE;
- Result := TRUE;
- end
- else
- if Msg.message = WM_NOTIFY then
- begin // îòëàâëèâàåòñÿ ìîìåíò îòðèñîâêè êàæäîãî óçëà, ÷òîáû ïðîâåðèòü íàëè÷èå
- // â íåì äî÷åðíèõ ïàïîê, è "ïîêàçàòü" êíîïêó [+], åñëè åñòü
- NMHdr := Pointer( Msg.lParam );
- if DirTree = nil then Exit;
- if NMHdr.hwndFrom = DirTree.Handle then
- CASE LongInt(NMHdr.code) OF
- NM_CUSTOMDRAW:
- begin
- NMCustomDraw := Pointer( NMHdr );
- if NMCustomDraw.dwDrawStage = CDDS_ITEMPOSTPAINT then
- begin
- i := NMCustomDraw.dwItemSpec;
- if DirTree.TVItemData[ i ] = nil then // óçåë åùå íå ïðîâåðÿëñÿ
- begin
- CheckNodeHasChildren( i ); // ïðîâåðèòü óçåë
- DirTree.TVItemData[ i ] := Pointer( 1 ); // ôëàã = "ïðîâåðåí"
- end;
- Rslt := CDRF_DODEFAULT; // ïóñòü ðèñóåò ñåáÿ ñàì êàê îáû÷íî
- end
- else
- if NMCustomDraw.dwDrawStage = CDDS_PREPAINT then
- Rslt := CDRF_NOTIFYITEMDRAW // ñîîáùèòü äëÿ êàæäîãî óçëà íà ñòàäèè CDDS_ITEMPREPAINT
- else
- Rslt := CDRF_NOTIFYPOSTPAINT; // ïðè CDDS_ITEMPREPAINT: ñîîáùèòü î CDDS_ITEMPOSTPAINT
- Result := TRUE;
- end;
- END;
- end;
- end;
-
- procedure TOpenDirDialogEx.DoNotClose(Sender: PObj;
- var Accept: Boolean);
- begin
- Accept := FALSE;
- DialogForm.Hide;
- end;
-
- procedure TOpenDirDialogEx.DoOK(Sender: PObj);
- begin
- DialogForm.ModalResult := 1;
- end;
-
- procedure TOpenDirDialogEx.DoShow(Sender: PObj);
- begin
- DlgClient.PostMsg( WM_USER_RESCANTREE, 0, 0 );
- {$IFDEF DIRDLGEX_LINKSPANEL}
- if LinksPanelOn and Assigned( LinksTape ) then
- begin
- Global_Align( LinksTape );
- SetupLinksTapeHeight;
- end;
- {$ENDIF DIRDLGEX_LINKSPANEL}
- end;
-
- type
- PControl_ = ^TControl_;
- TControl_ = object( TControl )
- end;
-
- procedure TOpenDirDialogEx.DoubleClick(Sender: PControl;
- var M: TMouseEventData);
- var N: DWORD;
- Where: DWORD;
- begin
- N := DirTree.TVItemAtPos( M.X, M.Y, Where );
- if (N = DirTree.TVSelected) and
- not DirTree.TVItemHasChildren[ N ] then
- Form.ModalResult := 1;
- end;
-
- function TOpenDirDialogEx.Execute: Boolean;
- var ParentForm: PControl_;
- begin
- CreateDialogForm;
- DlgClient.ActiveControl := DirTree;
- {$ifndef wince}
- DialogForm.Caption := Title;
- {$endif wince}
- ParentForm := PControl_( Applet.ActiveControl );
- if ParentForm <> nil then
- begin
- if not ParentForm.fIsForm then
- ParentForm := PControl_( Applet );
- end;
- if ParentForm <> nil then
- DialogForm.StayOnTop := ParentForm.StayOnTop;
- DialogForm.ShowModal;
- DialogForm.Hide;
- if ParentForm <> nil then
- SetForegroundWindow( ParentForm.Handle );
- Result := DialogForm.ModalResult >= 0;
- if Result then
- begin
- Path := IncludeTrailingPathDelimiter(
- GetNodePath( DirTree.TVSelected ) );
- end;
- end;
-
- function TOpenDirDialogEx.GetDialogForm: PControl;
- begin
- CreateDialogForm;
- Result := DialogForm;
- end;
-
- function TOpenDirDialogEx.GetFindFirstFileEx: TFindFirstFileEx;
- begin
- {$ifdef wince}
- FFindFirstFileEx:=@FindFirstFileEx;
- {$else}
- if not Assigned( FFindFirstFileEx ) then
- begin
- k32 := GetModuleHandle( 'kernel32.dll' );
- FFindFirstFileEx := GetProcAddress( k32, 'FindFirstFileEx' + {$ifdef UNICODE_CTRLS}'W'{$else}'A'{$endif} );
- end;
- {$endif wince}
- Result := FFindFirstFileEx;
- end;
-
- function TOpenDirDialogEx.GetNodePath(N: THandle): KOLString;
- begin
- Result:=DirTree.TVItemPath(N, '\');
- {$ifdef wince}
- System.Delete(Result, 1, 9);
- {$endif wince}
- end;
-
- {$IFDEF DIRDLGEX_LINKSPANEL}
- function TOpenDirDialogEx.GetLinks(idx: Integer): KOLString;
- begin
- Result := '';
- if (LinksList <> nil) and (LinksList.Count > idx) then
- Result := LinksList.Items[ idx ];
- end;
-
- function TOpenDirDialogEx.GetLinksCount: Integer;
- begin
- Result := 0;
- if LinksList <> nil then Result := LinksList.Count;
- end;
-
- function TOpenDirDialogEx.GetLinksPanelOn: Boolean;
- begin
- Result := (LinksPanel <> nil) and (LinksPanel.Visible);
- end;
-
- procedure TOpenDirDialogEx.LinkClick(Sender: PObj);
- var s, CurPath: KOLString;
- begin
- s := IncludeTrailingPathDelimiter(
- PKOLChar( PControl( Sender ).CustomData ) );
- if DirectoryExists( s ) then
- begin
- CurPath := IncludeTrailingPathDelimiter(
- GetNodePath( DirTree.TVSelected ) );
- if StrEq( CurPath, s ) then
- Form.ModalResult := 1
- else Path := s;
- end;
- end;
-
- function TOpenDirDialogEx.LinkPresent(const s: KOLString): Boolean;
- begin
- Result := (LinksList <> nil) and
- (LinksList.IndexOf_NoCase(
- IncludeTrailingPathDelimiter( s ) ) >= 0);
- end;
-
- procedure TOpenDirDialogEx.LinksAddClick(Sender: PObj);
- var SL: PStrList;
- CurPath: KOLString;
- begin
- CurPath := IncludeTrailingPathDelimiter(
- GetNodePath( DirTree.TVSelected ) );
- SL := NewStrList;
- if DirectoryExists( CurPath ) then
- begin
- SL.Add( CurPath );
- AddLinks( SL );
- end;
- SL.Free;
- end;
-
- procedure TOpenDirDialogEx.LinksDnClick(Sender: PControl; var Mouse: TMouseEventData);
- begin
- LinksRollTimer.Tag := 1;
- LinksRollTimer.Enabled := TRUE;
- end;
-
- {procedure TOpenDirDialogEx.LinksPanelShowEvent(Sender: PObj);
- begin
- end;}
-
- procedure TOpenDirDialogEx.LinksRollTimerTimer(Sender: PObj);
- var NewTop, d: Integer;
- begin
- d := Integer( LinksRollTimer.Tag );
- LinksRollTimer.Tag := Integer( LinksRollTimer.Tag ) + Sgn( d );
- NewTop := LinksTape.Top - (Sgn( d ) + d div 4) * 2;
- if (d > 0) and
- (NewTop + LinksTape.Height < LinksBox.Height) and
- (LinksTape.Top <= 0) then
- begin
- NewTop := LinksBox.Height - LinksTape.Height;
- if NewTop > 0 then
- NewTop := 0;
- end;
- if (d < 0) and (NewTop > 0) then NewTop := 0;
- if (NewTop = LinksTape.Top) or not Form.Visible then
- LinksRollTimer.Enabled := FALSE;
- LinksTape.Top := NewTop;
- LinksTape.Update;
- end;
-
- procedure TOpenDirDialogEx.LinksUpClick(Sender: PControl; var Mouse: TMouseEventData);
- begin
- LinksRollTimer.Tag := DWORD( -1 );
- LinksRollTimer.Enabled := TRUE;
- end;
-
- procedure TOpenDirDialogEx.LinksUpDnStop(Sender: PControl; var Mouse: TMouseEventData);
- begin
- LinksRollTimer.Enabled := FALSE;
- end;
- {$ENDIF DIRDLGEX_LINKSPANEL}
-
- function TOpenDirDialogEx.RemoteIconSysIdx: Integer;
- begin
- if FRemoteIconSysIdx = 0 then
- begin
- if DirectoryExists( '\\localhost\' ) then
- FRemoteIconSysIdx := DirIconSysIdxOffline( '\\localhost\' )
- else
- FRemoteIconSysIdx := DirIconSysIdxOffline( 'C:\' );
- end;
- Result := FRemoteIconSysIdx;
- end;
-
- {$IFDEF DIRDLGEX_LINKSPANEL}
- procedure TOpenDirDialogEx.RemoveLink(const s: KOLString);
- var i: Integer;
- Pn: PControl;
- begin
- i := LinksList.IndexOf( IncludeTrailingPathDelimiter( s ) );
- if i >= 0 then
- begin
- Pn := Pointer( LinksList.Objects[ i ] );
- Pn.Free;
- LinksList.Delete( i );
- end;
- Global_Align( LinksTape );
- SetupLinksTapeHeight;
- end;
-
- procedure TOpenDirDialogEx.RemoveLinkClick(Sender: PMenu; Item: Integer);
- var Pn: PControl;
- i: Integer;
- begin
- Form.ModalResult := 0; //????
- Pn := Sender.CurCtl;
- if Pn <> nil then
- begin
- i := LinksList.IndexOfObj( Pn );
- if i >= 0 then
- begin
- RemoveLink( LinksList.Items[ i ] );
- end;
- end;
- end;
- {$ENDIF DIRDLGEX_LINKSPANEL}
-
- procedure TOpenDirDialogEx.RescanDisks;
- begin
- RescanNode( 0 );
- end;
-
- procedure TOpenDirDialogEx.RescanNode(node: Integer);
- { (Ïåðå)ñêàíèðîâàíèå ïîääèðåêòîðèé â çàäàííîé óçëîì node ðîäèòåëüñêîé ïàïêå.
- Åñëè node = 0, òî ñêàíèðóåòñÿ ñïèñîê äèñêîâ íà óðîâíå êîðíÿ äåðåâà.
- }
- var p, s: KOLString;
- i, j, n, d, m, ii: Integer;
- Find32: TWin32FindData;
- F: THandle;
- SL: PStrListEx;
- {$ifndef wince}
- DL: PDirList;
- disk: Char;
- {$endif wince}
- //test: KOLString;
- begin
- if AppletTerminated or not AppletRunning then Exit;
- RescanningNode := TRUE;
- //Applet.ProcessMessages;
- TRY
- // âû÷èñëÿåòñÿ ïóòü ê ðîäèòåëüñêîé ïàïêå èëè äèñêó (ïóñòî, åñëè âåðõíèé óðîâåíü)
- p := '';
- if node <> 0 then
- p := IncludeTrailingPathDelimiter( GetNodePath( node ) );
- // â SL íàêàïëèâàåòñÿ ñïèñîê äî÷åðíèõ äèðåêòîðèé (èëè äèñêîâ)
- SL := NewStrListEx;
- TRY
- if node = 0 then
- begin
- {$ifdef wince}
- SL.AddObject( 'My Device', 0 );
- {$else}
- for disk := 'A' to 'Z' do
- begin
- case GetDriveType( PKOLChar( KOLString(disk) + ':\' ) ) of
- DRIVE_FIXED, DRIVE_RAMDISK: ii := 0;
- DRIVE_REMOVABLE, DRIVE_CDROM: ii := 1;
- DRIVE_REMOTE: ii := 2;
- else ii := -1;
- end;
- if ii >= 0 then SL.AddObject( disk + ':', ii );
- end;
- {$endif wince}
- end
- else
- {$ifndef wince}
- if WinVer >= wvNT then // èñïîëüçóåòñÿ áîëåå áûñòðûé âàðèàíò - äëÿ NT/2K/XP
- {$endif wince}
- begin
- _FindFirstFileEx;
- F := FFindFirstFileEx( PKOLChar( p + '*.*' ), FindExInfoStandard, @ Find32,
- FindExSearchLimitToDirectories, nil, 0 );
- if F <> INVALID_HANDLE_VALUE then
- begin
- TRY
- while TRUE do
- begin
- if Find32.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
- if (Find32.cFileName <> KOLString( '.' )) and (Find32.cFileName <> '..') then
- if DoFilterAttrs( Find32.dwFileAttributes, Find32.{$ifdef wince}cFileName{$else}cAlternateFileName{$endif} ) then
- SL.Add( Find32.cFileName );
- if not FindNextFile( F, Find32 ) then break;
- end;
- SL.Sort( FALSE );
- FINALLY
- FindClose( F );
- END;
- end;
- {$ifndef wince}
- end
- else
- begin
- DL := NewDirListEx( p, '*.*;*', FILE_ATTRIBUTE_DIRECTORY );
- TRY
- DL.Sort( [ ] );
- for i := 0 to DL.Count-1 do
- if DoFilterAttrs( DL.Items[ i ].dwFileAttributes,
- DL.Items[ i ].cAlternateFileName ) then
- SL.Add( DL.Names[ i ] );
- FINALLY
- DL.Free;
- END;
- {$endif wince}
- end;
- // òåïåðü ïðîñìàòðèâàþòñÿ âñå äî÷åðíèå óçëû ðîäèòåëÿ node (èëè äèñêè
- // íà êîðíåâîì óðîâíå)
- if node = 0 then
- n := DirTree.TVRoot
- else
- n := DirTree.TVItemChild[ node ];
- for i := 0 to SL.Count do
- begin
- //test := DirTree.TVItemText[ n ];
- //test := SL.Items[ i ];
- // ïîêà î÷åðåäíîå èìÿ â ñïèñêå áîëüøå ÷åì òî ÷òî â î÷åðåäíîì óçëå
- while (n <> 0) and
- ( (i >= SL.Count) or
- (AnsiCompareStrNoCase( SL.Items[ i ], DirTree.TVItemText[ n ] ) > 0)
- ) do
- begin
- //test := DirTree.TVItemText[ n ];
- //test := SL.Items[ i ];
- // åñëè äèðåêòîðèÿ â òåêóùåì óçëå îòñóòñòâóåò â ñïèñêå, òî îíà óäàëåíà
- // è åå ñëåäóåò óäàëèòü èç äåðåâà ïîñëå ïåðåõîäà ê ñëåäóþùåìó óçëó
- d := n;
- s := DirTree.TVItemText[ n ];
- for j := 0 to SL.Count-1 do
- if AnsiCompareStrNoCase( SL.Items[ j ], s ) = 0 then
- begin
- d := 0; break; // åñòü òàêàÿ â ñïèñêå, íå óäàëÿòü
- end;
- if d = 0 then
- DirTree.TVItemData[ n ] := nil; // ñáðîñ ôëàæêà "äî÷åðíèå ïðîâåðåíû"
- n := DirTree.TVItemNext[ n ]; // ïåðåõîä ê ñëåäóþùåìó óçëó äåðåâà
- if d <> 0 then // óäàëÿåòñÿ óçåë íåñóùåñòâóþøåé äèðåêòîðèè
- //DirTree.TVDelete( d );
- DeleteNode( d );
- end;
- if i >= SL.Count then break;
- if (n <> 0) and
- (AnsiCompareStrNoCase( SL.Items[ i ], DirTree.TVItemText[ n ] ) = 0) then
- begin
- DirTree.TVItemData[ n ] := nil; // ñáðîñ ôëàæêà "äî÷åðíèå ïðîâåðåíû"
- n := DirTree.TVItemNext[ n ]; // ïåðåõîä ê ñëåäóþùåìó óçëó äåðåâà
- continue;
- end;
- // îñòàåòñÿ ñëó÷àé, êîãäà (íîâîå) èìÿ äèðåêòîðèè ìåíüøå ÷åì èìÿ â
- // î÷åðåäíîì óçëå (èëè óçëû èñ÷åðïàíû): íàäî äîáàâèòü åãî ïåðåä ýòèì óçëîì
- // (â êîíåö ñïèñêà óçëîâ):
- if n = 0 then
- m := DirTree.TVInsert( node, TVI_LAST, SL.Items[ i ] )
- else
- begin
- m := DirTree.TVItemPrevious[ n ];
- if m = 0 then
- m := DirTree.TVInsert( node, TVI_FIRST, SL.Items[ i ] )
- else
- m := DirTree.TVInsert( node, m, SL.Items[ i ] );
- end;
- if (SL.Objects[ i ] = 1) and FastScan then
- SL.Objects[ i ] := 2;
- CASE SL.Objects[ i ] OF
- 0{,1}: ii := FileIconSystemIdx( p + SL.Items[ i ]{$ifndef wince} + '\' {$endif} );
- {$ifndef wince}
- 1: ii := DirIconSysIdxOffline( p + SL.Items[ i ] + '\' );
- {2:}else ii := RemoteIconSysIdx;
- {$endif wince}
- END;
- DirTree.TVItemImage[ m ] := ii;
- DirTree.TVItemSelImg[ m ] := ii;
- end;
- if SL.Count = 0 then
- if node <> 0 then
- DirTree.TVItemHasChildren[ node ] := FALSE;
- FINALLY
- SL.Free;
- END;
- FINALLY
- RescanningNode := FALSE;
- END;
- end;
-
- procedure TOpenDirDialogEx.Rescantree;
- var s, n, {$ifndef wince}d,{$endif} e: KOLString;
- node, parent, ii: Integer;
- begin
- RescanningTree := TRUE;
- //DirTree.BeginUpdate;
- TRY
- RescanDisks;
- if (Path = '') or not DirectoryExists( Path ) then Path := GetWorkDir;
- node := DirTree.TVSelected;
- if (node = 0)
- // äåðåâî ïóñòî: ïåðâîíà÷àëüíîå çàïîëíåíèå - îò òåêóùåãî óçëà ê êîðíþ (äèñêó)
- // è äîáàâëåíèå ñïèñêà âñåõ äèñêîâ íà âåðõíåì óðîâíå
- OR
- (AnsiCompareStrNoCase( IncludeTrailingPathDelimiter(
- GetNodePath( node ) ),
- IncludeTrailingPathDelimiter( Path ) ) <> 0 )
- // èëè òåêóùèé óçåë â äåðåâå îòëè÷àòñÿ îò òîãî, ÷òî óêàçàíî â Path
- then
- begin
- s := Path;
- {$ifdef wince}
- node:=DirTree.TVRoot;
- if s = '\' then
- RescanNode( node );
- DirTree.TVExpand( node, TVE_EXPAND );
- {$else}
- node := 0;
- {$endif wince}
- e := '';
- // ïàðñèðóåì ïóòü, ïî î÷åðåäè îïóñàÿñü âñå íèæå ê óêàçàííîé ïàïêå
- while s <> '' do
- begin
- if AppletTerminated or not AppletRunning then Exit;
- n := Parse( s, '\/' );
- if n = '' then continue;
- {$ifndef wince}
- if (n[ Length( n ) ] <> ':') and (pos( ':', n ) > 0) then
- begin
- d := Parse( n, ':' ) + ':';
- s := n + '\' + s;
- n := d;
- end;
- {$endif wince}
- // n = î÷åðåäíîé óçåë, êîòîðûé íàäî ëèáî íàéòè ñðåäè äåòîê node,
- // ëèáî ïîñòðîèòü â ýòîì ñïèñêå, åñëè åãî òàì íåò
- parent := node;
- if parent = 0 then
- node := DirTree.TVRoot
- else begin
- {$ifndef wince}
- if (Length( n ) = 2) and (n[ 2 ] = ':') then
- begin
- if not IntIn( GetDriveType( PKOLChar( n + '\' ) ),
- [ DRIVE_REMOVABLE, DRIVE_REMOTE, DRIVE_CDROM ] ) then
- RescanNode( parent );
- end
- else
- {$endif wince}
- RescanNode( parent );
- node := DirTree.TVItemChild[ parent ];
- end;
- while node <> 0 do
- begin
- if AnsiCompareStrNoCase( DirTree.TVItemText[ node ], n ) = 0 then
- break;
- node := DirTree.TVItemNext[ node ];
- end;
- if node = 0 then
- node := DirTree.TVInsert( parent, TVI_LAST, n );
- if parent <> 0 then
- DirTree.TVExpand( parent, TVE_EXPAND );
- e := e + n + '\'; // ïî äîðîãå â e ñòðîèì ïîëíûé ïóòü
- ii := FileIconSystemIdx( e );
- DirTree.TVItemImage[ node ] := ii;
- DirTree.TVItemSelImg[ node ] := ii;
- end;
- DirTree.TVSelected := node;
- end;
- if node <> 0 then
- DirTree.Perform( TVM_ENSUREVISIBLE, 0, node );
- FINALLY
- RescanningTree := FALSE;
- //DirTree.EndUpdate;
- END;
- end;
-
- {$IFDEF DIRDLGEX_LINKSPANEL}
- procedure TOpenDirDialogEx.SetLinks(idx: Integer; const Value: KOLString);
- var Bar, Pn: PControl;
- Bmp: PBitmap;
- Ico: PIcon;
- s: KOLString;
- H: Integer;
- begin
- CreateLinksPanel;
-
- s := ExcludeTrailingPathDelimiter( Value );
- if LinksList = nil then
- LinksList := NewStrListEx;
- while LinksList.Count <= idx do
- LinksList.AddObject( '', 0 );
- if LinksList.Objects[ idx ] <> 0 then
- begin
- PObj( Pointer( LinksList.Objects[ idx ] ) ).Free;
- end;
- Bmp := NewDibBitmap( 32, 32, pf32bit );
- Bmp.Canvas.Brush.Color := clBtnFace;
- Bmp.Canvas.FillRect( Bmp.BoundsRect );
- if LinksImgList = nil then
- begin
- LinksImgList := NewImageList( LinksPanel );
- LinksImgList.LoadSystemIcons( FALSE );
- end;
- Ico := NewIcon;
- Ico.Handle := LinksImgList.ExtractIcon( FileIconSystemIdx( s ) );
- Ico.Draw( Bmp.Canvas.Handle, 0, 0 );
- Ico.Free;
-
- if LinksPopupMenu = nil then
- begin
- NewMenu( Form, 0, [ '' ], nil );
- LinksPopupMenu := NewMenu( Form, 0, [ '&Remove link' ], nil );
- LinksPopupMenu.AssignEvents( 0, [ RemoveLinkClick ] );
- end;
-
- H := 60;
- {$IFDEF DIRDLGEX_BIGGERPANEL}
- {$IFDEF USE_GRUSH}
- {$IFDEF TOGRUSH_OPTIONAL}
- if not NoGrush then
- {$ENDIF TOGRUSH_OPTIONAL}
- inc( H, 14 );
- {$ENDIF USE_GRUSH}
- {$ENDIF DIRDLGEX_BIGGERPANEL}
- NewPanelWithSingleButtonToolbar( LinksTape, LinksBox.Width,
- H, caTop, Bmp,
- ExtractFileName( s ), s, Pn, Bar, LinkClick, nil, nil, LinksPopupMenu );
- Pn.CreateWindow;
-
- LinksList.Items[ idx ] := IncludeTrailingPathDelimiter( Value );
- LinksList.Objects[ idx ] := DWORD( Pn );
-
- SetUpTaborders;
- SetupLinksTapeHeight;
- end;
-
- procedure TOpenDirDialogEx.SetLinksPanelOn(const Value: Boolean);
- begin
- if LinksPanelOn = Value then Exit;
- GetDialogForm;
- if Assigned( LinksPanel ) then
- LinksPanel.Visible := Value;
- if not Value then LinksAdd.Visible := FALSE
- else
- begin
- CreateLinksPanel;
- LinksPanel.Visible := TRUE;
- end;
- end;
- {$ENDIF DIRDLGEX_LINKSPANEL}
-
- procedure TOpenDirDialogEx.SetPath(const Value: KOLString);
- begin
- FPath := Value;
- if FPath <> '' then
- FPath := IncludeTrailingPathDelimiter( FPath );
- if Assigned( DialogForm ) and (DialogForm.Visible) then
- Rescantree;
- end;
-
- {$IFDEF DIRDLGEX_LINKSPANEL}
- procedure TOpenDirDialogEx.SetupLinksTapeHeight;
- var H: Integer;
- Pn: PControl;
- begin
- H := 0;
- if LinksList.Count > 0 then
- begin
- Pn := Pointer( LinksList.Objects[ LinksList.Count-1 ] );
- H := Pn.Top + Pn.Height;
- end;
- LinksTape.Height := H + 4;
- end;
-
- procedure TOpenDirDialogEx.SetUpTaborders;
- var i: Integer;
- Pn: PControl;
- begin
- for i := 0 to LinksCount-1 do
- begin
- Pn := Pointer( LinksList.Objects[ i ] );
- Pn.TabOrder := i;
- end;
- end;
- {$ENDIF DIRDLGEX_LINKSPANEL}
-
- {$ifndef read_implementation}
- end.
- {$endif read_implementation}
|