2292 lines
69 KiB
Plaintext
2292 lines
69 KiB
Plaintext
//------------------------------------------------------------------------------
|
|
// ImageEn Painter : Version 1.0
|
|
// Copyright (c) 2007 : Adirondack Software & Graphics
|
|
// Created : 05-25-2007
|
|
// Last Modification : 05-25-2007
|
|
// Description : Main Unit
|
|
//------------------------------------------------------------------------------
|
|
|
|
unit umain;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
Menus, ieview, imageenview, ExtCtrls, StdCtrls, Buttons, ComCtrls, ImgList,
|
|
ToolWin, ExtDlgs, ieopensavedlg, IniFiles, ActnList, hyieutils, iexBitmaps,
|
|
hyiedefs, iesettings, iexLayers, iexRulers;
|
|
|
|
type
|
|
TFrmMain = class ( TForm )
|
|
ImageEnView1: TImageEnView;
|
|
ScrollBar1: TScrollBar;
|
|
ColorDialog1: TColorDialog;
|
|
PageControl1: TPageControl;
|
|
PaintTab: TTabSheet;
|
|
DrawTab: TTabSheet;
|
|
ImageList1: TImageList;
|
|
StatusBar1: TStatusBar;
|
|
TabSheet1: TTabSheet;
|
|
PageControl2: TPageControl;
|
|
FileTab2: TTabSheet;
|
|
FileToolBar: TToolBar;
|
|
New1: TToolButton;
|
|
Open2: TToolButton;
|
|
Save1: TToolButton;
|
|
SaveAs: TToolButton;
|
|
ToolButton5: TToolButton;
|
|
Exit: TToolButton;
|
|
EditTab2: TTabSheet;
|
|
SelectTab2: TTabSheet;
|
|
HelpTab2: TTabSheet;
|
|
EditToolBar: TToolBar;
|
|
Undo1: TToolButton;
|
|
Redo1: TToolButton;
|
|
Cut1: TToolButton;
|
|
SelectToolBar: TToolBar;
|
|
SelectRectangle1: TToolButton;
|
|
SelectEllipse1: TToolButton;
|
|
SelectNone1: TToolButton;
|
|
ConvertTab2: TTabSheet;
|
|
ConvertToolBar: TToolBar;
|
|
ConvertTo32Bit1: TToolButton;
|
|
ConvertTo24Bit1: TToolButton;
|
|
ConvertTo8Bit1: TToolButton;
|
|
ConvertTo4Bit1: TToolButton;
|
|
HelpToolBar: TToolBar;
|
|
About1: TToolButton;
|
|
HomePage1: TToolButton;
|
|
SelectZoom1: TToolButton;
|
|
Copy1: TToolButton;
|
|
Paste1: TToolButton;
|
|
ToolButton7: TToolButton;
|
|
Resize1: TToolButton;
|
|
Resample1: TToolButton;
|
|
Crop1: TToolButton;
|
|
Rotate1: TToolButton;
|
|
Flip1: TToolButton;
|
|
OpenPictureDialog1: TOpenPictureDialog;
|
|
SavePictureDialog1: TSavePictureDialog;
|
|
ToolButton2: TToolButton;
|
|
SelectLasso1: TToolButton;
|
|
ToolBar8: TToolBar;
|
|
Undo2: TToolButton;
|
|
Redo2: TToolButton;
|
|
ToolButton6: TToolButton;
|
|
ImageList2: TImageList;
|
|
ImageList3: TImageList;
|
|
SelectPolygon1: TToolButton;
|
|
SelectMagicWand1: TToolButton;
|
|
GroupBox2: TGroupBox;
|
|
MagicWandTolerance1: TEdit;
|
|
Label10: TLabel;
|
|
UpDown2: TUpDown;
|
|
IEMagicWandMode1: TComboBox;
|
|
Label11: TLabel;
|
|
MagicWandMaxFilter1: TCheckBox;
|
|
TabSheet7: TTabSheet;
|
|
GroupBox3: TGroupBox;
|
|
DisplayGrid1: TCheckBox;
|
|
BMP_HandleTransparency1: TCheckBox;
|
|
EnableAlphaChannel1: TCheckBox;
|
|
GroupBox4: TGroupBox;
|
|
Label6: TLabel;
|
|
PaintColor: TPanel;
|
|
Label1: TLabel;
|
|
TransparentColor: TPanel;
|
|
Filled1: TCheckBox;
|
|
GroupBox5: TGroupBox;
|
|
Label7: TLabel;
|
|
FillTolerance1: TEdit;
|
|
Updown7: TUpDown;
|
|
GroupBox6: TGroupBox;
|
|
GroupBox7: TGroupBox;
|
|
Label2: TLabel;
|
|
BrushSize: TEdit;
|
|
UpDown1: TUpDown;
|
|
Label3: TLabel;
|
|
BrushColor: TPanel;
|
|
Label4: TLabel;
|
|
Transparency: TEdit;
|
|
Label5: TLabel;
|
|
Operation: TComboBox;
|
|
chkAntialias: TCheckBox;
|
|
ViewTab2: TTabSheet;
|
|
ViewToolBar: TToolBar;
|
|
N100: TToolButton;
|
|
Fit1: TToolButton;
|
|
DrawTab2: TTabSheet;
|
|
PaintTab2: TTabSheet;
|
|
SaveImageEnDialog1: TSaveImageEnDialog;
|
|
Transparent1: TCheckBox;
|
|
Opacity1: TEdit;
|
|
Label12: TLabel;
|
|
UpDown3: TUpDown;
|
|
SaveSelection1: TToolButton;
|
|
RestoreSelection1: TToolButton;
|
|
GroupBox1: TGroupBox;
|
|
Label8: TLabel;
|
|
Label9: TLabel;
|
|
NewWidth1: TEdit;
|
|
NewHeight1: TEdit;
|
|
DrawToolBar: TToolBar;
|
|
PaintPoint: TToolButton;
|
|
PaintLine: TToolButton;
|
|
PaintEllipse: TToolButton;
|
|
PaintRectangle: TToolButton;
|
|
PickColor1: TToolButton;
|
|
PickTransparent1: TToolButton;
|
|
Erase1: TToolButton;
|
|
Fill1: TToolButton;
|
|
ToolBar1: TToolBar;
|
|
RectangleButton: TToolButton;
|
|
CircleButton: TToolButton;
|
|
PointsButton: TToolButton;
|
|
OpenImageEnDialog1: TOpenImageEnDialog;
|
|
ToolButton1: TToolButton;
|
|
TabSheet2: TTabSheet;
|
|
ImageEnView2: TImageEnView;
|
|
GroupBox8: TGroupBox;
|
|
Label13: TLabel;
|
|
UndoLimit1: TEdit;
|
|
UpDown4: TUpDown;
|
|
UpDown5: TUpDown;
|
|
UpDown6: TUpDown;
|
|
Panel1: TPanel;
|
|
Label14: TLabel;
|
|
FillColor: TPanel;
|
|
Help1: TToolButton;
|
|
AutoFitOnLoad1: TCheckBox;
|
|
ToolButton3: TToolButton;
|
|
ToolButton4: TToolButton;
|
|
UpDown8: TUpDown;
|
|
DrawBorderOpague1: TCheckBox;
|
|
ToolButton8: TToolButton;
|
|
PopupMenuMRU: TPopupMenu;
|
|
RecentFiles1: TMenuItem;
|
|
Clear1: TMenuItem;
|
|
BackGroundColor: TPanel;
|
|
Label15: TLabel;
|
|
chkContinuous: TCheckBox;
|
|
procedure Open1Click ( Sender: TObject );
|
|
procedure Exit1Click ( Sender: TObject );
|
|
procedure ScrollBar1Change ( Sender: TObject );
|
|
procedure BrushColorClick ( Sender: TObject );
|
|
procedure FormCreate ( Sender: TObject );
|
|
procedure ImageEnView1MouseMove ( Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer );
|
|
procedure CreateBrush ( Sender: TObject );
|
|
procedure ImageEnView1MouseDown ( Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer );
|
|
procedure DisplayGrid1Click ( Sender: TObject );
|
|
procedure PaintColorClick ( Sender: TObject );
|
|
procedure PageControl1Change ( Sender: TObject );
|
|
procedure New1Click ( Sender: TObject );
|
|
procedure About1Click ( Sender: TObject );
|
|
procedure ConvertTo32Bit1Click ( Sender: TObject );
|
|
procedure ConvertTo24Bit1Click ( Sender: TObject );
|
|
procedure ConvertTo8Bit1Click ( Sender: TObject );
|
|
procedure ConvertTo4Bit1Click ( Sender: TObject );
|
|
procedure PickTransparent1Click ( Sender: TObject );
|
|
procedure Resize1Click ( Sender: TObject );
|
|
procedure Resample1Click ( Sender: TObject );
|
|
procedure Rotate1Click ( Sender: TObject );
|
|
procedure Flip1Click ( Sender: TObject );
|
|
procedure TransparentColorClick ( Sender: TObject );
|
|
procedure SaveAsClick ( Sender: TObject );
|
|
procedure Fill1Click ( Sender: TObject );
|
|
procedure ImageEnView1MouseUp ( Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer );
|
|
procedure PointsButtonClick ( Sender: TObject );
|
|
procedure PickColor1Click ( Sender: TObject );
|
|
procedure Undo1Click ( Sender: TObject );
|
|
procedure Redo1Click ( Sender: TObject );
|
|
procedure Cut1Click ( Sender: TObject );
|
|
procedure Copy1Click ( Sender: TObject );
|
|
procedure Paste1Click ( Sender: TObject );
|
|
procedure Crop1Click ( Sender: TObject );
|
|
procedure SelectNone1Click ( Sender: TObject );
|
|
procedure SelectRectangle1Click ( Sender: TObject );
|
|
procedure SelectEllipse1Click ( Sender: TObject );
|
|
procedure SelectZoom1Click ( Sender: TObject );
|
|
procedure ToolButton2Click ( Sender: TObject );
|
|
procedure SelectLasso1Click ( Sender: TObject );
|
|
procedure RectangleButtonClick ( Sender: TObject );
|
|
procedure CircleButtonClick ( Sender: TObject );
|
|
procedure EnableAlphaChannel1Click ( Sender: TObject );
|
|
procedure HomePage1Click ( Sender: TObject );
|
|
procedure Erase1Click ( Sender: TObject );
|
|
procedure BMP_HandleTransparency1Click ( Sender: TObject );
|
|
procedure SelectPolygon1Click ( Sender: TObject );
|
|
procedure SelectMagicWand1Click ( Sender: TObject );
|
|
procedure MagicWandTolerance1Change ( Sender: TObject );
|
|
procedure IEMagicWandMode1Change ( Sender: TObject );
|
|
procedure MagicWandMaxFilter1Click ( Sender: TObject );
|
|
procedure PaintPointClick ( Sender: TObject );
|
|
procedure PaintLineClick ( Sender: TObject );
|
|
procedure Fit1Click ( Sender: TObject );
|
|
procedure N100Click ( Sender: TObject );
|
|
procedure FormResize ( Sender: TObject );
|
|
procedure PageControl2Change ( Sender: TObject );
|
|
procedure Transparent1Click ( Sender: TObject );
|
|
procedure Opacity1Change ( Sender: TObject );
|
|
procedure SaveSelection1Click ( Sender: TObject );
|
|
procedure RestoreSelection1Click ( Sender: TObject );
|
|
procedure PaintEllipseClick ( Sender: TObject );
|
|
procedure PaintRectangleClick ( Sender: TObject );
|
|
procedure UndoLimit1Change ( Sender: TObject );
|
|
procedure FillColorClick ( Sender: TObject );
|
|
procedure Help1Click ( Sender: TObject );
|
|
procedure Save1Click ( Sender: TObject );
|
|
procedure FormDestroy ( Sender: TObject );
|
|
procedure xx1Click ( Sender: TObject );
|
|
procedure FormActivate ( Sender: TObject );
|
|
procedure Clear1Click ( Sender: TObject );
|
|
procedure PopupMenuMRUChange ( Sender: TObject; Source: TMenuItem;
|
|
Rebuild: Boolean );
|
|
procedure BackGroundColorClick ( Sender: TObject );
|
|
private
|
|
{ Private declarations }
|
|
startX, startY: integer;
|
|
lastX, lastY: integer;
|
|
FilePath: string;
|
|
OldPaintColor: TColor;
|
|
FConfig: TIniFile;
|
|
MRUFiles: TStringList;
|
|
fLastPointX : Integer;
|
|
fLastPointY : Integer;
|
|
procedure UpdateStatusBar;
|
|
procedure UpdateUndoMenu;
|
|
procedure MRUItemClick ( Sender: TObject );
|
|
public
|
|
{ Public declarations }
|
|
Alpha: integer;
|
|
procedure SetTransparent;
|
|
end;
|
|
|
|
var
|
|
FrmMain: TFrmMain;
|
|
|
|
implementation
|
|
|
|
uses ImageEnIO, ImageEnProc, Clipbrd, ShellAPI, ActiveX,
|
|
ShlObj, StrUtils, uAbout, uMsg, upick, uResize, uRotate, uPaste, uFlip, uHelp;
|
|
|
|
{$R *.DFM}
|
|
{$R WindowsTheme.res}
|
|
|
|
// Add a thousand separator to a string
|
|
|
|
function AddThousandSeparator ( S: string; Chr: Char ): string;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := S;
|
|
I := Length ( S ) - 2;
|
|
while I > 1 do
|
|
begin
|
|
Insert ( Chr, Result, I );
|
|
I := I - 3;
|
|
end;
|
|
end;
|
|
|
|
function PathToDir ( const Path: string ): string;
|
|
begin
|
|
Result := Path;
|
|
if ( Path <> '' ) and ( Path [ Length ( Path ) ] = '\' ) then
|
|
Delete ( Result, Length ( Result ), 1 );
|
|
end;
|
|
|
|
// Returns true if given name is a valid directory and false
|
|
// otherwise. DirName can be any file system name (with or
|
|
// without trailing path delimiter).
|
|
|
|
function IsDirectory ( const DirName: string ): Boolean;
|
|
var
|
|
Attr: Integer; // directory's file attributes
|
|
begin
|
|
Attr := SysUtils.FileGetAttr ( DirName );
|
|
Result := ( Attr <> -1 ) and ( Attr and SysUtils.faDirectory
|
|
= SysUtils.faDirectory );
|
|
end;
|
|
|
|
// Ensures that the given folder and its sub folders exist, and creates them if they do not. Uses recursion.
|
|
|
|
procedure EnsureFolders ( Path: string );
|
|
var
|
|
SlashPos: Integer; // position of last backslash in path
|
|
SubPath: string; // immediate parent folder of given path
|
|
begin
|
|
// Check there's a path to create
|
|
if Length ( Path ) = 0 then
|
|
Exit;
|
|
// Remove any trailing '\'
|
|
Path := PathToDir ( Path );
|
|
// Check if folder exists and quit if it does - we're done
|
|
if IsDirectory ( Path ) then
|
|
Exit;
|
|
// Recursively call routine on immediate parent folder
|
|
// remove bottomost folder from path - ie move up to parent folder
|
|
SubPath := Path;
|
|
SlashPos := Length ( SubPath );
|
|
while ( SlashPos > 2 ) and ( SubPath [ SlashPos ] <> '\' ) do
|
|
Dec ( SlashPos );
|
|
Delete ( SubPath, SlashPos, Length ( Path ) - SlashPos + 1 );
|
|
// do recursive call - ensures that parent folder of current path exist
|
|
EnsureFolders ( SubPath );
|
|
// Create this current folder now we know parent folder exists
|
|
SysUtils.CreateDir ( Path );
|
|
end;
|
|
|
|
procedure SetSquarePen ( Canvas: TCanvas; Color: TColor; Width: integer );
|
|
var
|
|
LogBrush: TLOGBRUSH;
|
|
begin
|
|
if Width > 1 then
|
|
begin
|
|
LogBrush.lbStyle := BS_Solid;
|
|
LogBrush.lbColor := Color;
|
|
LogBrush.lbHatch := 0;
|
|
Canvas.Pen.Handle := ExtCreatePen ( PS_Geometric or PS_Solid or
|
|
PS_ENDCAP_SQUARE, Width, LogBrush, 0, nil );
|
|
end
|
|
else
|
|
begin
|
|
Canvas.Pen.Color := Color;
|
|
Canvas.Pen.Width := Width;
|
|
Canvas.Pen.Style := psSolid;
|
|
end;
|
|
end;
|
|
|
|
//FormCreate
|
|
|
|
procedure TFrmMain.FormActivate ( Sender: TObject );
|
|
begin
|
|
Open2.Enabled := True;
|
|
Open2.Indeterminate := False;
|
|
end;
|
|
|
|
procedure TFrmMain.FormCreate ( Sender: TObject );
|
|
var
|
|
Path: string;
|
|
Allocator: IMalloc;
|
|
SpecialDir: PItemIdList;
|
|
FBuf: array [ 0..MAX_PATH ] of Char;
|
|
Item: TMenuItem;
|
|
i: integer;
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
EnableAlphaChannel := True;
|
|
MinBitmapSize := 1;
|
|
DisplayGrid := true;
|
|
Proc.Fill ( CreateRGB ( 255, 255, 255 ) );
|
|
Proc.AutoUndo := False;
|
|
Proc.UndoLimit := 25;
|
|
BackGroundStyle := iebsChessboard;
|
|
SetChessboardStyle ( 6, bsSolid );
|
|
Proc.Clear;
|
|
Proc.ImageResize ( StrToIntDef ( NewWidth1.Text, 640 ), StrToIntDef ( NewHeight1.Text, 480 ), iehLeft, ievTop );
|
|
Proc.CastColor ( 0, 0, TColor2TRGB ( clGradientActiveCaption ), 1 );
|
|
TransparentColor.Color := clGradientActiveCaption;
|
|
Proc.ClearUndo;
|
|
IO.Params.Width := IEBitmap.Width;
|
|
IO.Params.Height := IEBitmap.Height;
|
|
SetNavigator ( ImageEnView2 );
|
|
end;
|
|
Operation.ItemIndex := 0;
|
|
OldPaintColor := clBlack;
|
|
PageControl1.ActivePageIndex := 0;
|
|
PageControl2.ActivePageIndex := 0;
|
|
MRUFiles := TStringList.Create;
|
|
MRUFiles.Capacity := 8;
|
|
UpdateUndoMenu;
|
|
Undo1.Enabled := false;
|
|
UpdateStatusBar;
|
|
// Load Application Settings from ini file
|
|
if SHGetMalloc ( Allocator ) = NOERROR then
|
|
begin
|
|
SHGetSpecialFolderLocation ( FrmMain.Handle, CSIDL_LOCAL_APPDATA, SpecialDir );
|
|
SHGetPathFromIDList ( SpecialDir, @FBuf [ 0 ] );
|
|
Allocator.Free ( SpecialDir );
|
|
Path := string ( FBuf ) + '\ImageEnPainter';
|
|
// Create folder
|
|
EnsureFolders ( Path );
|
|
end;
|
|
|
|
FConfig := TIniFile.Create ( Path + '\ImageEnPainter.INI' );
|
|
try
|
|
FrmMain.Left := FConfig.ReadInteger ( 'Settings', 'Left', 0 );
|
|
FrmMain.Top := FConfig.ReadInteger ( 'Settings', 'Top', 0 );
|
|
FrmMain.Height := FConfig.ReadInteger ( 'Settings', 'Height', 600 );
|
|
FrmMain.Width := FConfig.ReadInteger ( 'Settings', 'Width', 800 );
|
|
DisplayGrid1.Checked := FConfig.ReadBool ( 'Settings', 'Display Grid', False );
|
|
BMP_HandleTransparency1.Checked := FConfig.ReadBool ( 'Settings', 'BMP HandleTransparency', True );
|
|
EnableAlphaChannel1.Checked := FConfig.ReadBool ( 'Settings', 'Enable AlphaChannel', False );
|
|
AutoFitOnLoad1.Checked := FConfig.ReadBool ( 'Settings', 'AutoFitOnLoad', True );
|
|
NewWidth1.Text := FConfig.ReadString ( 'Settings', 'New Image Width', '640' );
|
|
NewHeight1.Text := FConfig.ReadString ( 'Settings', 'New Image Height', '480' );
|
|
BackGroundColor.Color := FConfig.ReadInteger ( 'Settings', 'New Image BackGround Color', clBtnFace );
|
|
UndoLimit1.Text := FConfig.ReadString ( 'Settings', 'Undo Limit', '25' );
|
|
finally; FConfig.Free; end;
|
|
if FileExists ( Path + '\ImageEnPainterMRU.txt' ) then
|
|
begin
|
|
MRUFiles.LoadFromFile ( Path + '\ImageEnPainterMRU.txt' );
|
|
for i := 0 to MRUFiles.Count - 1 do begin
|
|
Item := TMenuItem.Create ( PopupMenuMRU );
|
|
Item.Caption := MRUFiles.Strings [ i ];
|
|
Item.OnClick := MRUItemClick;
|
|
PopupMenuMRU.Items.Add ( Item );
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmMain.FormDestroy ( Sender: TObject );
|
|
var
|
|
Path: string;
|
|
Allocator: IMalloc;
|
|
SpecialDir: PItemIdList;
|
|
FBuf: array [ 0..MAX_PATH ] of Char;
|
|
begin
|
|
// Save Application Settings to ini file
|
|
if SHGetMalloc ( Allocator ) = NOERROR then
|
|
begin
|
|
SHGetSpecialFolderLocation ( FrmMain.Handle, CSIDL_LOCAL_APPDATA, SpecialDir );
|
|
SHGetPathFromIDList ( SpecialDir, @FBuf [ 0 ] );
|
|
Allocator.Free ( SpecialDir );
|
|
Path := string ( FBuf ) + '\ImageEnPainter';
|
|
// Create folder
|
|
EnsureFolders ( Path );
|
|
end;
|
|
|
|
FConfig := TIniFile.Create ( Path + '\ImageEnPainter.ini' );
|
|
try
|
|
FConfig.WriteInteger ( 'Settings', 'Left', FrmMain.Left );
|
|
FConfig.WriteInteger ( 'Settings', 'Top', FrmMain.Top );
|
|
FConfig.WriteInteger ( 'Settings', 'Height', FrmMain.Height );
|
|
FConfig.WriteInteger ( 'Settings', 'Width', FrmMain.Width );
|
|
FConfig.WriteBool ( 'Settings', 'Display Grid', DisplayGrid1.Checked );
|
|
FConfig.WriteBool ( 'Settings', 'BMP HandleTransparency', BMP_HandleTransparency1.Checked );
|
|
FConfig.WriteBool ( 'Settings', 'Enable AlphaChannel', EnableAlphaChannel1.Checked );
|
|
FConfig.WriteBool ( 'Settings', 'AutoFitOnLoad', AutoFitOnLoad1.Checked );
|
|
FConfig.WriteString ( 'Settings', 'New Image Width', NewWidth1.Text );
|
|
FConfig.WriteString ( 'Settings', 'New Image Height', NewHeight1.Text );
|
|
FConfig.WriteInteger ( 'Settings', 'New Image BackGround Color', BackGroundColor.Color );
|
|
FConfig.WriteString ( 'Settings', 'Undo Limit', UndoLimit1.Text );
|
|
finally; FConfig.Free; end;
|
|
MRUFiles.SaveToFile ( Path + '\ImageEnPainterMRU.txt' );
|
|
MRUFiles.Free;
|
|
end;
|
|
|
|
//FormResize
|
|
|
|
procedure TFrmMain.FormResize ( Sender: TObject );
|
|
begin
|
|
if Fit1.Down then begin
|
|
ImageEnView1.Fit;
|
|
UpdateStatusBar;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmMain.MRUItemClick ( Sender: TObject );
|
|
var
|
|
fExt: string;
|
|
fTransparentColor: TColor;
|
|
RGB: TRGB;
|
|
Item: TMenuItem;
|
|
begin
|
|
ImageEnView1.LayersCurrent := 0;
|
|
Item := Sender as TMenuItem;
|
|
FilePath := Item.Caption;
|
|
if FileExists ( FilePath ) then
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
try
|
|
FrmMain.Caption := ExtractFileName ( FilePath ) + '- ImageEn Painter';
|
|
with ImageEnView1 do
|
|
begin
|
|
IO.LoadFromFile ( FilePath );
|
|
|
|
RGB := IEBitmap.Pixels [ 0, IEBitmap.Height - 1 ];
|
|
fTransparentColor := TRGB2TColor ( RGB );
|
|
IO.Params.BMP_HandleTransparency := BMP_HandleTransparency1.Checked;
|
|
|
|
fExt := LowerCase ( ExtractFileExt ( FilePath ) );
|
|
if fExt = '.cur' then
|
|
IO.Params.CUR_Background := TColor2TRGB ( fTransparentColor );
|
|
if fExt = '.ico' then
|
|
IO.Params.ICO_Background := TColor2TRGB ( fTransparentColor );
|
|
if ( fExt = '.gif' ) and ( IO.Params.GIF_FlagTranspColor ) then
|
|
begin
|
|
IO.Params.GIF_FlagTranspColor := True;
|
|
IO.Params.GIF_TranspColor := TColor2TRGB ( fTransparentColor );
|
|
end;
|
|
if fExt = '.png' then
|
|
IO.Params.PNG_Background := TColor2TRGB ( fTransparentColor );
|
|
if fExt = '.tga' then
|
|
IO.Params.TGA_Background := TColor2TRGB ( fTransparentColor );
|
|
|
|
TransparentColor.Color := fTransparentColor;
|
|
if ( IO.Params.BitsPerSample = 8 ) and ( IO.Params.SamplesPerPixel = 4 ) then
|
|
Proc.SetTransparentColors ( RGB, RGB, 0 );
|
|
|
|
ScrollBar1.Position := Round ( Zoom );
|
|
Update;
|
|
if AutoFitOnLoad1.Checked then begin
|
|
Fit;
|
|
Fit1.Down := True;
|
|
end;
|
|
UpdateStatusBar;
|
|
end;
|
|
finally; Screen.Cursor := crDefault; end;
|
|
end;
|
|
end;
|
|
|
|
// open internet explorer and load HomePage
|
|
|
|
procedure TFrmMain.HomePage1Click ( Sender: TObject );
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
try
|
|
ShellExecute ( Handle, 'open', PChar ( 'http://www.hicomponents.com' ), nil, nil, SW_SHOWNORMAL );
|
|
finally; Screen.Cursor := crDefault; end;
|
|
end;
|
|
|
|
// File | Open
|
|
|
|
procedure TFrmMain.Open1Click ( Sender: TObject );
|
|
var
|
|
fExt: string;
|
|
fTransparentColor: TColor;
|
|
RGB: TRGB;
|
|
Item: TMenuItem;
|
|
begin
|
|
ImageEnView1.LayersCurrent := 0;
|
|
OpenPictureDialog1.Filter := OpenImageEnDialog1.Filter;
|
|
OpenPictureDialog1.FilterIndex := 0;
|
|
OpenPictureDialog1.FileName := '';
|
|
OpenPictureDialog1.DefaultExt := '.jpg';
|
|
if OpenPictureDialog1.Execute then
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
try
|
|
FilePath := OpenPictureDialog1.FileName;
|
|
MRUFiles.Add ( FilePath );
|
|
Item := TMenuItem.Create ( PopupMenuMRU );
|
|
Item.Caption := FilePath;
|
|
Item.OnClick := MRUItemClick;
|
|
PopupMenuMRU.Items.Add ( Item );
|
|
//Item.Free;
|
|
FrmMain.Caption := ExtractFileName ( FilePath ) + '- ImageEn Painter';
|
|
with ImageEnView1 do
|
|
begin
|
|
IO.LoadFromFile ( FilePath );
|
|
|
|
RGB := IEBitmap.Pixels [ 0, IEBitmap.Height - 1 ];
|
|
fTransparentColor := TRGB2TColor ( RGB );
|
|
IO.Params.BMP_HandleTransparency := BMP_HandleTransparency1.Checked;
|
|
|
|
fExt := LowerCase ( ExtractFileExt ( FilePath ) );
|
|
if fExt = '.cur' then
|
|
IO.Params.CUR_Background := TColor2TRGB ( fTransparentColor );
|
|
if fExt = '.ico' then
|
|
IO.Params.ICO_Background := TColor2TRGB ( fTransparentColor );
|
|
if ( fExt = '.gif' ) and ( IO.Params.GIF_FlagTranspColor ) then
|
|
begin
|
|
IO.Params.GIF_FlagTranspColor := True;
|
|
IO.Params.GIF_TranspColor := TColor2TRGB ( fTransparentColor );
|
|
end;
|
|
if fExt = '.png' then
|
|
IO.Params.PNG_Background := TColor2TRGB ( fTransparentColor );
|
|
if fExt = '.tga' then
|
|
IO.Params.TGA_Background := TColor2TRGB ( fTransparentColor );
|
|
|
|
TransparentColor.Color := fTransparentColor;
|
|
if ( IO.Params.BitsPerSample = 8 ) and ( IO.Params.SamplesPerPixel = 4 ) then
|
|
Proc.SetTransparentColors ( RGB, RGB, 0 );
|
|
|
|
ScrollBar1.Position := Round ( Zoom );
|
|
Update;
|
|
if AutoFitOnLoad1.Checked then begin
|
|
Fit;
|
|
Fit1.Down := True;
|
|
end;
|
|
UpdateStatusBar;
|
|
end;
|
|
finally; Screen.Cursor := crDefault; end;
|
|
end;
|
|
end;
|
|
|
|
// EnableAlphaChannel
|
|
|
|
procedure TFrmMain.MagicWandMaxFilter1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
with ImageEnView1 do begin
|
|
MagicWandMaxFilter := MagicWandMaxFilter1.Checked;
|
|
end;
|
|
end;
|
|
|
|
//MagicWandTolerance
|
|
|
|
procedure TFrmMain.MagicWandTolerance1Change ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
with ImageEnView1 do begin
|
|
MagicWandTolerance := StrToIntDef ( MagicWandTolerance1.Text, 15 );
|
|
end;
|
|
end;
|
|
|
|
//Opacity1Change
|
|
|
|
procedure TFrmMain.Opacity1Change ( Sender: TObject );
|
|
begin
|
|
Alpha := ( StrToInt ( Opacity1.Text ) * 255 ) div 100;
|
|
end;
|
|
|
|
//EnableAlphaChannel
|
|
|
|
procedure TFrmMain.UndoLimit1Change ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then begin
|
|
ImageEnView1.Proc.UndoLimit := StrToInt ( UndoLimit1.Text );
|
|
UpdateStatusBar;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmMain.EnableAlphaChannel1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
with ImageEnView1 do begin
|
|
EnableAlphaChannel := EnableAlphaChannel1.Checked;
|
|
if EnableAlphaChannel1.Checked then
|
|
begin
|
|
BackGroundStyle := iebsChessboard;
|
|
SetChessboardStyle ( 6, bsSolid );
|
|
end
|
|
else
|
|
BackGroundStyle := iebsSolid;
|
|
end;
|
|
end;
|
|
|
|
// Erase pixel
|
|
|
|
procedure TFrmMain.Erase1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
with ImageEnView1 do
|
|
begin
|
|
SelectNone1.Click;
|
|
if Erase1.Down then
|
|
Cursor := crIEEraser
|
|
else
|
|
Cursor := crIECross;
|
|
end;
|
|
end;
|
|
|
|
// Exit
|
|
|
|
procedure TFrmMain.Exit1Click ( Sender: TObject );
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
// Save
|
|
|
|
procedure TFrmMain.Save1Click ( Sender: TObject );
|
|
var
|
|
fExt: string;
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
if FileExists ( FilePath ) then begin
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
try
|
|
fExt := LowerCase ( ExtractFileExt ( FilePath ) );
|
|
Proc.SaveUndo;
|
|
// previews
|
|
IO.Params.BMP_HandleTransparency := True;
|
|
IO.Params.BMP_Version := ioBMP_BM3;
|
|
IO.Params.FileType := IEExtToFileFormat ( fExt );
|
|
if fExt <> '.ico' then
|
|
begin
|
|
IO.PreviewsParams := [ ioppDefaultLockPreview ];
|
|
if IO.DoPreviews ( [ ppAUTO ] ) then
|
|
// save to disk
|
|
IO.SaveToFile ( FilePath );
|
|
end
|
|
else
|
|
// save to disk
|
|
IO.SaveToFile ( FilePath );
|
|
FrmMain.Caption := ExtractFileName ( FilePath ) + '- ImageEn Painter';
|
|
Proc.ClearUndo;
|
|
Proc.ClearRedo;
|
|
UpdateStatusbar;
|
|
finally; Screen.Cursor := crDefault; end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// SaveAs
|
|
|
|
procedure TFrmMain.SaveAsClick ( Sender: TObject );
|
|
var
|
|
fExt: string;
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
with ImageEnView1 do
|
|
begin
|
|
SavePictureDialog1.Filter := SaveImageEnDialog1.Filter;
|
|
SavePictureDialog1.FilterIndex := 1;
|
|
SavePictureDialog1.InitialDir := ExtractFileDir ( IO.Params.FileName );
|
|
SavePictureDialog1.FileName := ExtractFilename ( IO.Params.FileName );
|
|
if SavePictureDialog1.Execute then
|
|
begin
|
|
FilePath := SavePictureDialog1.FileName;
|
|
if FilePath <> '' then
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
try
|
|
fExt := LowerCase ( ExtractFileExt ( FilePath ) );
|
|
Proc.SaveUndo;
|
|
// previews
|
|
IO.Params.BMP_HandleTransparency := True;
|
|
IO.Params.BMP_Version := ioBMP_BM3;
|
|
IO.Params.FileType := IEExtToFileFormat ( fExt );
|
|
if fExt <> '.ico' then
|
|
begin
|
|
IO.PreviewsParams := [ ioppDefaultLockPreview ];
|
|
if IO.DoPreviews ( [ ppAUTO ] ) then
|
|
// save to disk
|
|
IO.SaveToFile ( FilePath );
|
|
end
|
|
else
|
|
// save to disk
|
|
IO.SaveToFile ( FilePath );
|
|
FrmMain.Caption := FilePath;
|
|
Proc.ClearUndo;
|
|
Proc.ClearRedo;
|
|
UpdateStatusbar;
|
|
finally; Screen.Cursor := crDefault; end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Change Zoom
|
|
|
|
procedure TFrmMain.ScrollBar1Change ( Sender: TObject );
|
|
begin
|
|
ImageEnView1.Zoom := ScrollBar1.Position;
|
|
UpdateStatusbar;
|
|
end;
|
|
|
|
// Select Ellipse
|
|
|
|
procedure TFrmMain.SelectEllipse1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIEMultipleArrow;
|
|
MouseInteract := [ miSelectCircle ];
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintEllipse.Down := False;
|
|
PickColor1.Down := False;
|
|
PickTransparent1.Down := False;
|
|
Fill1.Down := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Select Lasso
|
|
|
|
procedure TFrmMain.SelectLasso1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIEMultipleArrow;
|
|
MouseInteract := [ miSelectLasso ];
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintEllipse.Down := False;
|
|
PickColor1.Down := False;
|
|
PickTransparent1.Down := False;
|
|
Fill1.Down := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmMain.SelectMagicWand1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIESelectArrow;
|
|
MouseInteract := [ miSelectMagicWand ];
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintEllipse.Down := False;
|
|
PickColor1.Down := False;
|
|
PickTransparent1.Down := False;
|
|
Fill1.Down := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Select None
|
|
|
|
procedure TFrmMain.SelectNone1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIECross;
|
|
MouseInteract := [ ];
|
|
Deselect;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Select Polygon
|
|
|
|
procedure TFrmMain.SelectPolygon1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIESmallArrow;
|
|
MouseInteract := [ miSelectPolygon ];
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintEllipse.Down := False;
|
|
PickColor1.Down := False;
|
|
PickTransparent1.Down := False;
|
|
Fill1.Down := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Select Rectangle
|
|
|
|
procedure TFrmMain.SelectRectangle1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIESelectArrow;
|
|
MouseInteract := [ miSelect ];
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintEllipse.Down := False;
|
|
PickColor1.Down := False;
|
|
PickTransparent1.Down := False;
|
|
Fill1.Down := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Select Zoom
|
|
|
|
procedure TFrmMain.SelectZoom1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIEZoomIn;
|
|
MouseInteract := [ miZoom ];
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintEllipse.Down := False;
|
|
PickColor1.Down := False;
|
|
PickTransparent1.Down := False;
|
|
Fill1.Down := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Select zoom
|
|
|
|
procedure TFrmMain.ToolButton2Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIEZoomIn;
|
|
MouseInteract := [ miSelectZoom ];
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintPoint.Down := False;
|
|
PaintLine.Down := False;
|
|
PaintEllipse.Down := False;
|
|
PickColor1.Down := False;
|
|
PickTransparent1.Down := False;
|
|
Fill1.Down := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmMain.Help1Click ( Sender: TObject );
|
|
begin
|
|
FrmHelp := TFrmHelp.Create ( Self );
|
|
try
|
|
FrmHelp.ShowModal;
|
|
finally; FrmHelp.Free; end;
|
|
end;
|
|
|
|
// Save Selection
|
|
|
|
procedure TFrmMain.SaveSelection1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
ImageEnView1.SaveSelection;
|
|
end;
|
|
|
|
// Restore Selection
|
|
|
|
procedure TFrmMain.RestoreSelection1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
ImageEnView1.RestoreSelection;
|
|
end;
|
|
|
|
// Zoom to 100%
|
|
|
|
procedure TFrmMain.N100Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then begin
|
|
if N100.Down then
|
|
ImageEnView1.Zoom := 100;
|
|
UpdateStatusBar;
|
|
end;
|
|
end;
|
|
|
|
// Fit
|
|
|
|
procedure TFrmMain.Fit1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then begin
|
|
if Fit1.Down then
|
|
ImageEnView1.Fit;
|
|
UpdateStatusBar;
|
|
end;
|
|
end;
|
|
|
|
// Set Transparent Color
|
|
|
|
procedure TFrmMain.Transparent1Click ( Sender: TObject );
|
|
begin
|
|
if Transparent1.Checked then
|
|
begin
|
|
Opacity1.Text := '0';
|
|
Alpha := 0;
|
|
OldPaintColor := PaintColor.Color;
|
|
PaintColor.Color := TRGB2TColor ( ImageEnView1.IO.IEBitmap.Pixels [ 0, ImageEnView1.IEBitmap.Height - 1 ] );
|
|
end
|
|
else
|
|
begin
|
|
Opacity1.Text := '100';
|
|
Alpha := 100;
|
|
PaintColor.Color := OldPaintColor;
|
|
end;
|
|
end;
|
|
|
|
// Transparent Color
|
|
|
|
procedure TFrmMain.TransparentColorClick ( Sender: TObject );
|
|
var
|
|
RGB: TRGB;
|
|
begin
|
|
ColorDialog1.Color := TransparentColor.Color;
|
|
if ColorDialog1.Execute then begin
|
|
TransparentColor.Color := ColorDialog1.Color;
|
|
RGB := TColor2TRGB ( ColorDialog1.Color );
|
|
ImageEnView1.Proc.SetTransparentColors ( RGB, RGB, 0 );
|
|
end;
|
|
end;
|
|
|
|
// ConvertTo32Bit
|
|
|
|
procedure TFrmMain.ConvertTo32Bit1Click ( Sender: TObject );
|
|
var
|
|
RGB: TRGB;
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
FrmMsg := TFrmMsg.Create ( Self );
|
|
try
|
|
FrmMsg.Msg1.Caption := 'Converting To 32-bit...';
|
|
FrmMsg.Show;
|
|
FrmMsg.Msg1.Update;
|
|
Sleep ( 1000 );
|
|
with ImageEnView1 do
|
|
begin
|
|
Proc.SaveUndoCaptioned ( 'Convert To 32-bit ' + IntToStr ( Proc.UndoCount ) );
|
|
Undo1.Hint := 'Convert To 32-bit ' + IntToStr ( Proc.UndoCount + 1 );
|
|
Proc.ClearAllRedo;
|
|
IO.Params.BitsPerSample := 8;
|
|
IO.Params.SamplesPerPixel := 4;
|
|
EnableAlphaChannel := True;
|
|
with Proc do
|
|
begin
|
|
RGB := IEBitmap.Pixels [ 0, IEBitmap.Height - 1 ];
|
|
SetTransparentColors ( RGB, RGB, 0 );
|
|
end;
|
|
Update;
|
|
end;
|
|
finally; FrmMsg.Free; end;
|
|
end;
|
|
ImageEnView1.Update;
|
|
UpdateUndoMenu;
|
|
UpdateStatusbar;
|
|
end;
|
|
|
|
// About
|
|
|
|
procedure TFrmMain.About1Click ( Sender: TObject );
|
|
begin
|
|
FrmAbout := TFrmAbout.Create ( Self );
|
|
try
|
|
FrmAbout.ShowModal;
|
|
finally; FrmAbout.Free; end;
|
|
end;
|
|
|
|
//New
|
|
|
|
procedure TFrmMain.New1Click ( Sender: TObject );
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
if PageControl1.ActivePage = DrawTab then
|
|
ImageEnView1.LayersRemove ( 1 );
|
|
Blank;
|
|
Proc.ImageResize ( StrToIntDef ( NewWidth1.Text, 640 ), StrToIntDef ( NewHeight1.Text, 480 ), iehLeft, ievTop );
|
|
Proc.CastColor ( 0, 0, TColor2TRGB ( BackGroundColor.Color ), 1 );
|
|
Proc.ClearUndo;
|
|
Proc.ClearRedo;
|
|
IO.Params.Width := IEBitmap.Width;
|
|
IO.Params.Height := IEBitmap.Height;
|
|
Cursor := crIECrossSight;
|
|
PointsButton.Down := False;
|
|
end;
|
|
Undo1.Enabled := false;
|
|
if AutoFitOnLoad1.Checked then
|
|
ImageEnView1.Fit;
|
|
UpdateStatusBar;
|
|
end;
|
|
|
|
// Fill
|
|
|
|
procedure TFrmMain.Fill1Click ( Sender: TObject );
|
|
begin
|
|
if Fill1.Down then
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIEPaintFill;
|
|
MouseInteract := [ ];
|
|
DeSelect;
|
|
end;
|
|
end
|
|
else
|
|
Cursor := crIECross;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmMain.FillColorClick ( Sender: TObject );
|
|
begin
|
|
ColorDialog1.Color := FillColor.Color;
|
|
if ColorDialog1.Execute then
|
|
FillColor.Color := ColorDialog1.Color;
|
|
end;
|
|
|
|
// Flip
|
|
|
|
procedure TFrmMain.Flip1Click ( Sender: TObject );
|
|
begin
|
|
frmFlip := TfrmFlip.Create ( Self );
|
|
try
|
|
with ImageEnView1 do
|
|
begin
|
|
Proc.SaveUndoCaptioned ( 'Flip ' + IntToStr ( Proc.UndoCount ) );
|
|
frmFlip.ImageEnView1.IEBitmap.Assign ( IEBitmap );
|
|
frmFlip.ImageEnView1.Update;
|
|
if frmFlip.ShowModal = mrOk then
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
try
|
|
FrmMsg := TFrmMsg.Create ( Self );
|
|
try
|
|
FrmMsg.Msg1.Caption := 'Flipping the Picture...';
|
|
FrmMsg.Show;
|
|
FrmMsg.Msg1.Update;
|
|
Proc.SaveUndoCaptioned ( 'Flip ' + IntToStr ( Proc.UndoCount ) );
|
|
Undo1.Hint := 'Flip ' + IntToStr ( Proc.UndoCount + 1 );
|
|
Proc.ClearAllRedo;
|
|
if frmFlip.RadioGroup1.ItemIndex = 0 then
|
|
Proc.Flip ( fdHorizontal )
|
|
else
|
|
Proc.Flip ( fdVertical );
|
|
Update;
|
|
UpdateUndoMenu;
|
|
UpdateStatusbar;
|
|
Sleep ( 1000 );
|
|
finally; FrmMsg.Free; end;
|
|
finally; Screen.Cursor := crDefault; end;
|
|
end;
|
|
end;
|
|
finally; frmFlip.Free; end;
|
|
UpdateUndoMenu;
|
|
UpdateStatusBar;
|
|
end;
|
|
|
|
// Pick Color
|
|
|
|
procedure TFrmMain.PickColor1Click ( Sender: TObject );
|
|
begin
|
|
if PickColor1.Down then
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIEEyeDropper;
|
|
Transparent1.Checked := False;
|
|
Opacity1.Text := '100';
|
|
Alpha := 100;
|
|
PaintColor.Color := OldPaintColor;
|
|
SelectNone1.Down := True;
|
|
MouseInteract := [ ];
|
|
DeSelect;
|
|
end;
|
|
end
|
|
else
|
|
Cursor := crIECross;
|
|
end;
|
|
end;
|
|
|
|
// Pick Transparent Color
|
|
|
|
procedure TFrmMain.PickTransparent1Click ( Sender: TObject );
|
|
begin
|
|
if PickTransparent1.Down then
|
|
begin
|
|
PickDialog := TPickDialog.Create ( Self );
|
|
ImageEnView1.Cursor := crIEEyeDropper;
|
|
SelectNone1.Down := True;
|
|
ImageEnView1.MouseInteract := [ ];
|
|
ImageEnView1.DeSelect;
|
|
PickTransparent1.Down := True;
|
|
PickDialog.Show;
|
|
end
|
|
else
|
|
ImageEnView1.Cursor := crIECross;
|
|
end;
|
|
|
|
//PointsButton
|
|
|
|
procedure TFrmMain.PointsButtonClick ( Sender: TObject );
|
|
begin
|
|
DisplayGrid1.Checked := False;
|
|
with ImageEnView1 do
|
|
begin
|
|
DisplayGrid := False;
|
|
if Assigned ( IEBitmap ) then
|
|
begin
|
|
Cursor := crIEBrush;
|
|
CreateBrush ( Self );
|
|
end
|
|
else
|
|
Cursor := crIECrossSight;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmMain.PopupMenuMRUChange ( Sender: TObject; Source: TMenuItem;
|
|
Rebuild: Boolean );
|
|
begin
|
|
Open2.Enabled := True;
|
|
Open2.Indeterminate := False;
|
|
end;
|
|
|
|
// Create Rectangle brush
|
|
|
|
procedure TFrmMain.RectangleButtonClick ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
if PaintPoint.Down then begin
|
|
ImageEnView1.Cursor := crIEPencil;
|
|
DisplayGrid1.Checked := False;
|
|
ImageEnView1.DisplayGrid := False;
|
|
chkAntialias.Checked := not RectangleButton.Down;
|
|
CreateBrush ( Self );
|
|
end
|
|
else begin
|
|
ImageEnView1.Cursor := crIECrossSight;
|
|
CreateBrush ( Self );
|
|
end;
|
|
end;
|
|
|
|
// Redo
|
|
|
|
procedure TFrmMain.Redo1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
with Proc do
|
|
begin
|
|
SaveUndoCaptioned ( RedoCaptions [ 0 ], ieuImage );
|
|
Redo;
|
|
ClearRedo;
|
|
end;
|
|
IO.Params.Width := IEBitmap.Width;
|
|
IO.Params.Height := IEBitmap.Height;
|
|
Update;
|
|
UpdateUndoMenu;
|
|
UpdateStatusBar;
|
|
Fit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Resample
|
|
|
|
procedure TFrmMain.Resample1Click ( Sender: TObject );
|
|
var
|
|
w, h: integer;
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
frmResize := TfrmResize.Create ( Self );
|
|
try
|
|
frmResize.OrgWidth := Bitmap.Width;
|
|
frmResize.OrgHeight := Bitmap.Height;
|
|
frmResize.Caption := 'Resample';
|
|
frmResize.Caption := ' Resample image';
|
|
frmResize.Resize := False;
|
|
frmResize.Resample := True;
|
|
frmResize.ImageEnView1.Assign ( IEBitmap );
|
|
frmResize.ImageEnView1.Fit;
|
|
if frmResize.ShowModal = mrOK then
|
|
begin
|
|
FrmMsg := TFrmMsg.Create ( Self );
|
|
try
|
|
FrmMsg.Msg1.Caption := 'Resamping the Picture...';
|
|
FrmMsg.Show;
|
|
FrmMsg.Msg1.Update;
|
|
Proc.SaveUndoCaptioned ( 'Resample ' + IntToStr ( Proc.UndoCount ) );
|
|
Undo1.Hint := 'Resample ' + IntToStr ( Proc.UndoCount + 1 );
|
|
Proc.ClearAllRedo;
|
|
w := StrToIntDef ( frmResize.Edit1.Text, 0 );
|
|
h := StrToIntDef ( frmResize.Edit2.Text, 0 );
|
|
Proc.Resample ( w, h, TResampleFilter ( frmResize.ComboBox1.ItemIndex ) );
|
|
Invalidate;
|
|
IO.Params.Width := IEBitmap.Width;
|
|
IO.Params.Height := IEBitmap.Height;
|
|
Update;
|
|
UpdateUndoMenu;
|
|
UpdateStatusbar;
|
|
Sleep ( 1000 );
|
|
finally; FrmMsg.Free; end;
|
|
end;
|
|
finally frmResize.Free; end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Resize
|
|
|
|
procedure TFrmMain.Resize1Click ( Sender: TObject );
|
|
var
|
|
w, h: integer;
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
frmResize := TfrmResize.Create ( Self );
|
|
try
|
|
frmResize.OrgWidth := IEBitmap.Width;
|
|
frmResize.OrgHeight := IEBitmap.Height;
|
|
frmResize.Caption := 'Resize';
|
|
frmResize.Caption := ' Resize Image';
|
|
frmResize.Resize := True;
|
|
frmResize.Resample := False;
|
|
frmResize.ImageEnView1.Assign ( IEBitmap );
|
|
frmResize.ImageEnView1.Fit;
|
|
if frmResize.ShowModal = mrOK then
|
|
begin
|
|
FrmMsg := TFrmMsg.Create ( Self );
|
|
try
|
|
FrmMsg.Msg1.Caption := 'Resizing the Picture...';
|
|
FrmMsg.Show;
|
|
FrmMsg.Msg1.Update;
|
|
Proc.ClearAllRedo;
|
|
Proc.SaveUndoCaptioned ( 'Resize ' + IntToStr ( Proc.UndoCount ) );
|
|
Undo1.Hint := 'Resize ' + IntToStr ( Proc.UndoCount + 1 );
|
|
w := StrToIntDef ( frmResize.Edit1.Text, 0 );
|
|
h := StrToIntDef ( frmResize.Edit2.Text, 0 );
|
|
Proc.ImageResize ( w, h );
|
|
Invalidate;
|
|
IO.Params.Width := IEBitmap.Width;
|
|
IO.Params.Height := IEBitmap.Height;
|
|
Update;
|
|
UpdateUndoMenu;
|
|
UpdateStatusbar;
|
|
Sleep ( 1000 );
|
|
finally; FrmMsg.Free; end;
|
|
end;
|
|
finally frmResize.Free; end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Rotate
|
|
|
|
procedure TFrmMain.Rotate1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
frmRotate := TfrmRotate.Create ( Self );
|
|
try
|
|
frmRotate.ImageEnView1.IEBitmap.Assign ( IEBitmap );
|
|
frmRotate.ImageEnView1.Update;
|
|
if frmRotate.ShowModal = mrOk then
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
try
|
|
FrmMsg := TFrmMsg.Create ( Self );
|
|
try
|
|
FrmMsg.Msg1.Caption := 'Rotating the Picture...';
|
|
FrmMsg.Show;
|
|
try
|
|
FrmMsg.Msg1.Update;
|
|
Sleep ( 1000 );
|
|
Proc.SaveUndoCaptioned ( 'Rotate ' + IntToStr ( Proc.UndoCount ) );
|
|
Proc.ClearAllRedo;
|
|
Undo1.Hint := 'Rotate ' + IntToStr ( Proc.UndoCount + 1 );
|
|
Proc.Rotate ( StrToIntDef ( frmRotate.Edit1.Text, 90 ) );
|
|
Update;
|
|
Fit;
|
|
UpdateUndoMenu;
|
|
UpdateStatusbar;
|
|
finally; FrmMsg.Free; end;
|
|
finally; Screen.Cursor := crDefault; end;
|
|
finally; FrmMsg.Hide; end;
|
|
end;
|
|
finally; frmRotate.Free; end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// BMP_HandleTransparency
|
|
|
|
procedure TFrmMain.BackGroundColorClick ( Sender: TObject );
|
|
begin
|
|
ColorDialog1.Color := BackGroundColor.Color;
|
|
if ColorDialog1.Execute then
|
|
BackGroundColor.Color := ColorDialog1.Color;
|
|
end;
|
|
|
|
procedure TFrmMain.BMP_HandleTransparency1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
IO.Params.BMP_HandleTransparency := BMP_HandleTransparency1.Checked;
|
|
end;
|
|
end;
|
|
|
|
// Select brush color
|
|
|
|
procedure TFrmMain.BrushColorClick ( Sender: TObject );
|
|
begin
|
|
ColorDialog1.Color := BrushColor.Color;
|
|
if ColorDialog1.Execute then
|
|
BrushColor.Color := ColorDialog1.Color;
|
|
CreateBrush ( Self );
|
|
end;
|
|
|
|
|
|
// ImageEnView1MouseDown
|
|
|
|
procedure TFrmMain.ImageEnView1MouseDown ( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
|
|
var
|
|
Transparency: integer;
|
|
begin
|
|
startX := X;
|
|
startY := Y;
|
|
if ( PageControl2.ActivePage = DrawTab2 ) and PaintPoint.Down then
|
|
begin
|
|
// Paint Point
|
|
with ImageEnView1 do
|
|
begin
|
|
Proc.SaveUndo ( ieuImage );
|
|
X := XScr2Bmp ( X );
|
|
Y := YScr2Bmp ( Y );
|
|
fLastPointX := X;
|
|
fLastPointY := Y;
|
|
Transparency := ( ( StrToInt ( Opacity1.Text ) * 255 ) div 100 );
|
|
IEBitmap.Canvas.Pixels [ X, Y ] := PaintColor.Color;
|
|
IEBitmap.AlphaChannel.Canvas.Pen.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
IEBitmap.AlphaChannel.Canvas.Brush.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
IEBitmap.AlphaChannel.Canvas.Pixels [ X, Y ] := PaintColor.Color;
|
|
IEBitmap.Alpha [ X, Y ] := Transparency;
|
|
Update;
|
|
end;
|
|
UpdateUndoMenu;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and PaintLine.Down then
|
|
begin
|
|
// Begin paint line
|
|
ImageEnView1.Proc.SaveUndo ( ieuImage );
|
|
UpdateUndoMenu;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and PaintRectangle.Down then
|
|
begin
|
|
// Begin paint Rectangle
|
|
ImageEnView1.Proc.SaveUndo ( ieuImage );
|
|
UpdateUndoMenu;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and PaintEllipse.Down then
|
|
begin
|
|
// Begin paint ellipse
|
|
ImageEnView1.Proc.SaveUndo ( ieuImage );
|
|
UpdateUndoMenu;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and Fill1.Down then
|
|
begin
|
|
// fill
|
|
with ImageEnView1 do
|
|
begin
|
|
Proc.SaveUndo ( ieuImage );
|
|
Proc.CastColor ( CurrentLayer.ConvXScr2Bmp ( X ), CurrentLayer.ConvYScr2Bmp ( Y ), TColor2TRGB ( FillColor.Color ), StrToInt ( FillTolerance1.Text ) );
|
|
Update;
|
|
UpdateUndoMenu;
|
|
end;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and PickColor1.Down and ImageEnView1.MouseCapture then
|
|
begin
|
|
// pick color
|
|
with ImageEnView1 do
|
|
begin
|
|
PaintColor.Color := IEBitmap.Canvas.Pixels [ CurrentLayer.ConvXScr2Bmp ( X ), CurrentLayer.ConvYScr2Bmp ( Y ) ];
|
|
BrushColor.Color := IEBitmap.Canvas.Pixels [ CurrentLayer.ConvXScr2Bmp ( X ), CurrentLayer.ConvYScr2Bmp ( Y ) ];
|
|
end;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and Erase1.Down then
|
|
begin
|
|
// erase
|
|
with ImageEnView1 do
|
|
begin
|
|
X := XScr2Bmp ( X );
|
|
Y := YScr2Bmp ( Y );
|
|
if ( IO.Params.BitsPerSample = 8 ) and ( IO.Params.SamplesPerPixel = 4 ) then
|
|
Transparency := 0
|
|
else
|
|
Transparency := 255;
|
|
IEBitmap.Canvas.Pixels [ X, Y ] := TransparentColor.Color;
|
|
IEBitmap.AlphaChannel.Canvas.Pen.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
IEBitmap.AlphaChannel.Canvas.Brush.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
IEBitmap.AlphaChannel.Canvas.Pixels [ X, Y ] := TransparentColor.Color;
|
|
IEBitmap.Alpha [ X, Y ] := Transparency;
|
|
Update;
|
|
end;
|
|
UpdateUndoMenu;
|
|
end
|
|
else if ( PageControl2.ActivePage = PaintTab ) then begin
|
|
// paint
|
|
ImageEnView1.Proc.SaveUndo ( ieuImage );
|
|
UpdateUndoMenu;
|
|
ImageEnView1MouseMove ( self, Shift, X, Y );
|
|
end;
|
|
end;
|
|
|
|
// moving mouse (move the brush layer)
|
|
|
|
procedure TFrmMain.ImageEnView1MouseMove ( Sender: TObject; Shift: TShiftState; X, Y: Integer );
|
|
var
|
|
px, py: integer;
|
|
bx, by: integer;
|
|
op: TIERenderOperation;
|
|
Transparency: integer;
|
|
cl_rgb: TRGB;
|
|
begin
|
|
if ( PageControl2.ActivePage = DrawTab2 ) and PaintPoint.Down and ImageEnView1.MouseCapture then
|
|
begin
|
|
// Paint Point
|
|
with ImageEnView1 do
|
|
begin
|
|
X := XScr2Bmp ( X );
|
|
Y := YScr2Bmp ( Y );
|
|
Transparency := ( ( StrToInt ( Opacity1.Text ) * 255 ) div 100 );
|
|
|
|
if chkContinuous.checked then
|
|
begin
|
|
IEBitmap.Canvas.Pen.Color := PaintColor.Color;
|
|
IEBitmap.Canvas.MoveTo( X, Y ) ;
|
|
IEBitmap.Canvas.LineTo( fLastPointX, fLastPointY );
|
|
|
|
// HAVE NOT TESTED THIS ALPHA CODE
|
|
IEBitmap.AlphaChannel.Canvas.Pen.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
IEBitmap.AlphaChannel.Canvas.MoveTo( X, Y ) ;
|
|
IEBitmap.AlphaChannel.Canvas.LineTo( fLastPointX, fLastPointY );
|
|
end
|
|
else
|
|
begin
|
|
IEBitmap.Canvas.Pixels [ X, Y ] := PaintColor.Color;
|
|
IEBitmap.Alpha [ X, Y ] := Transparency;
|
|
end;
|
|
|
|
|
|
fLastPointX := X;
|
|
fLastPointY := Y;
|
|
Update;
|
|
end;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and PaintLine.Down and ImageEnView1.MouseCapture then
|
|
begin
|
|
// Paint Line
|
|
with ImageEnView1 do
|
|
begin
|
|
Proc.UndoRect ( XScr2Bmp ( startX ), YScr2Bmp ( startY ), XScr2Bmp ( lastX ), YScr2Bmp ( lastY ) );
|
|
SetSquarePen ( IEBitmap.Canvas, PaintColor.Color, 1 );
|
|
Transparency := ( ( StrToInt ( Opacity1.Text ) * 255 ) div 100 );
|
|
IEBitmap.Canvas.Brush.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
IEBitmap.Canvas.MoveTo ( XScr2Bmp ( startX ), YScr2Bmp ( startY ) );
|
|
IEBitmap.Canvas.LineTo ( XScr2Bmp ( X ), YScr2Bmp ( Y ) );
|
|
IEBitmap.Canvas.LineTo ( XScr2Bmp ( startX ), YScr2Bmp ( startY ) );
|
|
//IEBitmap.Alpha [ XScr2Bmp ( X ), YScr2Bmp ( Y ) ] := Transparency;
|
|
if ( IO.Params.BitsPerSample = 8 ) and ( IO.Params.SamplesPerPixel = 4 ) then
|
|
SetSquarePen ( IEBitmap.AlphaChannel.Canvas, $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 ), 1 )
|
|
else
|
|
SetSquarePen ( IEBitmap.AlphaChannel.Canvas, $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 ), 1 );
|
|
IEBitmap.AlphaChannel.Canvas.Brush.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
IEBitmap.AlphaChannel.Canvas.MoveTo ( XScr2Bmp ( startX ), YScr2Bmp ( startY ) );
|
|
IEBitmap.AlphaChannel.Canvas.LineTo ( XScr2Bmp ( X ), YScr2Bmp ( Y ) );
|
|
IEBitmap.AlphaChannel.Canvas.LineTo ( XScr2Bmp ( startX ), YScr2Bmp ( startY ) );
|
|
//IEBitmap.Alpha [ XScr2Bmp ( X ), YScr2Bmp ( Y ) ] := Transparency;
|
|
Update;
|
|
end;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and PaintEllipse.Down and ImageEnView1.MouseCapture then
|
|
begin
|
|
// Paint Ellipse
|
|
with ImageEnView1 do
|
|
begin
|
|
Proc.UndoRect ( XScr2Bmp ( startX ), YScr2Bmp ( startY ), XScr2Bmp ( lastX ), YScr2Bmp ( lastY ) );
|
|
IEBitmap.Canvas.Pen.Color := PaintColor.Color;
|
|
if not Filled1.Checked then begin
|
|
IEBitmap.Canvas.Brush.Style := bsClear;
|
|
IEBitmap.Canvas.Ellipse ( XScr2Bmp ( startX ), YScr2Bmp ( startY ), XScr2Bmp ( X ), YScr2Bmp ( Y ) );
|
|
end
|
|
else
|
|
begin
|
|
if DrawBorderOpague1.Checked then
|
|
Transparency := 255
|
|
else
|
|
Transparency := ( ( StrToInt ( Opacity1.Text ) * 255 ) div 100 );
|
|
IEBitmap.Canvas.Ellipse ( XScr2Bmp ( startX ), YScr2Bmp ( startY ), XScr2Bmp ( X ), YScr2Bmp ( Y ) );
|
|
IEBitmap.Canvas.Pen.Color := PaintColor.Color;
|
|
IEBitmap.Canvas.Brush.Color := FillColor.Color;
|
|
IEBitmap.AlphaChannel.Canvas.Brush.Color := FillColor.Color;
|
|
IEBitmap.Canvas.Brush.Style := bsSolid;
|
|
IEBitmap.AlphaChannel.Canvas.Pen.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
Transparency := ( ( StrToInt ( Opacity1.Text ) * 255 ) div 100 );
|
|
IEBitmap.AlphaChannel.Canvas.Brush.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
if DrawBorderOpague1.Checked then
|
|
Transparency := 255
|
|
else
|
|
Transparency := ( ( StrToInt ( Opacity1.Text ) * 255 ) div 100 );
|
|
IEBitmap.AlphaChannel.Canvas.Ellipse ( XScr2Bmp ( startX ), YScr2Bmp ( startY ), XScr2Bmp ( X ), YScr2Bmp ( Y ) );
|
|
end;
|
|
Update;
|
|
end;
|
|
Update;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and PaintRectangle.Down and ImageEnView1.MouseCapture then
|
|
begin
|
|
// Paint Rectangle
|
|
with ImageEnView1 do
|
|
begin
|
|
Proc.UndoRect ( XScr2Bmp ( startX ), YScr2Bmp ( startY ), XScr2Bmp ( lastX ), YScr2Bmp ( lastY ) );
|
|
IEBitmap.Canvas.Pen.Color := PaintColor.Color;
|
|
if not Filled1.Checked then begin
|
|
IEBitmap.Canvas.Brush.Style := bsClear;
|
|
IEBitmap.Canvas.Rectangle ( XScr2Bmp ( startX ), YScr2Bmp ( startY ), XScr2Bmp ( X ), YScr2Bmp ( Y ) );
|
|
end
|
|
else
|
|
begin
|
|
if DrawBorderOpague1.Checked then
|
|
Transparency := 255
|
|
else
|
|
Transparency := ( ( StrToInt ( Opacity1.Text ) * 255 ) div 100 );
|
|
IEBitmap.Canvas.Rectangle ( XScr2Bmp ( startX ), YScr2Bmp ( startY ), XScr2Bmp ( X ), YScr2Bmp ( Y ) );
|
|
IEBitmap.Canvas.Pen.Color := PaintColor.Color;
|
|
IEBitmap.Canvas.Brush.Color := FillColor.Color;
|
|
IEBitmap.AlphaChannel.Canvas.Brush.Color := FillColor.Color;
|
|
IEBitmap.Canvas.Brush.Style := bsSolid;
|
|
IEBitmap.AlphaChannel.Canvas.Pen.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
Transparency := ( ( StrToInt ( Opacity1.Text ) * 255 ) div 100 );
|
|
IEBitmap.AlphaChannel.Canvas.Brush.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
if DrawBorderOpague1.Checked then
|
|
Transparency := 255
|
|
else
|
|
Transparency := ( ( StrToInt ( Opacity1.Text ) * 255 ) div 100 );
|
|
IEBitmap.AlphaChannel.Canvas.Rectangle ( XScr2Bmp ( startX ), YScr2Bmp ( startY ), XScr2Bmp ( X ), YScr2Bmp ( Y ) );
|
|
end;
|
|
Update;
|
|
end;
|
|
Update;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and PickColor1.Down then
|
|
begin
|
|
// Pick Color
|
|
with ImageEnView1 do
|
|
begin
|
|
Cursor := crIEEyeDropper;
|
|
PaintColor.Color := IEBitmap.Canvas.Pixels [ CurrentLayer.ConvXScr2Bmp ( X ), CurrentLayer.ConvYScr2Bmp ( Y ) ];
|
|
BrushColor.Color := IEBitmap.AlphaChannel.Canvas.Pixels [ CurrentLayer.ConvXScr2Bmp ( X ), CurrentLayer.ConvYScr2Bmp ( Y ) ];
|
|
end;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and PickTransparent1.Down then
|
|
//PickTransparent
|
|
with ImageEnView1 do
|
|
begin
|
|
// transform client coorindates to bitmap ones
|
|
X := XScr2Bmp ( X );
|
|
Y := YScr2Bmp ( Y );
|
|
// check limits
|
|
if ( X >= 0 ) and ( X < IEBitmap.Width ) and
|
|
( Y >= 0 ) and ( Y < IEBitmap.Height ) then
|
|
begin
|
|
cl_rgb := IEBitmap.Pixels [ X, Y ];
|
|
PickDialog.ColorUnderCursor1.Color := TRGB2TColor ( cl_rgb );
|
|
Application.ProcessMessages;
|
|
PickDialog.ColorUnderCursor1.Invalidate;
|
|
with cl_rgb do
|
|
PickDialog.Label3.Caption := 'RGB: ' + IntToStr ( r ) + ',' + IntToStr ( g ) + ',' + IntToStr ( b );
|
|
PickDialog.Label4.Caption := 'Color: ' + ColorToString ( PickDialog.ColorUnderCursor1.Color );
|
|
end;
|
|
if ( ssLeft in Shift ) and ( PickTransparent1.Down ) then
|
|
begin
|
|
PickDialog.PickColor.Color := TRGB2TColor ( cl_rgb );
|
|
SetTransparent;
|
|
Cursor := crIECross;
|
|
PickTransparent1.Down := False;
|
|
PickDialog.Free;
|
|
end;
|
|
end
|
|
else if ( PageControl2.ActivePage = DrawTab2 ) and Erase1.Down and ImageEnView1.MouseCapture then
|
|
begin
|
|
// Erase
|
|
with ImageEnView1 do
|
|
begin
|
|
X := XScr2Bmp ( X );
|
|
Y := YScr2Bmp ( Y );
|
|
if ( IO.Params.BitsPerSample = 8 ) and ( IO.Params.SamplesPerPixel = 4 ) then
|
|
Transparency := 0
|
|
else
|
|
Transparency := 255;
|
|
IEBitmap.Canvas.Pixels [ X, Y ] := TransparentColor.Color;
|
|
IEBitmap.AlphaChannel.Canvas.Pen.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
IEBitmap.AlphaChannel.Canvas.Brush.Color := $02000000 or ( Transparency ) or ( Transparency shl 8 ) or ( Transparency shl 16 );
|
|
IEBitmap.AlphaChannel.Canvas.Pixels [ X, Y ] := TransparentColor.Color;
|
|
IEBitmap.Alpha [ X, Y ] := Transparency;
|
|
Update;
|
|
end;
|
|
end
|
|
else if ( PageControl2.ActivePage = PaintTab2 ) then
|
|
begin
|
|
// Paint
|
|
op := TIERenderOperation ( Self.Operation.ItemIndex );
|
|
with ImageEnView1 do
|
|
if LayersCount = 2 then
|
|
begin
|
|
with Layers [ 1 ] do
|
|
begin
|
|
bx := IEBitmap.Width;
|
|
by := IEBitmap.Height;
|
|
if chkAntialias.Checked then
|
|
begin
|
|
Width := bx div 2;
|
|
Height := by div 2;
|
|
end;
|
|
px := XScr2Bmp ( X ) - Width div 2;
|
|
py := YScr2Bmp ( Y ) - Height div 2;
|
|
PosX := px;
|
|
PosY := py;
|
|
Operation := op;
|
|
end;
|
|
if MouseCapture then // paint the layer (the brush...)
|
|
begin
|
|
ImageEnView1.Proc.SaveUndo ( ieuImage );
|
|
if chkAntialias.Checked then
|
|
Layers [ 1 ].Bitmap.RenderToTIEBitmapEx ( Layers [ 0 ].Bitmap, px, py, bx div 2, by div 2, 0, 0, bx, by, True, 255, rfFastLinear, op )
|
|
else
|
|
Layers [ 1 ].Bitmap.RenderToTIEBitmapEx ( Layers [ 0 ].Bitmap, px, py, bx, by, 0, 0, bx, by, True, 255, rfNone, op );
|
|
Layers [ 1 ].Bitmap.MergeAlphaRectTo ( Layers [ 0 ].Bitmap, 0, 0, px, py, bx, by );
|
|
end;
|
|
Update;
|
|
end;
|
|
end;
|
|
lastX := X;
|
|
lastY := Y;
|
|
end;
|
|
|
|
// ImageEnView1MouseUp
|
|
|
|
procedure TFrmMain.ImageEnView1MouseUp ( Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer );
|
|
begin
|
|
if PickColor1.Down then
|
|
begin
|
|
// Reset PickColor
|
|
PickColor1.Down := False;
|
|
PaintPoint.Down := True;
|
|
ImageEnView1.Cursor := crIEBrush;
|
|
end
|
|
else if Fill1.Down then
|
|
begin
|
|
// Reset Fill
|
|
Fill1.Down := False;
|
|
ImageEnView1.Cursor := crIEBrush;
|
|
end;
|
|
UpdateStatusBar;
|
|
end;
|
|
|
|
|
|
// CreateBrush
|
|
|
|
procedure TFrmMain.CreateBrush ( Sender: TObject );
|
|
var
|
|
brushsiz: integer;
|
|
c: TColor;
|
|
transpvalue: integer;
|
|
i: integer;
|
|
x, y: integer;
|
|
begin
|
|
if ImageEnView1.LayersCount = 1 then
|
|
ImageEnView1.LayersAdd;
|
|
ImageEnView1.LayersCurrent := 1;
|
|
brushsiz := StrToIntDef ( BrushSize.Text, 1 );
|
|
if brushsiz = 1 then
|
|
chkAntialias.Checked := false;
|
|
if chkAntialias.Checked then
|
|
brushsiz := brushsiz * 2;
|
|
ImageEnView1.Proc.ImageResize ( brushsiz, brushsiz, iehLeft, ievTop );
|
|
// prepare main color
|
|
ImageEnView1.IEBitmap.Canvas.Brush.Color := BrushColor.Color;
|
|
ImageEnView1.IEBitmap.Canvas.Pen.Color := BrushColor.Color;
|
|
// prepare alpha channel
|
|
ImageEnView1.AlphaChannel.Fill ( 0 );
|
|
with ImageEnView1.AlphaChannel.Canvas do
|
|
begin
|
|
transpvalue := StrToIntDef ( Transparency.Text, 255 );
|
|
c := $02000000 or ( transpvalue ) or ( transpvalue shl 8 ) or ( transpvalue shl 16 );
|
|
Brush.Color := c;
|
|
Pen.Color := c;
|
|
end;
|
|
// draws a rectangle brush
|
|
if RectangleButton.Down then
|
|
begin
|
|
// draw the shape
|
|
ImageEnView1.IEBitmap.Canvas.Rectangle ( 0, 0, brushsiz + 1, brushsiz + 1 );
|
|
// draw the shape alpha channel
|
|
ImageEnView1.AlphaChannel.Canvas.Rectangle ( 0, 0, brushsiz + 1, brushsiz + 1 );
|
|
end
|
|
// draws a circle brush
|
|
else if CircleButton.Down then
|
|
begin
|
|
// draw the shape
|
|
ImageEnView1.IEBitmap.Canvas.Ellipse ( 0, 0, brushsiz + 1, brushsiz + 1 );
|
|
// draw the shape alpha channel
|
|
ImageEnView1.AlphaChannel.Canvas.Ellipse ( 0, 0, brushsiz + 1, brushsiz + 1 );
|
|
end
|
|
// draws random points brush (should be a "spray"...)
|
|
else if PointsButton.Down and ( brushsiz > 1 ) then
|
|
begin
|
|
for i := 0 to brushsiz * 3 do // change "3" to adjust the spary intensity
|
|
begin
|
|
repeat
|
|
x := random ( brushsiz );
|
|
y := random ( brushsiz );
|
|
until sqr ( x - brushsiz div 2 ) + sqr ( y - brushsiz div 2 ) < sqr ( brushsiz div 2 ); // repeat until (x,y) is inside a circle!
|
|
ImageEnView1.IEBitmap.Canvas.Pixels [ x, y ] := BrushColor.Color;
|
|
ImageEnView1.AlphaChannel.Canvas.Pixels [ x, y ] := c;
|
|
end;
|
|
end;
|
|
ImageEnView1MouseMove ( self, [ ], 0, 0 ); // refresh current brush
|
|
end;
|
|
|
|
// Crop
|
|
|
|
procedure TFrmMain.Crop1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
if Selected then
|
|
begin
|
|
FrmMsg := TFrmMsg.Create ( Self );
|
|
try
|
|
FrmMsg.Msg1.Caption := 'Cropping the Picture...';
|
|
FrmMsg.Show;
|
|
FrmMsg.Msg1.Update;
|
|
Proc.SaveUndoCaptioned ( 'Crop ' + IntToStr ( Proc.UndoCount ) );
|
|
Undo1.Hint := 'Crop ' + IntToStr ( Proc.UndoCount + 1 );
|
|
Proc.ClearAllRedo;
|
|
Proc.CropSel;
|
|
DeSelect;
|
|
IO.Params.Width := IEBitmap.Width;
|
|
IO.Params.Height := IEBitmap.Height;
|
|
Update;
|
|
UpdateUndoMenu;
|
|
UpdateStatusBar;
|
|
Sleep ( 1000 );
|
|
finally; FrmMsg.Free; end;
|
|
end
|
|
else
|
|
TaskMessageDlg ( 'Error', 'Please select an area of the image to crop.', mtError, [ mbOK ], 0 );
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//Cut
|
|
|
|
procedure TFrmMain.Cut1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
if Selected then begin
|
|
Proc.SaveUndoCaptioned ( 'Cut ' + IntToStr ( Proc.UndoCount ) );
|
|
Undo1.Hint := 'Cut ' + IntToStr ( Proc.UndoCount + 1 );
|
|
Proc.ClearAllRedo;
|
|
Proc.SelCutToClip;
|
|
UpdateUndoMenu;
|
|
UpdateStatusbar;
|
|
end
|
|
else
|
|
TaskMessageDlg ( 'Error', 'Please select an area of the image to crop.', mtError, [ mbOK ], 0 );
|
|
Paste1.Enabled := ( Clipboard.HasFormat ( IERAWCLIPFORMAT ) ) or ( Clipboard.HasFormat ( CF_PICTURE ) );
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// DisplayGrid
|
|
|
|
procedure TFrmMain.DisplayGrid1Click ( Sender: TObject );
|
|
begin
|
|
ImageEnView1.DisplayGrid := DisplayGrid1.Checked;
|
|
end;
|
|
|
|
// Create round brush
|
|
|
|
procedure TFrmMain.CircleButtonClick ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
if CircleButton.Down then begin
|
|
ImageEnView1.Cursor := crIEPencil;
|
|
DisplayGrid1.Checked := False;
|
|
ImageEnView1.DisplayGrid := False;
|
|
chkAntialias.Checked := not CircleButton.Down;
|
|
CreateBrush ( Self );
|
|
end
|
|
else begin
|
|
ImageEnView1.Cursor := crIECrossSight;
|
|
CreateBrush ( Self );
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmMain.Clear1Click ( Sender: TObject );
|
|
var
|
|
i, j: integer;
|
|
begin
|
|
for i := PopupMenuMRU.Items.Count - 1 downto 2 do
|
|
PopupMenuMRU.Items.Delete ( i );
|
|
for j := MRUFiles.Count - 1 downto 0 do
|
|
MRUFiles.Delete ( j );
|
|
end;
|
|
|
|
// select paint color
|
|
|
|
procedure TFrmMain.PaintColorClick ( Sender: TObject );
|
|
begin
|
|
ColorDialog1.Color := PaintColor.Color;
|
|
if ColorDialog1.Execute then
|
|
PaintColor.Color := ColorDialog1.Color;
|
|
end;
|
|
|
|
//PaintEllipse
|
|
|
|
procedure TFrmMain.PaintEllipseClick ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
if PaintEllipse.Down then
|
|
ImageEnView1.Cursor := crIEPencil
|
|
else
|
|
ImageEnView1.Cursor := crIECrossSight;
|
|
end;
|
|
|
|
//PaintLine
|
|
|
|
procedure TFrmMain.PaintLineClick ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
if PaintLine.Down then
|
|
ImageEnView1.Cursor := crIEPencil
|
|
else
|
|
ImageEnView1.Cursor := crIECrossSight;
|
|
end;
|
|
|
|
//PaintPoint
|
|
|
|
procedure TFrmMain.PaintPointClick ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
if PaintPoint.Down then
|
|
ImageEnView1.Cursor := crIEPencil
|
|
else
|
|
ImageEnView1.Cursor := crIECrossSight;
|
|
end;
|
|
|
|
// PaintRectangle
|
|
|
|
procedure TFrmMain.PaintRectangleClick ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
if PaintRectangle.Down then
|
|
ImageEnView1.Cursor := crIEPencil
|
|
else
|
|
ImageEnView1.Cursor := crIECrossSight;
|
|
end;
|
|
|
|
// Paste
|
|
|
|
procedure TFrmMain.Paste1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
frmPaste := TfrmPaste.Create ( Self );
|
|
try
|
|
frmPaste.PopupParent := Self;
|
|
if frmPaste.ShowModal = mrOk then
|
|
begin
|
|
if ( Clipboard.HasFormat ( IERAWCLIPFORMAT ) ) or
|
|
( Clipboard.HasFormat ( CF_PICTURE ) ) then
|
|
begin
|
|
if ( Clipboard.HasFormat ( CF_PICTURE ) ) or ( Clipboard.HasFormat ( IERAWCLIPFORMAT ) ) then
|
|
case frmPaste.PasteTypeRadioGroup1.ItemIndex of
|
|
0:
|
|
begin
|
|
Proc.SaveUndoCaptioned ( 'Paste ' + IntToStr ( Proc.UndoCount ) );
|
|
Undo1.Hint := 'Paste ' + IntToStr ( Proc.UndoCount + 1 );
|
|
Proc.ClearAllRedo;
|
|
Proc.PasteFromClipboard;
|
|
Update;
|
|
UpdateUndoMenu;
|
|
UpdateStatusbar;
|
|
end;
|
|
1:
|
|
begin
|
|
if VisibleSelection then
|
|
begin
|
|
with Proc do
|
|
begin
|
|
SaveUndoCaptioned ( 'PasteFromClipStretch ' + IntToStr ( UndoCount ) );
|
|
Undo1.Hint := 'PasteFromClipStretch ' + IntToStr ( UndoCount + 1 );
|
|
SelPasteFromClip( True, False, True );
|
|
Update;
|
|
UpdateStatusBar;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally; frmPaste.Free; end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//PageControl1Change
|
|
|
|
procedure TFrmMain.PageControl1Change ( Sender: TObject );
|
|
begin
|
|
if PageControl1.ActivePage <> PaintTab then begin
|
|
ImageEnView1.LayersRemove ( 1 );
|
|
ImageEnView1.DisplayGrid := DisplayGrid1.Checked;
|
|
end;
|
|
if PageControl1.ActivePage = DrawTab then begin
|
|
PageControl2.ActivePage := DrawTab2;
|
|
end
|
|
else if PageControl1.ActivePage = PaintTab then begin
|
|
PageControl2.ActivePage := PaintTab2;
|
|
ImageEnView1.DisplayGrid := False;
|
|
CreateBrush ( Self );
|
|
end
|
|
else
|
|
ImageEnView1.DisplayGrid := DisplayGrid1.Checked;
|
|
end;
|
|
|
|
// PageControl2Change
|
|
|
|
procedure TFrmMain.PageControl2Change ( Sender: TObject );
|
|
begin
|
|
if PageControl2.ActivePage <> PaintTab2 then begin
|
|
ImageEnView1.LayersRemove ( 1 );
|
|
ImageEnView1.DisplayGrid := DisplayGrid1.Checked;
|
|
end;
|
|
if PageControl2.ActivePage = DrawTab2 then begin
|
|
PageControl1.ActivePage := DrawTab;
|
|
end
|
|
else if PageControl2.ActivePage = PaintTab2 then begin
|
|
PageControl1.ActivePage := PaintTab;
|
|
ImageEnView1.DisplayGrid := False;
|
|
CreateBrush ( Self );
|
|
end;
|
|
end;
|
|
|
|
//IEMagicWandMode
|
|
|
|
procedure TFrmMain.IEMagicWandMode1Change ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
with ImageEnView1 do begin
|
|
MagicWandMode := TIEMagicWandMode ( IEMagicWandMode1.ItemIndex );
|
|
end;
|
|
end;
|
|
|
|
// ConvertTo24Bit
|
|
|
|
procedure TFrmMain.ConvertTo24Bit1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
FrmMsg := TFrmMsg.Create ( Self );
|
|
try
|
|
FrmMsg.Msg1.Caption := 'Converting To 24-bit...';
|
|
FrmMsg.Show;
|
|
FrmMsg.Msg1.Update;
|
|
Sleep ( 1000 );
|
|
with ImageEnView1 do
|
|
begin
|
|
Proc.SaveUndoCaptioned ( 'Convert To 24-bit ' + IntToStr ( Proc.UndoCount ) );
|
|
Undo1.Hint := 'Convert To 24-bit ' + IntToStr ( Proc.UndoCount + 1 );
|
|
Proc.ClearAllRedo;
|
|
IO.Params.BitsPerSample := 8;
|
|
IO.Params.SamplesPerPixel := 3;
|
|
RemoveAlphaChannel;
|
|
end;
|
|
finally; FrmMsg.Free; end;
|
|
end;
|
|
ImageEnView1.Update;
|
|
UpdateUndoMenu;
|
|
UpdateStatusbar;
|
|
end;
|
|
|
|
// ConvertTo8Bit
|
|
|
|
procedure TFrmMain.ConvertTo8Bit1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
FrmMsg := TFrmMsg.Create ( Self );
|
|
try
|
|
FrmMsg.Msg1.Caption := 'Converting To 8-bit...';
|
|
FrmMsg.Show;
|
|
FrmMsg.Msg1.Update;
|
|
Sleep ( 1000 );
|
|
with ImageEnView1 do
|
|
begin
|
|
Proc.SaveUndoCaptioned ( 'Convert To 8-bit ' + IntToStr ( Proc.UndoCount ) );
|
|
Undo1.Hint := 'Convert To 8-bit ' + IntToStr ( Proc.UndoCount + 1 );
|
|
Proc.ClearAllRedo;
|
|
Proc.ConvertTo ( 256, ieThreshold );
|
|
IO.Params.BitsPerSample := 8;
|
|
IO.Params.SamplesPerPixel := 1;
|
|
RemoveAlphaChannel;
|
|
end;
|
|
finally; FrmMsg.Free; end;
|
|
end;
|
|
ImageEnView1.Update;
|
|
UpdateUndoMenu;
|
|
UpdateStatusbar;
|
|
end;
|
|
|
|
// Copy
|
|
|
|
procedure TFrmMain.Copy1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
if VisibleSelection then
|
|
Proc.SelCopyToClip
|
|
else
|
|
Proc.CopyToClipboard;
|
|
Paste1.Enabled := ( Clipboard.HasFormat ( IERAWCLIPFORMAT ) ) or ( Clipboard.HasFormat ( CF_PICTURE ) );
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// ConvertTo4Bit
|
|
|
|
procedure TFrmMain.ConvertTo4Bit1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
FrmMsg := TFrmMsg.Create ( Self );
|
|
try
|
|
FrmMsg.Msg1.Caption := 'Converting To 4-bit...';
|
|
FrmMsg.Show;
|
|
FrmMsg.Msg1.Update;
|
|
Sleep ( 1000 );
|
|
with ImageEnView1 do
|
|
begin
|
|
Proc.SaveUndoCaptioned ( 'Convert To 4-bit ' + IntToStr ( Proc.UndoCount ) );
|
|
Undo1.Hint := 'Convert To 4-bit ' + IntToStr ( Proc.UndoCount + 1 );
|
|
Proc.ClearAllRedo;
|
|
Proc.ConvertTo ( 16, ieThreshold );
|
|
IO.Params.BitsPerSample := 4;
|
|
IO.Params.SamplesPerPixel := 1;
|
|
RemoveAlphaChannel;
|
|
end;
|
|
finally; FrmMsg.Free; end;
|
|
end;
|
|
ImageEnView1.Update;
|
|
UpdateUndoMenu;
|
|
UpdateStatusbar;
|
|
end;
|
|
|
|
// Undo
|
|
|
|
procedure TFrmMain.Undo1Click ( Sender: TObject );
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
with Proc do
|
|
begin
|
|
SaveRedoCaptioned ( UndoCaptions [ 0 ], ieuImage ); // saves in Redo list
|
|
Undo;
|
|
ClearUndo;
|
|
end;
|
|
UpdateUndoMenu;
|
|
IO.Params.Width := ImageEnView1.IEBitmap.Width;
|
|
IO.Params.Height := ImageEnView1.IEBitmap.Height;
|
|
Update;
|
|
UpdateStatusBar;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// UpdateStatusBar
|
|
|
|
procedure TFrmMain.UpdateStatusBar;
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
FilePath := IO.Params.FileName;
|
|
StatusBar1.Panels [ 0 ].Text := ExtractFilePath ( IO.Params.FileName );
|
|
StatusBar1.Panels [ 1 ].Text := ExtractFileName ( IO.Params.FileName );
|
|
StatusBar1.Panels [ 2 ].Text := IntToStr ( IO.Params.Width ) + ' x ' + IntToStr ( IO.Params.Height );
|
|
StatusBar1.Panels [ 3 ].Text := IntToStr ( IO.Params.SamplesPerPixel * IO.Params.BitsPerSample ) + ' bit';
|
|
StatusBar1.Panels [ 4 ].Text := 'Colors: ' + AddThousandSeparator ( IntToStr ( ImageEnView1.Proc.CalcImageNumColors ), ',' );
|
|
StatusBar1.Panels [ 5 ].Text := 'Zoom: ' + FloatToStrF ( Zoom, ffFixed, 10, 1 ) + '%';
|
|
StatusBar1.Panels [ 6 ].Text := 'Undo Count: ' + IntToStr ( Proc.UndoCount );
|
|
StatusBar1.Panels [ 7 ].Text := 'Undo Limit: ' + IntToStr ( Proc.UndoLimit );
|
|
ScrollBar1.Hint := 'Zoom - ' + IntToStr ( Round ( Zoom ) ) + '%';
|
|
ScrollBar1.Position := Round ( Zoom );
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// UpdateUndoMenu
|
|
|
|
procedure TFrmMain.UpdateUndoMenu;
|
|
begin
|
|
if Assigned ( ImageEnView1.IEBitmap ) then
|
|
begin
|
|
with ImageEnView1 do
|
|
begin
|
|
with Proc do
|
|
begin
|
|
// Undo
|
|
Undo1.Hint := 'Undo ';
|
|
Undo2.Hint := 'Undo ';
|
|
Undo1.Enabled := UndoCount > 0;
|
|
Undo2.Enabled := UndoCount > 0;
|
|
if UndoCount > 0 then begin
|
|
Undo1.Hint := 'Undo ' + UndoCaptions [ 0 ];
|
|
Undo2.Hint := 'Undo ' + UndoCaptions [ 0 ];
|
|
end;
|
|
// Redo
|
|
Redo1.Hint := 'Redo ';
|
|
Redo2.Hint := 'Redo ';
|
|
Redo1.Enabled := RedoCount > 0;
|
|
Redo2.Enabled := RedoCount > 0;
|
|
if RedoCount > 0 then begin
|
|
Redo1.Hint := 'Redo ' + RedoCaptions [ 0 ];
|
|
Redo2.Hint := 'Redo ' + RedoCaptions [ 0 ];
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmMain.xx1Click ( Sender: TObject );
|
|
begin
|
|
|
|
end;
|
|
|
|
// SetTransparent
|
|
|
|
procedure TFrmMain.SetTransparent;
|
|
var
|
|
cl_rgb: TRGB;
|
|
begin
|
|
cl_rgb := TColor2TRGB ( PickDialog.PickColor.Color );
|
|
ImageEnView1.Proc.SetTransparentColors ( cl_rgb, cl_rgb, 0 );
|
|
end;
|
|
|
|
end.
|
|
|