Softwarová Záchrana 3/Softwarova-zachrana-3.bin/ArsClip/source.zip/UnitFrmPermanent.pas

Pascal/Delphi Source File | 2003-02-18 | 15KB | 574 lines

unit UnitFrmPermanent;
{
    NOTE:
        This beast has gone BYE BYE. See UnitFrmPermanentNew for it's
        replacement.



    Purpose:
        This unit stores/reads/edits the permanent items.
        The form is not a dummy form.

    Updates:
        Display '&' without defining an accelerator key in text items

        Improved error reporting for corrupt data file

        New procedure to show the form with a new item added

        Refresh dropdown when saving a new permanent item group.
        Saves before group change and saves before closing.

        Crapy, Crappy, Crappy code.
        Changes where not saved before the group was changed.
        Essentially, changes would not be saved at all in some cases.

        CRLF wasn't used to count the number of lines in "Text to Paste".
}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;


const DEFAULT_FOLDER = 'Default';
      ADDNEW_FOLDER = '<add new>';
      PERM0_FILE = 'perm0.ini';
      PERM1_FILE = 'perm1.ini';

type
  TfrmPermanentOld = class(TForm)
    GroupBox1: TGroupBox;
    txtItemName: TEdit;
    Label1: TLabel;
    mItemText: TMemo;
    btnSave: TButton;
    Panel1: TPanel;
    lbItemName: TListBox;
    lbItemText: TListBox;
    btnUp: TButton;
    btnDown: TButton;
    Label2: TLabel;
    btnDelete: TButton;
    cbGroups: TComboBox;
    labelx: TLabel;
    btnDeleteGroup: TButton;
    Label3: TLabel;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure txtItemNameChange(Sender: TObject);
    procedure mItemTextChange(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure lbItemNameClick(Sender: TObject);
    procedure btnUpClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnDownClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure cbGroupsCloseUp(Sender: TObject);
    procedure btnDeleteGroupClick(Sender: TObject);
    procedure cbGroupsClick(Sender: TObject);
  private
    { Private declarations }
    AppPath : string;
    PermPath : string;
    PermFolders : TStringList;
    OverrideBlankItem : boolean;

    function GetOldDataFilename (i: integer): string;
    function GetDataFilename (i: integer): string;
    procedure LoadPermanentItems;
    procedure SavePermanentItems;
  public
    { Public declarations }

    {item enumeration API}
    function GetCount: integer;
    function GetItemName(i: integer): string;
    function GetItemText(i: integer): string;
    function GetTextFrom(name: string): string;

    {permanent items group}
    {for frmConfig}
    procedure PermFoldersRefresh;
    function PermFoldersGetCount : cardinal;
    function PermFoldersGetItem(index : cardinal) : string;

    function GetPermanentPath : string;
    procedure SetPermanentPath( path : string );
    procedure ShowWithNewItem(item : string);
  end;

var
  frmPermanentOld: TfrmPermanentOld;

implementation

{$R *.dfm}

uses INIFiles;
const PERM_ITEMS = 'Permanent Items';


{
--======================
-- // Public Inteface //
--======================
}

procedure TfrmPermanentOld.ShowWithNewItem(item : string);
begin
    OverrideBlankItem := true;
    mItemText.Text := item;
    self.Show;
end;

function TfrmPermanentOld.GetCount: integer;
begin
    result := lbItemName.Count;
end;

function TfrmPermanentOld.GetItemName(i: integer): string;
begin
    result := lbItemName.Items[i];
end;

function TfrmPermanentOld.GetItemText(i: integer): string;
begin
    result := lbItemText.Items[i];
end;

function TfrmPermanentOld.GetTextFrom(name: string): string;
var pos: integer;
    i: integer;
begin
    pos := -1;
    for i := 0 to lbItemname.count - 1 do begin
        if (name = lbItemName.items[i]) then begin
            pos := i;
        end;
    end;

    result := lbItemText.items[pos];
end;


//
//
//
function TfrmPermanentOld.GetPermanentPath : string;
begin
    result := PermPath;
end;

procedure TfrmPermanentOld.SetPermanentPath( path : string );
begin
    PermPath := path;
    self.LoadPermanentItems;
end;

procedure TfrmPermanentOld.PermFoldersRefresh;
var rec : TSearchRec;
    r : integer;
begin
    //
    // Load the permanent items group
    // Select the current group
    //
    cbGroups.items.clear;
    PermFolders.Clear;
    cbGroups.items.Add(ADDNEW_FOLDER);
    r := FindFirst(AppPath + '*.*', faDirectory, rec);
    while (r = 0) do begin
        if (rec.Attr and faDirectory) > 0 then begin
            if (rec.name <> '.') and (rec.name <> '..') then begin
                if fileexists(AppPath + rec.name + '\' + PERM0_FILE  ) then begin
                    PermFolders.Add(rec.name);
                    cbGroups.Items.Add(rec.name);
                end;
                if lowercase(rec.name) = lowercase(PermPath) then begin
                    cbGroups.ItemIndex := cbGroups.Items.Count - 1;
                end;
            end;
        end;
        r := FindNext(rec);
    end;

    //
    // If no permanent items found, insert the default folder name and select it
    //
    if cbGroups.Items.count = 1 then begin
        cbGroups.Items.Add(DEFAULT_FOLDER);
        cbGroups.ItemIndex := 1;
    end;

end;
function TfrmPermanentOld.PermFoldersGetCount : cardinal;
begin
    result := PermFolders.Count;
end;
function TfrmPermanentOld.PermFoldersGetItem(index : cardinal) : string;
begin
    result := PermFolders.Strings[index];
end;



{
--======================
-- // Create/Destroy //
--======================
}
function TfrmPermanentOld.GetOldDataFilename(i: integer): string;
begin
    result := self.AppPath + 'perm' + IntToStr(i) + '.ini';
end;
function TfrmPermanentOld.GetDataFilename(i: integer): string;
begin
    case i of
    0: result := IncludeTrailingPathDelimiter(self.AppPath + PermPath) + PERM0_FILE;
    1: result := IncludeTrailingPathDelimiter(self.AppPath + PermPath) + PERM1_FILE;
    end
end;



procedure TfrmPermanentOld.FormCreate(Sender: TObject);
var    name: string;
begin
    self.PermPath := DEFAULT_FOLDER;
    self.AppPath := ExtractFilePath(application.ExeName);
    self.PermFolders := TStringList.Create;

    //
    // 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.LoadPermanentItems;
    self.PermFoldersRefresh;
end;

procedure TfrmPermanentOld.FormDestroy(Sender: TObject);
begin
    //self.SavePermanentItems;
    self.PermFolders.Free;
end;


{
--======================
-- // Show / Close    //
--======================
}

procedure TfrmPermanentOld.FormShow(Sender: TObject);
begin
    //
    // blank out the edit window
    //
    if (lbItemname.ItemIndex = -1) then begin
        txtItemName.Text := '';
        if (not OverrideBlankItem) then begin
            mItemText.Text := '';
        end;
    end;

    //
    // disable the up/down buttons (until an item is clicked in the list)
    //
    btnup.Enabled := (lbItemName.itemindex <> -1);
    btndown.Enabled := btnup.enabled;
    btndelete.Enabled := btnup.Enabled;

    btnsave.Enabled := false;

    self.PermFoldersRefresh;
end;

procedure TfrmPermanentOld.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
    if Trim(cbGroups.Text) = '' then begin
        if PermPath = '' then begin
            cbGroups.Text := DEFAULT_FOLDER;
            PermPath := cbGroups.Text;
        end else begin
            cbGroups.text := PermPath;
        end;
        self.LoadPermanentItems;
    end else begin
        PermPath := trim(cbGroups.text);
    end;


    self.SavePermanentItems;
    self.PermFoldersRefresh;
    self.ModalResult := 1;
end;




{
--==================================
-- // Load/Save Permanent Items //
--==================================
}
procedure TfrmPermanentOld.LoadPermanentItems;
var name, itemText, s : string;
    lineCount : cardinal;
    i : integer;
    tf : textfile;
begin
    //
    // load permanent items
    //
    lbItemName.Items.Clear;
    name := GetDataFilename(0);
    if FileExists(name) then begin
        lbItemName.Items.LoadFromFile(name);
    end;

    //
    // abort reading and show message on error
    // always close the file
    //
    lbItemText.Items.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;

                    lbItemText.Items.Add(itemText);
                except
                     on E: Exception do begin
                        ShowMessage('The "Permanent Item" file for group ' + PermPath + ' is corrupted - ' + name + #13#10#13#10 +
                                    'Error Message: ' + E.Message);
                        break;
                     end;
                end;
            end;
        finally
            CloseFile(tf);
        end;
    end;
end;

procedure TfrmPermanentOld.SavePermanentItems;
var name: string;
    s : string;
    cnt : cardinal;

    i,j: longint;
    tf: textfile;

    DoRefresh : boolean;
begin
    PermPath := trim(cbGroups.text);
    if (PermPath = '') then
        EXIT;

    DoRefresh := false;
    if not DirectoryExists(AppPath + PermPath) then begin
        mkdir(AppPath + PermPath);
        DoRefresh := true;
    end;
    //
    // save items
    //
    name := GetDataFilename(0);
    lbItemName.Items.SaveToFile(name);

    name := GetDataFilename(1);
    AssignFile(tf, name);
    Rewrite(tf);


    for i := 0 to lbItemText.Count - 1 do begin
        s := lbItemText.Items[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);

    if (DoRefresh) then begin
        self.PermFoldersRefresh;
    end;
end;

{
--
-- Only show the save button when an item name and some item text has been entered
--
}
procedure TfrmPermanentOld.txtItemNameChange(Sender: TObject);
begin
    btnsave.Enabled := (trim(txtitemname.Text) <> '') and (mItemText.Text <> '');
end;

procedure TfrmPermanentOld.mItemTextChange(Sender: TObject);
begin
    btnsave.Enabled := (trim(txtitemname.Text) <> '') and (mItemText.Text <> '');
end;

procedure TfrmPermanentOld.btnSaveClick(Sender: TObject);
var i: integer;
    pos: integer;
begin
    txtItemName.text := trim(txtItemName.text);
    pos := -1;
    for i := 0 to lbItemName.count -1 do begin
        if (lbItemName.items[i] = txtItemName.Text) then begin
            pos := i;
        end;

    end;

    if (pos = -1) then begin
        lbItemName.Items.Add( trim(txtItemName.Text) );
        lbItemText.Items.Add( mItemText.Text );
    end else begin
        lbItemText.Items[pos] := mItemText.Text;
    end;

    txtItemName.Text := '';
    mItemText.Text := '';
end;



{
Load the edit pane when an item is selected from the lsit
Enable position moving
}

procedure TfrmPermanentOld.lbItemNameClick(Sender: TObject);
begin
    btnUp.Enabled := (lbItemName.Count > 0);
    btnDown.Enabled := btnUp.Enabled;
    btnDelete.Enabled := btnUp.Enabled;

    txtItemName.text := lbItemName.items[ lbItemName.ItemIndex ];
    mItemText.Text := lbItemText.Items[ lbItemName.ItemIndex ];
end;

{
move selected item up or down and keep selected
}
procedure TfrmPermanentOld.btnUpClick(Sender: TObject);
var i: integer;
begin
    i := lbItemName.ItemIndex;
    if (i <> 0) then begin
        lbItemName.Items.Move(i, i - 1);
        lbItemText.Items.Move(i, i - 1);

        lbItemName.ItemIndex := i - 1;
    end;
end;
procedure TfrmPermanentOld.btnDownClick(Sender: TObject);
var i: integer;
begin
    i := lbItemName.ItemIndex;
    if (i <> lbItemName.Count -1) then begin
        lbItemName.Items.Move(i, i + 1);
        lbItemText.Items.Move(i, i + 1);

        lbItemName.ItemIndex := i + 1;
    end;
end;

procedure TfrmPermanentOld.btnDeleteClick(Sender: TObject);
var i: integer;
begin
    i := lbItemName.ItemIndex;
    lbItemName.Items.Delete(i);
    lbItemText.Items.Delete(i);
    txtItemName.Text := '';
    mItemText.Text := '';
end;


procedure TfrmPermanentOld.cbGroupsCloseUp(Sender: TObject);
begin
    //
    // load an existing group or get ready for a brand new group
    //
    if cbGroups.Items[cbGroups.ItemIndex] = ADDNEW_FOLDER then begin
        lbItemName.Items.clear;
        lbItemText.Items.Clear;
        cbGroups.Text := '';
        cbGroups.SelText := '';
    end else begin
        self.SavePermanentItems;

        PermPath := cbGroups.items[cbGroups.ItemIndex];
        self.LoadPermanentItems;
    end;

end;

procedure TfrmPermanentOld.btnDeleteGroupClick(Sender: TObject);
begin
    //
    // get rid of the data files and remove the folder
    // refresh to show changes
    //
    if DirectoryExists(AppPath + cbGroups.Text) then begin
        deletefile( GetDataFilename(0) );
        deleteFile( GetDataFilename(1) );
        RmDir(AppPath + cbGroups.Text);

        cbGroups.Text := '';
        PermPath := '';
        self.PermFoldersRefresh;
        self.LoadPermanentItems;
    end;
end;

procedure TfrmPermanentOld.cbGroupsClick(Sender: TObject);
begin
    self.SavePermanentItems;
end;

end.