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

📄 fjvclconvertermain.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -