pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

clipanalizer: implemented delete format.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6272 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jesusr
2018-03-23 22:43:41 +00:00
parent ee873d3378
commit cd5e168a20
2 changed files with 103 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
applications/clipanalizer/main.lfm
View File

@ -2,10 +2,10 @@ object frmClipboardAnalizer: TfrmClipboardAnalizer
Left = 175
Height = 517
Top = 185
Width = 771
Width = 858
Caption = 'Clipboard Analizer'
ClientHeight = 517
ClientWidth = 771
ClientWidth = 858
LCLVersion = '1.9.0.0'
object lstTypes: TListBox
Left = 0
@ -22,20 +22,20 @@ object frmClipboardAnalizer: TfrmClipboardAnalizer
Left = 277
Height = 517
Top = 0
Width = 494
Width = 581
Align = alClient
Caption = 'Panel1'
ClientHeight = 517
ClientWidth = 494
ClientWidth = 581
TabOrder = 1
object Panel2: TPanel
Left = 1
Height = 111
Top = 1
Width = 492
Width = 579
Align = alTop
ClientHeight = 111
ClientWidth = 492
ClientWidth = 579
TabOrder = 0
object btnUpdate: TButton
Left = 8
@ -113,7 +113,7 @@ object frmClipboardAnalizer: TfrmClipboardAnalizer
Left = 112
Height = 23
Top = 5
Width = 375
Width = 462
Anchors = [akTop, akLeft, akRight]
ReadOnly = True
TabOrder = 6
@ -128,7 +128,7 @@ object frmClipboardAnalizer: TfrmClipboardAnalizer
TabOrder = 7
end
object btnIsolate: TButton
Left = 272
Left = 368
Height = 25
Top = 40
Width = 91
@ -137,7 +137,7 @@ object frmClipboardAnalizer: TfrmClipboardAnalizer
TabOrder = 8
end
object btnUpdateIsolate: TButton
Left = 368
Left = 464
Height = 25
Top = 40
Width = 107
@ -163,12 +163,21 @@ object frmClipboardAnalizer: TfrmClipboardAnalizer
OnClick = btnReOpenClick
TabOrder = 11
end
object btnDeleteFormat: TButton
Left = 272
Height = 25
Top = 40
Width = 91
Caption = 'Delete Format'
OnClick = btnDeleteFormatClick
TabOrder = 12
end
end
object memoDump: TMemo
Left = 1
Height = 404
Top = 112
Width = 492
Width = 579
Align = alClient
Font.Height = -11
Font.Name = 'Courier New'

132
applications/clipanalizer/main.pas
View File

@ -54,6 +54,7 @@ type
btnIsolate: TButton;
btnUpdateIsolate: TButton;
btnOpen: TButton;
btnDeleteFormat: TButton;
chkBinText: TCheckBox;
oDlg: TOpenDialog;
sDlg: TSaveDialog;
@ -69,6 +70,7 @@ type
radStream: TRadioButton;
radEncoding: TRadioButton;
Splitter1: TSplitter;
procedure btnDeleteFormatClick(Sender: TObject);
procedure btnOpenClick(Sender: TObject);
procedure btnUpdateIsolateClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
@ -80,7 +82,9 @@ type
private
fFilename: string;
procedure DumpClipboard;
procedure IsolateFormat(updateWithContent: boolean);
procedure UpdateFormatList;
procedure DeleteFormat;
public
end;
@ -239,31 +243,8 @@ begin
end;
procedure TfrmClipboardAnalizer.btnUpdateIsolateClick(Sender: TObject);
var
aIndex: Integer;
formatID: TClipboardFormat;
stream: TMemoryStream;
begin
aIndex := lstTypes.ItemIndex;
if aIndex<0 then
exit;
formatID := TClipboardFormat(lstTypes.Items.Objects[aIndex]);
stream := TMemoryStream.Create;
try
memoDump.Lines.SaveToStream(stream);
stream.position := 0;
Clipboard.Open;
Clipboard.Clear;
Clipboard.AddFormat(formatID, stream);
Clipboard.Close;
UpdateFormatList;
finally
stream.free;
end;
IsolateFormat(true);
end;
procedure TfrmClipboardAnalizer.btnOpenClick(Sender: TObject);
@ -274,32 +255,14 @@ begin
end;
end;
procedure TfrmClipboardAnalizer.btnIsolateClick(Sender: TObject);
var
aIndex: Integer;
formatID: TClipboardFormat;
stream: TMemoryStream;
procedure TfrmClipboardAnalizer.btnDeleteFormatClick(Sender: TObject);
begin
aIndex := lstTypes.ItemIndex;
if aIndex<0 then
exit;
DeleteFormat;
end;
formatID := TClipboardFormat(lstTypes.Items.Objects[aIndex]);
stream := TMemoryStream.Create;
try
ClipboardGetFormat(formatID, stream);
stream.position := 0;
Clipboard.Open;
Clipboard.Clear;
Clipboard.AddFormat(formatID, stream);
Clipboard.Close;
UpdateFormatList;
finally
stream.free;
end;
procedure TfrmClipboardAnalizer.btnIsolateClick(Sender: TObject);
begin
IsolateFormat(false);
end;
procedure TfrmClipboardAnalizer.btnReOpenClick(Sender: TObject);
@ -389,6 +352,37 @@ begin
end;
end;
procedure TfrmClipboardAnalizer.IsolateFormat(updateWithContent: boolean);
var
stream: TMemoryStream;
formatID: TClipboardFormat;
aIndex: Integer;
begin
aIndex := lstTypes.ItemIndex;
if aIndex<0 then
exit;
formatID := TClipboardFormat(lstTypes.Items.Objects[aIndex]);
stream := TMemoryStream.Create;
try
if updateWithContent then
memoDump.Lines.SaveToStream(stream)
else
ClipboardGetFormat(formatID, stream);
stream.position := 0;
Clipboard.Open;
Clipboard.Clear;
Clipboard.AddFormat(formatID, stream);
Clipboard.Close;
UpdateFormatList;
finally
stream.free;
end;
end;
procedure TfrmClipboardAnalizer.UpdateFormatList;
var
L: TStringList;
@ -413,5 +407,47 @@ begin
L.Free;
end;
type
TFormatItem = record
formatID: TClipboardFormat;
stream: TMemoryStream;
end;
procedure TfrmClipboardAnalizer.DeleteFormat;
var
item: TFormatItem;
Lista: array of TFormatItem;
aIndex, n: Integer;
begin
for aIndex:=0 to lstTypes.Count-1 do begin
if lstTypes.ItemIndex=aIndex then
continue;
item.formatID := TClipboardFormat(lstTypes.Items.Objects[aIndex]);
item.stream := TMemoryStream.Create;
ClipboardGetFormat(item.formatID, item.stream);
item.stream.Position := 0;
n := Length(Lista);
SetLength(lista, n+1);
lista[n] := item;
end;
if length(lista)=0 then
exit;
try
Clipboard.Open;
Clipboard.Clear;
for aIndex := 0 to Length(Lista)-1 do begin
Clipboard.AddFormat(lista[aIndex].formatID, lista[aIndex].stream);
lista[aIndex].stream.free;
end;
finally
Clipboard.Close;
UpdateFormatList;
end;
end;
end.