unit uMain;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.ExtCtrls,
Vcl.ComCtrls,
Vcl.Imaging.jpeg,
Vcl.Imaging.pngimage,
Vcl.Imaging.GIFImg;
type
TfrmMain =
class(TForm)
pnlImages: TPanel;
pnlImgB: TPanel;
pnlImgA: TPanel;
ImgA: TImage;
ImgB: TImage;
btnGo: TButton;
pnlOptions: TPanel;
cbReset: TCheckBox;
lblFileA: TLabel;
lblFileB: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure btnGoClick(Sender: TObject);
procedure ImgAClick(Sender: TObject);
procedure ImgBClick(Sender: TObject);
private
{ Private declarations }
FFileA, FFileB:
string;
FFormA, FFormB: TForm;
FImageA, FImageB: TImage;
FTrackBarA, FTrackBarB: TTrackBar;
function GetImageFilename:
string;
procedure TrackBarAChange(Sender: TObject);
procedure TrackBarBChange(Sender: TObject);
procedure FormAClose(Sender: TObject;
var Action: TCloseAction);
procedure FormBClose(Sender: TObject;
var Action: TCloseAction);
procedure FormAKeyPress(Sender: TObject;
var Key: Char);
procedure FormBKeyPress(Sender: TObject;
var Key: Char);
procedure ResetForms;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
resourcestring
FileAText =
string('
Press left box to select a file.');
FileBText =
string('
Press right box to select a file.');
FileError =
string('
File format error!');
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FFormA := TForm.Create(Self);
try
FFormA.Parent := Self.Parent;
FFormA.Height := 800;
FFormA.Width := 800;
FFormA.Position := poScreenCenter;
FFormA.BorderStyle := bsSizeToolWin;
FFormA.AlphaBlend := True;
FFormA.Visible := False;
FFormA.KeyPreview := True;
FFormA.OnClose := FormAClose;
FFormA.OnKeyPress := FormAKeypress;
FImageA := TImage.Create(FFormA);
try
FImageA.Parent := FFormA;
FImageA.Align := alClient;
FImageA.IncrementalDisplay := True;
FImageA.Center := True;
FImageA.Stretch := True;
FTrackBarA := TTrackBar.Create(FFormA);
try
FTrackBarA.Parent := FFormA;
FTrackBarA.Align := alBottom;
FTrackBarA.Max := 255;
FTrackBarA.Min := 15;
FTrackBarA.Position := 255;
FTrackBarA.Frequency := 25;
FTrackBarA.OnChange := TrackBarAChange;
finally
end;
finally
end;
finally
end;
FFormB := TForm.Create(Self);
try
FFormB.Parent := Self.Parent;
FFormB.Height := 800;
FFormB.Width := 800;
FFormB.Position := poScreenCenter;
FFormB.BorderStyle := bsSizeToolWin;
FFormB.AlphaBlend := True;
FFormB.Visible := False;
FFormB.KeyPreview := True;
FFormB.OnClose := FormBClose;
FFormB.OnKeyPress := FormBKeypress;
FImageB := TImage.Create(FFormB);
try
FImageB.Parent := FFormB;
FImageB.Align := alClient;
FImageB.IncrementalDisplay := True;
FImageB.Center := True;
FImageB.Stretch := True;
FTrackBarB := TTrackBar.Create(FFormB);
try
FTrackBarB.Parent := FFormB;
FTrackBarB.Align := alBottom;
FTrackBarB.Max := 255;
FTrackBarB.Min := 15;
FTrackBarB.Position := 255;
FTrackBarB.Frequency := 25;
FTrackBarB.OnChange := TrackBarBChange;
finally
end;
finally
end;
finally
end;
lblFileA.Caption := FileAText;
lblFileB.Caption := FileBText;
ImgA.Picture.WICImage.LoadFromResourceName(HInstance, '
DefaultImage');
ImgA.Repaint;
ImgB.Picture.WICImage.LoadFromResourceName(HInstance, '
DefaultImage');
ImgB.Repaint;
end;
procedure TfrmMain.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
FTrackBarA.Free;
FTrackBarB.Free;
FImageA.Free;
FImageB.Free;
FFormA.Free;
FFormB.Free;
Action := caFree;
end;
procedure TfrmMain.FormAClose(Sender: TObject;
var Action: TCloseAction);
begin
if FFormB.Visible
then
FFormB.Visible := False;
FFormA.Visible := False;
Action := caNone;
end;
procedure TfrmMain.FormBClose(Sender: TObject;
var Action: TCloseAction);
begin
if FFormA.Visible
then
FFormA.Visible := False;
FFormB.Visible := False;
Action := caNone;
end;
procedure TfrmMain.FormAKeyPress(Sender: TObject;
var Key: Char);
begin
case Key
of
Char(VK_ESCAPE): FFormA.Close;
Char(VK_SPACE) :
begin
FFormB.BringToFront;
FFormB.SetFocus;
end;
end;
end;
procedure TfrmMain.FormBKeyPress(Sender: TObject;
var Key: Char);
begin
case Key
of
Char(VK_ESCAPE): FFormB.Close;
Char(VK_SPACE) :
begin
FFormA.BringToFront;
FFormA.SetFocus;
end;
end;
end;
procedure TfrmMain.TrackBarAChange(Sender: TObject);
begin
FFormA.AlphaBlendValue := (Sender
As TTrackBar).Position
end;
procedure TfrmMain.TrackBarBChange(Sender: TObject);
begin
FFormB.AlphaBlendValue := (Sender
As TTrackBar).Position
end;
function TfrmMain.GetImageFilename:
string;
const CFilter =
string(
'
All Files (*.*)|*.*|'+
'
All internal Image types|*.gif;*.jpg;*.jpeg;*.png;*.bmp;*.ico;*.emf;*.wmf;*.tif;*.tiff|'+
'
GIF Images|*.gif|'+
'
JPEG Images|*.jpg;*.jpeg|'+
'
Portable Network Graphics|*.png|'+
'
Bitmaps|*.bmp|'+
'
Icons|*.ico|'+
'
Enhanced Metafiles|*.emf|'+
'
Metafiles|*.wmf|'+
'
TIFF Images|*.tif;*.tiff'
);
var
dlg: TOpenDialog;
begin
Result := '
';
dlg := TOpenDialog.Create(Self);
try
dlg.Options := [ofReadOnly, ofPathMustExist, ofFileMustExist, ofShareAware, ofNoTestFileCreate, ofNoDereferenceLinks, ofEnableSizing, ofDontAddToRecent, ofForceShowHidden];
dlg.Filter := CFilter;
dlg.FilterIndex := 2;
dlg.Title := '
Select a valid image file.';
if dlg.Execute(Self.Handle)
then
Result := dlg.FileName;
finally
dlg.Free;
end;
end;
procedure TfrmMain.ImgAClick(Sender: TObject);
var
s:
string;
begin
s := GetImageFilename;
try
ImgA.Picture.WICImage.LoadFromFile(s);
ImgA.Repaint;
except
ImgA.Picture.WICImage.LoadFromResourceName(HInstance, '
DefaultImage');
ImgA.Repaint;
s := '
';
end;
if (s <> '
')
then
lblFileA.Caption := s
else
lblFileA.Caption := FileAText;
lblFileA.Hint := lblFileA.Caption;
end;
procedure TfrmMain.ImgBClick(Sender: TObject);
var
s:
string;
begin
s := GetImageFilename;
try
ImgB.Picture.WICImage.LoadFromFile(s);
ImgB.Repaint;
except
ImgB.Picture.WICImage.LoadFromResourceName(HInstance, '
DefaultImage');
ImgB.Repaint;
s := '
';
end;
if (s <> '
')
then
lblFileB.Caption := s
else
lblFileB.Caption := FileBText;
lblFileB.Hint := lblFileB.Caption;
end;
procedure TfrmMain.ResetForms;
begin
FFormA.Position := poDesigned;
FFormB.Position := poDesigned;
FFormA.Top := 0;
FFormB.Top := 0;
FFormA.Width := 800;
FFormA.Height := 800;
FFormB.Width := 800;
FFormB.Height := 800;
FTrackBarA.Position := 255;
FTrackBarB.Position := 255;
FFormA.Position := poScreenCenter;
FFormB.Position := poScreenCenter;
end;
procedure TfrmMain.btnGoClick(Sender: TObject);
begin
if FFormA.Visible
then
FFormA.Visible := False;
if FFormB.Visible
then
FFormB.Visible := False;
if (
not FileExists(lblFileA.Caption))
then
ImgAClick(Sender);
FFileA := lblFileA.Caption;
if (
not FileExists(FFileA))
then
begin
lblFileA.Caption := FileError;
lblFileA.Hint := FFileA;
Exit;
end;
if (
not FileExists(lblFileB.Caption))
then
ImgBClick(Sender);
FFileB := lblFileB.Caption;
if (
not FileExists(FFileB))
then
begin
lblFileB.Caption := FileError;
lblFileB.Hint := FFileB;
Exit;
end;
try
FImageA.Picture.WICImage.Assign(ImgA.Picture.WICImage);
except
lblFileA.Caption := FileError;
lblFileA.Hint := FFileA;
Exit;
end;
try
FImageB.Picture.WICImage.Assign(ImgB.Picture.WICImage);
except
lblFileB.Caption := FileError;
lblFileB.Hint := FFileB;
Exit;
end;
FImageA.Repaint;
FImageB.Repaint;
if (UpperCase(ExtractFilePath(FFileA)) = UpperCase(ExtractFilePath(FFileB)))
then
begin
FFormA.Caption := ExtractFileName(FFileA);
FFormB.Caption := ExtractFileName(FFileB);
end
else
begin
FFormA.Caption := FFileA;
FFormB.Caption := FFileB;
end;
if cbReset.Checked
then
ResetForms;
FFormA.Visible := True;
FFormB.Visible := True;
end;
end.