"Fossies" - the Fresh Open Source Software Archive

Member "peazip-8.0.0.src/unit6.pas" (1 Jun 2021, 3885 Bytes) of package /linux/misc/peazip-8.0.0.src.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) delphi source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "unit6.pas": 7.9.0_vs_8.0.0.

    1 unit Unit6; 
    2 
    3 {$mode objfpc}{$H+}
    4 
    5 interface
    6 
    7 uses
    8   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
    9   ButtonPanel, StdCtrls, Buttons, ExtCtrls, list_utils;
   10 
   11 type
   12 
   13   { TFormInput }
   14 
   15   TFormInput = class(TForm)
   16     BitBtn1: TBitBtn;
   17     BitBtn2: TBitBtn;
   18     ButtonPanel1: TButtonPanel;
   19     CheckBox1: TCheckBox;
   20     Editinputquery: TComboBox;
   21     LabelLow: TLabel;
   22     Labelrenamereset: TLabel;
   23     Labelspac2: TLabel;
   24     Labelspac3: TLabel;
   25     Labelappdirn: TLabel;
   26     Labelspac4: TLabel;
   27     LabelUp: TLabel;
   28     LabelTimestamp: TLabel;
   29     Labelprepdirn: TLabel;
   30     LabelWarning: TLabel;
   31     OpenDialog3: TOpenDialog;
   32     PanelInput: TPanel;
   33     procedure BitBtn2Click(Sender: TObject);
   34     procedure EditinputqueryKeyPress(Sender: TObject; var Key: char);
   35     procedure LabelappdirnClick(Sender: TObject);
   36     procedure LabelLowClick(Sender: TObject);
   37     procedure LabelprepdirnClick(Sender: TObject);
   38     procedure LabelrenameresetClick(Sender: TObject);
   39     procedure LabelTimestampClick(Sender: TObject);
   40     procedure LabelUpClick(Sender: TObject);
   41   private
   42     { private declarations }
   43   public
   44     { public declarations }
   45   end; 
   46 
   47 var
   48   FormInput: TFormInput;
   49   tsstyle:integer;
   50   dirn,instr:ansistring;
   51 
   52 implementation
   53 
   54 { TFormInput }
   55 
   56 procedure apply_timestamptofilename(var s:ansistring);
   57 var
   58    dt_stamp,s0,s1,s2:ansistring;
   59 begin
   60 case tsstyle of
   61    0: dt_stamp:=formatdatetime('.yyyymmdd.hhnnss',now);
   62    1: dt_stamp:=formatdatetime('.yyyymmdd',now);
   63    2: dt_stamp:=formatdatetime('yyyymmdd.hhnnss.',now);
   64    3: dt_stamp:=formatdatetime('yyyymmdd.',now);
   65    end;
   66 s0:=extractfilepath(s);
   67 s1:=extractfilename(s);
   68 if not(DirectoryExists(dirn+s)) then
   69    begin
   70    cutextension(s1);
   71    s2:=extractfileext(s);
   72    end
   73 else s2:='';
   74 case tsstyle of
   75    2: s1:=dt_stamp+s1;
   76    3: s1:=dt_stamp+s1;
   77    else s1:=s1+dt_stamp;
   78 end;
   79 s:=s0+s1+s2;
   80 end;
   81 
   82 procedure apply_dirnametoname(var s:ansistring; dmode:ansistring);
   83 var
   84    s1,s2,sdir:ansistring;
   85 begin
   86 s1:=extractfilename(s);
   87 if not(DirectoryExists(dirn+s)) then
   88    begin
   89    cutextension(s1);
   90    s2:=extractfileext(s);
   91    end
   92 else s2:='';
   93 sdir:=dirn;
   94 if length(sdir)<=3 then exit;
   95 if sdir[length(sdir)]=directoryseparator then setlength(sdir,length(sdir)-1);
   96 sdir:=extractfilename(sdir);
   97 if length(sdir)>128 then sdir:=copy(sdir,1,128);
   98 case dmode of
   99    'prepend': s1:=sdir+' - '+s1;
  100    'append': s1:=s1+' - '+sdir;
  101    end;
  102 s:=s1+s2;
  103 end;
  104 
  105 procedure TFormInput.EditinputqueryKeyPress(Sender: TObject; var Key: char);
  106 begin
  107 {if Key=char(13) then
  108    begin
  109    FormInput.Close;
  110    FormInput.ModalResult:=1;
  111    end; }
  112 end;
  113 
  114 procedure TFormInput.LabelappdirnClick(Sender: TObject);
  115 var
  116    s:ansistring;
  117 begin
  118 s:=Editinputquery.Text;
  119 apply_dirnametoname(s,'append');
  120 Editinputquery.Text:=s;
  121 end;
  122 
  123 procedure TFormInput.LabelLowClick(Sender: TObject);
  124 begin
  125 Editinputquery.Text:=LowerCase(Editinputquery.Text);
  126 end;
  127 
  128 procedure TFormInput.LabelprepdirnClick(Sender: TObject);
  129 var
  130    s:ansistring;
  131 begin
  132 s:=Editinputquery.Text;
  133 apply_dirnametoname(s,'prepend');
  134 Editinputquery.Text:=s;
  135 end;
  136 
  137 procedure TFormInput.LabelrenameresetClick(Sender: TObject);
  138 begin
  139 Editinputquery.Text:=instr;
  140 end;
  141 
  142 procedure TFormInput.LabelTimestampClick(Sender: TObject);
  143 var
  144    s:ansistring;
  145 begin
  146 s:=Editinputquery.Text;
  147 apply_timestamptofilename(s);
  148 Editinputquery.Text:=s;
  149 end;
  150 
  151 procedure TFormInput.LabelUpClick(Sender: TObject);
  152 begin
  153 Editinputquery.Text:=UpperCase(Editinputquery.Text);
  154 end;
  155 
  156 procedure TFormInput.BitBtn2Click(Sender: TObject);
  157 begin
  158 if FormInput.OpenDialog3.Execute then
  159    if FormInput.OpenDialog3.FileName<>'' then
  160       FormInput.Editinputquery.Caption:=stringdelim(FormInput.OpenDialog3.FileName);
  161 end;
  162 
  163 initialization
  164   {$I unit6.lrs}
  165 
  166 end.
  167