home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Softwarová Záchrana 3
/
Softwarova-zachrana-3.bin
/
ArsClip
/
source.zip
/
UnitFrmPermanentNew.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2004-11-09
|
32KB
|
1,141 lines
unit UnitFrmPermanentNew;
{
Purpose:
This unit stores/reads/edits the permanent items.
The form is not a dummy form.
Updates:
New: Permanent Items Groups sorted by name
--------------
Fix: Up button did not range check
--------------
Changes for complex item as permanent items,
show them when it's shown or hovered
Folder list not cleared when "LoadPermanent" was called
----------------
Made scalable
New Keystroke support
-----------------
Updates for autotamically switching PIGs for a specific program
-------------------
Complete Rewrite. Old form was too poorly designed
to save.
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, INIFiles, ComCtrls {for THahsedStringList},
UnitClipQueue, UnitFrmDummyUnicodeTooltip, Menus, Buttons, ClipBrd;
const DEFAULT_FOLDER = 'Default';
ADDNEW_FOLDER = '<add new>';
PERM0_FILE = 'perm0.ini';
PERM1_FILE = 'perm1.ini';
EXEPIG_FILE = 'exepigs.ini';
type
TFrmPermanent = class(TForm)
pcPermanent: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Label1: TLabel;
cbPIGs: TComboBox;
btnAddPIG: TButton;
btnDeletePIG: TButton;
pnlNames: TPanel;
btnUp: TButton;
btnDown: TButton;
btnDelete: TButton;
lbItemNames: TListBox;
btnEdit: TButton;
btnNew: TButton;
Panel2: TPanel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
txtItemName: TEdit;
mItemText: TMemo;
btnSave: TButton;
btnCancel: TButton;
lvAutoSwitch: TListView;
Label5: TLabel;
cbKeystrokes: TCheckBox;
pnlKeys: TPanel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
Button10: TButton;
Button11: TButton;
pPreview: TImage;
bGetClipboard: TButton;
lblClipType: TLabel;
reItemText: TRichEdit;
bGetClipboardAs: TBitBtn;
pmGetAs: TPopupMenu;
PlaintText1: TMenuItem;
DIBPicture1: TMenuItem;
CopiedFiles1: TMenuItem;
RichTExt1: TMenuItem;
btnMove: TButton;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cbPIGsChange(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure btnDownClick(Sender: TObject);
procedure btnUpClick(Sender: TObject);
procedure btnEditClick(Sender: TObject);
procedure lbItemNamesClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnAddPIGClick(Sender: TObject);
procedure btnNewClick(Sender: TObject);
procedure btnDeletePIGClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure cbKeystrokesClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure bGetClipboardClick(Sender: TObject);
procedure bGetClipboardAsClick(Sender: TObject);
procedure btnMoveClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
AppPath : string;
CurrentPermPath : string;
FolderList : TStringList;
ItemNameList : TStringList;
ItemDataList : TStringList;
EXEPigList : THashedStringList;
EXEPasteList : THashedStringList;
Tooltip : TTooltipWindow;
Clipboard : TClipItem;
PushpopPath : string;
EditModeOn : boolean;
// util functions
function GetOldDataFilename (i: integer): string;
function GetDataFilename (i: integer): string;
procedure UpdateFolderList;
procedure LoadPermanentItemsGroup;
procedure SavePermanentItemsGroup;
function IsPermanentPathFolder(folder : string) : boolean;
procedure RefreshFormData;
//
procedure SetEditMode(value : boolean);
procedure ShowSelectedItem;
procedure RefreshCurrentItem;
procedure PopupItemClick(sender: TObject);
function GetNextComplexIndex : integer;
function ExtractComplexIndex(s : string) : integer;
public
{ Public declarations }
procedure SetPermanentPath( path : string );
function GetPermanentPath : string;
function GetPermanentPathFull : string;
// to enumerate permanent item names
function PermFoldersGetCount : cardinal;
function PermFoldersGetItem(index : cardinal) : string;
function IsComplexItem(s : string) : boolean;
function GetComplexItem(s : string) : TClipItem;
procedure PermFolderPush;
procedure PermFolderPop;
// to enumerate items in the current permanent folder
function GetCount: integer;
function GetItemName(i: integer): string;
function GetItemText(i: integer): string;
function GetTextFrom(name: string): string;
// display form with a newly created item
procedure ShowWithNewItem(item : string; name : string = ''); overload;
procedure ShowWithNewComplexItem(ci : TClipItem; name : string = ''); overload;
procedure AutoSwitch(EXEName : string);
procedure AssignPIG(EXEName : string);
end;
var
FrmPermanent: TFrmPermanent;
implementation
uses UnitMisc, StrUtils, UnitFrmClipboardManager, UnitFrmMove;
{$R *.dfm}
//
// public API
//
procedure TfrmPermanent.SetPermanentPath( path : string );
begin
if (self.EditModeOn) then begin
ShowMessage('Cannot switch groups while editing a permanent item.');
EXIT;
end;
if Self.IsPermanentPathFolder(path) then begin
CurrentPermPath := path;
self.LoadPermanentItemsGroup;
end else begin
CurrentPermPath := DEFAULT_FOLDER;
self.LoadPermanentItemsGroup;
end;
lbItemNames.ItemIndex := -1;
end;
function TfrmPermanent.GetPermanentPath : string;
begin
result := self.CurrentPermPath;
end;
function TFrmPermanent.GetPermanentPathFull: string;
begin
result := IncludeTrailingPathDelimiter(
IncludeTrailingPathDelimiter(self.AppPath) + self.GetPermanentPath
);
end;
function TfrmPermanent.PermFoldersGetCount : cardinal;
begin
result := FolderList.Count;
end;
function TfrmPermanent.PermFoldersGetItem(index : cardinal) : string;
begin
result := FolderList[index];
end;
function TfrmPermanent.GetCount: integer;
begin
result := ItemNameList.Count;
end;
function TfrmPermanent.GetItemName(i: integer): string;
begin
result := ItemNameList[i];
end;
function TfrmPermanent.GetItemText(i: integer): string;
begin
result := ItemDataList[i];
end;
function TfrmPermanent.GetTextFrom(name: string): string;
var pos: integer;
i: integer;
begin
pos := -1;
for i := 0 to ItemNameList.count - 1 do begin
if (lowercase(name) = lowercase(ItemNameList[i])) then begin
pos := i;
end;
end;
result := ItemDataList[pos];
end;
procedure TfrmPermanent.ShowWithNewItem(item : string; name : string = '');
begin
self.Show;
self.btnNew.Click;
mItemText.text := item;
txtItemName.text := name;
self.SetEditMode(true);
self.RefreshCurrentItem;
end;
procedure TFrmPermanent.ShowWithNewComplexItem(ci: TClipItem; name : string = '');
var i : integer;
begin
i := self.GetNextComplexIndex;
if (ci <> nil) then begin
ci.SaveToFile(self.GetPermanentPathFull, i );
end;
self.ShowWithNewItem('[FILE=' + IntToStr(i) + ']', name);
end;
//
// Create / Destroy
//
procedure TFrmPermanent.FormCreate(Sender: TObject);
var name: string;
lc : TListColumn;
begin
self.Font.Size := 8;
self.FolderList := TStringList.Create;
self.ItemNameList := TStringList.Create;
self.ItemDataList := TStringList.Create;
self.EXEPigList := THashedStringList.Create;
self.EXEPasteList := THashedStringList.Create;
self.Tooltip := TTooltipWindow.Create;
self.Clipboard := TClipItem.Create;
self.CurrentPermPath := DEFAULT_FOLDER;
self.AppPath := IncludeTrailingPathDelimiter(
ExtractFilePath(application.ExeName));
// fix
if FileExists(self.AppPath + EXEPIG_FILE) then begin
self.EXEPigList.LoadFromFile(self.AppPath + EXEPIG_FILE);
end;
//
// make the new Default directory and import and
// current permanent items
//
if not DirectoryExists( self.AppPath + DEFAULT_FOLDER) then begin
mkdir(self.AppPath + DEFAULT_FOLDER);
name := GetOldDataFilename(0);
if FileExists(name) then
copyfile(pchar(name), PChar(GetDataFileName(0)), true);
name := GetOldDataFilename(1);
if fileExists(name) then
copyfile(pchar(name), PChar(GetDataFilename(1)), true);
end;
self.UpdateFolderList;
//
// init the Auto Switch window
//
lc := lvAutoSwitch.Columns.Add;
lc.Caption := 'Program Name';
lc.Width := 100;
lc := lvAutoSwitch.Columns.Add;
lc.Caption := 'Group';
lc.Width := 100;
lblClipType.Caption := '';
pcPermanent.ActivePageIndex := 0;
pcPermanent.Align := alClient;
end;
procedure TFrmPermanent.FormDestroy(Sender: TObject);
begin
self.EXEPigList.SaveToFile(EXEPIG_FILE);
MyFree(self.EXEPasteList);
MyFree(self.ItemNameList);
MyFree(self.ItemDataList);
MyFree(self.FolderList);
MyFree(self.Tooltip);
MyFree(self.Clipboard);
end;
//
// Util Functions
//
function TfrmPermanent.GetOldDataFilename(i: integer): string;
begin
result := self.AppPath + 'perm' + IntToStr(i) + '.ini';
end;
function TfrmPermanent.GetDataFilename(i: integer): string;
begin
case i of
0: result := IncludeTrailingPathDelimiter(self.AppPath + CurrentPermPath) + PERM0_FILE;
1: result := IncludeTrailingPathDelimiter(self.AppPath + CurrentPermPath) + PERM1_FILE;
end
end;
procedure TfrmPermanent.LoadPermanentItemsGroup;
var name, itemText, s : string;
lineCount : cardinal;
i : integer;
tf : textfile;
begin
//
// load permanent items
//
ItemNameList.Clear;
name := GetDataFilename(0);
if FileExists(name) then begin
ItemNameList.LoadFromFile(name);
end;
//
// abort reading and show message on error
// always close the file
//
ItemDataList.Clear;
name := GetDataFilename(1);
if FileExists(name) then begin
AssignFile(tf, name);
Reset(tf, name);
try
while not eof(tf) do begin
try
Readln(tf, s);
itemText := '';
lineCount := StrToInt(s);
for i := 0 to lineCount - 1 do begin
Readln(tf, s);
if (itemText = '') then begin
itemText := s;
end else begin
itemText := itemText + chr(13) + chr(10) + s;
end;
end;
ItemDataList.Add(itemText);
except
on E: Exception do begin
ShowMessage('The "Permanent Item" file for group ' + CurrentPermPath + ' is corrupted - ' + name + #13#10#13#10 +
'Error Message: ' + E.Message);
break;
end;
end;
end;
finally
CloseFile(tf);
end;
end;
end;
procedure TfrmPermanent.SavePermanentItemsGroup;
var name: string;
s : string;
cnt : cardinal;
i,j: longint;
tf: textfile;
begin
if (CurrentPermPath = '') then
EXIT;
if not DirectoryExists(IncludeTrailingPathDelimiter(AppPath) + CurrentPermPath) then begin
mkdir(IncludeTrailingPathDelimiter(AppPath) + CurrentPermPath);
end;
//
// save items
//
name := GetDataFilename(0);
ItemNameList.SaveToFile(name);
name := GetDataFilename(1);
AssignFile(tf, name);
Rewrite(tf);
for i := 0 to ItemDataList.Count - 1 do begin
s := ItemDataList[i];
cnt := 1;
for j := 1 to length(s) - 1 do begin
if (s[j] = #13) and (s[j+1]= #10) then inc(cnt);
end;
writeln(tf, cnt);
writeln(tf, s);
end;
CloseFile(tf);
end;
procedure TfrmPermanent.UpdateFolderList;
var rec : TSearchRec;
r : integer;
begin
//
// scan each subfolder and look for permanent item config files
// this will generate a list of permanent item groups (using their
// folder name)
//
FolderList.clear;
FolderList.Sorted := true;
r := FindFirst(AppPath + '*.*', faDirectory, rec);
while (r = 0) do begin
// is file a subfolder?
if (rec.Attr and faDirectory) > 0 then begin
if (rec.name <> '.') and (rec.name <> '..') then begin
if IsPermanentPathFolder(rec.name) then begin
FolderList.Add(rec.name);
end;
end;
end;
r := FindNext(rec);
end;
end;
function TFrmPermanent.IsPermanentPathFolder(folder : string) : boolean;
begin
result := fileexists(IncludeTrailingPathDelimiter(AppPath) + folder + '\' + PERM0_FILE )
end;
//===================================================
// User Interface Interaction
// [State Philosophy]
// Save after any action that changes the current group.
// This includes item position, additions, or deletions.
//===================================================
procedure TFrmPermanent.FormShow(Sender: TObject);
begin
self.LoadPermanentItemsGroup;
self.RefreshFormData;
self.SetEditMode(false);
txtItemName.Text := '';
mItemText.Text := '';
self.btnEdit.Enabled := false;
self.btnDelete.Enabled := false;
self.btnUp.Enabled := false;
self.btnDown.Enabled := false;
self.btnMove.Enabled := false;
end;
procedure TFrmPermanent.RefreshFormData;
var i : integer;
li : TListItem;
begin
// show the curent Permanent Item Group names and
// select the current folder in the dropdown
cbpigs.Clear;
cbPIGs.Items.AddStrings(FolderList);
for i := 0 to FolderList.Count - 1 do begin
if lowercase(cbpigs.Items[i]) = lowercase(CurrentPermPath) then begin
cbPIGs.ItemIndex := i;
end;
end;
// load the current item names
//
lbItemNames.Clear;
lbItemNames.Items.AddStrings(ItemNameList);
lvAutoSwitch.Items.clear;
for i := 0 to EXEPigList.Count - 1 do begin
li := lvAutoSwitch.items.Add;
li.Caption := EXEPigList.Names[i];
li.SubItems.Add(EXEPigList.Values[EXEPigList.Names[i]]);
end;
end;
//
// group changed or item clicked
//
procedure TFrmPermanent.cbPIGsChange(Sender: TObject);
begin
//self.SavePermanentItemsGroup;
self.SetPermanentPath(cbpigs.text);
self.RefreshFormData;
txtItemName.Text := '';
mItemText.Text := '';
end;
procedure TFrmPermanent.lbItemNamesClick(Sender: TObject);
begin
self.ShowSelectedItem;
self.btnEdit.Enabled := true;
self.btnDelete.Enabled := true;
self.btnUp.Enabled := true;
self.btnDown.Enabled := true;
self.btnMove.Enabled := true;
end;
procedure TFrmPermanent.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
self.btnEdit.Enabled := false;
self.btnDelete.Enabled := false;
self.btnUp.Enabled := false;
self.btnDown.Enabled := false;
self.btnMove.Enabled := false;
Tooltip.CloseTooltip;
end;
// permanent item edit buttons
//
procedure TfrmPermanent.btnUpClick(Sender: TObject);
var i: integer;
begin
i := lbItemNames.ItemIndex;
if not (i < 0) then begin
ItemNameList.Move(i, i - 1);
ItemDataList.Move(i, i - 1);
lbItemNames.Items.Move(i, i - 1);
lbItemNames.ItemIndex := i - 1;
end;
self.SavePermanentItemsGroup;
end;
procedure TfrmPermanent.btnDownClick(Sender: TObject);
var i: integer;
begin
i := lbItemNames.ItemIndex;
if (i <> lbItemNames.Count -1) and (i <> -1)then begin
ItemNameList.Move(i, i + 1);
ItemDataList.Move(i, i + 1);
lbItemNames.Items.Move(i, i + 1);
lbItemNames.ItemIndex := i + 1;
end;
self.SavePermanentItemsGroup;
end;
procedure TfrmPermanent.btnDeleteClick(Sender: TObject);
var i: integer;
begin
Tooltip.CloseTooltip;
i := lbItemNames.ItemIndex;
if (i <> -1) then begin
ItemNameList.Delete(i);
ItemDataList.Delete(i);
lbItemNames.DeleteSelected;
end;
self.SavePermanentItemsGroup;
//TODO : clear the screen or select something else
if (lbItemNames.Count > 0) then begin
// Select the previous item if the last item item in list was delted
while (i >= lbItemNames.Count) and (i > 0) do begin
Dec(i);
end;
lbItemNames.ItemIndex := i;
end else begin
self.mItemText.Text := '';
self.txtItemName.text := '';
end;
Self.ShowSelectedItem;
Self.RefreshCurrentItem;
end;
procedure TFrmPermanent.btnEditClick(Sender: TObject);
var i: integer;
begin
i := lbItemNames.ItemIndex;
if (i <> -1) then begin
//ShowSelectedItem;
SetEditMode(true);
end;
end;
procedure TfrmPermanent.SetEditMode(value : boolean);
var i : integer;
prefix : string;
begin
Tooltip.CloseTooltip;
Self.EditModeOn := value;
if (value) then begin
txtItemName.Enabled := true;
mItemText.enabled := true;
btnSave.Visible := true;
btnCancel.Visible := true;
cbKeystrokes.Visible := true;
bGetClipboard.Visible := true;
bGetClipboardAs.Visible := true;
prefix := uppercase(leftstr(mItemText.Text,6));
cbKeystrokes.Checked := prefix = '[KEYS]';
pnlKeys.Visible := cbKeystrokes.Checked;
for i := 0 to pnlNames.ControlCount - 1 do begin
pnlNames.Controls[i].Enabled := false;
end;
pnlNames.Enabled := false;
lbItemNames.Enabled := false;
cbPIGs.Enabled := false;
if (self.IsComplexItem(mItemText.text)) then begin
mItemText.ReadOnly := true;
cbKeystrokes.Visible := false;
end else begin
mItemText.ReadOnly := false;
end;
end else begin
mItemText.Visible := true;
pPreview.Visible := false;
reItemText.Visible := false;
txtItemName.Enabled := false;
mItemText.Enabled := false;
btnSave.Visible := false;
btnCancel.Visible := false;
cbKeystrokes.Visible := false;
pnlKeys.Visible := false;
bGetClipboard.Visible := false;
bGetClipboardAs.Visible := false;
for i := 0 to pnlNames.ControlCount - 1 do begin
pnlNames.Controls[i].Enabled := true;
end;
pnlNames.Enabled := true;
lbItemNames.Enabled := true;
cbPIGs.Enabled := true;
end;
end;
procedure TfrmPermanent.ShowSelectedItem;
var i : integer;
begin
i := lbItemNames.ItemIndex;
if (i <> -1) then begin
txtItemName.Text := ItemNameList[i];
mItemText.Text := ItemDataList[i];
end;
Tooltip.CloseTooltip;
Clipboard.GetClipboardItem(0);
bGetClipboard.Caption := 'Get Clipboard as ' + Clipboard.GetFormatName;
self.RefreshCurrentItem;
end;
procedure TFrmPermanent.RefreshCurrentItem;
var ci : TClipItem;
p : TPoint;
s : string;
begin
// display the appropriete control depending on the content
// (supports the new [file=] clip format)
pPreview.Visible := false;
mItemText.Visible := false;
reItemText.Visible := false;
if (self.IsComplexItem(mItemText.text)) then begin
ci := self.GetComplexItem(mItemText.text);
lblClipType.Caption := ci.GetFormatName;
if (ci.GetFormat = Windows.CF_DIB) then begin
pPreview.Visible := true;
ci.GetDIB(pPreview.Picture);
pPreview.Hint := mItemText.text;
end else if (ci.GetFormat = frmClipboardManager.CF_RICHTEXT)
or (ci.GetFormat = frmClipboardManager.CF_HTML) then begin
reItemText.Visible := true;
reItemText.PlainText := false;
reItemText.Lines.Clear;
ci.GetRichText(s);
reItemText.Text := s;
reItemText.Hint := mItemText.Text;
end else if (ci.GetFormat = Windows.CF_UNICODETEXT) then begin
//mItemText.Visible := true;
Windows.ClientToScreen(mItemText.Handle, p);
Tooltip.ShowTooltip(ci, p);
MyFree(ci);
end else begin
end;
end else begin
mItemText.Visible := true;
lblClipType.Caption := 'Plain Text';
end;
end;
//
// Save / Cancel button used durring Edit Mode
//
procedure TFrmPermanent.btnCancelClick(Sender: TObject);
begin
self.SetEditMode(false);
self.ShowSelectedItem;
if (lbItemNames.ItemIndex = -1) then begin
self.btnEdit.Enabled := false;
self.btnDelete.Enabled := false;
self.btnUp.Enabled := false;
self.btnDown.Enabled := false;
self.mItemText.Text := '';
self.txtItemName.text := '';
end;
end;
procedure TFrmPermanent.btnSaveClick(Sender: TObject);
var i : integer;
begin
{ TODO : Rewrite teh NEw/Edit logic }
if txtItemName.text = '' then begin
ShowMessage('A name is required for an item');
EXIT;
end;
// detect 'New' or 'Edit'
i := lbItemNames.ItemIndex;
if (cbKeystrokes.checked) then begin
end;
if (i = -1) then begin
i := lbItemNames.count;
ItemNameList.Add(txtItemName.Text);
ItemDataList.Add(mItemText.text);
end else begin
ItemNameList[i] := txtItemName.Text;
ItemDataList[i] := mItemText.text;
end;
self.SavePermanentItemsGroup;
self.SetEditMode(false);
self.RefreshFormData;
lbItemNames.ItemIndex := i;
self.ShowSelectedItem;
end;
procedure TFrmPermanent.btnNewClick(Sender: TObject);
begin
Tooltip.CloseTooltip;
txtItemName.text := '';
mItemText.text := '';
reItemText.Text := '';
self.RefreshCurrentItem;
lbItemNames.ItemIndex := -1;
self.SetEditMode(true);
Clipboard.GetClipboardItem(0);
bGetClipboard.Caption := 'Get Clipboard as ' + Clipboard.GetFormatName;
lblClipType.Caption := 'Plain Text';
self.txtItemName.SetFocus;
end;
//
// add / delete Permanent Item Group
//
procedure TFrmPermanent.btnAddPIGClick(Sender: TObject);
var newgroup : string;
begin
if
Dialogs.InputQuery('Add Group','Please enter a new group name', newgroup)
then begin
if not IsPermanentPathFolder(newgroup) then begin
self.CurrentPermPath := newgroup;
self.ItemNameList.Clear;
self.ItemDataList.clear;
self.SavePermanentItemsGroup;
self.UpdateFolderList;
self.RefreshFormData;
end else begin
Dialogs.showmessage('Group name already exists');
end;
end;
end;
procedure TFrmPermanent.btnDeletePIGClick(Sender: TObject);
begin
if DirectoryExists(IncludeTrailingPathDelimiter(AppPath) + cbPIGs.Text) then begin
deletefile( GetDataFilename(0) );
deleteFile( GetDataFilename(1) );
RmDir(IncludeTrailingPathDelimiter(AppPath) + cbPIGs.Text);
self.SetPermanentPath(cbPIGs.Items[0]);
self.UpdateFolderList;
self.RefreshFormData;
end;
end;
procedure TFrmPermanent.AutoSwitch(EXEName: string);
var path : string;
begin
// given an EXE name, change to a PIG if it's associated with one
// Associate the current PIG with the EXE if no association exist
path := EXEPigList.Values[EXEName];
if (path <> '') then begin
self.SetPermanentPath(path);
end else begin
if EXEName <> '' then begin
EXEPigList.Values[EXEName] := self.GetPermanentPath;
end;
end;
end;
procedure TFrmPermanent.AssignPIG(EXEName: string);
begin
EXEPigList.Values[EXEName] := self.GetPermanentPath;
end;
procedure TFrmPermanent.cbKeystrokesClick(Sender: TObject);
begin
// add or remove the [KEYS] tag
if (cbKeystrokes.Checked) then begin
if (uppercase(leftstr(mItemText.text, 6)) <> '[KEYS]') then begin
mItemText.Text := '[KEYS]' + mItemText.Text;
end;
pnlKeys.Visible := true;
end else begin
if (uppercase(leftstr(mItemText.text, 6)) = '[KEYS]') then begin
mItemText.Text := rightstr(mItemText.Text, length(mItemText.Text) - 6);
end;
pnlKeys.Visible := false;
end;
end;
procedure TFrmPermanent.Button1Click(Sender: TObject);
var btn : TButton;
begin
btn := TButton(sender);
mItemText.SelText := '[' + btn.Caption + ']';
end;
function TFrmPermanent.GetComplexItem(s: string): TClipItem;
var i : integer;
begin
result := TClipItem.Create;
s := midstr(s,7,length(s)-7);
i := StrToInt(s);
result.LoadFromFIle(
self.GetPermanentPathFull,
i);
end;
function TFrmPermanent.IsComplexItem(s: string): boolean;
begin
result := uppercase(leftstr(s,6)) = '[FILE=';
end;
procedure TFrmPermanent.bGetClipboardClick(Sender: TObject);
var i : integer;
begin
// find the first unused index
// default to selected item index, or (last used + 1)
// to store the clip item
i := self.GetNextComplexIndex;
while FileExists(clipboard.GetFilename(self.GetPermanentPathFull, i)) do
inc(i);
clipboard.SaveToFile(self.GetPermanentPathFull, i);
mItemText.Text := '[FILE=' + IntToStr(i) + ']';
self.SetEditMode(true);
self.RefreshCurrentItem;
end;
procedure TFrmPermanent.bGetClipboardAsClick(Sender: TObject);
var mi : TMenuItem;
p : TPoint;
begin
pmGetAs.Items.Clear;
if Clipbrd.clipboard.HasFormat(CF_WAVE) then begin
mi := TMenuItem.Create(pmGetAs);
mi.Caption := 'Wave Audio';
mi.Hint := IntToStr(CF_WAVE);
mi.OnClick := self.PopupItemClick;
pmGetAs.Items.Add(mi);
end;
if Clipbrd.clipboard.HasFormat(CF_DIB) then begin
mi := TMenuItem.Create(pmGetAs);
mi.Caption := 'DIB (Picture)';
mi.Hint := IntToStr(CF_DIB);
mi.OnClick := self.PopupItemClick;
pmGetAs.Items.Add(mi);
end;
if Clipbrd.clipboard.HasFormat(CF_HDROP) then begin
mi := TMenuItem.Create(pmGetAs);
mi.Caption := 'File(s)';
mi.Hint := IntToStr(CF_HDROP);
mi.OnClick := self.PopupItemClick;
pmGetAs.Items.Add(mi);
end;
if Clipbrd.clipboard.HasFormat(frmClipboardManager.CF_RICHTEXT) then begin
mi := TMenuItem.Create(pmGetAs);
mi.Caption := 'Rich Text';
mi.Hint := IntToStr(frmClipboardManager.CF_RICHTEXT);
mi.OnClick := self.PopupItemClick;
pmGetAs.Items.Add(mi);
end;
if Clipbrd.clipboard.HasFormat(frmClipboardManager.CF_HTML) then begin
mi := TMenuItem.Create(pmGetAs);
mi.Caption := 'HTML';
mi.Hint := IntToStr(frmClipboardManager.CF_HTML);
mi.OnClick := self.PopupItemClick;
pmGetAs.Items.Add(mi);
end;
if Clipbrd.clipboard.HasFormat(CF_UNICODETEXT) then begin
mi := TMenuItem.Create(pmGetAs);
mi.Hint := IntToStr(CF_UNICODETEXT);
mi.OnClick := self.PopupItemClick;
mi.Caption := 'Unicode';
pmGetAs.Items.Add(mi);
end;
Windows.ClientToScreen(bGetClipboardAs.Handle, p);
pmGetAs.Popup(p.X + 4, p.y + 4);
end;
procedure TFrmPermanent.PopupItemClick(sender: TObject);
var i, format : integer;
begin
with sender as TMenuItem do begin
format := StrToInt(Hint);
end;
{TODO: This is copy/pasted code and should be actually chared with the normal
GetClipboard button }
// find the first unused index
// default to selected item index, or (last used + 1)
// to store the clip item
i := self.GetNextComplexIndex;
while FileExists(clipboard.GetFilename(self.GetPermanentPathFull, i)) do
inc(i);
clipboard.GetClipboardItem(0, Format);
clipboard.SaveToFile(self.GetPermanentPathFull, i);
mItemText.Text := '[FILE=' + IntToStr(i) + ']';
self.SetEditMode(true);
self.RefreshCurrentItem;
end;
procedure TFrmPermanent.PermFolderPop;
begin
if self.PushpopPath <> self.CurrentPermPath then begin
self.SetPermanentPath(self.PushpopPath);
end;
end;
procedure TFrmPermanent.PermFolderPush;
begin
self.PushpopPath := self.CurrentPermPath;
end;
procedure TFrmPermanent.btnMoveClick(Sender: TObject);
var ci : TClipItem;
name, text : string;
begin
self.Tooltip.CloseTooltip;
// get as complex item or plain text
ci := nil;
name := txtItemName.Text;
if (self.IsComplexItem(mItemText.text)) then begin
ci := self.GetComplexItem(mItemText.text);
end else begin
text := mItemText.text;
end;
// Show the Move dialog
// Delete the selected item,
// Show the form with the new item,
// click save, select the new item in the list
// cleanup
FrmMove.ShowModal;
if (FrmMove.ModalResult = mrOK) then begin
btnDelete.Click;
self.SetPermanentPath(FrmMove.cbMove.text);
self.RefreshFormData;
//self.hide;
if (ci = nil) then begin
self.ShowWithNewItem(text, name);
end else begin
self.ShowWithNewComplexItem(ci, name);
self.btnSave.Click;
end;
end;
//lbItemNames.ItemIndex := lbItemNames.count - 1;
UnitMisc.MyFree(ci);
end;
function TFrmPermanent.GetNextComplexIndex: integer;
var i, j : integer;
sl : TStringList;
begin
sl := TStringList.Create;
for i := 0 to (ItemDataList.Count - 1) do begin
if self.IsComplexItem(ItemDataList[i]) then begin
j := self.ExtractComplexIndex(ItemDataList[i]);
sl.Add(IntToStr(j));
end;
end;
result := 0;
while sl.IndexOf(IntToStr(result)) <> -1 do inc(result);
UnitMisc.MyFree(sl);
end;
function TFrmPermanent.ExtractComplexIndex(s: string): integer;
begin
s := midstr(s,7,length(s)-7);
result := StrToInt(s);
end;
procedure TFrmPermanent.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if btnCancel.Visible then begin
btnCancel.Click;
end;
CanClose := true;
end;
end.