Просьба оценить написанный код по всем существующим параметрам (утечки памяти, стиль и тд…). А также желательно прокомментировать участи с ошибками/неточностями
| Код | unit unViewClasses;
interface
uses unNavigatorClasses, Classes, SysUtils, Buttons, StdCtrls, ExtCtrls, VirtualTrees, Controls, Graphics, Dialogs, ActiveX, unElementManager, Windows;
type
TFCView = class(TPanel) private FNavigator: INavigator; FElementManager: IElementManager; var vtTree: TVirtualStringTree; vtSelectedNode: PVirtualNode; btnCloseView: TSpeedButton; FixedSize: Boolean; Header: TPanel; TopHeader: TPanel; DrivesHeader: TPanel; btnFixSize: TSpeedButton; btnDespFixSize: TSpeedButton; DrivesButtons: array of TSpeedButton; procedure OnFCViewResize(Sender: TObject); procedure OnBtnCloseViewClick(Sender: TObject); procedure RefreshTopHeader; procedure ResizeDrivesButtons; procedure RefreshDrivesButtons; {Создаём актуальный контейнер элементов (файлов)} procedure Build; procedure ActualSelect; procedure OnBtnFixSizeClick(Sender: TObject); procedure OnBtnDespFixSizeClick(Sender: TObject); procedure OnDrivesButtonClick(Sender: TObject); procedure OnDrivesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure SetVtTreeSettings; procedure OnVtTreeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure OnVtTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure OnVtTreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); procedure OnVtTreeDblClick(Sender: TObject); procedure OnVtTreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean); procedure OnVtTreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); procedure OnVtTreeBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); procedure OnVtTreeKeyPress(Sender: TObject; var Key: Char); procedure OnVtTreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); public constructor Create(AOwner: TWinControl; ANavigator: INavigator = nil; AElementManager: IElementManager = nil); reintroduce; destructor Destroy; override; end;
TLevelView = class(TPanel) private var btnNewView: TSpeedButton; pnlResize: TPanel; FixedSize: Boolean; FCViews: array of TFCView; btnFixSize: TSpeedButton; FCViewsManager: TPanel; btnDespFixSize: TSpeedButton; btnDeleteLevel: TSpeedButton; strict private function GetFixedFCViewCount: Integer; function GetAllFixedSize: Integer; procedure OnBtnFixSizeClick(Sender: TObject); procedure OnBtnDespFixSizeClick(Sender: TObject); procedure OnBtnDeleteLevelClick(Sender: TObject); procedure OnBtnNewViewClick(Sender: TObject); procedure OnLevelViewResize(Sender: TObject); public constructor Create(AOwner: TWinControl); reintroduce; destructor Destroy; override; procedure AddView; procedure DeleteView(AFCView: TFCView); procedure ActualSize; function GetFCViewCount: Integer; property FixedFCViewCount: Integer read GetFixedFCViewCount; property FCViewCount: Integer read GetFCViewCount; end;
TFCommander = class(TPanel) private var btnAddLevel: TSpeedButton; Levels: array of TLevelView; LevelsManager: TPanel; procedure OnBtnAddLevel(Sender: TObject); procedure OnFCommanderResize(Sender: TObject); //Узнаем общую высоту фиксированных уровней function GetAllFixedSize: Integer; strict private function GetFixedLevelCount: Integer; function GetLevelCount: Integer; public constructor Create(AOwner: TWinControl); reintroduce; procedure AddLevel; procedure ActualSize; procedure DeleteLevel(ALevel: TLevelView); property FixedLevelCount: Integer read GetFixedLevelCount; property LevelCount: Integer read GetLevelCount; end;
const LM_WIDTH = 20; PR_WIDTH = 10; FM_HEIGHT = 20;
TFCVIEW_HEADER_HEIGHT = 40; TFCVIEW_TOPHEADER_HEIGHT = 20;
implementation
constructor TFCommander.Create(AOwner: TWincontrol); begin inherited Create(AOwner);
Self.OnResize := OnFCommanderResize;
LevelsManager := TPanel.Create(Self); {Создаём панель управления уровнями} with LevelsManager do begin Parent := Self; Align := alLeft; Width := LM_WIDTH; end;
{Кнопка добавления уровней} btnAddLevel := TSpeedButton.Create(LevelsManager); with btnAddLevel do begin Parent := LevelsManager; OnClick := OnBtnAddLevel; Align := alTop; end;
end;
procedure TFCommander.AddLevel; begin SetLength(Levels, LevelCount + 1); Levels[LevelCount - 1] := TLevelView.Create(Self); with Levels[LevelCount - 1] do begin Parent := Self; end; ActualSize; end;
procedure TFCommander.ActualSize; var I: Integer; ResizeLevelCount: Integer; NewLevelHeight, NewLevelTop: Integer; begin NewLevelTop := 0; ResizeLevelCount := LevelCount - FixedLevelCount; if ResizeLevelCount < 1 then Exit; NewLevelHeight := (Self.Height - GetAllFixedSize) div ResizeLevelCount; for I := 0 to LevelCount - 1 do begin Levels[I].Top := NewLevelTop; if not Levels[I].FixedSize then Levels[I].Height := NewLevelHeight; Inc(NewLevelTop, Levels[I].Height); Levels[I].Left := LevelsManager.Width; Levels[I].Width := Self.Width - LevelsManager.Width; end; end;
procedure TFCommander.DeleteLevel(ALevel: TLevelView); var I: Integer; NilStatus: Boolean; begin NilStatus := False; for I := 0 to High(Levels) do begin if Levels[I] = ALevel then NilStatus := True; if NilStatus then begin Levels[I] := Levels[I + 1]; //ShowMessage('ok'); end;
end; SetLength(Levels, High(Levels)); ActualSize; end;
function TFCommander.GetFixedLevelCount: Integer; var I: Integer; begin Result := 0; for I := 0 to High(Levels) do if Levels[I].FixedSize then Inc(Result); end;
function TFCommander.GetLevelCount: Integer; begin Result := High(Levels) + 1; end;
function TFCommander.GetAllFixedSize: Integer; var I: Integer; begin Result := 0; for I := 0 to High(Levels) do begin if Levels[I].FixedSize then Inc(Result, Levels[I].Height); end; end;
procedure TFCommander.OnFCommanderResize(Sender: TObject); begin ActualSize; end;
procedure TFCommander.OnBtnAddLevel(Sender: TObject); begin AddLevel; end;
constructor TLevelView.Create; begin inherited Create(AOwner);
FixedSize := False;
Self.OnResize := OnLevelViewResize;
pnlResize := TPanel.Create(Self); with pnlResize do begin Parent := Self; Align := alBottom; Height := PR_WIDTH; Cursor := crSizeNS; end;
FCViewsManager := TPanel.Create(Self); with FCViewsManager do begin Parent := Self; Align := alTop; Height := FM_HEIGHT; end;
btnNewView := TSpeedButton.Create(FCViewsManager); with btnNewView do begin Parent := FCViewsManager; OnClick := OnBtnNewViewClick; end;
btnDeleteLevel := TSpeedButton.Create(FCViewsManager); with btnDeleteLevel do begin Parent := FCViewsManager; Align := alRight; OnClick := OnbtnDeleteLevelClick; end;
btnFixSize := TSpeedButton.Create(FCViewsManager); with btnFixSize do begin Parent := FCViewsManager; Left := btnNewView.Left + btnNewView.Width; GroupIndex := 1; Down := False; OnClick := OnBtnFixSizeClick; end;
btnDespFixSize := TSpeedButton.Create(FCViewsManager); with btnDespFixSize do begin Parent := FCViewsManager; Left:= btnFixSize.Left + btnFixSize.Width; GroupIndex := 1; Down := True; OnClick := OnBtnDespFixSizeClick; end; end;
destructor TLevelView.Destroy; var FCommander: TFCommander; begin FCommander := (Self.Owner as TFCommander); FCommander.DeleteLevel(Self); inherited Destroy; end;
procedure TLevelView.AddView; begin SetLength(FCViews, FCViewCount + 1); FCViews[FCViewCount - 1] := TFCView.Create(Self); with FCViews[FCViewCount - 1] do begin Parent := Self; end; ActualSize; end;
procedure TLevelView.DeleteView(AFCView: TFCView); var I: Integer; NilStatus: Boolean; begin NilStatus := False; for I := 0 to High(FCViews) do begin if FCViews[I] = AFCView then NilStatus := True; if NilStatus then FCViews[I] := FCViews[I + 1]; end; SetLength(FCViews, High(FCViews)); ActualSize; end;
procedure TLevelView.ActualSize; var I: Integer; ResizeFCViewCount: Integer; NewLevelWidth, NewLevelLeft: Integer; begin NewLevelLeft := 0; ResizeFCViewCount := FCViewCount - FixedFCViewCount;
if ResizeFCViewCount < 1 then Exit;
NewLevelWidth := (Self.Width - GetAllFixedSize) div ResizeFCViewCount; //ShowMessage(IntToStr(ResizeFCViewCount) ); for I := 0 to FCViewCount - 1 do begin FCViews[I].Left := NewLevelLeft; if not FCViews[I].FixedSize then FCViews[I].Width := NewLevelWidth; Inc(NewLevelLeft, FCViews[I].Width); FCViews[I].Top := FCViewsManager.Height; FCViews[I].Height := Self.Height - FCViewsManager.Height; end; end;
function TLevelView.GetFCViewCount: Integer; begin Result := High(FCViews) + 1; end;
procedure TFCView.ActualSelect; var SelElements: TNavigatElements; PNode: PVirtualNode; X: Integer; begin X := 0; PNode := vtTree.RootNode.FirstChild; SelElements := FNavigator.SelectionElements; SetLength(SelElements, X); while PNode.NextSibling <> nil do begin if vtTree.Selected[PNode] then begin Inc(X); SetLength(SelElements, X); SelElements[X - 1] := FNavigator.NavigatElements[PNode.Index]; end; PNode := PNode.NextSibling; end; FNavigator.SelectionElements := SelElements; end;
procedure TFCView.Build; var I: Integer; begin vtTree.Clear; FNavigator.List; for I := 0 to High(FNavigator.NavigatElements) do begin vtTree.AddChild(nil); end; vtTree.Selected[vtTree.RootNode.FirstChild] := True; end;
constructor TFCView.Create(AOwner: TWinControl; ANavigator: INavigator = nil; AElementManager: IElementManager = nil); begin inherited Create(AOwner); FixedSize := False;
Self.OnResize := OnFCViewResize;
{По умолчанию создаём объект класса} if ANavigator = nil then FNavigator := TFSNavigator.Create else FNavigator := ANavigator;
if AElementManager = nil then FElementManager := TFileManager.Create else FElementManager := AElementManager;
Header := TPanel.Create(Self); with Header do begin Parent := Self; Align := alTop; Height := TFCVIEW_HEADER_HEIGHT; end;
SetVtTreeSettings;
TopHeader := TPanel.Create(Header); with TopHeader do begin Parent := Header; Align := alTop; Height := TFCVIEW_TOPHEADER_HEIGHT; end;
DrivesHeader := TPanel.Create(Header); with DrivesHeader do begin Parent := Header; Align := alClient; end;
btnFixSize := TSpeedButton.Create(TopHeader); with btnFixSize do begin Parent := TopHeader; GroupIndex := 1; OnClick := OnBtnFixSizeClick; end;
btnDespFixSize := TSpeedButton.Create(TopHeader); with btnDespFixSize do begin Parent := TopHeader; GroupIndex := 1; Down := True; OnClick := OnBtnDespFixSizeClick; end;
btnCloseView := TSpeedButton.Create(TopHeader); with btnCloseView do begin Parent := TopHeader; OnClick := OnbtnCloseViewClick; end;
RefreshDrivesButtons ; RefreshTopHeader; Build; end;
destructor TFCView.Destroy; var LevelView: TLevelView; begin FNavigator.BeforeDestruction; Self.FNavigator := nil; LevelView := (Self.Owner as TLevelView); LevelView.DeleteView(Self); inherited Destroy; end;
procedure TFCView.OnbtnCloseViewClick(Sender: TObject); begin Free; end;
procedure TFCView.OnFCViewResize(Sender: TObject); begin RefreshTopHeader; ResizeDrivesButtons; end;
procedure TFCView.OnVtTreeBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); begin ActualSelect; end;
procedure TFCView.OnVtTreeDblClick(Sender: TObject); begin FNavigator.GoToElement(FNavigator.NavigatElements[vtSelectedNode.Index]); Build; end;
procedure TFCView.OnVtTreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); var FCViewSource: TFCView; InavSource, InavTarget: INavigator; PNode: PVirtualNode; begin {case Mode of dmNowhere: ShowMessage('dmNowhere') ; dmAbove: ShowMessage('dmAbove') ; dmOnNode: ShowMessage('dmOnNode') ; dmBelow: ShowMessage('dmBelow') ; end; }
FCViewSource := (Source as TVirtualStringTree).Owner as TFCView; InavSource := FCViewSource.FNavigator; InavTarget := (Sender.Owner as TFCView).FNavigator; PNode := Sender.GetNodeAt(Pt.X, Pt.Y);
if PNode <> nil then InavTarget.DropSelection := InavTarget.NavigatElements[PNode.Index];
//InavTarget.DropSelection := InavTarget.NavigatElements[0]; FElementManager.DropElement(InavSource, InavTarget, Mode);
{ ShowMessage(SourceText) ; ShowMessage(Sender.ClassName); }
//ShowMessage(IntToStr(Nodes[0].Index));
// ShowMessage(IntToStr(Sender.DropTargetNode.Index)); end;
procedure TFCView.OnVtTreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean); begin Accept := True; end;
procedure TFCView.OnVtTreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); begin vtSelectedNode := Node;
// ActualSelect; end;
procedure TFCView.OnVtTreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); begin case Column of 0: ImageIndex := Node.Index; end; end;
procedure TFCView.OnVtTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var NavigatElement: TNavigatElement; begin
NavigatElement := FNavigator.NavigatElements[Node.Index]; case Column of 0: begin CellText := NavigatElement.ElementName; end; 1: begin CellText := NavigatElement.ElementExt; end; 2: begin CellText := IntToStr(NavigatElement.ElementSize) ; end; 3: begin try CellText := DateTimeToStr(FileDateToDateTime( NavigatElement.ElementTime)); except CellText := '_'; end;
end; end;
end;
procedure TFCView.OnVtTreeKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then OnVtTreeDblClick(Sender); end;
procedure TFCView.OnVtTreeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin vtSelectedNode := vtTree.GetNodeAt(X, Y);
if not (ssShift in Shift) xor (ssCtrl in Shift) xor (ssLeft in Shift) {xor (TMouseButton.mbLeft = Button) } then begin vtTree.Selected[vtSelectedNode] := not vtTree.Selected[vtSelectedNode]; end;
ActualSelect;
if (vtSelectedNode = nil) or (FNavigator.SelectionElements = nil) then begin FNavigator.NotNode := True; end else begin FNavigator.NotNode := False; end;
if [ssRight] = Shift then FNavigator.BuildElementMenu(X, Y, Sender as TWinControl);
//FNavigator.FastSelect := FNavigator.NavigatElements[vtSelectedNode.Index]; end;
procedure TFCView.RefreshDrivesButtons; var I: Integer; begin {Уничтожаем кнопки} for I := 0 to High(DrivesButtons) do begin DrivesButtons[I].Parent := nil; DrivesButtons[I].Free; end; SetLength(DrivesButtons, 0);
{Создаём кнопки} for I := 0 to High(FNavigator.Drives) do begin SetLength(DrivesButtons, I + 1); DrivesButtons[I] := TSpeedButton.Create(DrivesHeader); with DrivesButtons[I] do begin Parent := DrivesHeader; Name := FNavigator.Drives[I].DriveName; Caption := FNavigator.Drives[I].DriveName; GroupIndex := 1; ShowHint := True; Hint := FNavigator.Drives[I].DriveName; OnClick := OnDrivesButtonClick; Down := FNavigator.Drives[I].IsSystem; if Down then FNavigator.Path := Name + DriveDelim; //FNavigator.BuildDriveButtonMenu(DrivesButtons[I]); OnMouseDown := OnDrivesMouseDown; end; end; ResizeDrivesButtons;
end;
procedure TFCView.RefreshTopHeader; var I: Integer; ControlLeft, ControlWidth: Integer; begin ControlLeft := 0; if TopHeader.ControlCount < 1 then Exit;
ControlWidth := TopHeader.Width div TopHeader.ControlCount; for I := 0 to TopHeader.ControlCount - 1 do begin TopHeader.Controls[I].Left := ControlLeft; TopHeader.Controls[I].Width := ControlWidth; Inc(ControlLeft, ControlWidth); end;
end;
procedure TFCView.ResizeDrivesButtons; var I: Integer; NewLeft, NewWidth, Rest, TempWidth: Integer; begin NewLeft := 0; NewWidth := DrivesHeader.Width div (High(FNavigator.Drives) + 1); Rest := DrivesHeader.Width - NewWidth * High(FNavigator.Drives); for I := 0 to High(FNavigator.Drives) do begin with DrivesButtons[I] do begin Left := NewLeft; Width := NewWidth; Inc(NewLeft, NewWidth); end; end; TempWidth := DrivesButtons[High(DrivesButtons)].Width; DrivesButtons[High(DrivesButtons)].Width := TempWidth + Rest; end;
procedure TFCView.SetVtTreeSettings; begin vtTree := TVirtualStringTree.Create(Self); with vtTree do begin Parent := Self; Align := alClient; DragType := dtOLE; DragMode := dmAutomatic; OnGetText := OnVtTreeGetText; OnMouseDown := OnVtTreeMouseDown; OnDblClick := OnVtTreeDblClick; OnGetImageIndex := OnVtTreeGetImageIndex; OnDragOver := OnVtTreeDragOver; OnDragDrop := OnVtTreeDragDrop; OnBeforePaint := OnVtTreeBeforePaint;
OnKeyPress := OnVtTreeKeyPress;
OnFocusChanged := OnVtTreeFocusChanged;
Header.Options := [hoVisible, hoColumnResize]; TreeOptions.SelectionOptions := [toFullRowSelect, toMultiSelect];
Images := FNavigator.Images; end;
vtTree.NodeDataSize := 4;
with vtTree.Header.Columns.Add do begin Text := 'Имя'; Width := 100; end;
with vtTree.Header.Columns.Add do begin Text := 'Тип'; Width := 100; end;
with vtTree.Header.Columns.Add do begin Text := 'Размер'; end;
with vtTree.Header.Columns.Add do begin Text := 'Время'; end; end;
procedure TLevelView.OnBtnNewViewClick(Sender: TObject); begin AddView; end;
procedure TLevelView.OnLevelViewResize(Sender: TObject); begin ActualSize; end;
function TLevelView.GetFixedFCViewCount: Integer; var I: Integer; begin Result := 0; for I := 0 to High(FCViews) do if FCViews[I].FixedSize then Inc(Result); end;
procedure TLevelView.OnBtnFixSizeClick(Sender: TObject); begin FixedSize := True; btnFixSize.Down := True; end;
procedure TLevelView.OnBtnDeleteLevelClick(Sender: TObject); begin Self.Parent := nil; Self.Free; end;
procedure TLevelView.OnBtnDespFixSizeClick(Sender: TObject); begin FixedSize := False; btnDespFixSize.Down := True; end;
procedure TFCView.OnBtnFixSizeClick(Sender: TObject); begin FixedSize := True; btnFixSize.Down := True;
//ShowMessage(IntToStr(High(FNavigator.SelectionElements))); //ShowMessage(FNavigator.SelectionElements[1].ElementName); end;
procedure TFCView.OnDrivesButtonClick(Sender: TObject); begin FNavigator.Path := (Sender as TSpeedButton).Name + DriveDelim; FNavigator.List; Build; end;
procedure TFCView.OnDrivesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if [ssRight] = Shift then FNavigator.BuildDriveButtonMenu(Sender as TSpeedButton); end;
procedure TFCView.OnBtnDespFixSizeClick(Sender: TObject); begin FixedSize := False; btnDespFixSize.Down := True; end;
function TLevelView.GetAllFixedSize: Integer; var I: Integer; begin Result := 0; for I := 0 to High(FCViews) do begin if FCViews[I].FixedSize then Inc(Result, FCViews[I].Width); end; end;
end.
|
|