BINARISATION D'IMAGES

unit MainFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgUtils, ExtDlgs, JPEG, ExtCtrls, Buttons, StdCtrls, ComCtrls,
  MedianBoxFilterFrameUnit, ChannelExtractFrameUnit, RGB2HSVFrameUnit,
  HSV2RGBFrameUnit, RGB2LuminanceFrameUnit, BinarizeFrameUnit,
  GradientNormFrameUnit, TresholdFrameUnit, FilterFrameUnit,
  Menus, ToolWin, ImgList;

type
  TMainForm = class(TForm)
    OpenPictureDialog1: TOpenPictureDialog;
    Panel1: TPanel;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    PopupMenu1: TPopupMenu;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    Panel2: TPanel;
    GroupBox2: TGroupBox;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ImageList1: TImageList;
    ToolButton5: TToolButton;
    Panel3: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ScrollBox1: TScrollBox;
    PaintBox1: TPaintBox;
    TabSheet2: TTabSheet;
    ScrollBox2: TScrollBox;
    PaintBox2: TPaintBox;
    TabSheet3: TTabSheet;
    ScrollBox3: TScrollBox;
    PaintBox3: TPaintBox;
    GroupBox3: TGroupBox;
    TrackBar1: TTrackBar;
    GroupBox4: TGroupBox;
    TrackBar2: TTrackBar;
    MainMenu1: TMainMenu;
    Fichier1: TMenuItem;
    Exporterlachanedefiltres1: TMenuItem;
    Importerunechanedefiltres1: TMenuItem;
    Lancerlachane1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox2Paint(Sender: TObject);
    procedure PaintBox3Paint(Sender: TObject);
    procedure Lancerlachane1Click(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure Exporterlachanedefiltres1Click(Sender: TObject);
    procedure Importerunechanedefiltres1Click(Sender: TObject);
  private
    FSrcBitmap,FDstBitmap,FPreviewBitmap:TBitmap;
  public
    procedure RegisterFilter(FilterClass:TFilterFrameClass);
    procedure FilterMenuItemClick(Sender:TObject);

    procedure UpdateGUI;
    procedure UpdatePreview;

    function GetZoomRect:TRect;

    procedure ResetProcess;
    procedure Process;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  SpeedButton1.Align:=alRight;
  Edit1.Align:=alRight;
  FSrcBitmap:=TBitmap.Create;
  FDstBitmap:=TBitmap.Create;
  FPreviewBitmap:=TBitmap.Create;
  RegisterFilter(TMedianBoxFilterFrame);
  RegisterFilter(TChannelExtractFrame);
  RegisterFilter(TRGB2HSVFrame);
  RegisterFilter(THSV2RGBFrame);
  RegisterFilter(TRGB2LuminanceFrame);
  RegisterFilter(TBinarizeFrame);
  RegisterFilter(TGradientNormFrame);
  RegisterFilter(TTresholdFrame);
end;

procedure TMainForm.SpeedButton1Click(Sender: TObject);
var
  p:TBitmap;
begin
  if OpenPictureDialog1.Execute then begin
    Edit1.Text:=OpenPictureDialog1.FileName;
    p:=LoadBitmapFromFile(OpenPictureDialog1.FileName);
    FSrcBitmap.Destroy;
    FSrcBitmap:=p;
    UpdatePreview;
    ResetProcess;
    Lancerlachane1.Enabled:=(FSrcBitmap.Width>0) and (FSrcBitmap.Height>0);
  end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FSrcBitmap.Destroy;
  FDstBitmap.Destroy;
  FPreviewBitmap.Destroy;
end;

procedure TMainForm.RegisterFilter(FilterClass: TFilterFrameClass);
var
  m:TMenuItem;
begin
  m:=TMenuItem.Create(Self);
  m.Caption:=FilterClass.Caption;
  m.Tag:=Integer(FilterClass);
  m.OnClick:=FilterMenuItemClick;
  PopupMenu1.Items.Add(m);
  RegisterClass(FilterClass);
end;

procedure TMainForm.UpdateGUI;
begin
  if ListBox1.ItemIndex>-1 then begin
    while GroupBox2.ControlCount>0 do
      GroupBox2.Controls[0].Parent:=nil;
    with TFilterFrame(ListBox1.Items.Objects[ListBox1.ItemIndex]) do begin
      Align:=alClient;
      Parent:=GroupBox2;
    end;
    ToolButton2.Enabled:=True;
  end else
    ToolButton2.Enabled:=False;
  ToolButton4.Enabled:=ListBox1.ItemIndex>0;
  ToolButton5.Enabled:=(ListBox1.ItemIndex>-1) and (ListBox1.ItemIndex<ListBox1.Count-1);
  UpdatePreview;
end;

procedure TMainForm.FilterMenuItemClick(Sender: TObject);
var
  f:TFrame;
begin
  with TFilterFrameClass(TMenuItem(Sender).Tag) do begin
    f:=Create(ListBox1);
    f.Name:='';
    ListBox1.ItemIndex:=ListBox1.Items.AddObject(Caption,f);
  end;
  UpdateGUI;
end;

procedure TMainForm.ListBox1Click(Sender: TObject);
begin
  UpdateGUI;
end;

procedure TMainForm.ToolButton2Click(Sender: TObject);
var
  a:Integer;
begin
  a:=ListBox1.ItemIndex;
  ListBox1.Items.Objects[a].Destroy;
  ListBox1.Items.Delete(a);
  if a>=ListBox1.Items.Count then
    Dec(a);
  ListBox1.ItemIndex:=a;
  UpdateGUI;
end;

procedure TMainForm.ToolButton4Click(Sender: TObject);
begin
  ListBox1.Items.Exchange(ListBox1.ItemIndex,ListBox1.ItemIndex-1);
  UpdateGUI;
end;

procedure TMainForm.ToolButton5Click(Sender: TObject);
begin
  ListBox1.Items.Exchange(ListBox1.ItemIndex,ListBox1.ItemIndex+1);
  UpdateGUI;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  TrackBar1.SetTick(0);
  Lancerlachane1.ImageIndex:=4;
end;

procedure TMainForm.TrackBar1Change(Sender: TObject);
begin
  UpdatePreview;
end;

procedure TMainForm.UpdatePreview;
var
  r:TRect;
begin
  r:=GetZoomRect;
  PaintBox1.BoundsRect:=r;
  PaintBox1.Invalidate;
  PaintBox2.BoundsRect:=r;
  PaintBox2.Invalidate;
  PaintBox3.BoundsRect:=r;
  PaintBox3.Invalidate;
end;

function TMainForm.GetZoomRect: TRect;
const
  T:array[-5..5] of Single=(0.1,0.2,0.3,0.5,0.75,1,1.5,2,3,5,10);
begin
  Result.TopLeft:=Point(0,0);
  Result.Right:=Round(FSrcBitmap.Width*T[TrackBar1.Position]);
  Result.Bottom:=Round(FSrcBitmap.Height*T[TrackBar1.Position]);
end;

procedure TMainForm.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.StretchDraw(GetZoomRect,FSrcBitmap);
end;

procedure TMainForm.PaintBox2Paint(Sender: TObject);
begin
  PaintBox2.Canvas.StretchDraw(GetZoomRect,FDstBitmap);
end;

procedure TMainForm.PaintBox3Paint(Sender: TObject);
var
  BF:TBlendFunction;
begin
  FPreviewBitmap.Width:=FSrcBitmap.Width;
  FPreviewBitmap.Height:=FSrcBitmap.Height;
  FPreviewBitmap.Canvas.Draw(0,0,FSrcBitmap);
  with BF do begin
    BlendOp:=AC_SRC_OVER;
    BlendFlags:=0;
    SourceConstantAlpha:=TrackBar2.Position;
    AlphaFormat:=0;
  end;
  with FDstBitmap do
    Windows.AlphaBlend(FPreviewBitmap.Canvas.Handle,0,0,FPreviewBitmap.Width,FPreviewBitmap.Height,Canvas.Handle,0,0,Width,Height,BF);
  PaintBox3.Canvas.StretchDraw(GetZoomRect,FPreviewBitmap);
end;

procedure TMainForm.Process;
var
  p:TBitmapData;
  a:Integer;
begin
  p:=TBitmapData.CreateAsRGB(FSrcBitmap);
  try
    for a:=0 to ListBox1.Items.Count-1 do
      with TFilterFrame(ListBox1.Items.Objects[a]) do
        try
          Filter(p);
        except
          on e:Exception do begin
            Messagebox(0,PChar('Le filtre "'+Caption+'" n°'+IntToStr(a)+' a provoqué une erreur: '#13+e.Message),PChar('Exception '+e.ClassName),MB_ICONERROR);
            raise;
          end;
        else
          Messagebox(0,PChar('Le filtre "'+Caption+'" n°'+IntToStr(a)+' a provoqué une erreur non spécifiée'),PChar('Exception inconnue'),MB_ICONERROR);
          raise;
        end;
    p.WriteToBitmap(FDstBitmap);
  finally
    p.Destroy;
    UpdatePreview;
  end;
end;

procedure TMainForm.ResetProcess;
begin
  FDstBitmap.Width:=0;
  FDstBitmap.Height:=0;
  UpdatePreview;
end;

procedure TMainForm.Lancerlachane1Click(Sender: TObject);
begin
  Process;
end;

procedure TMainForm.TrackBar2Change(Sender: TObject);
begin
  PaintBox3Paint(nil);
end;

procedure TMainForm.Exporterlachanedefiltres1Click(Sender: TObject);
var
  f:TFileStream;
  a,b:Integer;
  s:string;
begin
  if SaveDialog1.Execute then begin
    f:=TFileStream.Create(SaveDialog1.FileName,fmOpenWrite or fmCreate);
    try
      f.Seek(0,soFromBeginning);
      for a:=0 to ListBox1.Items.Count-1 do begin
        s:=ListBox1.Items.Objects[a].ClassName;
        b:=Length(s);
        f.Write(b,SizeOf(b));
        f.Write(s[1],b);
        f.WriteComponent(ListBox1.Items.Objects[a] as TComponent);
      end;
    finally
      f.Destroy;
    end;
  end;
end;

procedure TMainForm.Importerunechanedefiltres1Click(Sender: TObject);
var
  f:TFileStream;
  g:TFilterFrame;
  a:Integer;
  s:string;
begin
  if OpenDialog1.Execute then begin
    f:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
    try
      for a:=0 to ListBox1.Items.Count-1 do
        ListBox1.Items.Objects[a].Destroy;
      ListBox1.Items.Clear;
      ListBox1.ItemIndex:=-1;
      f.Seek(0,soFromBeginning);
      while f.Position<f.Size do begin
        f.Read(a,SizeOf(a));
        SetLength(s,a);
        f.Read(s[1],a);
        g:=TFilterFrameClass(GetClass(s)).Create(nil);
        g.DestroyComponents;
        g.Name:='';
        f.ReadComponent(g);
        ListBox1.Items.AddObject(g.Caption,g);
      end;
    finally
      f.Destroy;
      UpdateGUI;
    end;
  end;
end;

end.

Télécharger le zip