view/trunk/Unit1.pas

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  Vcl.Imaging.pngimage, System.Actions, Vcl.ActnList, Vcl.Touch.GestureMgr,
  Vcl.FileCtrl, Vcl.Buttons, System.UITypes, System.IniFiles, System.IOUtils,
  Vcl.ExtDlgs, System.Zip;

type
  TForm1 = class(TForm)
    AppBar: TPanel;
    CloseButton: TImage;
    ActionList1: TActionList;
    Action1: TAction;
    GestureManager1: TGestureManager;
    DirectoryListBox1: TDirectoryListBox;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    Button1: TButton;
    ListBox1: TListBox;
    Button2: TButton;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Button3: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Button4: TButton;
    OpenTextFileDialog1: TOpenTextFileDialog;
    CheckBox1: TCheckBox;
    DriveComboBox1: TDriveComboBox;
    Panel1: TPanel;
    procedure CloseButtonClick(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormGesture(Sender: TObject; const EventInfo: TGestureEventInfo;
      var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure DirectoryListBox1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Label3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { private ���� }
    procedure AppBarResize;
    procedure AppBarShow(mode: integer);
  public
    { public ���� }
    List: TStringList;
    procedure Preview(const fileName: string);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  AppBarHeight = 75;

procedure TForm1.AppBarResize;
begin
  AppBar.SetBounds(0, AppBar.Parent.Height - AppBarHeight, AppBar.Parent.Width,
    AppBarHeight);
end;

procedure TForm1.AppBarShow(mode: integer);
begin
  if mode = -1 then // ��������
    mode := integer(not AppBar.Visible);

  if mode = 0 then
    AppBar.Visible := False
  else
  begin
    AppBar.Visible := True;
    AppBar.BringToFront;
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  if System.SysUtils.DirectoryExists(Edit1.Text) = True then
  begin
    DirectoryListBox1.Directory := Edit1.Text;
    DirectoryListBox1Click(Sender);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  s1, s2, s3: string;
  z: TZipFile;
  x: Boolean;
begin
  s3 := '';
  x := Copy(Label1.Caption,1,10) <> 'Click here';
  if (Sender = Button1)or(x = true) then
    Preview(Edit1.Text + '\' + ComboBox1.Text);
  if (Sender = Button2)and(x = true) then
  begin
    z := TZipFile.Create;
    try
      for s1 in List do
      begin
        if s3 = '' then
        begin
          s3 := Label1.Caption + '\' + ChangeFileExt(ExtractFileName(s1), '');
          if CheckBox1.Checked = True then
          begin
            if FileExists(s3 + '.zip') = True then
              DeleteFile(s3 + '.zip');
            z.Open(s3 + '.zip', TZipMode.zmWrite);
          end
          else if System.SysUtils.DirectoryExists(s3) = False then
            MkDir(s3);
        end;
        s2 := s3 + '\' + ExtractFileName(s1);
        if CheckBox1.Checked = True then
          z.Add(s1)
        else
          CopyFile(System.PWideChar(s1), System.PWideChar(s2), False);
      end;
    finally
      z.Free;
    end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  if System.SysUtils.DirectoryExists(Label1.Caption) = True then
  begin
    OpenTextFileDialog1.InitialDir := Label1.Caption;
    OpenTextFileDialog1.Execute;
  end;
end;

procedure TForm1.Action1Execute(Sender: TObject);
begin
  AppBarShow(-1);
end;

procedure TForm1.CloseButtonClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.DirectoryListBox1Click(Sender: TObject);
var
  s: TSearchRec;
  i: integer;
  t: string;
begin
  t := '';
  for i := 0 to DirectoryListBox1.ItemIndex do
  begin
    if i < 2 then
    begin
      t := t + DirectoryListBox1.Items[i];
    end
    else
    begin
      t := t + '\' + DirectoryListBox1.Items[i];
    end;
    if (t = DirectoryListBox1.Directory) and (i < DirectoryListBox1.ItemIndex)
    then
    begin
      if i < 1 then
      begin
        t := t + DirectoryListBox1.Items[DirectoryListBox1.ItemIndex];
      end
      else
      begin
        t := t + '\' + DirectoryListBox1.Items[DirectoryListBox1.ItemIndex];
      end;
      break;
    end;
  end;
  Edit1.Text := t;
  if ListBox1.Items.Count > 0 then
    ListBox1.Items.Clear;
  if ComboBox1.Items.Count > 0 then
    ComboBox1.Items.Clear;
  i := FindFirst(Edit1.Text + '\*.dpr', faAnyFile, s);
  try
    while i = 0 do
    begin
      if CompareText(ExtractFileExt(s.Name), '.dpr') = 0 then
        ComboBox1.Items.Add(s.Name);
      i := FindNext(s);
    end;
  finally
    FindClose(s);
  end;
  if ComboBox1.Items.Count = 0 then
  begin
    ComboBox1.Text := '';
  end
  else
  begin
    ComboBox1.Text := ComboBox1.Items[0];
  end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  Edit1.Hint := Edit1.Text;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  s: TIniFile;
begin
  s := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    Edit1.Text := s.ReadString('Directory', 'Current',
      DirectoryListBox1.Directory);
    Label1.Caption := s.ReadString('Directory', 'Save', Label1.Caption);
  finally
    s.Free;
  end;
  BitBtn1Click(Sender);
  Label3.Caption := Edit1.Text;
  List := TStringList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  s: TIniFile;
begin
  List.Free;
  s := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    s.WriteString('Directory', 'Current', Label3.Caption);
    if System.SysUtils.DirectoryExists(Label1.Caption) = True then
      s.WriteString('Directory', 'Save', Label1.Caption);
  finally
    s.Free;
  end;
end;

procedure TForm1.FormGesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
  AppBarShow(0);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
    AppBarShow(-1)
  else
    AppBarShow(0);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  AppBarResize;
end;

procedure TForm1.Label1Click(Sender: TObject);
begin
  if System.SysUtils.DirectoryExists(Edit1.Text) = false then
    MkDir(Edit1.Text);
  if MessageDlg('Change Save-Dir?', mtInformation, [mbOK, mbCancel], 0) = mrOK then
    Label1.Caption := Edit1.Text;
end;

procedure TForm1.Label3Click(Sender: TObject);
begin
  if (System.SysUtils.DirectoryExists(Edit1.Text) = True) and
    (MessageDlg('Change Current-Dir?', mtInformation, [mbOK, mbCancel], 0)
    = mrOK) then
    Label3.Caption := Edit1.Text;
end;

procedure TForm1.Preview(const fileName: string);
var
  s: TStringList;
  str1, str2: string;
  i: integer;
  j: integer;
begin
  ListBox1.Items.Clear;
  List.Clear;
  if FileExists(ChangeFileExt(fileName, '.dproj')) = True then
  begin
    str1 := ChangeFileExt(fileName, '.dproj');
    List.Add(str1);
    ListBox1.Items.Add(ExtractFileName(str1));
  end;
  if FileExists(fileName) = True then
  begin
    List.Add(fileName);
    ListBox1.Items.Add(ExtractFileName(fileName));
  end;
  if FileExists(ChangeFileExt(fileName, '.res')) = True then
  begin
    str1 := ChangeFileExt(fileName, '.res');
    List.Add(str1);
    ListBox1.Items.Add(ExtractFileName(str1));
  end;
  s := TStringList.Create;
  try
    if FileExists(fileName) = True then
      s.LoadFromFile(fileName);
    for i := 0 to s.Count - 1 do
    begin
      str1 := s[i];
      j := Pos(' in ', str1);
      if j > 0 then
      begin
        Delete(str1, 1, j + 3);
        Delete(str1, 1, Pos('''', str1));
        str1 := Copy(str1, 1, Pos('''', str1) - 1);
        if List.Count > 0 then
          str2 := ExtractFilePath(List[0]);
        j := List.Add(TPath.Combine(str2, str1));
        ListBox1.Items.Add(ExtractFileName(str1));
        str1 := List[j];
        if CompareText(ExtractFileExt(str1), '.pas') = 0 then
        begin
          str1 := ChangeFileExt(str1, '.dfm');
          if FileExists(str1) = True then
          begin
            List.Add(str1);
            ListBox1.Items.Add(ExtractFileName(str1));
          end;
          str1 := ChangeFileExt(str1, '.fmx');
          if FileExists(str1) = True then
          begin
            List.Add(str1);
            ListBox1.Items.Add(ExtractFileName(str1));
          end;
        end;
        continue;
      end;
      str1 := Copy(TrimLeft(s[i]), 1, 5);
      if CompareText(str1, 'begin') = 0 then
        break;
    end;
  finally
    s.Free;
  end;
end;

end.