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 >
Wrap
Pascal/Delphi Source File
|
2002-06-15
|
39KB
|
1,118 lines
(*************************************************************************)
(* jBooster *)
(* (c) pulsar@mail.primorye.ru *)
(*************************************************************************)
{$J+,H+,A+,B-,I-}
Unit MainForm;
Interface
Uses
{ standart }
Windows, Messages, SysUtils, Classes,
{ vcl }
Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, CheckLst,
{ formats }
JPeg,
{ browse dialog }
ShlObj, ActiveX,
{ private }
Support, ViewerForm, ReportForm, AlignForm;
Type
TFormMain = class(TForm)
published
{ main }
LabelFiles: TLabel;
BoxFiles: TComboBox;
LabelPath: TLabel;
EditPath: TComboBox;
ButtonPath: TButton;
FileListBox: TListBox;
CheckBoxPanels: TCheckListBox;
ButtonRun: TButton;
ButtonExit: TButton;
FontDialog: TFontDialog;
ColorDialog: TColorDialog;
{ thumbnails }
PanelThumbnails: TPanel;
LabelMark: TLabel;
EditMark: TEdit;
LabelQuality: TLabel;
TrackThumbQuality: TTrackBar;
LabelScale: TLabel;
TrackScale: TTrackBar;
{ custom }
CheckCustom: TCheckBox;
PanelCustom: TPanel;
LabelCtmWidth: TLabel;
EditCtmWidth: TEdit;
LabelCtmHeight: TLabel;
EditCtmHeight: TEdit;
RadioCut: TRadioButton;
RadioFill: TRadioButton;
ButtonColor: TButton;
ButtonAlign: TButton;
{ include }
CheckInclude: TCheckBox;
PanelInclude: TPanel;
PanelNull: TPanel;
LabelText: TLabel;
EditText: TEdit;
CheckImage: TCheckBox;
CheckFile: TCheckBox;
ButtonFont: TButton;
ButtonGround: TButton;
{ rename }
PanelRename: TPanel;
LabelPrefix: TLabel;
LabelOrder: TLabel;
BoxOrder: TComboBox;
CheckDecs: TCheckBox;
EditPrefix: TEdit;
LabelFirst: TLabel;
EditFirst: TEdit;
LabelDigits: TLabel;
EditDigits: TEdit;
LabelStep: TLabel;
EditStep: TEdit;
LabelPostfix: TLabel;
EditPostfix: TEdit;
CheckFileTime: TCheckBox;
CheckReadOnly: TCheckBox;
{ collection }
PanelCollection: TPanel;
CheckDuplicate: TCheckBox;
LabelLike: TLabel;
TrackLike: TTrackBar;
CheckDescription: TCheckBox;
{ form handlers }
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
procedure AppActivate(Sender: TObject);
procedure TestNumeric (Sender: TObject; var Key: char);
procedure TestFileName (Sender: TObject; var Key: char);
procedure DropDownBox (Sender: TObject; var Key: word; Shift: TShiftState);
{ main handlers }
procedure BoxFilesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure BoxFilesChange(Sender: TObject);
procedure EditPathKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure EditPathExit(Sender: TObject);
procedure EditPathChange(Sender: TObject);
procedure ButtonPathClick(Sender: TObject);
procedure FileListBoxDblClick(Sender: TObject);
procedure FileListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FileListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure CheckBoxPanelsClick(Sender: TObject);
procedure CheckBoxPanelsClickCheck(Sender: TObject);
procedure ButtonRunClick(Sender: TObject);
procedure ButtonExitClick(Sender: TObject);
{ numerate handlers }
procedure BoxOrderChange(Sender: TObject);
procedure CheckDecsClick(Sender: TObject);
procedure EditPrefixChange(Sender: TObject);
procedure EditFirstChange(Sender: TObject);
procedure EditFirstExit(Sender: TObject);
procedure EditDigitsChange(Sender: TObject);
procedure EditDigitsExit(Sender: TObject);
procedure EditPostfixChange(Sender: TObject);
procedure EditStepChange(Sender: TObject);
procedure EditStepExit(Sender: TObject);
procedure CheckReadOnlyClick(Sender: TObject);
procedure CheckFileTimeClick(Sender: TObject);
{ thumbnails handlers }
procedure EditMarkChange(Sender: TObject);
procedure EditMarkExit(Sender: TObject);
procedure EditMarkKeyPress(Sender: TObject; var Key: Char);
procedure CheckThumbnailsClick(Sender: TObject);
procedure TrackScaleChange(Sender: TObject);
procedure TrackThumbQualityChange(Sender: TObject);
{ custom size handlers }
procedure CheckCustomClick(Sender: TObject);
procedure EditCtmWidthChange(Sender: TObject);
procedure EditCtmWidthExit(Sender: TObject);
procedure EditCtmHeightChange(Sender: TObject);
procedure EditCtmHeightExit(Sender: TObject);
procedure RadioModeClick(Sender: TObject);
procedure ButtonAlignClick(Sender: TObject);
procedure ButtonColorClick(Sender: TObject);
{ include handlers }
procedure CheckIncludeClick(Sender: TObject);
procedure EditTextChange(Sender: TObject);
procedure CheckImageClick(Sender: TObject);
procedure CheckFileClick(Sender: TObject);
procedure ButtonFontClick(Sender: TObject);
procedure ButtonGroundClick(Sender: TObject);
procedure FontDialogShow(Sender: TObject);
procedure ColorDialogShow(Sender: TObject);
{ collection handlers }
procedure CheckDuplicateClick(Sender: TObject);
procedure CheckDescriptionClick(Sender: TObject);
procedure TrackLikeChange(Sender: TObject);
private
LockField : pointer;
LastMark : string;
LastScan : TFileTime;
{ support }
function PanelOrder (Panel: TPanel): integer;
procedure SetPanel (Panel: TPanel; Enable, Init: boolean; Event: TNotifyEvent);
procedure EnablePanel (Panel: TPanel; Enable: boolean);
procedure InitEdit (Edit: TEdit; MaxLen: integer; const Str: string);
procedure SetEdit (Edit: TControl; const Str: string);
function GetEdit (var Str: string; Edit: TControl): boolean;
procedure GetNumeric (Edit: TEdit; var Int: integer; Min, Max, Std: integer);
procedure ResetNumeric (Edit: TEdit; Val: integer);
procedure GetFileName (var Val: string; Edit: TEdit; Min: integer);
procedure InitBox (Box: TComboBox; Count, Index: integer);
function KeyBox (Box: TComboBox; var Key: word): boolean;
function BoxChange (Box: TComboBox; var Index: integer): boolean;
procedure SetBox (Box: TComboBox; Index: integer);
function GetBox (var Index: integer; Box: TComboBox): boolean;
procedure SetCheck (Check: TButtonControl; Val: boolean);
function GetCheck (var Val: boolean; Check: TButtonControl): boolean;
procedure InitTrack (Track: TTrackBar; Min, Max, Val : integer);
procedure GetTrack (var Val: integer; Track: TTrackBar);
{ operate }
procedure SetStatus (const S: string = '');
procedure UpdateQuality;
procedure Rescan;
procedure ViewFile;
end; { TFormMain }
Var
FormMain: TFormMain;
Implementation
{$R *.DFM}
(*************************************************************************)
(* dialogs support *)
(*************************************************************************)
Const
DialogCaption : string = '';
procedure UpdateDialog (Handle: HWND; X, Y: integer);
begin
SetWindowPos (Handle, 0, X, Y, 0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
if DialogCaption > '' then SetWindowText (Handle, PChar (DialogCaption));
end; { UpdateDialog }
function EnumChildProc (Handle: HWND; lParam: LPARAM): BOOL; stdcall;
var
R : TRect;
begin
GetClientRect (Handle, R);
{ browser window }
if (R.Right > 180) and (R.Bottom > 180) then begin
GetWindowRect (GetParent (Handle), R);
{ resize }
MoveWindow (Handle, 0, 0, R.Right - R.Left - 7, R.Bottom - R.Top - 74, true);
{ stop }
Result := false;
end { if }
{ next }
else Result := true;
end; { EnumChildProc }
procedure BrowserCallBack (HWindow: HWND; Msg: Integer; lParameter: LPARAM; lpBrowseFolder: LPARAM); stdcall;
var
x, y : integer;
R : TRect;
begin
if Msg = BFFM_INITIALIZED then begin
{ window pos }
GetWindowRect (GetForegroundWindow, R);
x := R.Left + (R.Right - R.Left) div 2;
y := R.Top;
GetWindowRect (HWindow, R);
x := x - (R.Right - R.Left) div 2;
y := y + 25;
{ init }
UpdateDialog (HWindow, x, y);
SetWindowLong (HWindow, GWL_USERDATA, lpBrowseFolder);
SendMessage (HWindow, BFFM_SETSELECTION, Ord (true), Longint (PChar (Catalog)));
{ change size of browser window }
if ((R.Right - R.Left) = 324) and ((R.Bottom - R.Top) = 331)
then EnumChildWindows (HWindow, @EnumChildProc, 0);
end; { if }
end; { BrowserCallBack }
function SelectDirectory: boolean;
var
WindowList : Pointer;
BrowseInfo : TBrowseInfo;
ShellMalloc: IMalloc;
ItemIDList : PItemIDList;
Buffer : PChar;
begin
{ init }
Result := false;
FillChar (BrowseInfo, SizeOf (BrowseInfo), 0);
{ get mem handler }
if (ShGetMalloc (ShellMalloc) = S_OK) and (ShellMalloc <> nil) then begin
Buffer := ShellMalloc.Alloc (MAX_PATH);
Try
With BrowseInfo do begin
hwndOwner := Application.Handle;
pidlRoot := nil;
pszDisplayName := Buffer;
ulFlags := BIF_RETURNONLYFSDIRS;
lpfn := @BrowserCallBack;
end; { With }
WindowList := DisableTaskWindows(0);
Try
ItemIDList := ShBrowseForFolder(BrowseInfo);
Finally
EnableTaskWindows(WindowList);
end; { try }
Result := ItemIDList <> nil;
{ ok }
if Result then begin
ShGetPathFromIDList (ItemIDList, Buffer);
ShellMalloc.Free (ItemIDList);
Catalog := PathDelimiter (AnsiUpperCase (Buffer));
end; { if }
Finally
ShellMalloc.Free (Buffer);
end; { try }
end; { if }
end; { SelectDirectory }
procedure CorrectBounds (Form: TForm);
procedure CorrectRange (var Start, Stop: integer; Max: integer);
begin
if (Stop - Start) > Max then begin
Start := 0;
Stop := Max;
end { if }
else begin
if Start < 0 then begin
Stop := Stop - Start;
Start := 0;
end { if }
else if Stop > Max then begin
Start := Start - (Stop - Max);
Stop := Max;
end; { if }
end; { if }
end; { CorrectRange }
var
R : TRect;
begin
Form.WindowState := wsNormal;
R := Form.BoundsRect;
CorrectRange (R.Left, R.Right, Screen.DesktopWidth);
CorrectRange (R.Top, R.Bottom, Screen.DesktopHeight - 30);
Form.BoundsRect := R;
end; { CorrectBounds }
(*************************************************************************)
(* form *)
(*************************************************************************)
procedure TFormMain.FormShow(Sender: TObject);
var
i : integer;
begin
{ init app }
Application.Title := AppName;
Application.OnShowHint := ShowHint;
Application.HintPause := 300;
{ parameters }
LoadParameters (EditPath.Items, ColorDialog.CustomColors);
{ main form }
Constraints.MinWidth := MinWidth;
Constraints.MinHeight := MinHeight;
BoundsRect := Rect (MainLeft, MainTop, MainLeft + MainWidth, MainTop + MainHeight);
CorrectBounds (Self);
{ viewer form }
FormViewer.Constraints.MinHeight := MinView;
FormViewer.Constraints.MinWidth := MinView;
FormViewer.BoundsRect := Rect (ViewLeft, ViewTop, ViewLeft + ViewWidth, ViewTop + ViewHeight);
CorrectBounds (FormViewer);
{ main fields }
for i := MinFormat to MaxFormat do BoxFiles.Items.Add (Formats [i]);
InitBox (BoxFiles, Succ (MaxFormat), Files);
EditPath.MaxLength := MAX_PATH;
EditPath.CharCase := ecUpperCase;
InitBox (EditPath, MaxHistory, PathIndex);
SetEdit (EditPath, Catalog);
FileListBox.Items.Capacity := 512;
{ numerate }
for i := MinOrder to MaxOrder do BoxOrder.Items.Add (Orders [i]);
InitBox (BoxOrder, Succ (MaxOrder), Order);
SetCheck (CheckDecs, fDecs);
InitEdit (EditPrefix, LenNamePart, Prefix);
InitEdit (EditFirst, LenFirst, IntToStr (FirstNum));
InitEdit (EditDigits, LenDigits, IntToStr (Digits));
InitEdit (EditStep, LenStep, IntToStr (StepCount));
InitEdit (EditPostfix, LenNamePart, Postfix);
SetCheck (CheckReadOnly, fAttribute);
SetCheck (CheckFileTime, fFileTime);
{ thumbnails }
LastMark := Mark;
InitEdit (EditMark, LenNamePart, Mark);
InitTrack (TrackScale, MinScale, MaxScale, Scale);
InitTrack (TrackThumbQuality, MinQuality, MaxQuality, ThumbnailQuality);
{ custom }
SetCheck (CheckCustom, fCustom);
InitEdit (EditCtmWidth, LenCustom, IntToStr (CtmWidth));
InitEdit (EditCtmHeight, LenCustom, IntToStr (CtmHeight));
SetCheck (RadioCut, not CtmMode);
SetCheck (RadioFill, CtmMode);
{ include }
SetCheck (CheckInclude, fInclude);
InitEdit (EditText, LenComment, Comment);
SetCheck (CheckImage, fImgSize);
SetCheck (CheckFile, fFilSize);
{ font }
With FontDialog do begin
ParmsToFont (Font);
MaxFontSize := MaxFont;
MinFontSize := MinFont;
end; { With }
{ collection }
SetCheck (CheckDuplicate, fDuplicate);
InitTrack (TrackLike, MinLike, MaxLike, Likeness);
SetCheck (CheckDescription, fDescription);
{ init }
CheckBoxPanels.ItemIndex := PanelIndex;
SetPanel (PanelThumbnails, fThumbnail, true, CheckThumbnailsClick);
SetPanel (PanelRename, fRename, true, nil);
SetPanel (PanelCollection, fCollection, true, CheckDuplicateClick);
Rescan;
{ autorescan handler }
Application.OnActivate := AppActivate;
end; { FormShow }
procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{ main form }
CorrectBounds (Self);
MainTop := Top;
MainLeft := Left;
MainWidth := Width;
MainHeight := Height;
{ viewer form }
CorrectBounds (FormViewer);
With FormViewer do begin
ViewTop := Top;
ViewLeft := Left;
ViewWidth := Width;
ViewHeight := Height;
end; { With }
{ write }
SaveParameters (EditPath.Items, ColorDialog.CustomColors);
end; { FormClose }
procedure TFormMain.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
{ help }
if (Key = VK_HELP) or (Key = VK_F1) then begin
if not FormViewer.Help (ExePath + HlpName) then AppTitle;
end { if }
{ minimize }
else if Key = VK_ESCAPE then WindowState := wsMinimized;
end; { FormKeyDown }
procedure TFormMain.ShowHint
(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
begin
With HintInfo do begin
if HintControl = TrackScale then HintStr := IntToStr (Scale)
else if HintControl = TrackThumbQuality then HintStr := IntToStr (TrackToQuality (ThumbnailQuality))
else if HintControl = ButtonGround then HintColor := BGround
else if HintControl = ButtonColor then HintColor := FillColor
else if HintControl = ButtonFont then HintStr := FontName + ' ' + IntToStr (FontSize)
else if HintControl = ButtonAlign then HintStr := HAnchors [AnchorX] + '-' + VAnchors [AnchorY]
else if HintControl = TrackLike then HintStr := IntToStr (TrackToLikeness (Likeness)) + '%';
end; { With }
end; { ShowHint }
(*************************************************************************)
(* support *)
(*************************************************************************)
function TFormMain.PanelOrder (Panel: TPanel): integer;
begin
Result := Pred (Panel.TabOrder - CheckBoxPanels.TabOrder);
end; { PanelOrder }
procedure TFormMain.SetPanel (Panel: TPanel; Enable, Init: boolean; Event: TNotifyEvent);
var
V : boolean;
i : integer;
begin
i := PanelOrder (Panel);
{ init }
if Init then begin
Panel.Left := CheckBoxPanels.Left;
Panel.Top := CheckBoxPanels.Top + CheckBoxPanels.Height + 8;
LockField := CheckBoxPanels;
CheckBoxPanels.Checked [i] := Enable;
LockField := nil;
end; { if }
{ visible }
V := PanelIndex = i;
if (V and (Panel.Enabled <> Enable)) or Init then begin
Panel.Enabled := Enable;
EnablePanel (Panel, Enable);
if Assigned (Event) then Event (Self);
end; { if }
if V <> Panel.Visible then Panel.Visible := V;
end; { SetPanel }
procedure TFormMain.EnablePanel (Panel: TPanel; Enable: boolean);
var
i : integer;
begin
for i := 0 to Pred (Panel.ControlCount) do Panel.Controls [i].Enabled := Enable;
end; { EnablePanel }
procedure TFormMain.InitEdit (Edit: TEdit; MaxLen: integer; const Str: string);
begin
Edit.MaxLength := MaxLen;
SetEdit (Edit, Str);
end; { InitEdit }
procedure TFormMain.SetEdit (Edit: TControl; const Str: string);
begin
LockField := Edit;
if Edit is TEdit then TEdit(Edit).Text := Str
else if Edit is TComboBox then TComboBox(Edit).Text := Str;
LockField := nil;
end; { SetEdit }
function TFormMain.GetEdit (var Str: string; Edit: TControl): boolean;
begin
if LockField <> Edit then begin
if Edit is TEdit then Str := TEdit(Edit).Text
else if Edit is TComboBox then Str := TComboBox(Edit).Text;
Result := true;
end { if }
else Result := false;
end; { GetEdit }
procedure TFormMain.GetNumeric (Edit: TEdit; var Int: integer; Min, Max, Std: integer);
var
S : string;
n : integer;
begin
if not GetEdit (S, Edit) then Exit;
{ test }
if S > '' then begin
n := Std;
if StrToInt (S, n) and (n <= Max) and (n >= Min) then Int := n
else begin
if n < Min then Int := Min
else if n > Max then Int := Max
else Int := Std;
SetEdit (Edit, IntToStr (Int));
end; { else }
end { if }
else Int := Std;
end; { GetNumeric }
procedure TFormMain.TestNumeric (Sender: TObject; var Key: char);
begin
if not ((Key in Numerics) or (Key = #8)) then Key := #0;
end; { TestNumeric }
procedure TFormMain.ResetNumeric (Edit: TEdit; Val: integer);
begin
if Edit.Text = '' then SetEdit (Edit, IntToStr (Val));
end; { ResetNumeric }
procedure TFormMain.GetFileName (var Val: string; Edit: TEdit; Min: integer);
var
S : string;
i, j : integer;
begin
if not GetEdit (S, Edit) then Exit;
j := Length (S);
{ test len }
if j >= Min then begin
for i := 1 to j do begin
{ illegal char }
if S [i] in Illegals then begin
SetEdit (Edit, Val);
Exit;
end; { if}
end; { for }
{ ok }
Val := S;
end; { if }
end; { GetFileName }
procedure TFormMain.TestFileName (Sender: TObject; var Key: char);
begin
if (Key in Illegals) and (Key <> #8) then Key := #0;
end; { TestFileName }
function TFormMain.BoxChange (Box: TComboBox; var Index: integer): boolean;
var
i : integer;
begin
Result := GetBox (i, Box) and (i >= 0) and (i <> Index);
if Result then Index := i;
end; { BoxChange }
function TFormMain.KeyBox (Box: TComboBox; var Key: word): boolean;
begin
Result := false;
if ((Key = VK_DOWN) or (Key = VK_UP)) and (not Box.DroppedDown) then begin
Box.DroppedDown := true;
Key := 0;
end { if }
else if Key = VK_RETURN then begin
Result := true;
Key := 0
end; { else }
end; { KeyBox }
procedure TFormMain.DropDownBox (Sender: TObject; var Key: word; Shift: TShiftState);
begin
if Sender is TComboBox then KeyBox (TComboBox (Sender), Key);
end; { DropDownBox }
procedure TFormMain.InitBox (Box: TComboBox; Count, Index: integer);
begin
LockField := Box;
Box.Items.Capacity := Count;
Box.DropDownCount := Count;
SetBox (Box, Index);
end; { InitBox }
procedure TFormMain.SetBox (Box: TComboBox; Index: integer);
begin
LockField := Box;
Box.ItemIndex := Index;
LockField := nil;
end; { SetBox }
function TFormMain.GetBox (var Index: integer; Box: TComboBox): boolean;
begin
if LockField <> Box then begin
Index := Box.ItemIndex;
Result := true;
end { if }
else Result := false;
end; { GetBox }
procedure TFormMain.SetCheck (Check: TButtonControl; Val: boolean);
begin
LockField := Check;
if Check is TCheckBox then TCheckBox (Check).Checked := Val
else if Check is TRadioButton then TRadioButton (Check).Checked := Val;
LockField := nil;
end; { SetCheck }
function TFormMain.GetCheck (var Val: boolean; Check: TButtonControl): boolean;
begin
if LockField <> Check then begin
if Check is TCheckBox then Val := TCheckBox (Check).Checked
else if Check is TRadioButton then Val := TRadioButton (Check).Checked;
Result := true;
end { if }
else Result := false;
end; { GetCheck }
procedure TFormMain.InitTrack (Track: TTrackBar; Min, Max, Val : integer);
begin
LockField := Track;
Track.Min := Min;
Track.Max := Max;
Track.Position := Val;
LockField := nil;
end; { InitTrack }
procedure TFormMain.GetTrack (var Val: integer; Track: TTrackBar);
begin
if LockField <> Track then Val := Track.Position;
end; { GetTrack }
(*************************************************************************)
(* main *)
(*************************************************************************)
procedure TFormMain.BoxFilesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if KeyBox (BoxFiles, Key) then Rescan;
end; { BoxFilesKeyDown }
procedure TFormMain.BoxFilesChange(Sender: TObject);
begin
if BoxChange (BoxFiles, Files) then begin
UpdateQuality;
Rescan;
end; { if }
end; { BoxFilesChange }
procedure TFormMain.EditPathKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if KeyBox (EditPath, Key) then Rescan;
end; { EditPathKeyDown }
procedure TFormMain.EditPathExit(Sender: TObject);
begin
if PathDelimiter (EditPath.Text) <> Catalog then Rescan;
end; { EditPathExit }
procedure TFormMain.EditPathChange(Sender: TObject);
begin
if BoxChange (EditPath, PathIndex) then Rescan;
end; { EditPathChange }
procedure TFormMain.ButtonPathClick (Sender: TObject);
begin
DialogCaption := 'Browse';
if SelectDirectory then begin
SetEdit (EditPath, Catalog);
Rescan;
end; { if }
end; { ButtonPathClick }
procedure TFormMain.FileListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
S : string;
begin
if LockField = FileListBox then Exit;
With FileListBox do begin
Canvas.FillRect(Rect);
S := Items [Index];
if (State = []) and isThumbnail (S)
then Canvas.Font.Color := clInactiveCaptionText;
Canvas.TextOut (Rect.Left + 2, Rect.Top, S);
end; { With }
end; { FileListBoxDrawItem }
procedure TFormMain.FileListBoxDblClick(Sender: TObject);
begin
ViewFile;
end; { FileListBoxDblClick }
procedure TFormMain.FileListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = VK_RETURN then begin
ViewFile;
Key := 0;
end; { else }
end; { FileListBoxKeyDown }
procedure TFormMain.CheckBoxPanelsClick(Sender: TObject);
var
i : integer;
begin
if LockField = CheckBoxPanels then Exit;
i := CheckBoxPanels.ItemIndex;
if (i >= 0) and (i <> PanelIndex) then begin
PanelIndex := i;
SetPanel (PanelThumbnails, fThumbnail, false, CheckThumbnailsClick);
SetPanel (PanelRename, fRename, false, nil);
SetPanel (PanelCollection, fCollection, false, CheckDuplicateClick);
end; { if }
end; { CheckBoxPanelsClick }
procedure TFormMain.CheckBoxPanelsClickCheck(Sender: TObject);
begin
if LockField <> CheckBoxPanels then begin
fThumbnail := CheckBoxPanels.Checked [PanelOrder (PanelThumbnails)];
fRename := CheckBoxPanels.Checked [PanelOrder (PanelRename)];
fCollection := CheckBoxPanels.Checked [PanelOrder (PanelCollection)];
ButtonRun.Enabled := isValid;
PanelIndex := -1;
CheckBoxPanelsClick (Self);
end; { if }
end; { CheckBoxPanelsClickCheck }
procedure TFormMain.UpdateQuality;
begin
LabelQuality.Enabled := fThumbnail and (Files = 0);
TrackThumbQuality.Enabled := LabelQuality.Enabled;
end; { UpdateQuality }
procedure TFormMain.ViewFile;
begin
With FileListBox do begin
if (ItemIndex >= 0) and (ItemIndex < Items.Count) then begin
FormViewer.View (PImageInfo (Images.Items [ItemIndex])^);
SetFocus;
end; { if }
end; { With }
end; { ViewFile }
procedure TFormMain.SetStatus (const S: string = '');
begin
if S = '' then begin
Caption := AppName + ' (files: ' + IntToStr (Images.Count) +
', thumbnails: ' + IntToStr (Images.ThumbnailCount) + ')';
FileListBox.Cursor := crDefault;
Cursor := crDefault;
end { if }
else begin
Caption := AppName + ' (' + S + '...)';
FileListBox.Cursor := crHourGlass;
Cursor := crHourGlass;
end; { else }
Application.ProcessMessages;
end; { SetStatus }
procedure TFormMain.AppActivate(Sender: TObject);
var
Time: TFileTime;
begin
{ current dir }
if (not RunAuto) and Active and CatalogTime (Time) and
(CompareFileTime (LastScan, Time) < 0)
then begin
LastScan := Time;
Rescan;
end; { if }
end; { AppActivate }
procedure TFormMain.Rescan;
var
P : PImageInfo;
w, k : integer;
i : integer;
begin
if GetEdit (Catalog, EditPath) then begin
{ init }
PathIndex := EditPath.Items.IndexOf (Catalog);
Catalog := PathDelimiter (Catalog);
{ autorescan lock }
CatalogTime (LastScan);
{ status }
SetStatus ('Scanning');
{ free }
With FileListBox do begin
Items.BeginUpdate;
Items.Clear;
end; { With }
With EditPath do begin
Items.BeginUpdate;
if PathIndex < 0 then PathIndex := Items.IndexOf (Catalog);
end; { With }
w := 0;
{ scan }
if Images.Scan then begin
{ sort }
if fSortList then Images.Sort (0, false);
{ assign }
for i := 0 to Pred (Images.Count) do begin
P := Images.List[i];
With FileListBox do begin
Items.Add (P^.Name);
k := Canvas.TextWidth (P^.Name);
end; { Width }
if k > w then w := k;
end; { for }
{ add path }
With EditPath do begin
if PathIndex < 0 then begin
PathIndex := 0;
if Items.Count >= MaxHistory then Items.Delete (Pred (Items.Count));
Items.Insert (PathIndex, Catalog);
end; { if }
end; { With }
end { if }
else begin
if PathIndex >= 0 then EditPath.Items.Delete (PathIndex);
Catalog := '';
PathIndex := -1;
end; { else }
{ restore }
SetEdit (EditPath, Catalog);
SetBox (EditPath, PathIndex);
EditPath.Items.EndUpdate;
With FileListBox do begin
SendMessage (Handle, LB_SETHORIZONTALEXTENT, w + 4, 0);
Items.EndUpdate;
Repaint;
end; { With }
SetStatus;
{ test go }
ButtonRun.Enabled := isValid;
end; { if }
end; { Rescan }
procedure TFormMain.ButtonRunClick(Sender: TObject);
begin
{ init }
if FormViewer.Visible then FormViewer.Hide;
FileListBox.Items.Clear;
SetStatus ('Running');
{ run report }
FormReport := TFormReport.Create (Self);
FormReport.Width := Width - 10;
FormReport.ShowModal;
FormReport.Free;
{ restore }
if NextFirst then SetEdit (EditFirst, IntToStr (FirstNum));
Rescan;
end; { ButtonRunClick }
procedure TFormMain.ButtonExitClick(Sender: TObject);
begin
Close;
end; { ButtonExitClick }
(*************************************************************************)
(* rename *)
(*************************************************************************)
procedure TFormMain.BoxOrderChange(Sender: TObject);
begin
GetBox (Order, BoxOrder);
end; { BoxOrderChange }
procedure TFormMain.CheckDecsClick(Sender: TObject);
begin
GetCheck (fDecs, CheckDecs);
end; { CheckDecsClick }
procedure TFormMain.EditPrefixChange(Sender: TObject);
begin
GetFileName (Prefix, EditPrefix, 0);
end; { EditPrefixChange }
procedure TFormMain.EditFirstChange(Sender: TObject);
begin
GetNumeric (EditFirst, FirstNum, MinFirst, MaxFirst, MinFirst);
end; { EditFirstChange }
procedure TFormMain.EditFirstExit(Sender: TObject);
begin
ResetNumeric (EditFirst, FirstNum);
end; { EditFirstExit }
procedure TFormMain.EditDigitsChange(Sender: TObject);
begin
GetNumeric (EditDigits, Digits, MinDigits, MaxDigits, MinDigits)
end; { EditDigitsChange }
procedure TFormMain.EditDigitsExit(Sender: TObject);
begin
ResetNumeric (EditDigits, Digits);
end; { EditDigitsExit }
procedure TFormMain.EditStepChange(Sender: TObject);
begin
GetNumeric (EditStep, StepCount, MinStep, MaxStep, MinStep);
end; { EditStepChange }
procedure TFormMain.EditStepExit(Sender: TObject);
begin
ResetNumeric (EditStep, StepCount);
end; { EditStepExit }
procedure TFormMain.EditPostfixChange(Sender: TObject);
begin
GetFileName (Postfix, EditPostfix, 0);
end; { EditPostfixChange }
procedure TFormMain.CheckReadOnlyClick(Sender: TObject);
begin
GetCheck (fAttribute, CheckReadOnly);
end; { CheckReadOnlyClick }
procedure TFormMain.CheckFileTimeClick(Sender: TObject);
begin
GetCheck (fFileTime, CheckFileTime);
end; { CheckFileTimeClick }
(*************************************************************************)
(* thumbnails *)
(*************************************************************************)
procedure TFormMain.CheckThumbnailsClick (Sender: TObject);
begin
UpdateQuality;
CheckCustomClick (Self);
CheckIncludeClick (Self);
end; { CheckThumbnailClick }
procedure TFormMain.EditMarkChange(Sender: TObject);
begin
GetFileName (Mark, EditMark, 1);
end; { EditMarkChange }
procedure TFormMain.EditMarkExit(Sender: TObject);
begin
{ new value }
if LastMark <> Mark then begin
{ new viewcount }
Images.MarkChange;
{ confirm }
if Confirm (IntTostr (Images.ThumbnailCount) +
' thumbnails with the mark "' + Mark + '" was found',
'Apply this value')
{ ok }
then begin
FileListBox.Repaint;
LastMark := Mark;
SetStatus;
end { if }
{ old value }
else begin
Mark := LastMark;
Images.MarkChange;
SetEdit (EditMark, Mark);
end; { else }
end; { if }
{ restore }
if EditMark.Text = '' then SetEdit (EditMark, Mark);
end; { EditMarkExit }
procedure TFormMain.EditMarkKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then begin
EditMarkExit (Self);
Key := #0;
end { if }
else TestFileName (Sender, Key);
end; { EditMarkKeyPress }
procedure TFormMain.TrackScaleChange(Sender: TObject);
begin
GetTrack (Scale, TrackScale);
end; { TrackScaleChange }
procedure TFormMain.TrackThumbQualityChange(Sender: TObject);
begin
GetTrack (ThumbnailQuality, TrackThumbQuality);
end; { TrackThumbQualityChange }
(*************************************************************************)
(* custom *)
(*************************************************************************)
procedure TFormMain.CheckCustomClick(Sender: TObject);
begin
if GetCheck (fCustom, CheckCustom) then begin
EnablePanel (PanelCustom, fThumbnail and fCustom);
LabelScale.Enabled := fThumbnail and (not fCustom);
TrackScale.Enabled := LabelScale.Enabled;
RadioModeClick (Self);
end; { if }
end; { CheckCustomClick }
procedure TFormMain.EditCtmWidthChange(Sender: TObject);
begin
GetNumeric (EditCtmWidth, CtmWidth, MinCustom, MaxCustom, StdCustom);
end; { EditWidthChange }
procedure TFormMain.EditCtmWidthExit(Sender: TObject);
begin
ResetNumeric (EditCtmWidth, CtmWidth);
end; { EditWidthExit }
procedure TFormMain.EditCtmHeightChange(Sender: TObject);
begin
GetNumeric (EditCtmHeight, CtmHeight, MinCustom, MaxCustom, StdCustom);
end; { EditHeightChange }
procedure TFormMain.EditCtmHeightExit(Sender: TObject);
begin
ResetNumeric (EditCtmHeight, CtmHeight);
end; { EditHeightExit }
procedure TFormMain.RadioModeClick(Sender: TObject);
begin
if GetCheck (CtmMode, RadioFill)
then ButtonColor.Enabled := fThumbnail and fCustom and CtmMode;
end; { RadioModeClick }
procedure TFormMain.ButtonAlignClick(Sender: TObject);
var
i : integer;
begin
FormAlign := TFormAlign.Create (Self);
With FormAlign do begin
TRadioButton (PanelHor.Controls [AnchorX]).Checked := true;
TRadioButton (PanelVer.Controls [AnchorY]).Checked := true;
if ShowModal = mrOk then begin
for i := MinAnchor to MaxAnchor do begin
if TRadioButton (PanelHor.Controls [i]).Checked then AnchorX := i;
if TRadioButton (PanelVer.Controls [i]).Checked then AnchorY := i;
end; { for }
end; { if };
Free;
end; { With }
end; { ButtonLocateClick }
procedure TFormMain.ButtonColorClick(Sender: TObject);
begin
ColorDialog.Color := FillColor;
DialogCaption := 'Color';
if ColorDialog.Execute then FillColor := ColorDialog.Color;
end; { ButtonColorClick }
(*************************************************************************)
(* include *)
(*************************************************************************)
procedure TFormMain.CheckIncludeClick(Sender: TObject);
begin
if GetCheck (fInclude, CheckInclude) then EnablePanel (PanelInclude, fInclude and fThumbnail);
end; { CheckIncludeClick }
procedure TFormMain.EditTextChange(Sender: TObject);
begin
GetEdit (Comment, EditText);
end; { EditTextChange }
procedure TFormMain.CheckImageClick(Sender: TObject);
begin
GetCheck (fImgSize, CheckImage);
end; { CheckImageClick }
procedure TFormMain.CheckFileClick(Sender: TObject);
begin
GetCheck (fFilSize, CheckFile);
end; { CheckFileClick }
procedure TFormMain.ButtonFontClick(Sender: TObject);
begin
DialogCaption := 'Font';
With FontDialog do if Execute then FontToParms (Font);
end; { ButtonFontClick }
procedure TFormMain.ButtonGroundClick(Sender: TObject);
begin
DialogCaption := 'BGround';
ColorDialog.Color := BGround;
if ColorDialog.Execute then BGround := ColorDialog.Color;
end; { ButtonGroundClick }
procedure TFormMain.FontDialogShow(Sender: TObject);
begin
UpdateDialog (FontDialog.Handle, Left + 16, Top + 25);
end; { FontDialogShow }
procedure TFormMain.ColorDialogShow(Sender: TObject);
begin
UpdateDialog (ColorDialog.Handle, Left + 10, Top + 25);
end; { ColorDialogShow }
(*************************************************************************)
(* collection *)
(*************************************************************************)
procedure TFormMain.CheckDuplicateClick(Sender: TObject);
begin
if GetCheck (fDuplicate, CheckDuplicate) then begin
LabelLike.Enabled := fCollection and fDuplicate;
TrackLike.Enabled := LabelLike.Enabled;
end; { if }
end; { CheckDuplicateClick }
procedure TFormMain.TrackLikeChange(Sender: TObject);
begin
GetTrack (Likeness, TrackLike);
end; { TrackLikeChange }
procedure TFormMain.CheckDescriptionClick(Sender: TObject);
begin
GetCheck (fDescription, CheckDescription);
end; { CheckDescriptionClick }
End.