⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fjvclconvertermain.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: fJvclConverterMain.PAS, released on 2002-07-15.

The Initial Developer of the Original Code is Michel Beck <mbeck1@compuserve.com>
Portions created by Michael Beck are Copyright (C) 2002 Michael Beck
All Rights Reserved.

This program contains code released and copyrighted by:
Igor Komar (the original Replace routines)
Dave Jewell (new GUI for Igor's code)
Martin Waldenburg (FastTime)

Contributor(s): Peter Th鰎nqvist <peter3 at sourceforge dot net>
                Arioch <the_Arioch@chat.ru>

Last Modified: 2002-07-18

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
{$I jvcl.inc}

unit fJvclConverterMain;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  ComCtrls, ExtCtrls, Grids, ValEdit, JvComCtrls, Menus, ActnList, StdActns, ImgList,
  ToolWin,
  JvComponent, JvSearchFiles, JvBaseDlg, JvBrowseFolder, JVCLConvertUtils,
  JvFormPlacement, JvAppStorage, JvAppIniStorage, JvDialogs;

type
  { TValueListEditor (imposer class that allows "=" in strings) }
  TValueListEditor = class(ValEdit.TValueListEditor)
  protected
    procedure SetEditText(ACol: integer; ARow: integer;
      const Value: string); override;
    function GetEditText(ACol: integer; ARow: integer): string; override;
    procedure DrawCell(ACol: integer; ARow: integer; ARect: TRect;
      AState: TGridDrawState); override;
  end;

  TfrmMain = class(TForm)
    OpenDialog: TJvOpenDialog;
    JvPageControl: TPageControl;
    tbsFiles: TTabSheet;
    tbsStrings: TTabSheet;
    vleUnits: TValueListEditor;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Conversion1: TMenuItem;
    Help1: TMenuItem;
    AboutMe1: TMenuItem;
    OpenReplacementFile1: TMenuItem;
    Convert1: TMenuItem;
    OpenFilestoConvert1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    N2: TMenuItem;
    ToolBar1: TToolBar;
    btnAddFiles: TToolButton;
    btnOpenRepository: TToolButton;
    btnConvert: TToolButton;
    btnAboutMe: TToolButton;
    btnExit: TToolButton;
    ActionList1: TActionList;
    FileExit: TFileExit;
    FileOpen: TAction;
    Convert: TAction;
    OpenData: TAction;
    AboutMe: TAction;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    btnDeleteFiles: TToolButton;
    Remove1: TMenuItem;
    RemoveFiles: TAction;
    SaveData: TAction;
    btnSaveRepository: TToolButton;
    SaveConversionData1: TMenuItem;
    DeleteLine: TAction;
    btnDeleteLine: TToolButton;
    DeleteLine1: TMenuItem;
    Options1: TMenuItem;
    NewLine: TAction;
    btnInsertNewLine: TToolButton;
    InsertLine1: TMenuItem;
    JvSearchFiles1: TJvSearchFiles;
    IterateSubdirectories: TAction;
    btnIterateDir: TToolButton;
    IterateSubdirectories1: TMenuItem;
    SortArrows: TImageList;
    JvBrowseFolder1: TJvBrowseForFolderDialog;
    mnuFileMask: TMenuItem;
    btnNewRepository: TToolButton;
    NewRepository: TAction;
    SelectAll: TAction;
    Edit: TMenuItem;
    SelectAll1: TMenuItem;
    StandardImages: TImageList;
    SearchList: TListView;
    sbStatus: TStatusBar;
    Options: TAction;
    Options2: TMenuItem;
    N3: TMenuItem;
    FileMask: TAction;
    JvAppIniFileStorage: TJvAppIniFileStorage;
    JvFormStorage: TJvFormStorage;
    procedure btnAddClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure SearchListDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnAddLineClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure AboutMeExecute(Sender: TObject);
    procedure OpenDataExecute(Sender: TObject);
    procedure vleUnitsStringsChange(Sender: TObject);
    procedure ConvertUpdate(Sender: TObject);
    procedure NewLineUpdate(Sender: TObject);
    procedure DeleteLineUpdate(Sender: TObject);
    procedure RemoveFilesUpdate(Sender: TObject);
    procedure IterateSubdirectoriesExecute(Sender: TObject);
    procedure SearchListColumnClick(Sender: TObject; Column: TListColumn);
    procedure ActionList1Update(Action: TBasicAction;
      var Handled: boolean);
    procedure JvSearchFiles1FindFile(Sender: TObject; const AName: string);
    procedure NewRepositoryExecute(Sender: TObject);
    procedure SearchListKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SelectAllExecute(Sender: TObject);
    procedure SelectAllUpdate(Sender: TObject);
    procedure OptionsExecute(Sender: TObject);
    procedure FileMaskExecute(Sender: TObject);
  private
    { Private declarations }
    fCurrentDataFile: string;
    FAppOptions: TAppOptions;
    procedure SetStatus(const Msgs: array of string);
    procedure AddFiles(const FileName: string);
    function StringReplace(const FullFileName: string; WholeWord, Backup, Simulate: boolean; var ReplaceTime:
      TLargeInteger): integer;
    function FileNameReplace(var FileItem: TListItem): string;
    procedure LoadSettings;
    procedure SaveSettings;
    procedure SortListColumn(LV: TListView; Column: TListColumn);
    procedure LoadDATFile(const FileName: string);
  public
    { Public declarations }
    procedure WMDropFiles(var Msg: TWMDropFiles); message wm_DropFiles;
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

uses
  ShellAPI, FastTime, fAboutMe, CommCtrl, OptionsFrm,
  JvPropertyStore;

const
  Allowed = (['a'..'z', 'A'..'Z', '0'..'9', '_']);
  cReplaceEquals = #2;

var
  Lines: TStringlist; // create this once to speed things up
  ch: char;

type
  TValueListStringsEx = class(TValueListStrings);

{ TValueListEditor }

procedure TValueListEditor.DrawCell(ACol, ARow: integer; ARect: TRect;
  AState: TGridDrawState);
begin
  Canvas.TextRect(ARect, ARect.Left + 2, ARect.Top + 2, StringReplace(Cells[ACol, ARow], cReplaceEquals, '=',
    [rfReplaceAll]));
end;

function TValueListEditor.GetEditText(ACol, ARow: integer): string;
begin
  Result := StringReplace(inherited GetEditText(ACol, ARow), cReplaceEquals, '=', [rfReplaceAll]);
end;

procedure TValueListEditor.SetEditText(ACol, ARow: integer;
  const Value: string);
var
  tmp: string;
begin
  tmp := StringReplace(Value, '=', cReplaceEquals, [rfReplaceAll]);
  inherited SetEditText(ACol, ARow, tmp);
end;

{ TfrmMain }

function TfrmMain.StringReplace(const FullFileName: string; WholeWord, Backup, Simulate: boolean; var ReplaceTime:
  TLargeInteger): integer;
var
  OldLine, NewLine, HiLine, BackupName: string;
  FromStr, ToStr: string;
  i: integer;
  InputStream: TFileStream;
  OutputStream: TMemoryStream;

  function SearchReplace: integer;
  var
    LineNum, P: integer;
  begin
    Result := 0;
    for LineNum := 0 to Lines.Count - 1 do
    begin
      OldLine := Lines[LineNum];
      NewLine := '';
      HiLine := UpperCase(OldLine);

      while true do
      begin
        P := Pos(FromStr, HiLine);
        if P <= 0 then
          break;
        if not WholeWord or (((P = 1) or (not (OldLine[P - 1] in Allowed))) and ((P + Length(FromStr) > Length(OldLine))
          or (not (OldLine[P + Length(FromStr)] in Allowed)))) then
        begin
          Inc(Result);
          NewLine := NewLine + Copy(OldLine, 1, P - 1) + ToStr;
        end
        else
        begin
          NewLine := NewLine + Copy(OldLine, 1, P + Length(FromStr) - 1);
        end;
        Delete(OldLine, 1, P + Length(FromStr) - 1);
        Delete(HiLine, 1, P + Length(FromStr) - 1);
      end;

      Lines.Strings[LineNum] := NewLine + OldLine;
    end;
  end;

begin
  Result := 0;
  if not FileExists(FullFilename) then Exit;
  //if this is DFM file, convert it to text
  if UpperCase(ExtractFileExt(FullFileName)) = '.DFM' then
  begin
    InputStream := TFileStream.Create(FullFileName, fmOpenRead or fmShareDenyWrite);
    try
      begin
          //      if Size < 2 then memLog.Lines.Add('File size ' + IntToStr(Size) + ' for form ' + s);
        ch := #0;
        InputStream.Read(ch, 1);
        case ch of
          'o', 'O', 'i', 'I':
            Lines.LoadFromFile(FullFileName); //ok - text
          #$FF: //memLog.Lines.Add('Form been saved as BINary: ' + s);
            begin
              OutputStream := TMemoryStream.Create;
              try
                InputStream.Position := 0;
                ObjectResourceToText(InputStream, OutputStream);
                OutputStream.Position := 0;
                Lines.LoadFromStream(OutputStream);
              finally
                OutputStream.Free;
              end; // try/finally
            end;
        end;
      end;
    finally // wrap up
      InputStream.Free;
    end; // try/finally
  end
  else
    Lines.LoadFromFile(FullFileName);

  // For each line in the file...
  FastTimer.Start;
  for i := 1 to vleUnits.Strings.Count do // Iterate
  begin
    FromStr := UpperCase(SysUtils.StringReplace(vleUnits.Cells[0, i], cReplaceEquals, '=', [rfReplaceAll]));
    ToStr := SysUtils.StringReplace(vleUnits.Cells[1, i], cReplaceEquals, '=', [rfReplaceAll]);
    Result := Result + SearchReplace;
  end;

  FastTimer.Stop;
  ReplaceTime := FastTimer.ElapsedMicroseconds;

  if (Result > 0) and not Simulate then
  begin
    if Backup then
    begin
      BackupName := ChangeFileExt(FullFileName, '.BAK');
      if FileExists(BackupName) then
        DeleteFile(PChar(BackupName));
      RenameFile(FullFileName, BackupName);
    end;
    Lines.SaveToFile(FullFileName);
  end;
end;

function TfrmMain.FileNameReplace(var FileItem: TListItem): string;
var
  FilePath: string;
  FileName, NewFileName: string;
  FileExtension: string;
  FromStr, ToStr: string;
  i: integer;
begin
  FileName := ChangeFileExt(ExtractFileName(FileItem.Caption), '');
  FilePath := ExtractFilePath(FileItem.Caption);
  FileExtension := ExtractFileExt(FileItem.Caption);
  NewFileName := FileItem.Caption;

  for i := 1 to vleUnits.Strings.Count do // Iterate
  begin
    FromStr := UpperCase(vleUnits.Cells[0, i]);
    ToStr := vleUnits.Cells[1, i];
    if FAppOptions.WholeWords and (UpperCase(NewFileName) = FromStr) then
      NewFileName := FilePath + ToStr + FileExtension
    else if not FAppOptions.WholeWords then
      NewFileName := SysUtils.StringReplace(NewFileName, vleUnits.Cells[0, i], vleUnits.Cells[1, i], [rfReplaceAll,
        rfIgnoreCase]);
  end;

  if (NewFileName <> '') and not FAppOptions.Simulate then
  begin
    Lines.LoadFromFile(FileItem.Caption);
    if FAppOptions.Backup then
      Lines.SaveToFile(FilePath + FileName + '.~' + Copy(FileExtension, 2, Length(FileExtension) - 1));
    ForceDirectories(ExtractFilePath(NewFilename));
    if not RenameFile(FileItem.Caption, NewFileName) then
      raise Exception.CreateFmt('Unable to rename file "%s" to "%s".', [FileItem.Caption, NewFileName]);
    FileItem.Caption := NewFileName;
  end;
  Result := NewFileName;
end;

procedure TfrmMain.AddFiles(const FileName: string);
var
  //  Idx: Integer;
  Item: TListItem;
begin
  Item := SearchList.Items.Add;
  Item.Caption := FileName;
  Item.SubItems.Add('0');
  Item.SubItems.Add('Waiting');
  Item.SubItems.Add('-');
  Item.SubItems.Add('');
end;

procedure TfrmMain.btnAddClick(Sender: TObject);
var
  Idx: integer;
  //  Item: TListItem;
begin
  if OpenDialog.Execute then
  begin
    for Idx := 0 to OpenDialog.Files.Count - 1 do
      AddFiles(OpenDialog.Files[Idx]);
  end;
end;

procedure TfrmMain.btnRemoveClick(Sender: TObject);
var
  Idx: integer;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -