Delphi-PRAXiS - Gescanntes Bild transparent machen

Zitat:
Zitat von Andreas13 (Beitrag 1512668)
Danke! :thumb: :thumb:
Grüße, Andreas
Immer wieder gerne, ich hab es nun als "Vollprodukt" umgesetzt, also die letzte Evolutionsstufe sozusagen :P

Änderungen:
Nun hat man bereits im Hauptform 2 kleine Bilder sichtbar.
Ein klick auf ein Bild öffnet einen Dialog zur Dateiauswahl oder man drückt wie gehabt auf den fetten Knopf :-D
Auf die WIC-Engine umgestellt um noch mehr Formate zu unterstützen.

Hier der komplette Quelltext:
Delphi-Quellcode:
			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.
Im Anhang ein 32bit Kompilat um es sofort zu testen.