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)
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Could you post or mail me a project?
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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.
:)
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(Sende r: 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.Pic ture);
// resize
p := TPicture.Create;
try
p.Bitmap.Height := NewHeight;
p.Bitmap.Width := NewWidth;
p.Bitmap.Canvas.StretchDra w(Rect(0,0 ,p.Bitmap. Width,p.Bi tmap.Heigh t), Img.Picture.Graphic);
Form1.Img.Picture.Assign(p );
Form1.ImgAdjust;
finally
p.Free;
end;
end;
And the Cancel button:
procedure TFormResizeAndCrop.btnCanc elClick(Se nder: TObject);
begin
Close; // closes the form
end;
Regards, Geo
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(Sende
begin
FormResizeAndClick.Show;
end;
In that new form (Resize example) something like:
procedure TFormResize.btnResizeClick
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.Pic
// resize
p := TPicture.Create;
try
p.Bitmap.Height := NewHeight;
p.Bitmap.Width := NewWidth;
p.Bitmap.Canvas.StretchDra
Form1.Img.Picture.Assign(p
Form1.ImgAdjust;
finally
p.Free;
end;
end;
And the Cancel button:
procedure TFormResizeAndCrop.btnCanc
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
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(Send er: 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(Send er: 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(Send er: 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_CreateImageCli ck(Sender: TObject);
begin
{this button click will create a new image, each time it is clicked}
Reset;
SetLength (aryImageObj, Length(aryImageObj)+1);
aryImageObj[High(aryImageO bj)].Curre ntBmp := 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(aryImageO bj)].Curre ntBmp.Canv as.Brush.C olor := $93CAE4 shr ((High(aryImageObj) and 3) shl 3);
aryImageObj[High(aryImageO bj)].Curre ntBmp.Widt h := PaintBox4.Width shr 1;
aryImageObj[High(aryImageO bj)].Curre ntBmp.Heig ht := PaintBox4.Height shr 1;
aryImageObj[High(aryImageO bj)].Curre ntBmp.Canv as.TextOut (10,10, 'Bitmap '+IntToStr(High(aryImageOb j)+1));
aryImageObj[High(aryImageO bj)].PosRe ct.Left := 20+ (High(aryImageObj)* 40);
aryImageObj[High(aryImageO bj)].PosRe ct.Top := 20+ (High(aryImageObj)* 40);
aryImageObj[High(aryImageO bj)].PosRe ct.Right := aryImageObj[High(aryImageO bj)].PosRe ct.Left + aryImageObj[High(aryImageO bj)].Curre ntBmp.Widt h;
aryImageObj[High(aryImageO bj)].PosRe ct.Bottom := aryImageObj[High(aryImageO bj)].PosRe ct.Top + aryImageObj[High(aryImageO bj)].Curre ntBmp.Heig ht;
{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(aryImageO bj)].AspRa tio := aryImageObj[High(aryImageO bj)].Curre ntBmp.Heig ht / aryImageObj[High(aryImageO bj)].Curre ntBmp.Widt h;
PaintBox4.canvas.Draw(aryI mageObj[Hi gh(aryImag eObj)].Pos Rect.Left, aryImageObj[High(aryImageO bj)].PosRe ct.Top, aryImageObj[High(aryImageO bj)].Curre ntBmp);
end;
procedure TForm1.RadioGroup3Click(Se nder: 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.PaintBox4ContextPop up(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].Po sRect, MousePos) then
begin
Panel2.Show;
if i <> NumSel then
NumSel := i;
PaintBox4Paint(PaintBox4);
Break;
end;
end;
Handled := True;
end;
procedure TForm1.PaintBox4Paint(Send er: TObject);
var
i: Integer;
begin
{I just paint a Rectangle for the PaintBox background}
PaintBox4.Canvas.Brush.Col or := $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(aryI mageObj[i] .PosRect.L eft, aryImageObj[i].PosRect.Top , aryImageObj[i].CurrentBmp) ;
if Assigned(MetaRec1.Wmf) then
PaintBox4.Canvas.Draw(Draw Rect.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.Sty le := 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.Sty le := 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(R ectPB.TopL eft);
RectPB.BottomRight := PaintBox4.ClientToScreen(R ectPB.Bott omRight);
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);//aryImageOb j[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].Po sRect, Pnt1) then
begin
{see if the point is inside a graphic object rect and select that graphic obj}
Moving := True;
OffX := aryImageObj[i].PosRect.Lef t - X;
OffY := aryImageObj[i].PosRect.Top - Y;
DrawStart.x := aryImageObj[i].PosRect.Lef t;
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.DrawFocus Rect(DrawR ect);
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.DrawFocus Rect(DrawR ect);
Exit;
end;
if Cropping then
begin
if (X <> DrawRect.Right) and (Y <> DrawRect.Bottom) then
begin
PaintBox4.Canvas.DrawFocus Rect(DrawR ect);
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.DrawFocus Rect(DrawR ect);
end;
Exit;
end;
if Moving then
begin
PaintBox4.Canvas.Brush.Sty le := bsSolid;
PaintBox4.Canvas.DrawFocus Rect(DrawR ect);
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.DrawFocus Rect(DrawR ect);
exit;
end;
if Sizing or CropSize or TextSize then
begin
PaintBox4.Canvas.Brush.Sty le := bsSolid;
PaintBox4.Canvas.DrawFocus Rect(DrawR ect);
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].AspRat io);
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].AspRat io);
end else DrawRect.Top := Y;
PaintBox4.Canvas.DrawFocus Rect(DrawR ect);
PaintBox4.Canvas.TextOut(1 0,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(Se nder: 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].PosRec t := DrawRect;
PaintBox4Paint(PaintBox4);
end;
Moving := False;
Exit;
end;
if Sizing then
begin
aryImageObj[NumSel].PosRec t := DrawRect;
if NumSel > -1 then
begin
FreeAndNil(aryImageObj[Num Sel].BackU pBmp);
aryImageObj[NumSel].BackUp Bmp := TBitmap .Create;
aryImageObj[NumSel].BackUp Bmp.Assign (aryImageO bj[NumSel] .CurrentBm p);
aryImageObj[NumSel].Curren tBmp.Width := abs(DrawRect.Right - DrawRect.Left);
aryImageObj[NumSel].Curren tBmp.Heigh t := abs(DrawRect.Bottom - DrawRect.Top);
oRect := DrawRect;
OffsetRect(oRect, -DrawRect.Left, -DrawRect.Top);
aryImageObj[NumSel].Curren tBmp.Canva s.StretchD raw(oRect, aryImageObj[NumSel].BackUp Bmp);
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.DrawFocus Rect(DrawR ect);
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(Se nder: TObject);
var
oRect: TRect;
begin
{this button click will finalize the Crop, by cutting off the bitmap}
if (DrawRect.Left < aryImageObj[NumSel].PosRec t.Left) or
(DrawRect.Top < aryImageObj[NumSel].PosRec t.Top) or
(DrawRect.Bottom > aryImageObj[NumSel].PosRec t.Bottom) or
(DrawRect.Right > aryImageObj[NumSel].PosRec t.Right) then
begin
DrawRect := aryImageObj[NumSel].PosRec t;
ShowMessage('ERROR - The Crop Rectangle is OutSide of the image'#10'FAILURE');
PaintBox4Paint(PaintBox4);
Exit;
end;
FreeAndNil(aryImageObj[Num Sel].BackU pBmp);
aryImageObj[NumSel].BackUp Bmp := TBitmap .Create;
aryImageObj[NumSel].BackUp Bmp.Assign (aryImageO bj[NumSel] .CurrentBm p);
aryImageObj[NumSel].Curren tBmp.Width := DrawRect.Right - DrawRect.Left;
aryImageObj[NumSel].Curren tBmp.Heigh t := DrawRect.Bottom - DrawRect.Top;
aryImageObj[NumSel].Curren tBmp.Canva s.Draw(-(D rawRect.Le ft-aryImag eObj[NumSe l].PosRect .Left),
-(DrawRect.Top-aryImageObj [NumSel].P osRect.Top ), aryImageObj[NumSel].BackUp Bmp);
aryImageObj[NumSel].PosRec t := DrawRect;
PaintBox4Paint(PaintBox4);
PaintBox4.Cursor := crDrag;
StartCrop := True;
end;
procedure TForm1.sbut_MakeTextWmfCli ck(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.ProcessMessage s;
sbut_MakeTextWmf.Enabled := False;
TextSel := NumSel;
NumSel := -1;
PaintBox4Paint(PaintBox4);
TempFont := TFont.Create;
TempFont.Assign(PaintBox4. Canvas.Fon t);
PaintBox4.Canvas.Font.Name := Edit_FontName.Text;
PaintBox4.Canvas.Font.Heig ht := -24;
PaintBox4.Canvas.Font.Styl e := [];
MetaRec1.Wmf := TMetafile.Create;
MetaRec1.Wmf.Width := PaintBox4.Canvas.TextWidth (Edit_Text .Text);
MetaRec1.Wmf.Height := PaintBox4.Canvas.TextHeigh t(Edit_Tex t.Text);
PaintBox4.Canvas.Font.Assi gn(TempFon t);
TempFont.Free;
with TMetafileCanvas.Create(Met aRec1.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].PosRe ct.Left) or
(DrawRect.Top < aryImageObj[TextSel].PosRe ct.Top) or
(DrawRect.Bottom > aryImageObj[TextSel].PosRe ct.Bottom) or
(DrawRect.Right > aryImageObj[TextSel].PosRe ct.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[Tex tSel].Back UpBmp);
aryImageObj[TextSel].BackU pBmp := TBitmap .Create;
aryImageObj[TextSel].BackU pBmp.Assig n(aryImage Obj[TextSe l].Current Bmp);
aryImageObj[TextSel].Curre ntBmp.Canv as.Draw(Dr awRect.Lef t - aryImageObj[TextSel].PosRe ct.Left,
DrawRect.Top - aryImageObj[TextSel].PosRe ct.Top, MetaRec1.Wmf);
FreeAndNil(MetaRec1.Wmf);
DrawRect := aryImageObj[TextSel].PosRe ct;
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
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(Send
procedure PaintBox4MouseDown(Sender:
Shift: TShiftState; X, Y: Integer);
procedure PaintBox4MouseMove(Sender:
Y: Integer);
procedure PaintBox4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox4ContextPopup(Send
var Handled: Boolean);
procedure RadioGroup3Click(Sender: TObject); // the rest of these are on Panel2
procedure sbut_DoCropClick(Sender: TObject);
procedure sbut_MakeTextWmfClick(Send
procedure sbut_MergeTextClick(Sender
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:
var
i: Integer;
begin
for i := 0 to High(aryImageObj) do
begin
FreeAndNil(aryImageObj[i].
FreeAndNil(aryImageObj[i].
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_CreateImageCli
begin
{this button click will create a new image, each time it is clicked}
Reset;
SetLength (aryImageObj, Length(aryImageObj)+1);
aryImageObj[High(aryImageO
{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(aryImageO
aryImageObj[High(aryImageO
aryImageObj[High(aryImageO
aryImageObj[High(aryImageO
aryImageObj[High(aryImageO
aryImageObj[High(aryImageO
aryImageObj[High(aryImageO
aryImageObj[High(aryImageO
{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(aryImageO
PaintBox4.canvas.Draw(aryI
end;
procedure TForm1.RadioGroup3Click(Se
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.PaintBox4ContextPop
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].Po
begin
Panel2.Show;
if i <> NumSel then
NumSel := i;
PaintBox4Paint(PaintBox4);
Break;
end;
end;
Handled := True;
end;
procedure TForm1.PaintBox4Paint(Send
var
i: Integer;
begin
{I just paint a Rectangle for the PaintBox background}
PaintBox4.Canvas.Brush.Col
PaintBox4.Canvas.Rectangle
{this for loop paints all of the Image Objects on the painybox}
for i := 0 to High(aryImageObj) do
PaintBox4.canvas.Draw(aryI
if Assigned(MetaRec1.Wmf) then
PaintBox4.Canvas.Draw(Draw
if (NumSel > -1) or Assigned(MetaRec1.Wmf) then
begin
{this draws a Focus Rectangle on the selected Image or the Text}
PaintBox4.Canvas.Brush.Sty
PaintBox4.Canvas.Pen.Color
PaintBox4.Canvas.Pen.Width
PaintBox4.Canvas.Pen.Mode := pmNot;
PaintBox4.Canvas.Rectangle
PaintBox4.Canvas.Pen.Mode := pmCopy;
PaintBox4.Canvas.Brush.Sty
PaintBox4.Canvas.Pen.Width
end;
end;
procedure TForm1.PaintBox4MouseDown(
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(R
RectPB.BottomRight := PaintBox4.ClientToScreen(R
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);//aryImageOb
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].Po
begin
{see if the point is inside a graphic object rect and select that graphic obj}
Moving := True;
OffX := aryImageObj[i].PosRect.Lef
OffY := aryImageObj[i].PosRect.Top
DrawStart.x := aryImageObj[i].PosRect.Lef
DrawStart.y := aryImageObj[i].PosRect.Top
DrawRect := aryImageObj[i].PosRect;
if i <> NumSel then
NumSel := i;
PaintBox4Paint(PaintBox4);
Break;
end;
end;
procedure TForm1.PaintBox4MouseMove(
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.DrawFocus
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.DrawFocus
Exit;
end;
if Cropping then
begin
if (X <> DrawRect.Right) and (Y <> DrawRect.Bottom) then
begin
PaintBox4.Canvas.DrawFocus
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.DrawFocus
end;
Exit;
end;
if Moving then
begin
PaintBox4.Canvas.Brush.Sty
PaintBox4.Canvas.DrawFocus
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.DrawFocus
exit;
end;
if Sizing or CropSize or TextSize then
begin
PaintBox4.Canvas.Brush.Sty
PaintBox4.Canvas.DrawFocus
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].AspRat
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].
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].
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].AspRat
end else DrawRect.Top := Y;
PaintBox4.Canvas.DrawFocus
PaintBox4.Canvas.TextOut(1
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(Se
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].PosRec
PaintBox4Paint(PaintBox4);
end;
Moving := False;
Exit;
end;
if Sizing then
begin
aryImageObj[NumSel].PosRec
if NumSel > -1 then
begin
FreeAndNil(aryImageObj[Num
aryImageObj[NumSel].BackUp
aryImageObj[NumSel].BackUp
aryImageObj[NumSel].Curren
aryImageObj[NumSel].Curren
oRect := DrawRect;
OffsetRect(oRect, -DrawRect.Left, -DrawRect.Top);
aryImageObj[NumSel].Curren
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.DrawFocus
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(Se
var
oRect: TRect;
begin
{this button click will finalize the Crop, by cutting off the bitmap}
if (DrawRect.Left < aryImageObj[NumSel].PosRec
(DrawRect.Top < aryImageObj[NumSel].PosRec
(DrawRect.Bottom > aryImageObj[NumSel].PosRec
(DrawRect.Right > aryImageObj[NumSel].PosRec
begin
DrawRect := aryImageObj[NumSel].PosRec
ShowMessage('ERROR - The Crop Rectangle is OutSide of the image'#10'FAILURE');
PaintBox4Paint(PaintBox4);
Exit;
end;
FreeAndNil(aryImageObj[Num
aryImageObj[NumSel].BackUp
aryImageObj[NumSel].BackUp
aryImageObj[NumSel].Curren
aryImageObj[NumSel].Curren
aryImageObj[NumSel].Curren
-(DrawRect.Top-aryImageObj
aryImageObj[NumSel].PosRec
PaintBox4Paint(PaintBox4);
PaintBox4.Cursor := crDrag;
StartCrop := True;
end;
procedure TForm1.sbut_MakeTextWmfCli
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
Application.ProcessMessage
sbut_MakeTextWmf.Enabled := False;
TextSel := NumSel;
NumSel := -1;
PaintBox4Paint(PaintBox4);
TempFont := TFont.Create;
TempFont.Assign(PaintBox4.
PaintBox4.Canvas.Font.Name
PaintBox4.Canvas.Font.Heig
PaintBox4.Canvas.Font.Styl
MetaRec1.Wmf := TMetafile.Create;
MetaRec1.Wmf.Width := PaintBox4.Canvas.TextWidth
MetaRec1.Wmf.Height := PaintBox4.Canvas.TextHeigh
PaintBox4.Canvas.Font.Assi
TempFont.Free;
with TMetafileCanvas.Create(Met
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
begin
{this button click ends the text creation and draws the meta file onto the bitmap}
if (DrawRect.Left < aryImageObj[TextSel].PosRe
(DrawRect.Top < aryImageObj[TextSel].PosRe
(DrawRect.Bottom > aryImageObj[TextSel].PosRe
(DrawRect.Right > aryImageObj[TextSel].PosRe
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[Tex
aryImageObj[TextSel].BackU
aryImageObj[TextSel].BackU
aryImageObj[TextSel].Curre
DrawRect.Top - aryImageObj[TextSel].PosRe
FreeAndNil(MetaRec1.Wmf);
DrawRect := aryImageObj[TextSel].PosRe
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
ASKER
Sorry I've been so busy. I haven't forgotten about this question...
Slick,
Can you email this sample project to me please.
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
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
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. :|
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
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
ASKER
Being that it's currently ThanksGiving Day, I'll have to look at this tonight. :)