Einzelnen Beitrag anzeigen

Benutzerbild von KodeZwerg
KodeZwerg
Online

Registriert seit: 1. Feb 2018
3.574 Beiträge
 
Delphi 11 Alexandria
 
#22

AW: Gescanntes Bild transparent machen – Grafikprogramm gesucht

  Alt 29. Sep 2022, 18:17
Danke!
Grüße, Andreas
Immer wieder gerne, ich hab es nun als "Vollprodukt" umgesetzt, also die letzte Evolutionsstufe sozusagen

Ä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
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.
Angehängte Dateien
Dateityp: zip LayeredImage.zip (1,04 MB, 1x aufgerufen)
Gruß vom KodeZwerg

Geändert von KodeZwerg (29. Sep 2022 um 22:33 Uhr) Grund: fixed
  Mit Zitat antworten Zitat