BaseClipboard.pas 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159
  1. unit BaseClipboard;
  2. interface
  3. uses
  4. Clipbrd, Classes, Windows, XmlDoc, XmlIntf, SysUtils;
  5. type
  6. TInnerClipboard = class(TClipboard);
  7. TBaseClipboard = class
  8. private
  9. FStream: TMemoryStream;
  10. protected
  11. procedure LoadXmlData(AXmlDoc: IXMLDocument); virtual; abstract;
  12. procedure SaveXmlData(AXmlDoc: IXMLDocument); virtual; abstract;
  13. procedure SaveToClipboard(AFormat: Word);
  14. procedure LoadFromClipboard(AFormat: Word);
  15. procedure SaveToStream;
  16. procedure LoadFromStream;
  17. procedure SaveToXmlFile(const AFileName: string);
  18. procedure LoadFromXmlFile(const AFileName: string);
  19. public
  20. constructor Create;
  21. destructor Destroy; override;
  22. end;
  23. function HasClipboardFormat(AFormat: Word): Boolean;
  24. implementation
  25. function HasClipboardFormat(AFormat: Word): Boolean;
  26. begin
  27. Result := Clipboard.HasFormat(AFormat);
  28. end;
  29. { TBaseClipboard }
  30. constructor TBaseClipboard.Create;
  31. begin
  32. FStream := TMemoryStream.Create;
  33. end;
  34. destructor TBaseClipboard.Destroy;
  35. begin
  36. FStream.Free;
  37. inherited;
  38. end;
  39. procedure TBaseClipboard.LoadFromClipboard(AFormat: Word);
  40. procedure LockAndLoadData(AData: THandle);
  41. var
  42. DataPtr: Pointer;
  43. begin
  44. DataPtr := GlobalLock(AData);
  45. try
  46. FStream.WriteBuffer(DataPtr^, GlobalSize(AData));
  47. FStream.Position := 0;
  48. finally
  49. GlobalUnlock(AData);
  50. end;
  51. end;
  52. var
  53. Data: THandle;
  54. begin
  55. Clipboard.Open;
  56. try
  57. Data := GetClipboardData(AFormat);
  58. if Data <> 0 then
  59. LockAndLoadData(Data);
  60. finally
  61. Clipboard.Close;
  62. end;
  63. end;
  64. procedure TBaseClipboard.LoadFromStream;
  65. var
  66. FXmlDocument: IXMLDocument;
  67. I: Integer;
  68. begin
  69. FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument;
  70. try
  71. FXmlDocument.LoadFromStream(FStream);
  72. FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAutoPrefix,doNamespaceDecl];
  73. LoadXmlData(FXmlDocument);
  74. finally
  75. FXmlDocument := nil;
  76. end;
  77. end;
  78. procedure TBaseClipboard.LoadFromXmlFile(const AFileName: string);
  79. var
  80. FXmlDocument: IXMLDocument;
  81. I: Integer;
  82. begin
  83. FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument;
  84. try
  85. FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAutoPrefix,doNamespaceDecl];
  86. if not FileExists(AFileName) then Exit;
  87. FXmlDocument.LoadFromFile(AFileName);
  88. LoadXmlData(FXmlDocument);
  89. finally
  90. FXmlDocument := nil;
  91. end;
  92. end;
  93. procedure TBaseClipboard.SaveToClipboard(AFormat: Word);
  94. begin
  95. Clipboard.Open;
  96. try
  97. EmptyClipboard;
  98. FStream.Position := 0;
  99. TInnerClipboard(Clipboard).SetBuffer(AFormat, FStream.Memory^, FStream.Size);
  100. finally
  101. Clipboard.Close;
  102. end;
  103. end;
  104. procedure TBaseClipboard.SaveToStream;
  105. var
  106. FXmlDocument: IXMLDocument;
  107. I: Integer;
  108. begin
  109. FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument;
  110. try
  111. FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAttrNull,doAutoPrefix,doNamespaceDecl];
  112. FXmlDocument.Active := True;
  113. FXmlDocument.Encoding := 'GB2312';
  114. FXmlDocument.AddChild('BillsBlock_M');
  115. SaveXmlData(FXmlDocument);
  116. FXmlDocument.SaveToStream(FStream);
  117. finally
  118. FXmlDocument := nil;
  119. end;
  120. end;
  121. procedure TBaseClipboard.SaveToXmlFile(const AFileName: string);
  122. var
  123. FXmlDocument: IXMLDocument;
  124. I: Integer;
  125. begin
  126. FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument;
  127. try
  128. FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAttrNull,doAutoPrefix,doNamespaceDecl];
  129. FXmlDocument.Active := True;
  130. FXmlDocument.Encoding := 'GB2312';
  131. FXmlDocument.AddChild('BillsBlock_M');
  132. SaveXmlData(FXmlDocument);
  133. FXmlDocument.SaveToFile(AFileName);
  134. finally
  135. FXmlDocument := nil;
  136. end;
  137. end;
  138. end.