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.ExtDlgs,
Vcl.Imaging.jpeg,
Vcl.Imaging.pngimage,
Vcl.Imaging.GIFImg;
type
TfrmMain =
class(TForm)
pnlOptions: TPanel;
btnGo: TButton;
cbReset: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure btnGoClick(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}
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.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.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;
end;
procedure TfrmMain.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
FTrackBarB.Free;
FImageB.Free;
FFormB.Free;
FTrackBarA.Free;
FImageA.Free;
FFormA.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(
'
Alle Dateien (*.*)|*.*|'+
'
Alle Bilder|*.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 := [ofPathMustExist, ofFileMustExist, ofDontAddToRecent, ofForceShowHidden];
dlg.Filter := CFilter;
dlg.FilterIndex := 2;
dlg.Title := '
Bitte wählen Sie eine gültige Bild-Datei aus.';
if dlg.Execute(Self.Handle)
then
Result := dlg.FileName;
finally
dlg.Free;
end;
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;
FFileA := GetImageFilename;
if FFileA = '
'
then
Exit;
FFileB := GetImageFilename;
if FFileB = '
'
then
Exit;
try
FImageA.Picture.LoadFromFile(FFileA);
except
Exit;
end;
try
FImageB.Picture.LoadFromFile(FFileB);
except
Exit;
end;
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.