Taşı ve Bırak fonksiyonu (ufak bir sorun)

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
lash003
Üye
Mesajlar: 8
Kayıt: 10 Nis 2005 01:40

Taşı ve Bırak fonksiyonu (ufak bir sorun)

Mesaj gönderen lash003 »

Merhabalar;
FileListBox ile aram pek iyi değildi.Birkaç procedure ve function inceledikten sonra hiçte fena olmadığının farkına vardım.

Kod: Tümünü seç

type
  TForm1 = class(TForm)   
Procedure DragHandler (Var Msg : TMessage); Message WM_DROPFILES;

Kod: Tümünü seç

var
  Form1: TForm1;
  DroppedFile : Array[0..MAX_PATH * 2] of Char;
  TotalDroppedFiles, Counter : Cardinal;
  FindFile1 : _WIN32_FIND_DATAA;
  FindHandle : Cardinal;
  IsLooping : Boolean;
  FinalName : PChar;
  ListBoxHandle : HWND;
  sanaltasimalistesi:TListBox;
  Cancel: boolean;

implementation

Kod: Tümünü seç

procedure TForm1.FormCreate(Sender: TObject);
begin
sanaltasimalistesi:=TListBox.Create(self);
sanaltasimalistesi.Parent:=self;
sanaltasimalistesi.Visible:=false;
DragAcceptFiles(fileListBox1.Handle , True);
GetMem(FinalName, MAX_PATH * 2);

Kod: Tümünü seç

procedure TForm1.DragHandler(var Msg: TMessage);
var i,j:integer;
begin
if Msg.Msg = WM_DROPFILES then
  begin
    TotalDroppedFiles := DragQueryFile(Msg.wParam, $FFFFFFFF, nil, 0);
    sanaltasimalistesi.Items.BeginUpdate;
    for Counter := 0 to TotalDroppedFiles -1 do
      begin
        DragQueryFile(Msg.wParam, Counter, DroppedFile, SizeOf(DroppedFile));
                  if GetFileAttributes(DroppedFile) and FILE_ATTRIBUTE_DIRECTORY = 0 then
            begin
              SendMessage(sanaltasimalistesi.Handle, LB_ADDSTRING, 0, Integer(@DroppedFile));
                        for i:=0 to sanaltasimalistesi.Count-1 do
                         begin
                          lista.Items.Add(sanaltasimalistesi.Items[i]);
                          filelistbox1.Items.Add(extractfilename(sanaltasimalistesi.Items[i]));
                         end;
                    end else
        if GetFileAttributes(DroppedFile) and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then
          begin
              lstrcat(DroppedFile, '\');
              FindHandle := FindFirstFile(PChar(DroppedFile +'*.*'), FindFile1);
              if FindHandle <> INVALID_HANDLE_VALUE then
                begin
                  repeat
                    IsLooping := FindNextFile(FindHandle, FindFile1);
                    FillChar(FinalName^ , MAX_PATH * 2 , #0);
                    lstrcpy(FinalName, DroppedFile);
                    lstrcat(FinalName, FindFile1.cFileName);
                    if GetFileAttributes(FinalName) and FILE_ATTRIBUTE_DIRECTORY = 0 then
                       SendMessage(sanaltasimalistesi.Handle, LB_ADDSTRING, 0, Integer(FinalName));
                  until not IsLooping;
                    for i:=0 to sanaltasimalistesi.Count-1 do
                         begin
                          lista.Items.Add(sanaltasimalistesi.Items[i]);
                          filelistbox1.Items.Add(extractfilename(sanaltasimalistesi.Items[i]));
                         end;
                        end;
                  Windows.FindClose(FindHandle);
                end;
      end;
  DragFinish(Msg.wParam);
 sanaltasimalistesi.Items.EndUpdate;
 sanaltasimalistesi.Clear;
  End;
end;

Kod: Tümünü seç

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DragAcceptFiles(fileListBox1.Handle , False);
FreeMem(FinalName);

Kod: Tümünü seç

procedure TForm1.FormDestroy(Sender: TObject);
begin
sanaltasimalistesi.Free;
DragAcceptFiles(filelistbox1.Handle , False);

Hepimizin bildiği windows dragdrop kodlarını biraz değiştirdim ve tüm dosya yolundan sadece dosya adını ayıklattım.Sanal bir liste oluşturdum ve mouse taşınanları oraya aktardım.Ardından sanal listeyi tarattım ve dosya yolunu listA ya dosya adını ile filelistbox aktardım.

Şimdi buraya kadar herşey güzel ancak sorun şurada başlıyor.Birden fazla dosyayı seçtim ve taşıyıp bıraktığımda biraz saçmalıyor.Bazen aynı dosya isminden birden fazla ekliyor bazen ard ard a yazıyor.Bu sorunu nasıl çözebilirim.
Cevapla