Текущий архив: 2007.12.16;
Скачать: CL | DM;

Вниз

копировать из StringGrid   Найти похожие ветки 

← →
greengeneral   (2007-11-23 22:35) [0]

Мне надо скопирова данные со всех ячеек StringGrid в буфер обмена, не подскажете как это сделать.

---

← →
palva ©   (2007-11-23 23:15) [1]

Пробежаться по стринггриду и сформировать строку, которую хотите положить в буфер.
В юните Clipbrd описан класс TClipboard. нужно создать объект этого типа и его свойству AsText присвоить эту строку.

---

← →
GanibalLector ©   (2007-11-23 23:22) [2]


procedure CopyGrid(Grid: TStringGrid; Cut: boolean);
 //
 procedure SetClipBoard(Text: String);
   var LName: array[0..KL_NAMELENGTH] of  Char;
       Bool:Boolean;
       hglbCopy: THandle;
       I: Cardinal;
   const RUS="00000419";
 begin
   Bool:=False;
   GetKeyboardLayoutName(LName);
   if LName=RUS then Bool:=True else
    LoadKeyboardLayout(RUS,KLF_ACTIVATE);
   I:=Length(Text)+1;
   OpenClipboard(0);
   EmptyClipboard;
   try
     EmptyClipboard;
     hglbCopy:=GlobalAlloc(GMEM_DDESHARE,I);
     Move(PChar(Text)^,GlobalLock(hglbCopy)^,I);
     GlobalUnlock(hglbCopy);
     SetClipboardData(CF_TEXT, hglbCopy);
   finally
     CloseClipboard;
   end;
   if not Bool then  LoadKeyboardLayout(LName,KLF_ACTIVATE);
 end;
 //
// при Cut = false происходит Copy, а при true Cut
var x, y: integer;
  Buf: string;
begin
 Buf := "";
 with Grid,Grid.Selection do
 begin
   for y:=Top  to Bottom do
   begin
     for x:=Left to Right  do
     begin
       Buf := Buf + Cells[x, y];
       if Cut then Cells[x, y] := "";
       if x < Right then Buf := Buf+#9;  //только если несколько в ширину
     end;
     if y < Bottom then Buf := Buf+#13+#10;
   end;
 end;
 Buf:=Buf+#13+#10;  //можно не делать,но по аналогии с Excel
 Buf:=Buf+#0+#0;
 SetClipBoard(Buf);
end;



---

← →
Amoeba ©   (2007-11-23 23:35) [3]

> В юните Clipbrd описан класс TClipboard. нужно создать объект
> этого типа

Создавать его как раз не надо, т.к. он создается автоматически. Читаем справку:

Do not instantiate separate TClipboard objects by calling the constructor. Instead, use the global instance of TClipboard returned by the Clipboard function. This allows applications to share a single instance of TClipboard and safeguards against accidental deletion of the clipboard. Before calling Clipboard, be sure the uses clause includes the Clipbrd unit.

---

← →
Amoeba ©   (2007-11-23 23:44) [4]

> GanibalLector ©   (23.11.07 23:22) [2]


Зачем это городить?
procedure SetClipBoard(Text: String);
  var LName: array[0..KL_NAMELENGTH] of  Char;
      Bool:Boolean;
      hglbCopy: THandle;
      I: Cardinal;
  const RUS="00000419";
begin
  Bool:=False;
  GetKeyboardLayoutName(LName);
  if LName=RUS then Bool:=True else
   LoadKeyboardLayout(RUS,KLF_ACTIVATE);
  I:=Length(Text)+1;
  OpenClipboard(0);
  EmptyClipboard;
  try
    EmptyClipboard;
    hglbCopy:=GlobalAlloc(GMEM_DDESHARE,I);
    Move(PChar(Text)^,GlobalLock(hglbCopy)^,I);
    GlobalUnlock(hglbCopy);
    SetClipboardData(CF_TEXT, hglbCopy);
  finally
    CloseClipboard;
  end;
  if not Bool then  LoadKeyboardLayout(LName,KLF_ACTIVATE);
end;
Это излишне. Убрать.

Подготовка строки (Buf) - нормально. Оставить.
Вместо
SetClipBoard(Buf);
Достаточно. Главное не забыть добавить clipbrd в Uses/
Clipboard.AsText := Buf;
И не надо в данной задаче писать лишний код (= procedure SetClipBoard).

---

← →
Amoeba ©   (2007-11-23 23:50) [5]

Uses ...,clipbrd;
....

procedure CopyGrid(Grid: TStringGrid; Cut: boolean);
// при Cut = false происходит Copy, а при true Cut
var x, y: integer;
 Buf: string;
begin
Buf := "";
with Grid,Grid.Selection do
begin
  for y:=Top  to Bottom do
  begin
    for x:=Left to Right  do
    begin
      Buf := Buf + Cells[x, y];
      if Cut then Cells[x, y] := "";
      if x < Right then Buf := Buf+#9;  //только если несколько в ширину
    end;
    if y < Bottom then Buf := Buf+#13+#10;
  end;
end;
Buf:=Buf+#13+#10;  //можно не делать,но по аналогии с Excel
Buf:=Buf+#0+#0;
Clipboard.AsText := Buf;
end;

---

← →
GanibalLector ©   (2007-11-24 00:04) [6]

2 Зачем это городить?

А ты попробуй ;) Установи рус.язык, скопируй в буффер, открой тот же Excel (язык, предположим станет англ.) и вставь.

---

Страницы: 1 вся ветка

Текущий архив: 2007.12.16;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.017 c