BSOne.SFC/EM.Lib/ImageEn_SRC/Demos/ImageEditing/Dithering/umain.pas

unit umain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ieview, imageenview, ExtCtrls, ComCtrls, hyieutils, 
  iexBitmaps, hyiedefs, iesettings, iexLayers, iexRulers;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Panel1: TPanel;
    ImageEnView1: TImageEnView;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    LabelPaletteSize: TLabel;
    ListBoxPixelFormat: TListBox;
    ListBoxPaletteType: TListBox;
    ListBoxDitherType: TListBox;
    Label5: TLabel;
    miSaveAs: TMenuItem;
    Splitter1: TSplitter;
    procedure Open1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ListBoxPixelFormatClick(Sender: TObject);
    procedure ListBoxPaletteTypeClick(Sender: TObject);
    procedure ListBoxDitherTypeClick(Sender: TObject);
    procedure miSaveAsClick(Sender: TObject);
  private
    { Private declarations }
    function ProcessImage(PixelFormatIdx, PaletteTypeIdx, DitherTypeIdx: integer): boolean;
    procedure FillListBoxPaletteType();
    procedure FillListBoxDitherType();
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses
  imageenproc;

{$R *.DFM}
{$R WindowsTheme.res}


procedure TMainForm.FormActivate(Sender: TObject);
begin
  ImageEnView1.LegacyBitmap := False;
  if FileExists('lena.jpg') then
    ImageEnView1.IO.LoadFromFile('lena.jpg');
end;


// File Open
procedure TMainForm.Open1Click(Sender: TObject);
begin
  with ImageEnView1.IO do
    LoadFromFile(ExecuteOpenDialog('', '', false, 1, ''));
  ListBoxPixelFormat.ItemIndex := -1;
  ListBoxPaletteType.ItemIndex := -1;
  ListBoxDitherType.ItemIndex  := -1;
  FillListBoxPaletteType();
  FillListBoxDitherType();
end;


const
  PixelFormats: array [0..2] of TIEPixelFormat = (ie1g, ie8g, ie8p);

  PaletteTypeStr: array [TIEPaletteType] of string = ('Median Cut', 'Fixed BW', 'Fixed Halftone 8', 'Fixed Halftone 27', 'Fixed Halftone 64',
                                                      'Fixed Halftone 125', 'Fixed Web Palette', 'Fixed Halftone 252', 'Fixed Halftone 256',
                                                      'Fixed Gray 4', 'Fixed Gray 16', 'Fixed Gray 256');

  DitherTypeStr: array [TIEDitherType] of string = ('Solid', 'Ordered 4x4', 'Ordered 8x8', 'Ordered 16x16', 'Spiral 4x4',
                                                    'Spiral 8x8', 'DualSpiral 4x4', 'DualSpiral 8x8', 'Error Diffusion');


function TMainForm.ProcessImage(PixelFormatIdx, PaletteTypeIdx, DitherTypeIdx: integer): boolean;
begin
  result := false;
  if (PixelFormatIdx > -1) and (PaletteTypeIdx > -1) and (DitherTypeIdx > -1) then
  begin
    ImageEnView1.Proc.Undo();
    result := ImageEnView1.Proc.ConvertTo(PixelFormats[PixelFormatIdx], TIEPaletteType(PaletteTypeIdx), TIEDitherType(DitherTypeIdx));
    if not result then
      LabelPaletteSize.Caption := 'Error!'
    else
    if ImageEnView1.IEBitmap.PixelFormat = ie8p then
      LabelPaletteSize.Caption := IntToStr(ImageEnView1.IEBitmap.PaletteUsed)
    else
      LabelPaletteSize.Caption := 'None';
  end;
end;


procedure TMainForm.FillListBoxPaletteType();
var
  PixelFormatIdx: integer;
  pt: TIEPaletteType;
begin
  ListBoxPaletteType.Clear();
  PixelFormatIdx := ListBoxPixelFormat.ItemIndex;
  if PixelFormatIdx > -1 then
  begin
    ImageEnView1.Proc.Undo();
    for pt := Low(PaletteTypeStr) to High(PaletteTypeStr) do
    begin
      if ImageEnView1.Proc.ConvertTo(PixelFormats[PixelFormatIdx], pt, iedtSolid, true) then
        ListBoxPaletteType.Items.Add(PaletteTypeStr[pt])
      else
        ListBoxPaletteType.Items.Add('');
    end;
  end;
end;


procedure TMainForm.FillListBoxDitherType();
var
  PixelFormatIdx, PaletteTypeIdx: integer;
  dt: TIEDitherType;
begin
  ListBoxDitherType.Clear();
  PixelFormatIdx := ListBoxPixelFormat.ItemIndex;
  PaletteTypeIdx := ListBOxPaletteType.ItemIndex;
  if (PixelFormatIdx > -1) and (PaletteTypeIdx > -1) then
  begin
    ImageEnView1.Proc.Undo();
    for dt := Low(DitherTypeStr) to High(DitherTypeStr) do
    begin
      if ImageEnView1.Proc.ConvertTo(PixelFormats[PixelFormatIdx], TIEPaletteType(PaletteTypeIdx), dt, true) then
        ListBoxDitherType.Items.Add(DitherTypeStr[dt])
      else
        ListBoxDitherType.Items.Add('');
    end;
  end;
end;


procedure TMainForm.ListBoxPixelFormatClick(Sender: TObject);
begin
  FillListBoxPaletteType();
  ListBoxDitherType.ItemIndex := -1;
  ProcessImage(ListBoxPixelFormat.ItemIndex, ListBoxPaletteType.ItemIndex, ListBoxDitherType.ItemIndex);
end;


procedure TMainForm.ListBoxPaletteTypeClick(Sender: TObject);
begin
  FillListBoxDitherType();
  ProcessImage(ListBoxPixelFormat.ItemIndex, ListBoxPaletteType.ItemIndex, ListBoxDitherType.ItemIndex);
end;


procedure TMainForm.ListBoxDitherTypeClick(Sender: TObject);
begin
  ProcessImage(ListBoxPixelFormat.ItemIndex, ListBoxPaletteType.ItemIndex, ListBoxDitherType.ItemIndex);
end;

procedure TMainForm.miSaveAsClick(Sender: TObject);
var
  sFilename: string;
begin
  sFilename := ImageEnView1.IO.ExecuteSaveDialog;
  if sFilename <> '' then
    ImageEnView1.IO.SaveToFile(sFileName);  
end;

end.