Problemer med TShellListView

du implemterer et OnAddFolder event, Så i det skal du blot validere dine navne.

procedure TForm1.ShellListView1AddFolder(Sender: TObject; AFolder: TShellFolder; var CanAdd: Boolean);
begin
  Caption := AFolder.DisplayName;
end;


Jens B

og hvordan validere jeg navnene???? :D

sådan her :

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ShellCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    ShellListView1: TShellListView;
    procedure ShellListView1AddFolder(Sender: TObject; AFolder: TShellFolder; var CanAdd: Boolean);
  private
    { Private declarations }
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var
  ValidList : TStringList;


function Like(AString: string; APattern: string; Const CaseSensetive : Boolean = false): boolean;
var
  lng:    integer;
  p:      integer;
  segment: string;
  tPStr:  string;
begin
  if not CaseSensetive then
  begin
    AString := AnsiUpperCase(AString);
    APattern := AnsiUpperCase(APattern);
  end;

  lng    := Length(APattern);
  p      := Pos('*', APattern);
  SetLength(tPStr, 256);

  if p = 1 then // Find pattern at end.
  begin
    tPStr :=  Copy(APattern, 2, Pred(lng));
    if Length(AString) < Length(tPStr) then
      Result := false
    else
    begin
      segment := Copy(AString, Length(AString) - Length(tPStr) + 1, Length(AString));
      Result  := CompareText(segment, tPStr) = 0;
    end;
  end
  else if p = lng then // Find pattern at beginning.
      begin
        tPStr := Copy(APattern, 1, Pred(lng));
        if Length(AString) < Length(tPStr) then
          Result := false
        else
          begin
            segment := Copy(AString, 1, Length(tPStr));
            Result  := CompareText(segment, tPStr) = 0;
        end;
      end
  else
    begin // Find pattern anywhere.
      tPStr := APattern;
      if Length(AString) < Length(tPStr) then
        Result := false
      else
        Result := Pos(tPStr, AString) <> 0;
    end;
end;

procedure TForm1.ShellListView1AddFolder(Sender: TObject; AFolder: TShellFolder; var CanAdd: Boolean);
var
  i : Integer;
begin
  CanAdd := true;
  if not AFolder.IsFolder then
    for i := 0 to ValidList.Count -1 do
    begin
      CanAdd := Like(AFolder.DisplayName, ValidList[i]);
      if CanAdd then
        Exit;
    end;
end;

initialization
  ValidList := TStringList.Create;
  ValidList.Add('*.SQL');
  ValidList.Add('*.TXT');
  ValidList.Add('*.ZIP');
finalization
  FreeAndNil(ValidList);
end.

Jens B

Tak!! Du er for sej :D