home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / navody / JBOOSTER.ZIP / Source / MainForm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-06-15  |  37.7 KB  |  1,118 lines
  1. (*************************************************************************)
  2. (*                                jBooster                               *)
  3. (*                        (c) pulsar@mail.primorye.ru                    *)
  4. (*************************************************************************)
  5. {$J+,H+,A+,B-,I-}
  6.  Unit MainForm;
  7.  
  8.  Interface
  9.  
  10.  Uses
  11.   { standart }
  12.     Windows, Messages, SysUtils, Classes,
  13.   { vcl }
  14.     Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, CheckLst,
  15.   { formats }
  16.     JPeg,
  17.   { browse dialog }
  18.     ShlObj, ActiveX,
  19.   { private }
  20.     Support, ViewerForm, ReportForm, AlignForm;
  21.  
  22.  Type
  23.     TFormMain = class(TForm)
  24.     published
  25.     { main }
  26.       LabelFiles: TLabel;
  27.       BoxFiles: TComboBox;
  28.       LabelPath: TLabel;
  29.       EditPath: TComboBox;
  30.       ButtonPath: TButton;
  31.       FileListBox: TListBox;
  32.       CheckBoxPanels: TCheckListBox;
  33.       ButtonRun: TButton;
  34.       ButtonExit: TButton;
  35.       FontDialog: TFontDialog;
  36.       ColorDialog: TColorDialog;
  37.     { thumbnails }
  38.       PanelThumbnails: TPanel;
  39.       LabelMark: TLabel;
  40.       EditMark: TEdit;
  41.       LabelQuality: TLabel;
  42.       TrackThumbQuality: TTrackBar;
  43.       LabelScale: TLabel;
  44.       TrackScale: TTrackBar;
  45.     { custom }
  46.       CheckCustom: TCheckBox;
  47.       PanelCustom: TPanel;
  48.       LabelCtmWidth: TLabel;
  49.       EditCtmWidth: TEdit;
  50.       LabelCtmHeight: TLabel;
  51.       EditCtmHeight: TEdit;
  52.       RadioCut: TRadioButton;
  53.       RadioFill: TRadioButton;
  54.       ButtonColor: TButton;
  55.       ButtonAlign: TButton;
  56.     { include }
  57.       CheckInclude: TCheckBox;
  58.       PanelInclude: TPanel;
  59.       PanelNull: TPanel;
  60.       LabelText: TLabel;
  61.       EditText: TEdit;
  62.       CheckImage: TCheckBox;
  63.       CheckFile: TCheckBox;
  64.       ButtonFont: TButton;
  65.       ButtonGround: TButton;
  66.     { rename }
  67.       PanelRename: TPanel;
  68.       LabelPrefix: TLabel;
  69.       LabelOrder: TLabel;
  70.       BoxOrder: TComboBox;
  71.       CheckDecs: TCheckBox;
  72.       EditPrefix: TEdit;
  73.       LabelFirst: TLabel;
  74.       EditFirst: TEdit;
  75.       LabelDigits: TLabel;
  76.       EditDigits: TEdit;
  77.       LabelStep: TLabel;
  78.       EditStep: TEdit;
  79.       LabelPostfix: TLabel;
  80.       EditPostfix: TEdit;
  81.       CheckFileTime: TCheckBox;
  82.       CheckReadOnly: TCheckBox;
  83.     { collection }
  84.       PanelCollection: TPanel;
  85.       CheckDuplicate: TCheckBox;
  86.       LabelLike: TLabel;
  87.       TrackLike: TTrackBar;
  88.       CheckDescription: TCheckBox;
  89.     { form handlers }
  90.       procedure FormShow(Sender: TObject);
  91.       procedure FormClose(Sender: TObject; var Action: TCloseAction);
  92.       procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  93.       procedure ShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
  94.       procedure AppActivate(Sender: TObject);
  95.       procedure TestNumeric (Sender: TObject; var Key: char);
  96.       procedure TestFileName (Sender: TObject; var Key: char);
  97.       procedure DropDownBox (Sender: TObject; var Key: word; Shift: TShiftState);
  98.     { main handlers }
  99.       procedure BoxFilesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  100.       procedure BoxFilesChange(Sender: TObject);
  101.       procedure EditPathKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  102.       procedure EditPathExit(Sender: TObject);
  103.       procedure EditPathChange(Sender: TObject);
  104.       procedure ButtonPathClick(Sender: TObject);
  105.       procedure FileListBoxDblClick(Sender: TObject);
  106.       procedure FileListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  107.       procedure FileListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  108.       procedure CheckBoxPanelsClick(Sender: TObject);
  109.       procedure CheckBoxPanelsClickCheck(Sender: TObject);
  110.       procedure ButtonRunClick(Sender: TObject);
  111.       procedure ButtonExitClick(Sender: TObject);
  112.     { numerate handlers }
  113.       procedure BoxOrderChange(Sender: TObject);
  114.       procedure CheckDecsClick(Sender: TObject);
  115.       procedure EditPrefixChange(Sender: TObject);
  116.       procedure EditFirstChange(Sender: TObject);
  117.       procedure EditFirstExit(Sender: TObject);
  118.       procedure EditDigitsChange(Sender: TObject);
  119.       procedure EditDigitsExit(Sender: TObject);
  120.       procedure EditPostfixChange(Sender: TObject);
  121.       procedure EditStepChange(Sender: TObject);
  122.       procedure EditStepExit(Sender: TObject);
  123.       procedure CheckReadOnlyClick(Sender: TObject);
  124.       procedure CheckFileTimeClick(Sender: TObject);
  125.     { thumbnails handlers }
  126.       procedure EditMarkChange(Sender: TObject);
  127.       procedure EditMarkExit(Sender: TObject);
  128.       procedure EditMarkKeyPress(Sender: TObject; var Key: Char);
  129.       procedure CheckThumbnailsClick(Sender: TObject);
  130.       procedure TrackScaleChange(Sender: TObject);
  131.       procedure TrackThumbQualityChange(Sender: TObject);
  132.     { custom size handlers }
  133.       procedure CheckCustomClick(Sender: TObject);
  134.       procedure EditCtmWidthChange(Sender: TObject);
  135.       procedure EditCtmWidthExit(Sender: TObject);
  136.       procedure EditCtmHeightChange(Sender: TObject);
  137.       procedure EditCtmHeightExit(Sender: TObject);
  138.       procedure RadioModeClick(Sender: TObject);
  139.       procedure ButtonAlignClick(Sender: TObject);
  140.       procedure ButtonColorClick(Sender: TObject);
  141.     { include handlers }
  142.       procedure CheckIncludeClick(Sender: TObject);
  143.       procedure EditTextChange(Sender: TObject);
  144.       procedure CheckImageClick(Sender: TObject);
  145.       procedure CheckFileClick(Sender: TObject);
  146.       procedure ButtonFontClick(Sender: TObject);
  147.       procedure ButtonGroundClick(Sender: TObject);
  148.       procedure FontDialogShow(Sender: TObject);
  149.       procedure ColorDialogShow(Sender: TObject);
  150.     { collection handlers }
  151.       procedure CheckDuplicateClick(Sender: TObject);
  152.       procedure CheckDescriptionClick(Sender: TObject);
  153.       procedure TrackLikeChange(Sender: TObject);
  154.     private
  155.       LockField : pointer;
  156.       LastMark  : string;
  157.       LastScan  : TFileTime;
  158.     { support }
  159.       function PanelOrder (Panel: TPanel): integer;
  160.       procedure SetPanel (Panel: TPanel; Enable, Init: boolean; Event: TNotifyEvent);
  161.       procedure EnablePanel (Panel: TPanel; Enable: boolean);
  162.       procedure InitEdit (Edit: TEdit; MaxLen: integer; const Str: string);
  163.       procedure SetEdit (Edit: TControl; const Str: string);
  164.       function GetEdit (var Str: string; Edit: TControl): boolean;
  165.       procedure GetNumeric (Edit: TEdit; var Int: integer; Min, Max, Std: integer);
  166.       procedure ResetNumeric (Edit: TEdit; Val: integer);
  167.       procedure GetFileName (var Val: string; Edit: TEdit; Min: integer);
  168.       procedure InitBox (Box: TComboBox; Count, Index: integer);
  169.       function KeyBox (Box: TComboBox; var Key: word): boolean;
  170.       function BoxChange (Box: TComboBox; var Index: integer): boolean;
  171.       procedure SetBox (Box: TComboBox; Index: integer);
  172.       function GetBox (var Index: integer; Box: TComboBox): boolean;
  173.       procedure SetCheck (Check: TButtonControl; Val: boolean);
  174.       function GetCheck (var Val: boolean; Check: TButtonControl): boolean;
  175.       procedure InitTrack (Track: TTrackBar; Min, Max, Val : integer);
  176.       procedure GetTrack (var Val: integer; Track: TTrackBar);
  177.     { operate }
  178.       procedure SetStatus (const S: string = '');
  179.       procedure UpdateQuality;
  180.       procedure Rescan;
  181.       procedure ViewFile;
  182.     end; { TFormMain }
  183.  
  184.  Var
  185.     FormMain: TFormMain;
  186.  
  187.  Implementation
  188.  
  189. {$R *.DFM}
  190.  
  191. (*************************************************************************)
  192. (*                              dialogs support                          *)
  193. (*************************************************************************)
  194.  Const
  195.      DialogCaption : string = '';
  196.  
  197.  procedure UpdateDialog (Handle: HWND; X, Y: integer);
  198.  begin
  199.      SetWindowPos (Handle, 0, X, Y, 0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
  200.      if DialogCaption > '' then SetWindowText (Handle, PChar (DialogCaption));
  201.  end; { UpdateDialog }
  202.  
  203.  function EnumChildProc (Handle: HWND; lParam: LPARAM): BOOL; stdcall;
  204.  var
  205.      R : TRect;
  206.  begin
  207.      GetClientRect (Handle, R);
  208.    { browser window }
  209.      if (R.Right > 180) and (R.Bottom > 180) then begin
  210.         GetWindowRect (GetParent (Handle), R);
  211.       { resize }
  212.         MoveWindow (Handle, 0, 0, R.Right - R.Left - 7, R.Bottom - R.Top - 74, true);
  213.       { stop }
  214.         Result := false;
  215.      end { if }
  216.    { next }
  217.      else Result := true;
  218.  end; { EnumChildProc  }
  219.  
  220.  procedure BrowserCallBack (HWindow: HWND; Msg: Integer; lParameter: LPARAM; lpBrowseFolder: LPARAM); stdcall;
  221.  var
  222.      x, y : integer;
  223.      R    : TRect;
  224.  begin
  225.      if Msg = BFFM_INITIALIZED then begin
  226.       { window pos }
  227.         GetWindowRect (GetForegroundWindow, R);
  228.         x := R.Left + (R.Right - R.Left) div 2;
  229.         y := R.Top;
  230.         GetWindowRect (HWindow, R);
  231.         x := x - (R.Right - R.Left) div 2;
  232.         y := y + 25;
  233.       { init }
  234.         UpdateDialog (HWindow, x, y);
  235.         SetWindowLong (HWindow, GWL_USERDATA, lpBrowseFolder);
  236.         SendMessage (HWindow, BFFM_SETSELECTION, Ord (true), Longint (PChar (Catalog)));
  237.       { change size of browser window }
  238.         if ((R.Right - R.Left) = 324) and ((R.Bottom - R.Top) = 331)
  239.            then EnumChildWindows (HWindow, @EnumChildProc, 0);
  240.      end; { if }
  241.  end; { BrowserCallBack }
  242.  
  243.  function SelectDirectory: boolean;
  244.  var
  245.      WindowList : Pointer;
  246.      BrowseInfo : TBrowseInfo;
  247.      ShellMalloc: IMalloc;
  248.      ItemIDList : PItemIDList;
  249.      Buffer     : PChar;
  250.  begin
  251.    { init }
  252.      Result := false;
  253.      FillChar (BrowseInfo, SizeOf (BrowseInfo), 0);
  254.    { get mem handler }
  255.      if (ShGetMalloc (ShellMalloc) = S_OK) and (ShellMalloc <> nil) then begin
  256.         Buffer := ShellMalloc.Alloc (MAX_PATH);
  257.         Try
  258.           With BrowseInfo do begin
  259.                hwndOwner := Application.Handle;
  260.                pidlRoot := nil;
  261.                pszDisplayName := Buffer;
  262.                ulFlags := BIF_RETURNONLYFSDIRS;
  263.                lpfn := @BrowserCallBack;
  264.           end; { With }
  265.           WindowList := DisableTaskWindows(0);
  266.           Try
  267.              ItemIDList := ShBrowseForFolder(BrowseInfo);
  268.           Finally
  269.              EnableTaskWindows(WindowList);
  270.           end; { try }
  271.           Result := ItemIDList <> nil;
  272.         { ok }
  273.           if Result then begin
  274.              ShGetPathFromIDList (ItemIDList, Buffer);
  275.              ShellMalloc.Free (ItemIDList);
  276.              Catalog := PathDelimiter (AnsiUpperCase (Buffer));
  277.           end; { if }
  278.         Finally
  279.           ShellMalloc.Free (Buffer);
  280.         end; { try }
  281.      end; { if }
  282.  end; { SelectDirectory }
  283.  
  284.  procedure CorrectBounds (Form: TForm);
  285.  
  286.    procedure CorrectRange (var Start, Stop: integer; Max: integer);
  287.    begin
  288.        if (Stop - Start) > Max then begin
  289.           Start := 0;
  290.           Stop := Max;
  291.        end { if }
  292.        else begin
  293.             if Start < 0 then begin
  294.                Stop := Stop - Start;
  295.                Start := 0;
  296.             end { if }
  297.             else if Stop > Max then begin
  298.                Start := Start - (Stop - Max);
  299.                Stop := Max;
  300.             end; { if }
  301.        end; { if }
  302.    end; { CorrectRange }
  303.  
  304.  var
  305.      R : TRect;
  306.  begin
  307.      Form.WindowState := wsNormal;
  308.      R := Form.BoundsRect;
  309.      CorrectRange (R.Left, R.Right, Screen.DesktopWidth);
  310.      CorrectRange (R.Top, R.Bottom, Screen.DesktopHeight - 30);
  311.      Form.BoundsRect := R;
  312.  end; { CorrectBounds }
  313.  
  314. (*************************************************************************)
  315. (*                              form                                     *)
  316. (*************************************************************************)
  317.  procedure TFormMain.FormShow(Sender: TObject);
  318.  var
  319.      i : integer;
  320.  begin
  321.    { init app }
  322.      Application.Title := AppName;
  323.      Application.OnShowHint := ShowHint;
  324.      Application.HintPause := 300;
  325.    { parameters }
  326.      LoadParameters (EditPath.Items, ColorDialog.CustomColors);
  327.    { main form }
  328.      Constraints.MinWidth := MinWidth;
  329.      Constraints.MinHeight := MinHeight;
  330.      BoundsRect := Rect (MainLeft, MainTop, MainLeft + MainWidth, MainTop + MainHeight);
  331.      CorrectBounds (Self);
  332.    { viewer form }
  333.      FormViewer.Constraints.MinHeight := MinView;
  334.      FormViewer.Constraints.MinWidth := MinView;
  335.      FormViewer.BoundsRect := Rect (ViewLeft, ViewTop, ViewLeft + ViewWidth, ViewTop + ViewHeight);
  336.      CorrectBounds (FormViewer);
  337.    { main fields }
  338.      for i := MinFormat to MaxFormat do BoxFiles.Items.Add (Formats [i]);
  339.      InitBox (BoxFiles, Succ (MaxFormat), Files);
  340.      EditPath.MaxLength := MAX_PATH;
  341.      EditPath.CharCase := ecUpperCase;
  342.      InitBox (EditPath, MaxHistory, PathIndex);
  343.      SetEdit (EditPath, Catalog);
  344.      FileListBox.Items.Capacity := 512;
  345.    { numerate }
  346.      for i := MinOrder to MaxOrder do BoxOrder.Items.Add (Orders [i]);
  347.      InitBox (BoxOrder, Succ (MaxOrder), Order);
  348.      SetCheck (CheckDecs, fDecs);
  349.      InitEdit (EditPrefix, LenNamePart, Prefix);
  350.      InitEdit (EditFirst, LenFirst, IntToStr (FirstNum));
  351.      InitEdit (EditDigits, LenDigits, IntToStr (Digits));
  352.      InitEdit (EditStep, LenStep, IntToStr (StepCount));
  353.      InitEdit (EditPostfix, LenNamePart, Postfix);
  354.      SetCheck (CheckReadOnly, fAttribute);
  355.      SetCheck (CheckFileTime, fFileTime);
  356.    { thumbnails }
  357.      LastMark := Mark;
  358.      InitEdit (EditMark, LenNamePart, Mark);
  359.      InitTrack (TrackScale, MinScale, MaxScale, Scale);
  360.      InitTrack (TrackThumbQuality, MinQuality, MaxQuality, ThumbnailQuality);
  361.    { custom }
  362.      SetCheck (CheckCustom, fCustom);
  363.      InitEdit (EditCtmWidth, LenCustom, IntToStr (CtmWidth));
  364.      InitEdit (EditCtmHeight, LenCustom, IntToStr (CtmHeight));
  365.      SetCheck (RadioCut, not CtmMode);
  366.      SetCheck (RadioFill, CtmMode);
  367.    { include }
  368.      SetCheck (CheckInclude, fInclude);
  369.      InitEdit (EditText, LenComment, Comment);
  370.      SetCheck (CheckImage, fImgSize);
  371.      SetCheck (CheckFile, fFilSize);
  372.    { font }
  373.      With FontDialog do begin
  374.           ParmsToFont (Font);
  375.           MaxFontSize := MaxFont;
  376.           MinFontSize := MinFont;
  377.      end; { With }
  378.    { collection }
  379.      SetCheck (CheckDuplicate, fDuplicate);
  380.      InitTrack (TrackLike, MinLike, MaxLike, Likeness);
  381.      SetCheck (CheckDescription, fDescription);
  382.    { init }
  383.      CheckBoxPanels.ItemIndex := PanelIndex;
  384.      SetPanel (PanelThumbnails, fThumbnail, true, CheckThumbnailsClick);
  385.      SetPanel (PanelRename, fRename, true, nil);
  386.      SetPanel (PanelCollection, fCollection, true, CheckDuplicateClick);
  387.      Rescan;
  388.    { autorescan handler }
  389.      Application.OnActivate := AppActivate;
  390.  end; { FormShow }
  391.  
  392.  procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
  393.  begin
  394.    { main form }
  395.      CorrectBounds (Self);
  396.      MainTop := Top;
  397.      MainLeft := Left;
  398.      MainWidth := Width;
  399.      MainHeight := Height;
  400.    { viewer form }
  401.      CorrectBounds (FormViewer);
  402.      With FormViewer do begin
  403.           ViewTop := Top;
  404.           ViewLeft := Left;
  405.           ViewWidth := Width;
  406.           ViewHeight := Height;
  407.      end; { With }
  408.    { write }
  409.      SaveParameters (EditPath.Items, ColorDialog.CustomColors);
  410.  end; { FormClose }
  411.  
  412.  procedure TFormMain.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  413.  begin
  414.    { help }
  415.      if (Key = VK_HELP) or (Key = VK_F1) then begin
  416.         if not FormViewer.Help (ExePath + HlpName) then AppTitle;
  417.      end { if }
  418.    { minimize }
  419.      else if Key = VK_ESCAPE then WindowState := wsMinimized;
  420.  end; { FormKeyDown }
  421.  
  422.  procedure TFormMain.ShowHint
  423.  (var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
  424.  begin
  425.      With HintInfo do begin
  426.         if HintControl = TrackScale then HintStr := IntToStr (Scale)
  427.         else if HintControl = TrackThumbQuality then HintStr := IntToStr (TrackToQuality (ThumbnailQuality))
  428.         else if HintControl = ButtonGround then HintColor := BGround
  429.         else if HintControl = ButtonColor then HintColor := FillColor
  430.         else if HintControl = ButtonFont then HintStr := FontName + ' ' + IntToStr (FontSize)
  431.         else if HintControl = ButtonAlign then HintStr := HAnchors [AnchorX] + '-' + VAnchors [AnchorY]
  432.         else if HintControl = TrackLike then HintStr := IntToStr (TrackToLikeness (Likeness)) + '%';
  433.      end; { With }
  434.  end; { ShowHint }
  435.  
  436. (*************************************************************************)
  437. (*                            support                                    *)
  438. (*************************************************************************)
  439.  function TFormMain.PanelOrder (Panel: TPanel): integer;
  440.  begin
  441.      Result := Pred (Panel.TabOrder - CheckBoxPanels.TabOrder);
  442.  end; { PanelOrder }
  443.  
  444.  procedure TFormMain.SetPanel (Panel: TPanel; Enable, Init: boolean; Event: TNotifyEvent);
  445.  var
  446.      V : boolean;
  447.      i : integer;
  448.  begin
  449.      i := PanelOrder (Panel);
  450.    { init }
  451.      if Init then begin
  452.         Panel.Left := CheckBoxPanels.Left;
  453.         Panel.Top  := CheckBoxPanels.Top + CheckBoxPanels.Height + 8;
  454.         LockField := CheckBoxPanels;
  455.         CheckBoxPanels.Checked [i] := Enable;
  456.         LockField := nil;
  457.      end; { if }
  458.    { visible }
  459.      V := PanelIndex = i;
  460.      if (V and (Panel.Enabled <> Enable)) or Init then begin
  461.         Panel.Enabled := Enable;
  462.         EnablePanel (Panel, Enable);
  463.         if Assigned (Event) then Event (Self);
  464.      end; { if }
  465.      if V <> Panel.Visible then Panel.Visible := V;
  466.  end; { SetPanel }
  467.  
  468.  procedure TFormMain.EnablePanel (Panel: TPanel; Enable: boolean);
  469.  var
  470.      i : integer;
  471.  begin
  472.      for i := 0 to Pred (Panel.ControlCount) do Panel.Controls [i].Enabled := Enable;
  473.  end; { EnablePanel }
  474.  
  475.  procedure TFormMain.InitEdit (Edit: TEdit; MaxLen: integer; const Str: string);
  476.  begin
  477.      Edit.MaxLength := MaxLen;
  478.      SetEdit (Edit, Str);
  479.  end; { InitEdit }
  480.  
  481.  procedure TFormMain.SetEdit (Edit: TControl; const Str: string);
  482.  begin
  483.      LockField := Edit;
  484.      if Edit is TEdit then TEdit(Edit).Text := Str
  485.         else if Edit is TComboBox then TComboBox(Edit).Text := Str;
  486.      LockField := nil;
  487.  end; { SetEdit }
  488.  
  489.  function TFormMain.GetEdit (var Str: string; Edit: TControl): boolean;
  490.  begin
  491.      if LockField <> Edit then begin
  492.         if Edit is TEdit then Str := TEdit(Edit).Text
  493.            else if Edit is TComboBox then Str := TComboBox(Edit).Text;
  494.         Result := true;
  495.      end { if }
  496.      else Result := false;
  497.  end; { GetEdit }
  498.  
  499.  procedure TFormMain.GetNumeric (Edit: TEdit; var Int: integer; Min, Max, Std: integer);
  500.  var
  501.      S : string;
  502.      n : integer;
  503.  begin
  504.      if not GetEdit (S, Edit) then Exit;
  505.    { test }
  506.      if S > '' then begin
  507.         n := Std;
  508.         if StrToInt (S, n) and (n <= Max) and (n >= Min) then Int := n
  509.         else begin
  510.              if n < Min then Int := Min
  511.                 else if n > Max then Int := Max
  512.                         else Int := Std;
  513.              SetEdit (Edit, IntToStr (Int));
  514.         end; { else }
  515.      end { if }
  516.      else Int := Std;
  517.  end; { GetNumeric }
  518.  
  519.  procedure TFormMain.TestNumeric (Sender: TObject; var Key: char);
  520.  begin
  521.      if not ((Key in Numerics) or (Key = #8)) then Key := #0;
  522.  end; { TestNumeric }
  523.  
  524.  procedure TFormMain.ResetNumeric (Edit: TEdit; Val: integer);
  525.  begin
  526.      if Edit.Text = '' then SetEdit (Edit, IntToStr (Val));
  527.  end; { ResetNumeric }
  528.  
  529.  procedure TFormMain.GetFileName (var Val: string; Edit: TEdit; Min: integer);
  530.  var
  531.      S    : string;
  532.      i, j : integer;
  533.  begin
  534.      if not GetEdit (S, Edit) then Exit;
  535.      j := Length (S);
  536.    { test len }
  537.      if j >= Min then begin
  538.         for i := 1 to j do begin
  539.           { illegal char }
  540.             if S [i] in Illegals then begin
  541.                SetEdit (Edit, Val);
  542.                Exit;
  543.             end; { if}
  544.         end; { for }
  545.       { ok }
  546.         Val := S;
  547.      end; { if }
  548.  end; { GetFileName }
  549.  
  550.  procedure TFormMain.TestFileName (Sender: TObject; var Key: char);
  551.  begin
  552.       if (Key in Illegals) and (Key <> #8) then Key := #0;
  553.  end; { TestFileName }
  554.  
  555.  function TFormMain.BoxChange (Box: TComboBox; var Index: integer): boolean;
  556.  var
  557.      i : integer;
  558.  begin
  559.      Result := GetBox (i, Box) and (i >= 0) and (i <> Index);
  560.      if Result then Index := i;
  561.  end; { BoxChange }
  562.  
  563.  function TFormMain.KeyBox (Box: TComboBox; var Key: word): boolean;
  564.  begin
  565.      Result := false;
  566.      if ((Key = VK_DOWN) or (Key = VK_UP)) and (not Box.DroppedDown) then begin
  567.          Box.DroppedDown := true;
  568.          Key := 0;
  569.      end { if }
  570.      else if Key = VK_RETURN then begin
  571.              Result := true;
  572.              Key := 0
  573.      end; { else }
  574.  end; { KeyBox }
  575.  
  576.  procedure TFormMain.DropDownBox (Sender: TObject; var Key: word; Shift: TShiftState);
  577.  begin
  578.      if Sender is TComboBox then KeyBox (TComboBox (Sender), Key);
  579.  end; { DropDownBox }
  580.  
  581.  procedure TFormMain.InitBox (Box: TComboBox; Count, Index: integer);
  582.  begin
  583.      LockField := Box;
  584.      Box.Items.Capacity := Count;
  585.      Box.DropDownCount := Count;
  586.      SetBox (Box, Index);
  587.  end; { InitBox }
  588.  
  589.  procedure TFormMain.SetBox (Box: TComboBox; Index: integer);
  590.  begin
  591.      LockField := Box;
  592.      Box.ItemIndex := Index;
  593.      LockField := nil;
  594.  end; { SetBox }
  595.  
  596.  function TFormMain.GetBox (var Index: integer; Box: TComboBox): boolean;
  597.  begin
  598.      if LockField <> Box then begin
  599.         Index := Box.ItemIndex;
  600.         Result := true;
  601.      end { if }
  602.      else Result := false;
  603.  end; { GetBox }
  604.  
  605.  procedure TFormMain.SetCheck (Check: TButtonControl; Val: boolean);
  606.  begin
  607.      LockField := Check;
  608.      if Check is TCheckBox then TCheckBox (Check).Checked := Val
  609.         else if Check is TRadioButton then TRadioButton (Check).Checked := Val;
  610.      LockField := nil;
  611.  end; { SetCheck }
  612.  
  613.  function TFormMain.GetCheck (var Val: boolean; Check: TButtonControl): boolean;
  614.  begin
  615.      if LockField <> Check then begin
  616.         if Check is TCheckBox then Val := TCheckBox (Check).Checked
  617.            else if Check is TRadioButton then Val := TRadioButton (Check).Checked;
  618.         Result := true;
  619.      end { if }
  620.      else Result := false;
  621.  end; { GetCheck }
  622.  
  623.  procedure TFormMain.InitTrack (Track: TTrackBar; Min, Max, Val : integer);
  624.  begin
  625.      LockField := Track;
  626.      Track.Min := Min;
  627.      Track.Max := Max;
  628.      Track.Position := Val;
  629.      LockField := nil;
  630.  end; { InitTrack }
  631.  
  632.  procedure TFormMain.GetTrack (var Val: integer; Track: TTrackBar);
  633.  begin
  634.      if LockField <> Track then Val := Track.Position;
  635.  end; { GetTrack }
  636.  
  637. (*************************************************************************)
  638. (*                                   main                                *)
  639. (*************************************************************************)
  640.  procedure TFormMain.BoxFilesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  641.  begin
  642.      if KeyBox (BoxFiles, Key) then Rescan;
  643.  end; { BoxFilesKeyDown }
  644.  
  645.  procedure TFormMain.BoxFilesChange(Sender: TObject);
  646.  begin
  647.      if BoxChange (BoxFiles, Files) then begin
  648.         UpdateQuality;
  649.         Rescan;
  650.      end; { if }
  651.  end; { BoxFilesChange }
  652.  
  653.  procedure TFormMain.EditPathKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  654.  begin
  655.      if KeyBox (EditPath, Key) then Rescan;
  656.  end; { EditPathKeyDown }
  657.  
  658.  procedure TFormMain.EditPathExit(Sender: TObject);
  659.  begin
  660.      if PathDelimiter (EditPath.Text) <> Catalog then Rescan;
  661.  end; { EditPathExit }
  662.  
  663.  procedure TFormMain.EditPathChange(Sender: TObject);
  664.  begin
  665.      if BoxChange (EditPath, PathIndex) then Rescan;
  666.  end;  { EditPathChange }
  667.  
  668.  procedure TFormMain.ButtonPathClick (Sender: TObject);
  669.  begin
  670.     DialogCaption := 'Browse';
  671.     if SelectDirectory then begin
  672.        SetEdit (EditPath, Catalog);
  673.        Rescan;
  674.     end; { if }
  675.  end; { ButtonPathClick }
  676.  
  677.  procedure TFormMain.FileListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  678.  var
  679.      S : string;
  680.  begin
  681.      if LockField = FileListBox then Exit;
  682.      With FileListBox do begin
  683.           Canvas.FillRect(Rect);
  684.           S := Items [Index];
  685.           if (State = []) and isThumbnail (S)
  686.              then Canvas.Font.Color := clInactiveCaptionText;
  687.           Canvas.TextOut (Rect.Left + 2, Rect.Top, S);
  688.      end; { With }
  689.  end; { FileListBoxDrawItem }
  690.  
  691.  procedure TFormMain.FileListBoxDblClick(Sender: TObject);
  692.  begin
  693.      ViewFile;
  694.  end; { FileListBoxDblClick }
  695.  
  696.  procedure TFormMain.FileListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  697.  begin
  698.      if Key = VK_RETURN then begin
  699.         ViewFile;
  700.         Key := 0;
  701.      end; { else }
  702.  end; { FileListBoxKeyDown }
  703.  
  704.  procedure TFormMain.CheckBoxPanelsClick(Sender: TObject);
  705.  var
  706.      i : integer;
  707.  begin
  708.      if LockField = CheckBoxPanels then Exit;
  709.      i := CheckBoxPanels.ItemIndex;
  710.      if (i >= 0) and (i <> PanelIndex) then begin
  711.         PanelIndex := i;
  712.         SetPanel (PanelThumbnails, fThumbnail, false, CheckThumbnailsClick);
  713.         SetPanel (PanelRename, fRename, false, nil);
  714.         SetPanel (PanelCollection, fCollection, false, CheckDuplicateClick);
  715.      end; { if }
  716.  end; { CheckBoxPanelsClick }
  717.  
  718.  procedure TFormMain.CheckBoxPanelsClickCheck(Sender: TObject);
  719.  begin
  720.      if LockField <> CheckBoxPanels then begin
  721.         fThumbnail := CheckBoxPanels.Checked [PanelOrder (PanelThumbnails)];
  722.         fRename := CheckBoxPanels.Checked [PanelOrder (PanelRename)];
  723.         fCollection := CheckBoxPanels.Checked [PanelOrder (PanelCollection)];
  724.         ButtonRun.Enabled := isValid;
  725.         PanelIndex := -1;
  726.         CheckBoxPanelsClick (Self);
  727.      end; { if }
  728.  end; { CheckBoxPanelsClickCheck }
  729.  
  730.  procedure TFormMain.UpdateQuality;
  731.  begin
  732.      LabelQuality.Enabled := fThumbnail and (Files = 0);
  733.      TrackThumbQuality.Enabled := LabelQuality.Enabled;
  734.  end; { UpdateQuality }
  735.  
  736.  procedure TFormMain.ViewFile;
  737.  begin
  738.      With FileListBox do begin
  739.        if (ItemIndex >= 0) and (ItemIndex < Items.Count) then begin
  740.           FormViewer.View (PImageInfo (Images.Items [ItemIndex])^);
  741.           SetFocus;
  742.        end; { if }
  743.      end; { With }
  744.  end; { ViewFile }
  745.  
  746.  procedure TFormMain.SetStatus (const S: string = '');
  747.  begin
  748.      if S = '' then begin
  749.         Caption := AppName + ' (files: ' + IntToStr (Images.Count) +
  750.                    ', thumbnails: ' + IntToStr (Images.ThumbnailCount) + ')';
  751.         FileListBox.Cursor := crDefault;
  752.         Cursor := crDefault;
  753.      end { if }
  754.      else begin
  755.           Caption := AppName + ' (' + S + '...)';
  756.           FileListBox.Cursor := crHourGlass;
  757.           Cursor := crHourGlass;
  758.      end; { else }
  759.      Application.ProcessMessages;
  760.  end; { SetStatus }
  761.  
  762.  procedure TFormMain.AppActivate(Sender: TObject);
  763.  var
  764.      Time: TFileTime;
  765.  begin
  766.   { current dir }
  767.     if (not RunAuto) and Active and  CatalogTime (Time) and
  768.        (CompareFileTime (LastScan, Time) < 0)
  769.     then begin
  770.          LastScan := Time;
  771.          Rescan;
  772.     end; { if }
  773.  end; { AppActivate }
  774.  
  775.  procedure TFormMain.Rescan;
  776.  var
  777.      P    : PImageInfo;
  778.      w, k : integer;
  779.      i    : integer;
  780.  begin
  781.      if GetEdit (Catalog, EditPath) then begin
  782.       { init }
  783.         PathIndex := EditPath.Items.IndexOf (Catalog);
  784.         Catalog := PathDelimiter (Catalog);
  785.       { autorescan lock }
  786.         CatalogTime (LastScan);
  787.       { status }
  788.         SetStatus ('Scanning');
  789.       { free }
  790.         With FileListBox do begin
  791.              Items.BeginUpdate;
  792.              Items.Clear;
  793.         end; { With }
  794.         With EditPath do begin
  795.              Items.BeginUpdate;
  796.              if PathIndex < 0 then PathIndex := Items.IndexOf (Catalog);
  797.         end; { With }
  798.         w := 0;
  799.       { scan }
  800.         if Images.Scan then begin
  801.          { sort }
  802.            if fSortList then Images.Sort (0, false);
  803.          { assign }
  804.            for i := 0 to Pred (Images.Count) do begin
  805.                P := Images.List[i];
  806.                With FileListBox do begin
  807.                     Items.Add (P^.Name);
  808.                     k := Canvas.TextWidth (P^.Name);
  809.                end; { Width }
  810.                if k > w then w := k;
  811.            end; { for }
  812.          { add path }
  813.            With EditPath do begin
  814.               if PathIndex < 0 then begin
  815.                  PathIndex := 0;
  816.                  if Items.Count >= MaxHistory then Items.Delete (Pred (Items.Count));
  817.                  Items.Insert (PathIndex, Catalog);
  818.               end; { if }
  819.            end; { With }
  820.         end { if }
  821.         else begin
  822.              if PathIndex >= 0 then EditPath.Items.Delete (PathIndex);
  823.              Catalog := '';
  824.              PathIndex := -1;
  825.         end; { else }
  826.       { restore }
  827.         SetEdit (EditPath, Catalog);
  828.         SetBox (EditPath, PathIndex);
  829.         EditPath.Items.EndUpdate;
  830.         With FileListBox do begin
  831.              SendMessage (Handle, LB_SETHORIZONTALEXTENT, w + 4, 0);
  832.              Items.EndUpdate;
  833.              Repaint;
  834.         end; { With }
  835.         SetStatus;
  836.       { test go }
  837.         ButtonRun.Enabled := isValid;
  838.      end; { if }
  839.  end; { Rescan }
  840.  
  841.  procedure TFormMain.ButtonRunClick(Sender: TObject);
  842.  begin
  843.    { init }
  844.      if FormViewer.Visible then FormViewer.Hide;
  845.      FileListBox.Items.Clear;
  846.      SetStatus ('Running');
  847.    { run report }
  848.      FormReport := TFormReport.Create (Self);
  849.      FormReport.Width := Width - 10;
  850.      FormReport.ShowModal;
  851.      FormReport.Free;
  852.    { restore }
  853.      if NextFirst then SetEdit (EditFirst, IntToStr (FirstNum));
  854.      Rescan;
  855.  end; { ButtonRunClick }
  856.  
  857.  procedure TFormMain.ButtonExitClick(Sender: TObject);
  858.  begin
  859.      Close;
  860.  end; { ButtonExitClick }
  861.  
  862. (*************************************************************************)
  863. (*                                  rename                               *)
  864. (*************************************************************************)
  865.  procedure TFormMain.BoxOrderChange(Sender: TObject);
  866.  begin
  867.      GetBox (Order, BoxOrder);
  868.  end; { BoxOrderChange }
  869.  
  870.  procedure TFormMain.CheckDecsClick(Sender: TObject);
  871.  begin
  872.      GetCheck (fDecs, CheckDecs);
  873.  end; { CheckDecsClick }
  874.  
  875.  procedure TFormMain.EditPrefixChange(Sender: TObject);
  876.  begin
  877.      GetFileName (Prefix, EditPrefix, 0);
  878.  end; { EditPrefixChange }
  879.  
  880.  procedure TFormMain.EditFirstChange(Sender: TObject);
  881.  begin
  882.      GetNumeric (EditFirst, FirstNum, MinFirst, MaxFirst, MinFirst);
  883.  end; { EditFirstChange }
  884.  
  885.  procedure TFormMain.EditFirstExit(Sender: TObject);
  886.  begin
  887.      ResetNumeric (EditFirst, FirstNum);
  888.  end; { EditFirstExit }
  889.  
  890.  procedure TFormMain.EditDigitsChange(Sender: TObject);
  891.  begin
  892.      GetNumeric (EditDigits, Digits, MinDigits, MaxDigits, MinDigits)
  893.  end; { EditDigitsChange }
  894.  
  895.  procedure TFormMain.EditDigitsExit(Sender: TObject);
  896.  begin
  897.      ResetNumeric (EditDigits, Digits);
  898.  end; { EditDigitsExit }
  899.  
  900.  procedure TFormMain.EditStepChange(Sender: TObject);
  901.  begin
  902.      GetNumeric (EditStep, StepCount, MinStep, MaxStep, MinStep);
  903.  end; { EditStepChange }
  904.  
  905.  procedure TFormMain.EditStepExit(Sender: TObject);
  906.  begin
  907.      ResetNumeric (EditStep, StepCount);
  908.  end; { EditStepExit }
  909.  
  910.  procedure TFormMain.EditPostfixChange(Sender: TObject);
  911.  begin
  912.      GetFileName (Postfix, EditPostfix, 0);
  913.  end; { EditPostfixChange }
  914.  
  915.  procedure TFormMain.CheckReadOnlyClick(Sender: TObject);
  916.  begin
  917.      GetCheck (fAttribute, CheckReadOnly);
  918.  end; { CheckReadOnlyClick }
  919.  
  920.  procedure TFormMain.CheckFileTimeClick(Sender: TObject);
  921.  begin
  922.      GetCheck (fFileTime, CheckFileTime);
  923.  end; { CheckFileTimeClick }
  924.  
  925. (*************************************************************************)
  926. (*                             thumbnails                                *)
  927. (*************************************************************************)
  928.  procedure TFormMain.CheckThumbnailsClick (Sender: TObject);
  929.  begin
  930.      UpdateQuality;
  931.      CheckCustomClick (Self);
  932.      CheckIncludeClick (Self);
  933.  end; { CheckThumbnailClick }
  934.  
  935.  procedure TFormMain.EditMarkChange(Sender: TObject);
  936.  begin
  937.      GetFileName (Mark, EditMark, 1);
  938.  end; { EditMarkChange }
  939.  
  940.  procedure TFormMain.EditMarkExit(Sender: TObject);
  941.  begin
  942.    { new value }
  943.      if LastMark <> Mark then begin
  944.       { new viewcount }
  945.         Images.MarkChange;
  946.       { confirm }
  947.         if Confirm (IntTostr (Images.ThumbnailCount) +
  948.            ' thumbnails with the mark "' + Mark + '"  was found',
  949.            'Apply this value')
  950.       { ok }
  951.         then begin
  952.              FileListBox.Repaint;
  953.              LastMark := Mark;
  954.              SetStatus;
  955.         end { if }
  956.       { old value }
  957.         else begin
  958.              Mark := LastMark;
  959.              Images.MarkChange;
  960.              SetEdit (EditMark, Mark);
  961.         end; { else }
  962.      end; { if }
  963.    { restore }
  964.      if EditMark.Text = '' then SetEdit (EditMark, Mark);
  965.  end; { EditMarkExit }
  966.  
  967.  procedure TFormMain.EditMarkKeyPress(Sender: TObject; var Key: Char);
  968.  begin
  969.      if Key = #13 then begin
  970.         EditMarkExit (Self);
  971.         Key := #0;
  972.      end { if }
  973.      else TestFileName (Sender, Key);
  974.  end; { EditMarkKeyPress }
  975.  
  976.  procedure TFormMain.TrackScaleChange(Sender: TObject);
  977.  begin
  978.      GetTrack (Scale, TrackScale);
  979.  end; { TrackScaleChange }
  980.  
  981.  procedure TFormMain.TrackThumbQualityChange(Sender: TObject);
  982.  begin
  983.      GetTrack (ThumbnailQuality, TrackThumbQuality);
  984.  end; { TrackThumbQualityChange }
  985.  
  986. (*************************************************************************)
  987. (*                             custom                                    *)
  988. (*************************************************************************)
  989.  procedure TFormMain.CheckCustomClick(Sender: TObject);
  990.  begin
  991.      if GetCheck (fCustom, CheckCustom) then begin
  992.         EnablePanel (PanelCustom, fThumbnail and fCustom);
  993.         LabelScale.Enabled := fThumbnail and (not fCustom);
  994.         TrackScale.Enabled := LabelScale.Enabled;
  995.         RadioModeClick (Self);
  996.      end; { if }
  997.  end; { CheckCustomClick }
  998.  
  999.  procedure TFormMain.EditCtmWidthChange(Sender: TObject);
  1000.  begin
  1001.      GetNumeric (EditCtmWidth, CtmWidth, MinCustom, MaxCustom, StdCustom);
  1002.  end; { EditWidthChange }
  1003.  
  1004.  procedure TFormMain.EditCtmWidthExit(Sender: TObject);
  1005.  begin
  1006.      ResetNumeric (EditCtmWidth, CtmWidth);
  1007.  end; { EditWidthExit }
  1008.  
  1009.  procedure TFormMain.EditCtmHeightChange(Sender: TObject);
  1010.  begin
  1011.      GetNumeric (EditCtmHeight, CtmHeight, MinCustom, MaxCustom, StdCustom);
  1012.  end; { EditHeightChange }
  1013.  
  1014.  procedure TFormMain.EditCtmHeightExit(Sender: TObject);
  1015.  begin
  1016.      ResetNumeric (EditCtmHeight, CtmHeight);
  1017.  end; { EditHeightExit }
  1018.  
  1019.  procedure TFormMain.RadioModeClick(Sender: TObject);
  1020.  begin
  1021.      if GetCheck (CtmMode, RadioFill)
  1022.         then ButtonColor.Enabled := fThumbnail and fCustom and CtmMode;
  1023.  end; { RadioModeClick }
  1024.  
  1025.  procedure TFormMain.ButtonAlignClick(Sender: TObject);
  1026.  var
  1027.      i : integer;
  1028.  begin
  1029.      FormAlign := TFormAlign.Create (Self);
  1030.      With FormAlign do begin
  1031.         TRadioButton (PanelHor.Controls [AnchorX]).Checked := true;
  1032.         TRadioButton (PanelVer.Controls [AnchorY]).Checked := true;
  1033.         if ShowModal = mrOk then begin
  1034.            for i := MinAnchor to MaxAnchor do begin
  1035.                if TRadioButton (PanelHor.Controls [i]).Checked then AnchorX := i;
  1036.                if TRadioButton (PanelVer.Controls [i]).Checked then AnchorY := i;
  1037.            end; { for }
  1038.         end; { if };
  1039.         Free;
  1040.      end; { With }
  1041.  end; { ButtonLocateClick }
  1042.  
  1043.  procedure TFormMain.ButtonColorClick(Sender: TObject);
  1044.  begin
  1045.      ColorDialog.Color := FillColor;
  1046.      DialogCaption := 'Color';
  1047.      if ColorDialog.Execute then FillColor := ColorDialog.Color;
  1048.  end; { ButtonColorClick }
  1049.  
  1050. (*************************************************************************)
  1051. (*                             include                                   *)
  1052. (*************************************************************************)
  1053.  procedure TFormMain.CheckIncludeClick(Sender: TObject);
  1054.  begin
  1055.      if GetCheck (fInclude, CheckInclude) then EnablePanel (PanelInclude,  fInclude and fThumbnail);
  1056.  end; { CheckIncludeClick }
  1057.  
  1058.  procedure TFormMain.EditTextChange(Sender: TObject);
  1059.  begin
  1060.      GetEdit (Comment, EditText);
  1061.  end; { EditTextChange }
  1062.  
  1063.  procedure TFormMain.CheckImageClick(Sender: TObject);
  1064.  begin
  1065.      GetCheck (fImgSize, CheckImage);
  1066.  end; { CheckImageClick }
  1067.  
  1068.  procedure TFormMain.CheckFileClick(Sender: TObject);
  1069.  begin
  1070.      GetCheck (fFilSize, CheckFile);
  1071.  end; { CheckFileClick }
  1072.  
  1073.  procedure TFormMain.ButtonFontClick(Sender: TObject);
  1074.  begin
  1075.      DialogCaption := 'Font';
  1076.      With FontDialog do if Execute then FontToParms (Font);
  1077.  end; { ButtonFontClick }
  1078.  
  1079.  procedure TFormMain.ButtonGroundClick(Sender: TObject);
  1080.  begin
  1081.      DialogCaption := 'BGround';
  1082.      ColorDialog.Color := BGround;
  1083.      if ColorDialog.Execute then BGround := ColorDialog.Color;
  1084.  end; { ButtonGroundClick }
  1085.  
  1086.  procedure TFormMain.FontDialogShow(Sender: TObject);
  1087.  begin
  1088.      UpdateDialog (FontDialog.Handle, Left + 16, Top + 25);
  1089.  end; { FontDialogShow }
  1090.  
  1091.  procedure TFormMain.ColorDialogShow(Sender: TObject);
  1092.  begin
  1093.      UpdateDialog (ColorDialog.Handle, Left + 10, Top + 25);
  1094.  end; { ColorDialogShow }
  1095.  
  1096. (*************************************************************************)
  1097. (*                             collection                                *)
  1098. (*************************************************************************)
  1099.  procedure TFormMain.CheckDuplicateClick(Sender: TObject);
  1100.  begin
  1101.      if GetCheck (fDuplicate, CheckDuplicate) then begin
  1102.         LabelLike.Enabled := fCollection and fDuplicate;
  1103.         TrackLike.Enabled := LabelLike.Enabled;
  1104.      end; { if }
  1105.  end; { CheckDuplicateClick }
  1106.  
  1107.  procedure TFormMain.TrackLikeChange(Sender: TObject);
  1108.  begin
  1109.      GetTrack (Likeness, TrackLike);
  1110.  end; { TrackLikeChange }
  1111.  
  1112.  procedure TFormMain.CheckDescriptionClick(Sender: TObject);
  1113.  begin
  1114.      GetCheck (fDescription, CheckDescription);
  1115.  end; { CheckDescriptionClick }
  1116.  
  1117. End.
  1118.