398 lines
12 KiB
Plaintext
398 lines
12 KiB
Plaintext
unit main;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, {$IfNDef VER130} Variants, {$EndIf} Classes, Graphics, Controls, Forms,
|
|
StdCtrls, ExtCtrls, ComCtrls, Dialogs, IEOpenSaveDlg, IEView, ImageEnView,
|
|
ImageEnProc, HYIEDefs, HYIEUtils, iexBitmaps, iesettings, iexLayers, iexRulers;
|
|
|
|
type
|
|
TForm1 = class ( TForm )
|
|
Panel1: TPanel;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
Edit1: TEdit;
|
|
UpDownRows: TUpDown;
|
|
Edit2: TEdit;
|
|
UpDownColumns: TUpDown;
|
|
ColorBoxGrid: TColorBox;
|
|
Button2: TButton;
|
|
ImageEnView1: TImageEnView;
|
|
OpenImageEnDialog1: TOpenImageEnDialog;
|
|
GroupBox1: TGroupBox;
|
|
Button3: TButton;
|
|
ImageEnView2: TImageEnView;
|
|
Label6: TLabel;
|
|
Label7: TLabel;
|
|
Bevel1: TBevel;
|
|
CheckBoxProportional: TCheckBox;
|
|
Label5: TLabel;
|
|
Label8: TLabel;
|
|
Label9: TLabel;
|
|
Bevel2: TBevel;
|
|
Bevel3: TBevel;
|
|
Button4: TButton;
|
|
SaveImageEnDialog1: TSaveImageEnDialog;
|
|
Label4: TLabel;
|
|
Label10: TLabel;
|
|
FontSizeEdit: TEdit;
|
|
FontSizeUpDown: TUpDown;
|
|
FontComboBox: TComboBox;
|
|
Label11: TLabel;
|
|
Splitter1: TSplitter;
|
|
NegativeCheckBox: TCheckBox;
|
|
procedure FormCreate ( Sender: TObject );
|
|
procedure FormActivate ( Sender: TObject );
|
|
procedure ImageEnView1DrawBackBuffer ( Sender: TObject );
|
|
procedure ImageEnView1MouseDown ( Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer );
|
|
procedure ImageEnView1MouseMove ( Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer );
|
|
procedure Button2Click ( Sender: TObject );
|
|
procedure Button3Click ( Sender: TObject );
|
|
procedure Button4Click ( Sender: TObject );
|
|
procedure Edit1Change ( Sender: TObject );
|
|
procedure Edit2Change ( Sender: TObject );
|
|
procedure ColorBoxGridChange ( Sender: TObject );
|
|
procedure ImageEnView1MouseUp ( Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer );
|
|
private
|
|
{ Private declarations }
|
|
function GridPos ( view: TImageEnView; col, row: integer ): TPoint;
|
|
public
|
|
{ Public declarations }
|
|
Columns: integer;
|
|
Rows: integer;
|
|
Cells: integer;
|
|
ImageWidth: integer;
|
|
ImageHeight: integer;
|
|
CellWidth: double;
|
|
CellHeight: double;
|
|
Z: double;
|
|
SelectionCount: integer;
|
|
AllSelected: boolean;
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
{$R *.DFM}
|
|
{$R WindowsTheme.res}
|
|
|
|
procedure TForm1.FormCreate ( Sender: TObject );
|
|
begin
|
|
SelectionCount := 0;
|
|
Cells := 0;
|
|
AllSelected := false;
|
|
ImageEnView1.SelectionOptions := ImageEnView1.SelectionOptions - [ iesoSizeable ];
|
|
ImageEnView1.SelectionOptions := ImageEnView1.SelectionOptions - [ iesoMoveable ];
|
|
ImageEnView1.SelectionOptions := ImageEnView1.SelectionOptions + [ iesoFilled ];
|
|
FontComboBox.Items := Screen.Fonts;
|
|
end;
|
|
|
|
procedure TForm1.FormActivate ( Sender: TObject );
|
|
begin
|
|
Rows := StrToIntDef ( Edit1.Text, 2 );
|
|
Columns := StrToIntDef ( Edit2.Text, 2 );
|
|
Cells := Rows * Columns;
|
|
ImageHeight := ImageEnView1.IEBitmap.Height;
|
|
FontSizeUpDown.Position := Trunc ( ImageHeight ) div 5;
|
|
CellHeight := ImageHeight / Rows;
|
|
FontComboBox.Text := 'Arial';
|
|
Label4.Caption := 'Cells: ' + IntToStr ( Cells );
|
|
ImageEnView1.SelColor1 := ColorBoxGrid.Selected;
|
|
ImageEnView1.Update;
|
|
end;
|
|
|
|
function TForm1.GridPos ( view: TImageEnView; col, row: integer ): TPoint;
|
|
begin
|
|
Z := view.Zoom / 100;
|
|
ImageWidth := view.IEBitmap.Width;
|
|
ImageHeight := view.IEBitmap.Height;
|
|
CellWidth := ImageWidth / Columns;
|
|
CellHeight := ImageHeight / Rows;
|
|
// Column position
|
|
if col = Columns then
|
|
Result.X := ImageWidth
|
|
else
|
|
Result.X := Round ( CellWidth * col );
|
|
// Row position
|
|
if Row = Rows then
|
|
Result.Y := ImageHeight
|
|
else
|
|
Result.Y := Round ( CellHeight * row );
|
|
end;
|
|
|
|
procedure TForm1.ImageEnView1DrawBackBuffer ( Sender: TObject );
|
|
var
|
|
i: integer;
|
|
pt: TPoint;
|
|
begin
|
|
with ImageEnView1.BackBuffer.Canvas do
|
|
begin
|
|
Pen.Color := ColorBoxGrid.Selected;
|
|
Pen.Mode := pmNotXor;
|
|
MoveTo ( 0, 0 );
|
|
for i := 0 to Rows do
|
|
begin
|
|
pt := GridPos ( ImageEnView1, 0, i );
|
|
MoveTo ( 0, trunc ( pt.Y * z ) ); // draw rows
|
|
LineTo ( Trunc ( ImageWidth * z ), trunc ( pt.Y * z ) );
|
|
end;
|
|
for i := 0 to Columns do
|
|
begin
|
|
pt := GridPos ( ImageEnView1, i, 0 );
|
|
MoveTo ( trunc ( pt.X * z ), 0 ); // draw columns
|
|
LineTo ( trunc ( pt.X * z ), Trunc ( ImageHeight * z ) );
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure CustomNegative ( Proc: TImageEnProc );
|
|
var
|
|
ProcBitmap: TIEBitmap;
|
|
Mask: TIEMask;
|
|
x1, y1, x2, y2: integer;
|
|
x, y: integer;
|
|
px: PRGB;
|
|
begin
|
|
// we support only ie24RGB format
|
|
if not Proc.BeginImageProcessing ( [ ie24RGB ], x1, y1, x2, y2, 'CustomNegative', ProcBitmap, Mask ) then
|
|
exit;
|
|
for y := y1 to y2 - 1 do
|
|
begin
|
|
px := ProcBitmap.Scanline [ y ];
|
|
for x := x1 to x2 - 1 do
|
|
begin
|
|
with px^ do
|
|
begin
|
|
r := 255 - r;
|
|
g := 255 - g;
|
|
b := 255 - b;
|
|
end;
|
|
inc ( px );
|
|
end;
|
|
end;
|
|
// finalize
|
|
Proc.EndImageProcessing ( ProcBitmap, Mask );
|
|
end;
|
|
|
|
procedure TForm1.ImageEnView1MouseDown ( Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
|
|
var
|
|
R: TRect;
|
|
XP, YP, v: integer;
|
|
pt1, pt2: TPoint;
|
|
xx, yy: integer;
|
|
x1, y1, x2, y2: integer;
|
|
bx, by: Integer;
|
|
wasSelected: Boolean;
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
try
|
|
if ( Button = mbLeft ) and ( AllSelected ) then
|
|
exit;
|
|
BX := ImageEnView1.XScr2Bmp ( X );
|
|
BY := ImageEnView1.YScr2Bmp ( Y );
|
|
XP := Trunc ( BX / CellWidth );
|
|
YP := Trunc ( BY / CellHeight );
|
|
|
|
Label6.Caption := 'Column: ' + IntToStr ( XP + 1 );
|
|
Label7.Caption := 'Row: ' + IntToStr ( YP + 1 );
|
|
pt1 := GridPos ( ImageEnView1, xp, yp );
|
|
pt2 := GridPos ( ImageEnView1, xp + 1, yp + 1 );
|
|
R.TopLeft := pt1;
|
|
R.BottomRight := pt2;
|
|
|
|
R.Top := ImageEnView1.YScr2Bmp ( R.Top );
|
|
R.Bottom := ImageEnView1.YScr2Bmp ( R.Bottom );
|
|
R.Left := ImageEnView1.XScr2Bmp ( R.Left );
|
|
R.Right := ImageEnView1.XScr2Bmp ( R.Right );
|
|
|
|
if Button = mbLeft then
|
|
v := 1
|
|
else
|
|
v := 0;
|
|
|
|
wasSelected := ImageEnView1.IsPointInsideSelection ( bx, by );
|
|
|
|
if Button = mbRight then
|
|
if wasSelected then
|
|
begin
|
|
Dec ( SelectionCount );
|
|
Label9.Caption := 'Selected Cells: ' + IntToStr ( SelectionCount );
|
|
end;
|
|
|
|
with ImageEnView1 do
|
|
begin
|
|
x1 := Round ( R.Left * z );
|
|
x2 := Round ( R.Right * z );
|
|
y1 := Round ( R.Top * z );
|
|
y2 := Round ( R.Bottom * z );
|
|
for yy := y1 to y2 do
|
|
for xx := x1 to x2 do
|
|
SelectionMask.SetPixel ( xx, yy, v );
|
|
SelectCustom;
|
|
end;
|
|
|
|
if Button = mbLeft then
|
|
begin
|
|
if ImageEnView1.IsPointInsideSelection ( trunc ( bx ), trunc ( by ) ) and ( not wasSelected ) and
|
|
( SelectionCount < Cells ) then
|
|
Inc ( SelectionCount );
|
|
|
|
end;
|
|
ImageEnView1.CopySelectionToIEBitmap ( ImageEnView2.IEBitmap );
|
|
|
|
//ImageEnView2.Proc.Negative;
|
|
if NegativeCheckBox.Checked then
|
|
CustomNegative ( ImageEnView2.Proc );
|
|
ImageEnView2.Update;
|
|
Label4.Caption := 'Cells: ' + IntToStr ( Cells );
|
|
Label9.Caption := 'Selected Cells: ' + IntToStr ( SelectionCount );
|
|
ImageEnView1.Update;
|
|
ImageEnView2.Update;
|
|
|
|
finally; Screen.Cursor := crDefault; end;
|
|
end;
|
|
|
|
procedure TForm1.ImageEnView1MouseUp ( Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer );
|
|
var
|
|
w: integer;
|
|
h: integer;
|
|
begin
|
|
if ( Button = mbLeft ) and ( AllSelected ) then
|
|
exit;
|
|
if ( Cells = SelectionCount ) then
|
|
AllSelected := true
|
|
else
|
|
AllSelected := false;
|
|
if ( Button = mbLeft ) and ( Cells = SelectionCount ) then
|
|
begin
|
|
ImageEnView1.CopySelectionToIEBitmap ( ImageEnView2.IEBitmap );
|
|
MessageBox ( 0, 'All cells have been selected.', 'All Cells Selected', MB_ICONINFORMATION or MB_OK or MB_TOPMOST );
|
|
ImageEnView2.LayersAdd( ielkImage );
|
|
ImageEnView2.Layers [ 1 ].Transparency := 155;
|
|
ImageEnView2.IEBitmap.Canvas.Font.Name := FontComboBox.Items [ FontComboBox.ItemIndex ];
|
|
ImageEnView2.IEBitmap.Canvas.Font.Height := StrToInt ( FontSizeEdit.Text );
|
|
ImageEnView2.IEBitmap.Canvas.Font.Color := ColorBoxGrid.Selected;
|
|
ImageEnView2.IEBitmap.Canvas.Brush.Color := ColorBoxGrid.Selected;
|
|
ImageEnView2.IEBitmap.Canvas.Brush.Style := bsClear;
|
|
ImageEnView2.IEBitmap.Canvas.Rectangle ( 0, 0, ImageEnView2.IEBitmap.Width, ImageEnView2.IEBitmap.Height );
|
|
w := ( ImageEnView2.IEBitmap.Width div 2 ) - ( ImageEnView2.IEBitmap.Canvas.TextExtent ( 'All Selected' ).cx div 2 );
|
|
h := ( ImageEnView2.IEBitmap.Height div 2 ) - ( ImageEnView2.IEBitmap.Canvas.TextExtent ( 'All Selected' ).cy div 2 );
|
|
ImageEnView2.IEBitmap.Canvas.TextOut ( w, h, 'All Selected' ); // draw text
|
|
ImageEnView1.Update;
|
|
ImageEnView2.Update;
|
|
end;
|
|
if ( Button = mbRight ) then
|
|
begin
|
|
if ImageEnView2.LayersCurrent = 1 then
|
|
ImageEnView2.LayersRemove ( 1 );
|
|
ImageEnView1.CopySelectionToIEBitmap ( ImageEnView2.IEBitmap );
|
|
ImageEnView2.Update;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.ImageEnView1MouseMove ( Sender: TObject; Shift: TShiftState;
|
|
X, Y: Integer );
|
|
var
|
|
XP, YP, BX, BY: integer;
|
|
begin
|
|
if Z > 0 then
|
|
begin
|
|
BX := ImageEnView1.XScr2Bmp ( X );
|
|
BY := ImageEnView1.YScr2Bmp ( Y );
|
|
XP := Trunc ( BX / CellWidth );
|
|
YP := Trunc ( BY / CellHeight );
|
|
Label5.Caption := 'Column: ' + IntToStr ( XP + 1 );
|
|
Label8.Caption := 'Row: ' + IntToStr ( YP + 1 );
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.Button2Click ( Sender: TObject );
|
|
begin
|
|
if OpenImageEnDialog1.Execute then
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
try
|
|
ImageEnView1.IO.LoadFromFile ( OpenImageEnDialog1.FileName );
|
|
ImageEnView1.Deselect;
|
|
ImageEnView1.Update;
|
|
SelectionCount := 0;
|
|
Rows := StrToIntDef ( Edit1.Text, 2 );
|
|
Columns := StrToIntDef ( Edit2.Text, 2 );
|
|
Cells := Rows * Columns;
|
|
ImageHeight := ImageEnView1.IEBitmap.Height;
|
|
FontSizeUpDown.Position := Trunc ( ImageHeight ) div 5;
|
|
finally; Screen.Cursor := crDefault; end;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.Button3Click ( Sender: TObject );
|
|
begin
|
|
ImageEnView1.DeSelect;
|
|
ImageEnView1.Update;
|
|
ImageEnView2.Clear;
|
|
SelectionCount := 0;
|
|
Cells := Rows * Columns;
|
|
Label4.Caption := 'Cells: ' + IntToStr ( Cells );
|
|
Label9.Caption := 'Selected: ' + intToStr ( SelectionCount );
|
|
Label6.Caption := 'Column:';
|
|
Label7.Caption := 'Row:';
|
|
end;
|
|
|
|
procedure TForm1.Edit1Change ( Sender: TObject );
|
|
begin
|
|
if CheckBoxProportional.Checked then
|
|
Edit2.Text := Edit1.Text;
|
|
Rows := StrToIntDef ( Edit1.Text, 2 );
|
|
Columns := StrToIntDef ( Edit2.Text, 2 );
|
|
Cells := Rows * Columns;
|
|
Label4.Caption := 'Cells: ' + IntToStr ( Cells );
|
|
ImageEnView1.Update;
|
|
end;
|
|
|
|
procedure TForm1.Edit2Change ( Sender: TObject );
|
|
begin
|
|
if CheckBoxProportional.Checked then
|
|
Edit1.Text := Edit2.Text;
|
|
Rows := StrToIntDef ( Edit1.Text, 2 );
|
|
Columns := StrToIntDef ( Edit2.Text, 2 );
|
|
Cells := Rows * Columns;
|
|
Label4.Caption := 'Cells: ' + IntToStr ( Cells );
|
|
ImageEnView1.Update;
|
|
end;
|
|
|
|
procedure TForm1.Button4Click ( Sender: TObject );
|
|
begin
|
|
SaveImageEnDialog1.FileName := '*.png';
|
|
SaveImageEnDialog1.DefaultExt := '*.png';
|
|
SaveImageEnDialog1.FilterIndex := 7;
|
|
if SaveImageEnDialog1.Execute then
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
try
|
|
if ImageEnView2.LayersCurrent = 1 then
|
|
ImageEnView2.LayersMerge ( 0, 1 );
|
|
ImageEnView2.IO.SaveToFile ( SaveImageEnDialog1.FileName );
|
|
finally; Screen.Cursor := crDefault; end;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.ColorBoxGridChange ( Sender: TObject );
|
|
begin
|
|
ImageEnView1.SelColor1 := ColorBoxGrid.Selected;
|
|
ImageEnView1.Update;
|
|
end;
|
|
|
|
|
|
|
|
end.
|
|
|