Schowek

0

poniżej zamieszczam fragment kodu

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ActiveX, ShlObj, Clipbrd;
type
  TForm5 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    ListBox1: TListBox;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}

procedure ListBoxToClipboard(ListBox: TListBox; 
  BufferSize: Integer; 
  CopyAll: Boolean); 
var 
  Buffer: PChar; 
  Size: Integer; 
  Ptr: PChar; 
  I: Integer; 
  Line: string[255]; 
  Count: Integer; 
begin 
  if not Assigned(ListBox) then 
    Exit; 

  GetMem(Buffer, BufferSize); 
  Ptr   := Buffer; 
  Count := 0; 
  for I := 0 to ListBox.Items.Count - 1 do 
  begin 
    Line := ListBox.Items.strings[I]; 
    if not CopyAll and ListBox.MultiSelect and (not ListBox.Selected[I]) then 
      Continue; 
    { Check buffer overflow } 
    Count := Count + Length(Line) + 3; 
    if Count = BufferSize then 
      Break; 
    { Append to buffer } 
    Move(Line[1], Ptr^, Length(Line)); 
    Ptr    := Ptr + Length(Line); 
    Ptr[0] := #13; 
    Ptr[1] := #10; 
    Ptr    := Ptr + 2; 
  end; 
  Ptr[0] := #0; 
  ClipBoard.SetTextBuf(Buffer); 
  FreeMem(Buffer, BufferSize); 
end; 

procedure ClipboardToListBox(ListBox: TListbox); 
begin 
  if not Assigned(ListBox) then 
    Exit; 

  if not Clipboard.HasFormat(CF_TEXT) then 
    Exit;

  Listbox.Items.Text := Clipboard.AsText; 
end; 

 function GetIEFavourites(const favpath: string): TStrings;
var
  searchrec: TSearchRec;
  str: TStrings;
  path, dir, FileName: string;
  Buffer: array[0..2047] of Char;
  found: Integer;
begin
  str := TStringList.Create;
  // Get all file names in the favourites path
  path  := FavPath + '\*.url';
  dir   := ExtractFilepath(path);
  found := FindFirst(path, faAnyFile, searchrec);
  while found = 0 do
  begin
    // Get now URLs from files in variable files 
    Setstring(FileName, Buffer, GetPrivateProfilestring('InternetShortcut',
      PChar('URL'), nil, Buffer, SizeOf(Buffer), PChar(dir + searchrec.Name))); 
    str.Add(FileName);
    found := FindNext(searchrec); 
  end;
  // find Subfolders 
  found := FindFirst(dir + '\*.*', faAnyFile, searchrec);
  while found = 0 do 
  begin
    if ((searchrec.Attr and faDirectory) > 0) and (searchrec.Name[1] <> '.') then 
      str.Addstrings(GetIEFavourites(dir + '' + searchrec.Name));
    found := FindNext(searchrec); 
  end;
  FindClose(searchrec); 
  Result := str;
end; 

procedure FreePidl(pidl: PItemIDList); 
var
  allocator: IMalloc; 
begin
  if Succeeded(SHGetMalloc(allocator)) then
  begin
    allocator.Free(pidl);
    {$IFDEF VER100}
    allocator.Release;
    {$ENDIF}
  end;
end;

procedure TForm5.Button1Click(Sender: TObject);
 var
  pidl: PItemIDList;
  FavPath: array[0..MAX_PATH] of Char;
begin
  if Succeeded(ShGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl)) then
  begin
    if ShGetPathfromIDList(pidl, FavPath) then
      ListBox1.Items := GetIEFavourites(StrPas(FavPath));
    FreePIDL(pidl);
  end;
end;

procedure TForm5.Button3Click(Sender: TObject);
begin
close;
end;

procedure TForm5.Button2Click(Sender: TObject);
begin
ListBoxToClipboard(Listbox1,1024,False);

end;

end.

Problem polega natym, że przy dodawniu tekstu do schowka ( Button2) wyskauje mi seria błędów. Przeglądałem kod doładnie i niemoge znaleźć błędu. Byłbym wdzięczny za pomoc

0

Nie czytalem dokladniekodu, ale cos mi sie wydaje, ze tam nie ma procedury Button2click. A ty cos tam sie pytasz o nia :-)

0

jest... na samym dole :/

0

Nie czytalem dokladniekodu, ale cos mi sie wydaje, ze tam nie ma procedury Button2click. A ty cos tam sie pytasz o nia

Zakup okulary.

A co do błędu to wynika on (jak mi sie wydaje) ze zbyt małego bufora w procedurze ListBoxToClipboard. Przy 1024 wywala się na 34 okrązeniu pętli, przy 2 razy wiekszym gdzieś około 50. A tak w ogóle to wydaje mi się że jest jakiś łatwiejeszy sposób na kopiowanie kilkuliniowego textu do schowka...

0

tak, jest ale ja chce skopiować jedną linijkę

0

hmm

ClipBoard.AsText(ListBox.Items.Strings.Text);

tak, jest ale ja chce skopiować jedną linijkę

Wiec jeszcze latwiej, zamiast Text, Items[nr lini]

0

Ja moze jestem tępy, ale co ma ten kod w procedurze ListBoxToClipboard wspolnego z kopiowaniem jednej linijki ?
Moze napisz co ma ten program robić w założeniu, zamiast głowić sie co jest źle w kodzie, którego nie rozumiesz.

0

Masz troche racji Dominik - nie do końca rozumiem tą funkcję, ale programik napisać musze do szkoły....
Chodzi mi o to, żeby po naciśnięciu Button2 zaznaczona linijka w ListBox była kopiowana od schowka. Miałem z tym mały problem, więc postanowiłem bazować na kodzie z neta:
http://swissdelphicenter.ch/en/showcode.php?id=640
ale niedo końca mi wyszło

0

no wiec

ClipBoard.AsText(ListBox.Items[ListBox.ItemIndex]); 
0

no wiec

ClipBoard.AsText(ListBox.Items[ListBox.ItemIndex]); 

A nie

ClipBoard.asText(ListBox.Items.Strings[ListBox.ItemsIndex]);

?

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0