📄 fjvclconvertermain.pas
字号:
begin
with sbStatus do
SetStatus(['Removing files...', Panels[1].Text, Panels[2].Text]);
// this is faster...
for Idx := SearchList.Items.Count - 1 downto 0 do
if SearchList.Items[Idx].Selected then
SearchList.Items.Delete(Idx);
with sbStatus do
SetStatus(['Ready', Panels[1].Text, Panels[2].Text]);
end;
procedure TfrmMain.btnStartClick(Sender: TObject);
var
Item: TListItem;
FileNum, ReplaceCount: integer;
ReplaceTime, TotalTime: TLargeInteger;
begin
Screen.Cursor := crHourglass;
with sbStatus do
SetStatus(['Scanning...', Panels[1].Text, Panels[2].Text]);
TotalTime := 0;
try
// Reset all items
for FileNum := 0 to SearchList.Items.Count - 1 do
begin
Item := SearchList.Items[FileNum];
Item.SubItems[0] := '0';
Item.SubItems[1] := 'Waiting';
Item.SubItems[2] := '-';
Item.SubItems[3] := '';
Item.Update;
end;
for FileNum := 0 to SearchList.Items.Count - 1 do
begin
Item := SearchList.Items[FileNum];
Item.SubItems[1] := 'Busy';
Item.Update;
ReplaceCount := StringReplace(Item.Caption, FAppOptions.WholeWords, FAppOptions.Backup,
FAppOptions.Simulate, ReplaceTime);
Inc(TotalTime, ReplaceTime);
Item.SubItems[0] := IntToStr(ReplaceCount);
Item.SubItems[1] := 'Done';
Item.SubItems[2] := IntToStr(ReplaceTime);
if FAppOptions.ReplaceFileNames then
Item.SubItems[3] := FileNameReplace(Item);
Item.Update;
end;
finally // wrap up
Screen.Cursor := crDefault;
with sbStatus do
SetStatus(['Ready', Panels[1].Text, Format('Total: %f secs', [TotalTime / 1000000])]);
end; // try/finally
end;
procedure TfrmMain.SearchListDblClick(Sender: TObject);
var
Item: TListItem;
begin
Item := SearchList.Selected;
if Item <> nil then
WinExec(PChar('Notepad ' + Item.Caption), sw_Normal);
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, true);
FAppOptions:= TAppOptions.Create(self);
FAppOptions.AppStorage := JvAppIniFileStorage;
FAppOptions.AppStoragePath := 'Settings';
JvAppIniFileStorage.FileName := ChangeFileExt(Application.ExeName, '.ini');
LoadSettings;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
DragAcceptFiles(Handle, false);
SaveSettings;
FreeAndNil(FAppOptions);
end;
procedure TfrmMain.WMDropFiles(var Msg: TWMDropFiles);
{$IFDEF Windows}
const
MAX_PATH = 255;
{$ENDIF}
var
Pt: TPoint;
Count, Loop: integer;
Buf: array[0..MAX_PATH] of char;
begin
try
Msg.Result := 0;
DragQueryPoint(Msg.Drop, Pt);
Count := DragQueryFile(Msg.Drop, Cardinal(-1), Buf, sizeof(Buf));
for Loop := 0 to Pred(Count) do
begin
DragQueryFile(Msg.Drop, Loop, Buf, sizeof(Buf));
AddFiles(StrPas(Buf));
end
finally
DragFinish(Msg.Drop)
end
end;
procedure TfrmMain.btnAddLineClick(Sender: TObject);
begin
vleUnits.InsertRow('', '', true);
end;
procedure TfrmMain.btnSaveClick(Sender: TObject);
begin
with TSaveDialog.Create(nil) do
try
FileName := ExtractFileName(fCurrentDataFile);
Filter := 'Conversion files (*.dat)|*.dat';
DefaultExt := 'dat';
Options := Options + [ofOverWritePrompt];
if Execute then { Display Open dialog box }
begin
fCurrentDataFile := FileName;
vleUnits.Strings.SaveToFile(fCurrentDataFile);
SaveData.Enabled := false;
end;
finally // wrap up
Free;
end; // try/finally
end;
procedure TfrmMain.btnDeleteClick(Sender: TObject);
begin
with vleUnits do
if Strings.Count > 0 then
DeleteRow(Row);
end;
procedure TfrmMain.AboutMeExecute(Sender: TObject);
begin
with TfrmAboutMe.Create(nil) do
try
showModal;
finally // wrap up
Free;
end; // try/finally
end;
procedure TfrmMain.LoadDATFile(const FileName: string);
begin
if FileExists(FileName) then
begin
vleUnits.Strings.LoadFromFile(FileName);
fCurrentDataFile := FileName;
end;
end;
procedure TfrmMain.OpenDataExecute(Sender: TObject);
begin
with TOpenDialog.Create(nil) do
try
FileName := fCurrentDataFile;
Filter := 'Conversion files (*.dat)|*.dat';
DefaultExt := 'dat';
if Execute then { Display Open dialog box }
begin
LoadDATFile(FileName);
Caption := 'JVCL Convert: ' + ExtractFileName(FileName);
JvPageControl.ActivePage := tbsStrings;
end;
finally // wrap up
Free;
end; // try/finally
end;
procedure TfrmMain.vleUnitsStringsChange(Sender: TObject);
begin
SaveData.Enabled := true;
end;
procedure TfrmMain.ConvertUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled := vleUnits.Strings.Count > 0;
end;
procedure TfrmMain.NewLineUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled := JvPageControl.ActivePage = tbsStrings;
end;
procedure TfrmMain.DeleteLineUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled := (vleUnits.Strings.Count > 0) and (JvPageControl.ActivePage = tbsStrings);
end;
procedure TfrmMain.RemoveFilesUpdate(Sender: TObject);
begin
RemoveFiles.Enabled := (SearchList.Selected <> nil) and (JvPageControl.ActivePage = tbsFiles);
end;
procedure TfrmMain.IterateSubdirectoriesExecute(Sender: TObject);
begin
JvBrowseFolder1.Directory := ExcludeTrailingPathDelimiter(JvSearchFiles1.RootDirectory);
if JvBrowseFolder1.Execute then
begin
JvSearchFiles1.RootDirectory := JvBrowseFolder1.Directory;
if JvSearchFiles1.FileParams.FileMask = '' then
JvSearchFiles1.FileParams.FileMask := '*.pas;*.dpr;*.dpk;*.dfm';
JvSearchFiles1.Search;
end;
end;
procedure TfrmMain.JvSearchFiles1FindFile(Sender: TObject; const AName: string);
begin
AddFiles(AName);
end;
function SortFilename(lParam1, lParam2, lParamSort: integer): integer stdcall;
begin
Result := AnsiCompareFilename(TListItem(lParam1).Caption, TListItem(lParam2).Caption);
if lParamSort = 0 then
Result := -Result;
end;
function SortReplaceCount(lParam1, lParam2, lParamSort: integer): integer stdcall;
begin
Result := StrToIntDef(TListItem(lParam1).SubItems[0], 0) - StrToIntDef(TListItem(lParam2).SubItems[0], 0);
if lParamSort = 0 then
Result := -Result;
end;
function SortStatus(lParam1, lParam2, lParamSort: integer): integer stdcall;
begin
Result := AnsiCompareText(TListItem(lParam1).SubItems[1], TListItem(lParam2).SubItems[1]);
if lParamSort = 0 then
Result := -Result;
end;
function SortMSecs(lParam1, lParam2, lParamSort: integer): integer stdcall;
begin
Result := StrToIntDef(TListItem(lParam1).SubItems[2], 0) - StrToIntDef(TListItem(lParam2).SubItems[2], 0);
if lParamSort = 0 then
Result := -Result;
end;
procedure TfrmMain.SortListColumn(LV: TListView; Column: TListColumn);
var
i: integer;
FDescending: boolean;
SortFunc: TLVCompare;
begin
FDescending := (Column.ImageIndex <= 1);
for i := 0 to LV.Columns.Count - 1 do
LV.Columns[i].ImageIndex := -1;
case Column.Index of
0: SortFunc := SortFilename;
1: SortFunc := SortReplaceCount;
2: SortFunc := SortStatus;
3: SortFunc := SortMSecs;
else
SortFunc := nil;
end;
if Assigned(SortFunc) then
begin
LV.CustomSort(SortFunc, Ord(FDescending));
Column.ImageIndex := Ord(FDescending) + 1;
end;
end;
procedure TfrmMain.SearchListColumnClick(Sender: TObject;
Column: TListColumn);
begin
SortListColumn(SearchList, Column);
end;
procedure TfrmMain.LoadSettings;
begin
with FAppOptions do
begin
LoadProperties;
JvSearchFiles1.RootDirectory := RootDirectory;
JvSearchFiles1.FileParams.FileMask := FileMask;
fCurrentDataFile := DATFile;
end;
with sbStatus do
SetStatus(['Ready', JvSearchFiles1.FileParams.FileMask, '']);
LoadDATFile(fCurrentDataFile);
Caption := 'JVCL Convert: ' + ExtractFileName(fCurrentDataFile);
end;
procedure TfrmMain.SaveSettings;
begin
with FAppOptions do
begin
RootDirectory := JvSearchFiles1.RootDirectory;
FileMask := JvSearchFiles1.FileParams.FileMask;
DATFile := fCurrentDataFile;
StoreProperties;
end;
end;
procedure TfrmMain.ActionList1Update(Action: TBasicAction;
var Handled: boolean);
const
cViewColor: array[boolean] of TColor = (clWindow, clBtnFace);
begin
SearchList.Color := cViewColor[FAppOptions.Simulate];
end;
procedure TfrmMain.NewRepositoryExecute(Sender: TObject);
var
i: integer;
begin
btnSaveClick(Self);
for i := vleUnits.Strings.Count downto 1 do
vleUnits.DeleteRow(i);
fCurrentDataFile := '';
end;
procedure TfrmMain.SearchListKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_Delete then
if RemoveFiles.Enabled then btnRemoveClick(Self);
end;
procedure TfrmMain.SelectAllExecute(Sender: TObject);
begin
SearchList.SelectAll;
end;
procedure TfrmMain.SelectAllUpdate(Sender: TObject);
begin
SelectAll.Enabled := (SearchList.Items.Count > 0) and (JvPageControl.ActivePage = tbsFiles);
end;
procedure TfrmMain.SetStatus(const Msgs: array of string);
var
i: integer;
function Min(Val1, Val2: integer): integer;
begin
Result := Val1;
if Val2 < Val1 then
Result := Val2;
end;
begin
for i := 0 to sbStatus.Panels.Count - 1 do
begin
if i <= High(Msgs) then
sbStatus.Panels[i].Text := PChar(Msgs[i])
else
sbStatus.Panels[i].Text := '';
end;
sbStatus.Update;
end;
procedure TfrmMain.OptionsExecute(Sender: TObject);
begin
FAppOptions.FileMask := JvSearchFiles1.FileParams.FileMask;
if TfrmOptions.Edit(FAppOptions) then
JvSearchFiles1.FileParams.FileMask := FAppOptions.FileMask;
end;
procedure TfrmMain.FileMaskExecute(Sender: TObject);
var
S: string;
begin
S := JvSearchFiles1.FileParams.FileMask;
if InputQuery('File Mask', 'Set new file mask:', S) and (S <> '') then
JvSearchFiles1.FileParams.FileMask := S;
with sbStatus do
SetStatus([Panels[0].Text, JvSearchFiles1.FileParams.FileMask]);
end;
initialization
Lines := TStringlist.Create;
finalization
Lines.Free;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -