{ Double Commander ------------------------------------------------------------------------- Multi-Rename text range selector dialog window Copyright (C) 2007-2020 Alexander Koblov (alexx2000@mail.ru) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . } unit fSelectTextRange; {$mode objfpc}{$H+} interface uses //Lazarus, Free-Pascal, etc. Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ButtonPanel, Buttons, ExtCtrls, //DC uOSForms; type { TfrmSelectTextRange } TfrmSelectTextRange = class(TModalForm) ButtonPanel: TButtonPanel; edtSelectText: TEdit; gbRangeDescription: TGroupBox; gbCountFirstFrom: TGroupBox; gbCountLastFrom: TGroupBox; lblResult: TLabel; lblValueToReturn: TLabel; lblSelectText: TLabel; rbDescriptionFirstLast: TRadioButton; rbFirstFromStart: TRadioButton; rbLastFromStart: TRadioButton; rbDescriptionFirstLength: TRadioButton; rbFirstFromEnd: TRadioButton; rbLastFromEnd: TRadioButton; procedure edtSelectTextKeyUp(Sender: TObject; var {%H-}Key: word; {%H-}Shift: TShiftState); procedure edtSelectTextMouseUp(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: integer); procedure FormCreate(Sender: TObject); procedure SomethingChange(Sender: TObject); private FCanvaForAutosize: TControlCanvas; FSelStart, FSelFinish, FWholeLength: integer; FPrefix: string; procedure ResfreshHint; public property Prefix: string read FPrefix write FPrefix; end; function ShowSelectTextRangeDlg(TheOwner: TCustomForm; const ACaption, AText, sPrefix: string; var sResultingMaskValue: string): boolean; implementation {$R *.lfm} uses //Lazarus, Free-Pascal, etc. //DC uGlobs; function ShowSelectTextRangeDlg(TheOwner: TCustomForm; const ACaption, AText, sPrefix: string; var sResultingMaskValue: string): boolean; begin with TfrmSelectTextRange.Create(TheOwner) do try Result := False; Caption := ACaption; edtSelectText.Constraints.MinWidth := FCanvaForAutosize.TextWidth(AText) + 20; edtSelectText.Text := AText; Prefix := sPrefix; rbDescriptionFirstLength.Checked := not rbDescriptionFirstLast.Checked; rbFirstFromEnd.Checked := not rbFirstFromStart.Checked; rbLastFromEnd.Checked := not rbLastFromStart.Checked; if ShowModal = mrOk then begin if (FSelFinish >= FSelStart) and (lblValueToReturn.Caption <> '') then begin sResultingMaskValue := lblValueToReturn.Caption; Result := True; end; end; finally Free; end; end; { TfrmSelectTextRange } procedure TfrmSelectTextRange.SomethingChange(Sender: TObject); begin ResfreshHint; end; procedure TfrmSelectTextRange.edtSelectTextKeyUp(Sender: TObject; var Key: word; Shift: TShiftState); begin SomethingChange(Sender); end; procedure TfrmSelectTextRange.edtSelectTextMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: integer); begin SomethingChange(Sender); end; procedure TfrmSelectTextRange.FormCreate(Sender: TObject); begin InitPropStorage(Self); // TEdit "edtSelectText" does not have Canvas. // We will use "FCanvaForAutosize" to determine the required width to hold the whole text. // This way, we will see it all. FCanvaForAutosize := TControlCanvas.Create; FCanvaForAutosize.Control := edtSelectText; FCanvaForAutosize.Font.Assign(edtSelectText.Font); end; procedure TfrmSelectTextRange.ResfreshHint; var sTempo: string; begin gbCountLastFrom.Enabled := not rbDescriptionFirstLength.Checked; sTempo := ''; FSelStart := edtSelectText.SelStart + 1; FSelFinish := edtSelectText.SelStart + edtSelectText.SelLength; FWholeLength := length(edtSelectText.Text); if (FSelFinish >= FSelStart) and (FWholeLength > 0) then begin if rbFirstFromStart.Checked then begin if FSelFinish = FSelStart then sTempo := Format('%d', [FSelStart]) else begin if rbDescriptionFirstLength.Checked then sTempo := Format('%d,%d', [FSelStart, succ(FSelFinish - FSelStart)]) else if rbLastFromStart.Checked then sTempo := Format('%d:%d', [FSelStart, FSelFinish]) else sTempo := Format('%d:-%d', [FSelStart, succ(FWholeLength - FSelFinish)]); end; end else begin if FSelFinish = FSelStart then sTempo := Format('-%d', [succ(FWholeLength - FSelStart)]) else begin if rbDescriptionFirstLength.Checked then sTempo := Format('-%d,%d', [succ(FWholeLength - FSelFinish), succ(FSelFinish - FSelStart)]) else if rbLastFromStart.Checked then sTempo := Format('-%d:%d', [succ(FWholeLength - FSelStart), FSelFinish]) else sTempo := Format('-%d:-%d', [succ(FWholeLength - FSelStart), succ(FWholeLength - FSelFinish)]); end; end; lblValueToReturn.Caption := Format('[%s%s]', [Prefix, sTempo]); end else begin lblValueToReturn.Caption := ''; end; end; end.