Link to home
Start Free TrialLog in
Avatar of fibdev
fibdev

asked on

Simple Image Editor From Scratch

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)
ASKER CERTIFIED SOLUTION
Avatar of geobul
geobul

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of fibdev
fibdev

ASKER

Thank you,

Being that it's currently ThanksGiving Day, I'll have to look at this tonight.  :)
Avatar of fibdev

ASKER

Could you post or mail me a project?
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of fibdev

ASKER

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
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
Avatar of fibdev

ASKER

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.

 :)
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. . .
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
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
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
Avatar of fibdev

ASKER

Sorry I've been so busy.  I haven't forgotten about this question...

Slick,

 Can you email this sample project to me please.
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
Avatar of fibdev

ASKER

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.  :|
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