osapiutils

OSAPIClipboardTextTable.pas
111 строк · 3.2 Кб
Перенос по словам
1
unit OSAPIClipboardTextTable;
2

3
{$mode objfpc}{$H+}
4

5
interface
6

7
uses Forms, Classes, SysUtils, ShlObj, ClipBrd, Windows, LazUtils;
8

9
function CopyTextTableToClipboard(var AArray:Pointer): boolean;
10
function CopyTextTableToClipboardLite(var AArray: Pointer): boolean;
11

12
implementation
13

14
function CopyTextTableToClipboard(var AArray: Pointer): boolean;
15
var
16
  ArrTable      : array of array of string;
17
  ir,ic         :integer;
18
  sHTMLTable,
19
  sTable,
20
  sRow         :String;
21
begin
22
  Pointer(ArrTable):=AArray;
23

24
   try
25
    sTable:='';
26
    sHTMLTable:='<html>';
27
    sHTMLTable:=sHTMLTable+#13+'<head>';
28
    sHTMLTable:=sHTMLTable+#13+'<meta http-equiv=Content-Type content="text/html; charset=utf-8">';
29
    sHTMLTable:=sHTMLTable+#13+'<meta name=ProgId content=Excel.Sheet>';
30
    sHTMLTable:=sHTMLTable+#13+'<meta name=Generator content="Jadwiga">';
31
    //<link id=Main-File rel=Main-File href="file:///C:\Users\Pichugin\AppData\Local\Temp\msohtmlclip1\01\clip.htm">
32
    //<link rel=File-List href="file:///C:\Users\Pichugin\AppData\Local\Temp\msohtmlclip1\01\clip_filelist.xml">
33
    sHTMLTable:=sHTMLTable+#13+'<style>';
34
    sHTMLTable:=sHTMLTable+#13+'.xl65 {border:.5pt solid windowtext;}';
35
    sHTMLTable:=sHTMLTable+#13+'</style>';
36
    sHTMLTable:=sHTMLTable+#13+'</head>';
37
    sHTMLTable:=sHTMLTable+#13+'<body>';
38
    sHTMLTable:=sHTMLTable+#13+'<table>';
39
    for ir:=0 to high(ArrTable) do
40
    begin
41
        sHTMLTable:=sHTMLTable+'<tr>';
42
        for ic:=0 to high(ArrTable[ir]) do
43
        begin
44
          if ic=0 then
45
          begin
46
            sRow:=ArrTable[ir][ic];
47
            sHTMLTable:=sHTMLTable+'<td class=xl65>'+ArrTable[ir][ic]+'</td>';
48
          end
49
          else begin
50
            sRow:=sRow+#9+ArrTable[ir][ic];
51
            sHTMLTable:=sHTMLTable+'<td class=xl65>'+ArrTable[ir][ic]+'</td>';
52
          end;
53
        end;
54
        sTable:=sTable+#13+#10+sRow;
55
        sHTMLTable:=sHTMLTable+'</tr>';
56
    end;
57
    sHTMLTable:=sHTMLTable+'</table>';
58
    sHTMLTable:=sHTMLTable+#13+'</body>';
59
    sHTMLTable:=sHTMLTable+#13+'</html>';
60

61
    clipbrd.Clipboard.SetAsHtml(sHTMLTable,sTable);
62
      Result:=True;
63
   finally
64
      Result:=False;
65
   end;
66

67
end;
68

69
function CopyTextTableToClipboardLite(var AArray: Pointer): boolean;
70
var
71
  ArrTable      : array of array of string;
72
  ir,ic         :integer;
73
  sHTMLTable,
74
  sTable,
75
  sRow         :String;
76
begin
77
  Pointer(ArrTable):=AArray;
78

79
   try
80
    sTable:='';
81
    sHTMLTable:='<table>';
82
    for ir:=0 to high(ArrTable) do
83
    begin
84
        sHTMLTable:=sHTMLTable+'<tr>';
85
        for ic:=0 to high(ArrTable[ir]) do
86
        begin
87
          if ic=0 then
88
          begin
89
            sRow:=ArrTable[ir][ic];
90
            sHTMLTable:=sHTMLTable+'<td>'+ArrTable[ir][ic]+'</td>';
91
          end
92
          else begin
93
            sRow:=sRow+#9+ArrTable[ir][ic];
94
            sHTMLTable:=sHTMLTable+'<td>'+ArrTable[ir][ic]+'</td>';
95
          end;
96
        end;
97
        sTable:=sTable+#13+#10+sRow;
98
        sHTMLTable:=sHTMLTable+'</tr>';
99
    end;
100
    sHTMLTable:=sHTMLTable+'</table>';
101
    //clipbrd.Clipboard.AsText:=sTable;
102
    clipbrd.Clipboard.SetAsHtml(sHTMLTable,sTable);
103
      Result:=True;
104
   finally
105
      Result:=False;
106
   end;
107

108
end;
109

110

111
end.
112

113
osapiutils

Использование cookies
