Solved

Simple Image Editor From Scratch

Posted on 2003-11-27
15
571 Views
Last Modified: 2010-04-05
Hello Experts,

Here is what I'm looking for...

I need functions that do the fallowing.

1) Resize an Image using handles with an option to preserve aspect ratio with an option to cancel or undo.
2) Crop an Image using handles with an option to cancel or undo.
3) Create a new image over top of the origanal that can "float" until the image is saved.  More specificly, I want to be able to "insert" text over my image.  I would also like to change the font.

I know this is a tall order.  I'll give extra points for a sample project I can modify that conforms exactly to my specifications.  I don't want to sort through a bunch of unwanted code to get what I'm after.

Thank you in advance!  // Happy Coding.

GMF (fibdev)
0
Comment
Question by:fibdev
  • 6
  • 6
  • 3
15 Comments
 
LVL 17

Accepted Solution

by:
geobul earned 300 total points
Comment Utility
Hi,

I already have Open an image, Resize and Crop (both with cancel and undo). The main form follows (MainMenu, OpenDialog, ScrollBox and Image on the ScrollBox):
// unit1.pas
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Img: TImage;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Image2: TMenuItem;
    Resize1: TMenuItem;
    Crop1: TMenuItem;
    Text1: TMenuItem;
    N2: TMenuItem;
    Undo1: TMenuItem;
    OpenDialog1: TOpenDialog;
    procedure ImgAdjust;
    procedure Open1Click(Sender: TObject);
    procedure Resize1Click(Sender: TObject);
    procedure Undo1Click(Sender: TObject);
    procedure Crop1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FileName: string;
  UndoPicture: TPicture;

  NewWidth, NewHeight: integer;
  NewTop, NewLeft, NewRight, NewBottom: integer;
  AspectRatio: double;
  KeepAspectRatio: boolean;

implementation

{$R *.DFM}

uses jpeg, unit2, unit3;

procedure TForm1.ImgAdjust;
begin
  Img.Top := 0;
  Img.Left := 0;
  Img.Width := Img.Picture.Width;
  Img.Height := Img.Picture.Height;
end;

procedure TForm1.Open1Click(Sender: TObject);
var p: TPicture;
begin
  if OpenDialog1.Execute then begin
    FileName := OpenDialog1.Filename;
    Img.Picture.LoadFromFile(Filename);
    p := TPicture.Create;
    try
      p.Bitmap.Height := Img.Picture.Height;
      p.Bitmap.Width := Img.Picture.Width;
      p.Bitmap.Canvas.StretchDraw(Rect(0,0,p.Bitmap.Width,p.Bitmap.Height), Img.Picture.Graphic);
      Img.Picture.Assign(p);
      ImgAdjust;
      UndoPicture.Graphic := nil;
    finally
      p.Free;
    end;
    Form1.Caption := 'GeoView - '+ExtractFileName(Filename);
  end;
end;

procedure TForm1.Resize1Click(Sender: TObject);
var p: TPicture;
begin
  if FormResize.ShowModal = mrOK then begin
    // save
    UndoPicture.Assign(Img.Picture);
    // resize
    p := TPicture.Create;
    try
      p.Bitmap.Height := NewHeight;
      p.Bitmap.Width := NewWidth;
      p.Bitmap.Canvas.StretchDraw(Rect(0,0,p.Bitmap.Width,p.Bitmap.Height), Img.Picture.Graphic);
      Img.Picture.Assign(p);
      ImgAdjust;
    finally
      p.Free;
    end;
  end;
end;

procedure TForm1.Crop1Click(Sender: TObject);
var p: TPicture;
begin
  if FormCrop.ShowModal = mrOK then begin
    // save
    UndoPicture.Assign(Img.Picture);
    // crop
    p := TPicture.Create;
    try
      p.Bitmap.Height := NewBottom - NewTop;
      p.Bitmap.Width := NewRight - NewLeft;
      p.Bitmap.Canvas.CopyRect(Rect(0,0,p.Bitmap.Width,p.Bitmap.Height), Img.Picture.Bitmap.Canvas, Rect(NewLeft, NewTop, NewRight, NewBottom));
      Img.Picture.Assign(p);
      ImgAdjust;
    finally
      p.Free;
    end;
  end;
end;

procedure TForm1.Undo1Click(Sender: TObject);
begin
  if UndoPicture.Graphic <> nil then begin
    Img.Picture.Assign(UndoPicture);
    UndoPicture.Graphic := nil;
    ImgAdjust;
  end;
end;

initialization
  UndoPicture := TPicture.Create;

finalization
  if Assigned(UndoPicture) then UndoPicture.Free;

end.

// unit1.dfm
object Form1: TForm1
  Left = 192
  Top = 114
  Width = 696
  Height = 480
  Caption = 'GeoView'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ScrollBox1: TScrollBox
    Left = 8
    Top = 8
    Width = 665
    Height = 345
    TabOrder = 0
    object Img: TImage
      Left = 0
      Top = 0
      Width = 661
      Height = 177
    end
  end
  object MainMenu1: TMainMenu
    Left = 8
    object File1: TMenuItem
      Caption = 'File'
      object New1: TMenuItem
        Caption = 'New'
      end
      object Open1: TMenuItem
        Caption = 'Open'
        OnClick = Open1Click
      end
      object Save1: TMenuItem
        Caption = 'Save'
      end
      object N1: TMenuItem
        Caption = '-'
      end
      object Exit1: TMenuItem
        Caption = 'Exit'
      end
    end
    object Image2: TMenuItem
      Caption = 'Image'
      object Resize1: TMenuItem
        Caption = 'Resize'
        OnClick = Resize1Click
      end
      object Crop1: TMenuItem
        Caption = 'Crop'
        OnClick = Crop1Click
      end
      object Text1: TMenuItem
        Caption = 'Text'
      end
      object N2: TMenuItem
        Caption = '-'
      end
      object Undo1: TMenuItem
        Caption = 'Undo'
        OnClick = Undo1Click
      end
    end
  end
  object OpenDialog1: TOpenDialog
    Left = 40
  end
end
//

//FormResize in unit2.pas
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TFormResize = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    edtWidth: TEdit;
    Label3: TLabel;
    edtHeight: TEdit;
    CheckBox1: TCheckBox; // keep aspect ratio
    btnResize: TButton;
    btnCancel: TButton;
    procedure FormShow(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnResizeClick(Sender: TObject);
    procedure edtWidthChange(Sender: TObject);
    procedure edtHeightChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormResize: TFormResize;

implementation

{$R *.DFM}

uses unit1;

procedure TFormResize.FormShow(Sender: TObject);
begin
  edtWidth.Text := IntToStr(Form1.Img.Picture.Width);
  edtHeight.Text := IntToStr(Form1.Img.Picture.Height);
  Label1.Caption := 'Current Size: '+edtWidth.Text+' x '+edtHeight.Text;
  try
    AspectRatio := Form1.Img.Picture.Width / Form1.Img.Picture.Height;
  except
    AspectRatio := 0;
  end;
end;

procedure TFormResize.btnCancelClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TFormResize.btnResizeClick(Sender: TObject);
begin
  KeepAspectRatio := CheckBox1.Checked;
  try
    NewWidth := StrToInt(edtWidth.Text);
  except
    ShowMessage('Enter width');
    exit;
  end;
  try
    NewHeight := StrToInt(edtHeight.Text);
  except
    ShowMessage('Enter height');
    exit;
  end;
  ModalResult := mrOK;
end;

procedure TFormResize.edtWidthChange(Sender: TObject);
begin
 if edtWidth.Focused then
  if CheckBox1.Checked then begin
    try
      edtHeight.Text := IntToStr(Trunc(StrToInt(edtWidth.Text) / AspectRatio));
    except
    end;
  end;
end;

procedure TFormResize.edtHeightChange(Sender: TObject);
begin
 if edtHeight.Focused then
  if CheckBox1.Checked then begin
    try
      edtWidth.Text := IntToStr(Trunc(StrToInt(edtHeight.Text) * AspectRatio));
    except
    end;
  end;
end;

end.

// FormCrop in unit3.pas
unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TFormCrop = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    edtLeft: TEdit;
    edtTop: TEdit;
    edtRight: TEdit;
    edtBottom: TEdit;
    btnCrop: TButton;
    btnCancel: TButton;
    procedure FormShow(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnCropClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormCrop: TFormCrop;

implementation

{$R *.DFM}

uses unit1;

procedure TFormCrop.FormShow(Sender: TObject);
begin
  edtLeft.Text := '0';
  EdtTop.Text := '0';
  edtRight.Text := IntToStr(Form1.Img.Picture.Width);
  edtBottom.Text := IntToStr(Form1.Img.Picture.Height);
end;

procedure TFormCrop.btnCancelClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TFormCrop.btnCropClick(Sender: TObject);
begin
  try
    NewLeft := StrToInt(edtLeft.Text);
  except
    ShowMessage('Enter left');
    exit;
  end;
  try
    NewTop := StrToInt(edtTop.Text);
  except
    ShowMessage('Enter top');
    exit;
  end;
  try
    NewRight := StrToInt(edtRight.Text);
  except
    ShowMessage('Enter right');
    exit;
  end;
  try
    NewBottom := StrToInt(edtBottom.Text);
  except
    ShowMessage('Enter bottom');
    exit;
  end;

  ModalResult := mrOK;
end;

end.

Regards, Geo

PS: Sorry for the long post
0
 
LVL 3

Author Comment

by:fibdev
Comment Utility
Thank you,

Being that it's currently ThanksGiving Day, I'll have to look at this tonight.  :)
0
 
LVL 3

Author Comment

by:fibdev
Comment Utility
Could you post or mail me a project?
0
 
LVL 33

Assisted Solution

by:Slick812
Slick812 earned 200 total points
Comment Utility
hello  fibdev, what you are asking for involves very many things that are not covered in the delphi VCL, although ONE of your requests could be done without a whole lot of coding, if you combine all of the things together (Resize, Crop, New Image Over, Text on Top, Text Resize and Edit) you will probally have  a whole lot of code, and you might need to define your interface ALOT better than you have (none), because the way you have your user interaction with your graphic objects will determine how to code. I have done some Graphic Editor type programs, but it is not so easy. . . I can help you to do some (maybe all) of these things, you might want to look at these EE questions for some examples of Graphic Objects that are resizeable and moveable


http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20619562.html

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20718897.html

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20682653.html

you could use some of the same methods to set a "Crop" Rectangle and move it or resize it

Let me know if you need some more help with this
0
 
LVL 3

Author Comment

by:fibdev
Comment Utility
Ideally, I’d like to popup a AlwaysOnTop form to control the function requested and close it when the operation is completed.  A good example, of what I’m trying to convey is M$ ImageComposer.  http://www.fibdev.com/crop_example.png
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
I looked at the MS Image composer image in your link, ????? I would think the guys at MS are good at programming. . . anyway. . I can not hope to emulate the thousands of lines of code that went into that. . . good luck with doing a copy of that
0
 
LVL 3

Author Comment

by:fibdev
Comment Utility
lol,  I'm not trying to emulate that.  I just used that as an example of how I would like the interface to look.

My application has an image, The User Clicks Edit Image from the tools menu and a toolbox pops up that gives them the fallowing options.

*crop
*resize
*Insert text (not so critical)

Then they can close the box when they are done.  I would never presume that my code or anyone elses would be quite at that level.

 :)
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 33

Expert Comment

by:Slick812
Comment Utility
ok, did you get to try any of the code at the EE questions links I posted, they can do the resize thing by monitoring the mouse position over the Paintbox and showing the Resize arrow cursor and changing the size of the graphic image, you can do the same sort of thing with a Focus Rectangle of your "Crop" positioning. . .
0
 
LVL 17

Expert Comment

by:geobul
Comment Utility
Hi fibdev,

I already posted the project. There is nothing more to be posted here. You may create one form from the unit2 and unit3 (resize and crop forms), move the corresponding code from unit1 there (in the btnResize and btnCrop buttons OnClick events replacing the line 'ModalResult := mrOK;') and call that new form as non-modal (Show). You may set the form's FormStyle property to fsStayOnTop also. Keep one 'Cancel' button only with the following line in its OnClick event.

In the main form

procedure TForm1.btnToolsClick(Sender: TObject);
begin
  FormResizeAndClick.Show;
end;

In that new form (Resize example) something like:

procedure TFormResize.btnResizeClick(Sender: TObject);
var p: TPicture;
begin
  KeepAspectRatio := CheckBox1.Checked;
  try
    NewWidth := StrToInt(edtWidth.Text);
  except
    ShowMessage('Enter width');
    exit;
  end;
  try
    NewHeight := StrToInt(edtHeight.Text);
  except
    ShowMessage('Enter height');
    exit;
  end;

    // save
    UndoPicture.Assign(Img.Picture);
    // resize
    p := TPicture.Create;
    try
      p.Bitmap.Height := NewHeight;
      p.Bitmap.Width := NewWidth;
      p.Bitmap.Canvas.StretchDraw(Rect(0,0,p.Bitmap.Width,p.Bitmap.Height), Img.Picture.Graphic);
      Form1.Img.Picture.Assign(p);
      Form1.ImgAdjust;
    finally
      p.Free;
    end;

end;

And the Cancel button:

procedure TFormResizeAndCrop.btnCancelClick(Sender: TObject);
begin
  Close; // closes the form
end;

Regards, Geo
0
 
LVL 17

Expert Comment

by:geobul
Comment Utility
Two naming errors in my code above:
FormResizeAndClick should be FormResizeAndCrop
and
TFormResize should be TFormResizeAndCrop (or whatever you name that new form).

Also 'Img' should be changed to 'Form1.Img' inside the code of the new form in order to let it know where that image is.

Regards, Geo
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
I put together some code to do much of what you have described, It will create several "Bitmap Image Objects" on a TPaintBox, The Form has a TPaintbox called PaintBox4 (400x300), and One TSpeedButton (sbut_CreateImage) with the Caption "Create New Image". I do Not really care about your request to show some "Tool Palette container" I will just use a TPanel called Panel2 and it is initially Hidden, when you right Click the PaintBox4 the Hidden Panel2 will Show, but you can do whatever and however for your tool container.
This hidden Panel2 has one TRadioGroup (RadioGroup3) with 3 radio buttons with it's Index set to zero to start, having the text on the radio buttons of "Size" (Index 0), "Crop" (Index 1), and "Text" (Index 2). Again this is a simplistic graphic operation chooser, A ToolBar might be better, but I don't care. The Panel2 also has one TCheckBox (CkBox_Aspect) with Caption of "Maintain Aspect Ratio", and 3 TSpeedButtons (all 3 are set to Enabled := False to start) with Captons of "Do Crop" (sbut_DoCrop), "MakeTextObj" (sbut_MakeTextWmf) and "Merge Text" (sbut_MergeText). There are 2 TEdits, One to put the Text for a Text Object called Edit_Text and one for the font face name called Edit_FontName.
I do not have any code to Hide this Panel2, I dont care. I have included a BackUpBmp in the TImageObj Record, which is my only attempt to do an "UnDo" thing, I do not include any code to restore the backup bitmap to the current bitmap, but to UnDo just assign the BackupBmp to the CurrentBmp and change the PosRect to the new dimentions. . . .

To start a graphic Image Object, you click the "Create New Image" button and a Bipmap will be drawn on the Paintbox (you can click again for another, you will probally want to have some sore of Open dialog to get a File for the bitmaps), next Right click an Image and the Panel2 should Show, It will start as being set to "Size" Radio button, so you can mouse down and drag to move the image or drag the image edges to Resize the image. If you click the "Crop" radio button you can mouse down on the image and drag a rectangle to a crop dimention and then drag resize or move this crop rect. Once you got the needed Crop Rect, then Click the "Do Crop" button to chop off the image. When you click the "Text" radio button, you can type in to the Edit_Text box the words you want in the Tect object, and the font face name you want goes into the Edit_FontName box.
Then click the "Make Text Object" and go to the image and mouse down and drag a rectangle to the size of the Text you want, then you can drag move or resize this text, when the new Text is how you want it, click the "Merge Text" button, which will paint the text on the Bitmap, destroy the wmf be ready for the next operation.

This shoud be more than enough for a start, but this is ONLY A DEMO, I did not make this as a final finished project, so there are things I did not check or even try to do, like if the cursor goes out of the paint box on a drag operation.
Form unit code

Type

  TImageObj = Record
    PosRect: TRect;
    CurrentBmp, BackUpBmp: TBitmap;
    AspRatio: Double;
    end;

  TMetaRec = Record
    Wmf: TMetaFile;
    PosRect: TRect;
    end;



    procedure sbut_CreateImageClick(Sender: TObject); // Create Image button on form
    procedure PaintBox4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox4MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox4MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox4ContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);

    procedure RadioGroup3Click(Sender: TObject);  // the rest of these are on Panel2
    procedure sbut_DoCropClick(Sender: TObject);
    procedure sbut_MakeTextWmfClick(Sender: TObject);
    procedure sbut_MergeTextClick(Sender: TObject);
  private
    { Private declarations }
    OffX, OffY, NumSel, TextSel: Integer;
    DrawRect: TRect;
    Sizing, Moving, Cropping, CropSize, TextSize, NewMeta, FirstDraw, Drawing, StartCrop: Boolean;
    Side: Char;
    aryImageObj: Array of TImageObj;
    MetaRec1: TMetaRec;
    procedure Reset;



procedure TForm1.FormCreate(Sender: TObject);
begin
NumSel := -1;
Reset;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
i: Integer;
begin
for i := 0 to High(aryImageObj) do
  begin
  FreeAndNil(aryImageObj[i].CurrentBmp);
  FreeAndNil(aryImageObj[i].BackupBmp);
  end;
FreeAndNil(MetaRec1.Wmf);
end;

procedure TForm1.Reset;
begin
{all of these Booleans are reset to False at the change of operation}
Sizing := False;
Moving := False;
Cropping := False;
StartCrop := False;
CropSize := False;
TextSize := False;
Drawing := False;
FirstDraw := False;
end;

procedure TForm1.sbut_CreateImageClick(Sender: TObject);
begin
{this button click will create a new image, each time it is clicked}
Reset;
SetLength (aryImageObj, Length(aryImageObj)+1);
aryImageObj[High(aryImageObj)].CurrentBmp := TBitmap.Create;
{You would probally load a user selected Image from file
but I just create some bitmaps, the CurrentBmp is the bitmap shown}
{you need to record all of your image information in the aryImageObj array member for that image}
aryImageObj[High(aryImageObj)].CurrentBmp.Canvas.Brush.Color := $93CAE4 shr ((High(aryImageObj) and 3) shl 3);
aryImageObj[High(aryImageObj)].CurrentBmp.Width := PaintBox4.Width shr 1;
aryImageObj[High(aryImageObj)].CurrentBmp.Height := PaintBox4.Height shr 1;
aryImageObj[High(aryImageObj)].CurrentBmp.Canvas.TextOut(10,10, 'Bitmap '+IntToStr(High(aryImageObj)+1));
aryImageObj[High(aryImageObj)].PosRect.Left := 20+ (High(aryImageObj)* 40);
aryImageObj[High(aryImageObj)].PosRect.Top := 20+ (High(aryImageObj)* 40);
aryImageObj[High(aryImageObj)].PosRect.Right := aryImageObj[High(aryImageObj)].PosRect.Left + aryImageObj[High(aryImageObj)].CurrentBmp.Width;
aryImageObj[High(aryImageObj)].PosRect.Bottom := aryImageObj[High(aryImageObj)].PosRect.Top + aryImageObj[High(aryImageObj)].CurrentBmp.Height;

{ATTENTION
I only get the aspect ratio ONCE when the image is created, but you would probally want to update this aspect ratio
whenever the bitmap is resized or croped, or an UnDo}
aryImageObj[High(aryImageObj)].AspRatio := aryImageObj[High(aryImageObj)].CurrentBmp.Height / aryImageObj[High(aryImageObj)].CurrentBmp.Width;
PaintBox4.canvas.Draw(aryImageObj[High(aryImageObj)].PosRect.Left, aryImageObj[High(aryImageObj)].PosRect.Top, aryImageObj[High(aryImageObj)].CurrentBmp);
end;

procedure TForm1.RadioGroup3Click(Sender: TObject);
begin
{this radio group click will determine which graphic operation can be done on the image
this will Enable and disable the graphic op buttons}
Reset;
case RadioGroup3.ItemIndex of
  0: begin // sizing
     sbut_DoCrop.Enabled := False;
     sbut_MakeTextWmf.Enabled := False;
     PaintBox4.Cursor := crDefault;
     end;
  1: begin  // crop
     sbut_DoCrop.Enabled := True;
     sbut_MakeTextWmf.Enabled := False;
     StartCrop := True;
     PaintBox4.Cursor := crDrag;
     end;
  2: begin // text
     sbut_DoCrop.Enabled := False;
     sbut_MakeTextWmf.Enabled := True;
     PaintBox4.Cursor := crDefault;
     StartCrop := True; // StartCrop is just used to prevent sizing and moving of bitmap
     end;
  end;
end;

procedure TForm1.PaintBox4ContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
var
i: Integer;
begin
{This is the PaintBox4 Right click event, which will show the Panel2 if the click is inside a graphic object}
for i := High(aryImageObj) downTo 0 do
  begin
  if PtInRect(aryImageObj[i].PosRect, MousePos) then
    begin
    Panel2.Show;
    if i <> NumSel then
      NumSel := i;
    PaintBox4Paint(PaintBox4);
    Break;
    end;
  end;
Handled := True;
end;

procedure TForm1.PaintBox4Paint(Sender: TObject);
var
i: Integer;
begin
{I just paint a Rectangle for the PaintBox background}
PaintBox4.Canvas.Brush.Color := $DCEEF8;
PaintBox4.Canvas.Rectangle(0,0, PaintBox4.Width, PaintBox4.Height);
{this for loop paints all of the Image Objects on the painybox}
for i := 0 to High(aryImageObj) do
PaintBox4.canvas.Draw(aryImageObj[i].PosRect.Left, aryImageObj[i].PosRect.Top, aryImageObj[i].CurrentBmp);
if Assigned(MetaRec1.Wmf) then
  PaintBox4.Canvas.Draw(DrawRect.Left, DrawRect.Top, MetaRec1.Wmf);

if (NumSel > -1) or Assigned(MetaRec1.Wmf) then
  begin
  {this draws a Focus Rectangle on the selected Image or the Text}
  PaintBox4.Canvas.Brush.Style := bsClear;
  PaintBox4.Canvas.Pen.Color := clBlack;
  PaintBox4.Canvas.Pen.Width := 4;
  PaintBox4.Canvas.Pen.Mode := pmNot;
  PaintBox4.Canvas.Rectangle(DrawRect);
  PaintBox4.Canvas.Pen.Mode := pmCopy;
  PaintBox4.Canvas.Brush.Style := bsSolid;
  PaintBox4.Canvas.Pen.Width := 1;
  end;
end;


procedure TForm1.PaintBox4MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
i: Integer;
Pnt1: TPoint;
RectPB: TRect;
begin
{the mouse down will start the drag operations}
RectPB := PaintBox4.ClientRect;
RectPB.TopLeft := PaintBox4.ClientToScreen(RectPB.TopLeft);
RectPB.BottomRight := PaintBox4.ClientToScreen(RectPB.BottomRight);
ClipCursor(@RectPB);
{first test the cursor to see if it is going to do a drag resize}
if PaintBox4.Cursor = crSizeWE then
    begin
    case RadioGroup3.ItemIndex of
      0: Sizing := True;
      1: CropSize := True;
      2: TextSize := True;
      end;
    if (X < DrawRect.Left+ 3) and (X > DrawRect.Left -3) then
      Side := 'L'
      else
      Side := 'R';
    Exit;
    end else
    if PaintBox4.Cursor = crSizeNS then
      begin
      case RadioGroup3.ItemIndex of
        0: Sizing := True;
        1: CropSize := True;
        2: TextSize := True;
        end;
      if (Y < DrawRect.Top+ 3) and (Y > DrawRect.Top -3) then
        Side := 'T'
        else
        Side := 'B';
      Exit;
      end;

if NewMeta then
  begin
{NewMeta is true if this is the start of a Text Rectangle draw}
  DrawStart.x := X;
  DrawStart.y:= Y;
  DrawRect.Left := X;
  DrawRect.Top := Y;
  DrawRect.Right := X;
  DrawRect.Bottom := Y;
  FirstDraw := True; //set firstDraw to know that a new Rectangle is being started
  StartCrop := False;
  Exit;
  end;

Pnt1.x := X; // make a point
Pnt1.y := Y;

case RadioGroup3.ItemIndex of
  1: begin // crop
     DrawStart.x := X;
     DrawStart.y := Y;
     DrawRect := Rect(X,Y,X,Y);//aryImageObj[NumSel].PosRect;
     Cropping := True;
     StartCrop := False;
     Exit;
     end;
  2: begin // text
     if PtInRect(DrawRect, Pnt1) then
        begin
        Moving := True;
        OffX := DrawRect.Left - X;
        OffY := DrawRect.Top - Y;
        DrawStart.x := DrawRect.Left;
        DrawStart.y := DrawRect.Top;
        end;
     Exit;
     end;
  end;

for i := High(aryImageObj) downTo 0 do
  if PtInRect(aryImageObj[i].PosRect, Pnt1) then
  begin
  {see if the point is inside a graphic object rect and select that graphic obj}
  Moving := True;
  OffX := aryImageObj[i].PosRect.Left - X;
  OffY := aryImageObj[i].PosRect.Top - Y;
  DrawStart.x := aryImageObj[i].PosRect.Left;
  DrawStart.y := aryImageObj[i].PosRect.Top;
  DrawRect := aryImageObj[i].PosRect;
  if i <> NumSel then
    NumSel := i;
  PaintBox4Paint(PaintBox4);
  Break;
  end;

end;



procedure TForm1.PaintBox4MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if StartCrop or not Panel2.Visible then Exit;

if FirstDraw then // new meta rect
if (X > DrawStart.x+3) or (X < DrawStart.x-3) or (Y > DrawStart.y+3) or (Y < DrawStart.y-3) then
  begin
  Drawing := True;
  end;

if Drawing then
  begin
  if FirstDraw then
  FirstDraw := False else
  PaintBox4.Canvas.DrawFocusRect(DrawRect);
  if X >= DrawStart.x then
    begin
    if DrawRect.Left <> DrawStart.x then
      DrawRect.Left := DrawStart.x;
    DrawRect.Right := X
    end else
    begin
    if DrawRect.Right <> DrawStart.x then
    DrawRect.Right := DrawStart.x;
      DrawRect.Left := X;
    end;
  if Y >= DrawStart.y then
    begin
    if DrawRect.Top <> DrawStart.y then
      DrawRect.Top := DrawStart.y;
    DrawRect.Bottom := Y;
    end else
    begin
    if DrawRect.Bottom <> DrawStart.y then
    DrawRect.Bottom := DrawStart.y;
    DrawRect.Top := Y;
    end;
  PaintBox4.Canvas.DrawFocusRect(DrawRect);
  Exit;
  end;

if Cropping then
  begin
  if (X <> DrawRect.Right) and (Y <> DrawRect.Bottom) then
    begin
    PaintBox4.Canvas.DrawFocusRect(DrawRect);
    if X >= DrawStart.x then
      begin
      if DrawRect.Left <> DrawStart.x then
        DrawRect.Left := DrawStart.x;
      DrawRect.Right := X
      end else
      begin
      if DrawRect.Right <> DrawStart.x then
      DrawRect.Right := DrawStart.x;
      DrawRect.Left := X;
      end;
    if Y >= DrawStart.y then
      begin
      if DrawRect.Top <> DrawStart.y then
        DrawRect.Top := DrawStart.y;
      DrawRect.Bottom := Y;
      end else
      begin
      if DrawRect.Bottom <> DrawStart.y then
      DrawRect.Bottom := DrawStart.y;
      DrawRect.Top := Y;
      end;
    PaintBox4.Canvas.DrawFocusRect(DrawRect);
    end;
  Exit;
  end;


if Moving then
  begin
  PaintBox4.Canvas.Brush.Style := bsSolid;
  PaintBox4.Canvas.DrawFocusRect(DrawRect);
  DrawRect.Right := DrawRect.Right - DrawRect.Left + X + OffX;
  DrawRect.Bottom := DrawRect.Bottom - DrawRect.Top + Y+ OffY;
  DrawRect.Left := X+ OffX;
  DrawRect.Top := Y+ OffY;
  PaintBox4.Canvas.DrawFocusRect(DrawRect);
  exit;
  end;


if Sizing or CropSize or TextSize then
  begin
  PaintBox4.Canvas.Brush.Style := bsSolid;
  PaintBox4.Canvas.DrawFocusRect(DrawRect);
  if Side = 'T' then
    begin
    DrawRect.Top := Y;
    if (NumSel > -1) and CkBox_Aspect.Checked then // this checks to see if the checkbox for Aspect ratio is checked
    DrawRect.Right := DrawRect.Left + Round(abs(DrawRect.Top - DrawRect.Bottom) / aryImageObj[NumSel].AspRatio);
    end else
    if Side = 'L' then
    begin
    DrawRect.Left := X;
    if (NumSel > -1) and CkBox_Aspect.Checked then
    DrawRect.Bottom := DrawRect.Top + Round(aryImageObj[NumSel].AspRatio * abs(DrawRect.Right - DrawRect.Left));
    end else
    if Side = 'R' then
    begin
    DrawRect.Right := X;
    if (NumSel > -1) and CkBox_Aspect.Checked then
    DrawRect.Bottom := DrawRect.Top + Round(aryImageObj[NumSel].AspRatio * abs(DrawRect.Right - DrawRect.Left));
    end else
    if Side = 'B' then
    begin
    DrawRect.Bottom := Y;
    if (NumSel > -1) and CkBox_Aspect.Checked then
    DrawRect.Right := DrawRect.Left + Round(abs(DrawRect.Top - DrawRect.Bottom) / aryImageObj[NumSel].AspRatio);
    end else DrawRect.Top := Y;

  PaintBox4.Canvas.DrawFocusRect(DrawRect);
  PaintBox4.Canvas.TextOut(10,10, IntToStr(X));
  Exit;
  end;

if (NumSel > -1) or (NumSel = -10) then
  begin
  {these boolean tests set the Cursor if over the DrawRect}
  if (Y > DrawRect.Top-4) and (Y < DrawRect.Bottom +4) and
     ((X < DrawRect.Left+ 4) and (X > DrawRect.Left -4) or
     (X < DrawRect.Right+ 4) and (X > DrawRect.Right -4)) then
     PaintBox4.Cursor := crSizeWE else

  if (X > DrawRect.Left- 4) and (X < DrawRect.Right +4) and
     ((Y < DrawRect.Top+ 4) and (Y > DrawRect.Top -4) or
     (Y < DrawRect.Bottom+ 4) and (Y > DrawRect.Bottom -4)) then
     PaintBox4.Cursor := crSizeNS else
     PaintBox4.Cursor := crDefault;
  end;
end;



procedure TForm1.PaintBox4MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
oRect: TRect;
W, H: Integer;
begin
{the mouse up ends the drag opps}
ClipCursor(nil);
Drawing := False;
PaintBox1.Cursor := crDefault;
Cropping := False;

if Moving and (NumSel = -10) then
  begin
  PaintBox4Paint(PaintBox4);
  Moving := False;
  Exit;
  end;

if Moving then
  begin // just reset the PosRect to DrawRect
  if (DrawStart.x <> DrawRect.Left) and (DrawStart.x <> DrawRect.Top) then
    begin
    aryImageObj[NumSel].PosRect := DrawRect;
    PaintBox4Paint(PaintBox4);
    end;
  Moving := False;
  Exit;
  end;

if Sizing then
  begin
  aryImageObj[NumSel].PosRect := DrawRect;
  if NumSel > -1 then
    begin
    FreeAndNil(aryImageObj[NumSel].BackUpBmp);
    aryImageObj[NumSel].BackUpBmp := TBitmap .Create;
    aryImageObj[NumSel].BackUpBmp.Assign(aryImageObj[NumSel].CurrentBmp);
    aryImageObj[NumSel].CurrentBmp.Width := abs(DrawRect.Right - DrawRect.Left);
    aryImageObj[NumSel].CurrentBmp.Height := abs(DrawRect.Bottom - DrawRect.Top);
    oRect := DrawRect;
    OffsetRect(oRect, -DrawRect.Left, -DrawRect.Top);
    aryImageObj[NumSel].CurrentBmp.Canvas.StretchDraw(oRect, aryImageObj[NumSel].BackUpBmp);
    end;
  PaintBox4Paint(PaintBox4);
  Sizing := False;
  end;

if NewMeta or TextSize then
  if FirstDraw then
  MetaRec1.Wmf.Free
  else
  begin
  TextSize := False;
  NumSel := -10;  // set NumSel to -10 to indicate a sizing opp
  PaintBox4.Canvas.DrawFocusRect(DrawRect);
  MetaRec1.PosRect := DrawRect;
  W := MetaRec1.PosRect.Right -MetaRec1.PosRect.Left;
  H := MetaRec1.PosRect.Bottom -MetaRec1.PosRect.Top;
  if W > 10 then
  MetaRec1.Wmf.Width := W else
    begin
    MetaRec1.PosRect.Right := MetaRec1.PosRect.Left + 10;
    MetaRec1.Wmf.Width := 10;
    end;
  if H > 10 then
  MetaRec1.Wmf.Height := H else
    begin
    MetaRec1.PosRect.Bottom := MetaRec1.PosRect.Top + 10;
    MetaRec1.Wmf.Height := 10;
    end;
  PaintBox4Paint(PaintBox4);
  sbut_MergeText.Enabled := True;
  end;

NewMeta := False;
FirstDraw := False;
TextSize := False;
CropSize := False;
end;

procedure TForm1.sbut_DoCropClick(Sender: TObject);
var
oRect: TRect;
begin
{this button click will finalize the Crop, by cutting off the bitmap}
if (DrawRect.Left < aryImageObj[NumSel].PosRect.Left) or
     (DrawRect.Top < aryImageObj[NumSel].PosRect.Top) or
     (DrawRect.Bottom > aryImageObj[NumSel].PosRect.Bottom) or
     (DrawRect.Right > aryImageObj[NumSel].PosRect.Right) then
  begin
  DrawRect := aryImageObj[NumSel].PosRect;
  ShowMessage('ERROR - The Crop Rectangle is OutSide of the image'#10'FAILURE');
  PaintBox4Paint(PaintBox4);
  Exit;
  end;

FreeAndNil(aryImageObj[NumSel].BackUpBmp);
aryImageObj[NumSel].BackUpBmp := TBitmap .Create;
aryImageObj[NumSel].BackUpBmp.Assign(aryImageObj[NumSel].CurrentBmp);
aryImageObj[NumSel].CurrentBmp.Width := DrawRect.Right - DrawRect.Left;
aryImageObj[NumSel].CurrentBmp.Height := DrawRect.Bottom - DrawRect.Top;

aryImageObj[NumSel].CurrentBmp.Canvas.Draw(-(DrawRect.Left-aryImageObj[NumSel].PosRect.Left),
                -(DrawRect.Top-aryImageObj[NumSel].PosRect.Top), aryImageObj[NumSel].BackUpBmp);

aryImageObj[NumSel].PosRect := DrawRect;
PaintBox4Paint(PaintBox4);
PaintBox4.Cursor := crDrag;
StartCrop := True;
end;


procedure TForm1.sbut_MakeTextWmfClick(Sender: TObject);
var
TempFont: TFont;
begin
{this button click will start the New Text object creation}
if NewMeta or (NumSel < 0) then Exit;
if (Length(Edit_Text.Text) < 1) or (Length(Edit_FontName.Text) < 1) then Exit;
Application.ProcessMessages;
sbut_MakeTextWmf.Enabled := False;
TextSel := NumSel;
NumSel := -1;
PaintBox4Paint(PaintBox4);
TempFont := TFont.Create;
TempFont.Assign(PaintBox4.Canvas.Font);
PaintBox4.Canvas.Font.Name := Edit_FontName.Text;
PaintBox4.Canvas.Font.Height := -24;
PaintBox4.Canvas.Font.Style := [];
MetaRec1.Wmf := TMetafile.Create;
MetaRec1.Wmf.Width := PaintBox4.Canvas.TextWidth(Edit_Text.Text);
MetaRec1.Wmf.Height := PaintBox4.Canvas.TextHeight(Edit_Text.Text);
PaintBox4.Canvas.Font.Assign(TempFont);
TempFont.Free;
with TMetafileCanvas.Create(MetaRec1.Wmf, 0) do
  try
  Font.Name := Edit_FontName.Text;
  Font.Height := -24;
  SetBkMode(Handle, 1);
  TextOut(0,0,Edit_Text.Text);
  finally
  Free;
  end;
MetaRec1.PosRect := Rect(0,0, MetaRec1.Wmf.Width, MetaRec1.Wmf.Height);

PaintBox4.Cursor := crDrag;
RadioGroup3.Enabled := False;
NewMeta := True;
Moving := False;
Sizing := False;
CropSize := False;
TextSize := False;
end;


procedure TForm1.sbut_MergeTextClick(Sender: TObject);
begin
{this button click ends the text creation and draws the meta file onto the bitmap}
if (DrawRect.Left < aryImageObj[TextSel].PosRect.Left) or
     (DrawRect.Top < aryImageObj[TextSel].PosRect.Top) or
     (DrawRect.Bottom > aryImageObj[TextSel].PosRect.Bottom) or
     (DrawRect.Right > aryImageObj[TextSel].PosRect.Right) then
  begin
  ShowMessage('ERROR - The Text Rectangle is OutSide of the image'#10'FAILURE');
  PaintBox4Paint(PaintBox4);
  Exit;
  end;
sbut_MergeText.Enabled := False;
sbut_MakeTextWmf.Enabled := True;
RadioGroup3.Enabled := True;
StartCrop := True;
FreeAndNil(aryImageObj[TextSel].BackUpBmp);
aryImageObj[TextSel].BackUpBmp := TBitmap .Create;
aryImageObj[TextSel].BackUpBmp.Assign(aryImageObj[TextSel].CurrentBmp);

aryImageObj[TextSel].CurrentBmp.Canvas.Draw(DrawRect.Left - aryImageObj[TextSel].PosRect.Left,
                              DrawRect.Top - aryImageObj[TextSel].PosRect.Top, MetaRec1.Wmf);
FreeAndNil(MetaRec1.Wmf);
DrawRect := aryImageObj[TextSel].PosRect;
NumSel := TextSel;
PaintBox4Paint(PaintBox4);
end;


- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
this is just a meager demo example, and can use lots of  testing and inprovement
I hope this can help you
0
 
LVL 3

Author Comment

by:fibdev
Comment Utility
Sorry I've been so busy.  I haven't forgotten about this question...

Slick,

 Can you email this sample project to me please.
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
EE does NOT allow Email transaction here. . . .
and I find your question to be puzzleling? ? ?
geobul  and  I have already posted alot of code for you, I kinda wish I had forrgotten about you
0
 
LVL 3

Author Comment

by:fibdev
Comment Utility
OK, If you must know Slick!

I have never had to build in this fasion.  I've used snippits given to me, but never this much code.  So I don't know how to procede with what you gave me.  I'm sure it's a fine piece of work, but I don't know what to do with it to get it working.  I guess my pride is the reason I made the request, but now I'm just offended.  I kind of wish you had forgotten about me too.  You may be a talented programmer, but I find your last post does not reflect the spirit of what we are doing here or what this site represents.  It's been a while since I've read the "rules" and I'm sorry I wasn't aware that ee does not "allow" email corrispondence between users.

I'm sorry you waisted your time on me.  I guess you should just unsubscribe to this thread.  :|
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
Did not mean any offence with my comment, however as I said I was puzzled,  and  still am,  very sorry about any lack of sprit on my part. . .

you should at least try geobul's code, since he was good enough to post it for you

Good luck with all of your projects
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Delphi OLE Error 8 82
Mydac connection data base issue 3 106
code issue 8 84
SUM 2 INTEGER ARRAYS INTO 1 10 53
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
This video discusses moving either the default database or any database to a new volume.
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now