Delphi Image Components

>1. Let me Create text image and be able to change it's fonts, colors, scale, rotate etc..

looks like windows Meta File (*.wmf)

>2. Save it in JPG or BMP type.

wmf can be converted to this types

--> no components needed -> designer needed i guess

meikl ;-)

Ok, i am ready to pay for such small application with Source.

I have done many things with the Font sizing, positioning using EMF and WMF memory files, and some Font rotation, for graphics display, however there are so many factors, for this type of thing, that creating a universal Font, do it ALL component, is maybe not in reach, for instance,  in resizing of a WMF, you can only use True Type fonts (or the newer win XP O type fonts, I forget their type name at the moment),
can you give a little more info about it, what you really need and try and pull back a little from a do it all component

Ok, no problem at all.

This can maybe be a application, not component.

I will need small application that can let users create text i.e..
"MY Name is Mark" then be able to...

1. Resize it.
2. Rotate it. (All supported).
3. Change colors and on different font.
4. Scale it.
5. Be able to choose the Font used (True Type).

Good and nice interface for it and easily be able to save it
to BMP or JPG etc... file.

Any offering?

Thanks.

Hi.

Anyone here that can build such application?

Oh yea
But you seem to think it is an easy thing
I did some work on it to day, and have got it, ,
EXCEPT
for your requirement of font "Rotation", as you know the Delphi TFont Does NOT recognize any Rotated font settings,  none
so I need to use the API create font to get a rotated font, and this makes the Delphi TFont unuseable, so I will need to re-code it all in API

Oh, since I am asking
What is the difference to you of
1. Resize it.

and

4. Scale it.

Sorry 1 and 4 are same.

Sorry it took some time for me to get this up, I got the drag and drop text sizing running real soon, I have done that before. . . I have done Text Rotation before also, However, I have not combined the two, like you wanted. I thought it would not be difficult, but I was wrong.
I have to admit that I was defeated by the math skills that this requires, the trigonometric perception this needs is NOT one of my strengths, so I will give you a program that works in the first rotation quadrent (0 to 90 degrees), but will not center the text in the container rectangle in the other 3 quadrents, although I can still effectively, move and size the Text, but it goes outside the rectangle. I am out of time to do any more with this.
After alot of trial and error I decided to go with the  SetWorldTransform( ) method to rotate the text, it gives the best looking text output, but it is complicated and, ONLY availible on NT systems. . . .
You will need a form with a TPaintBox, A TLabel, a TComboBox, 3 TCheckboxes, 3 TEdits, 3 TButtons and one TOpenPictureDialog. You acn look at the TForm1 = class(TForm) for their names and a description of the controls. . . . .




unit FontOnBmp1;

interface

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

type
  TMetaRec = Record                          
    Emf: TMetaFile;
    PosRect: TRect;
    end;


  TForm1 = class(TForm)
    PaintBox1: TPaintBox; // shows Bitmap and Text
    ComboBox1: TComboBox; // lists all True Type Fonts
    Label1: TLabel; // Shows a Sample of the choosen Font
    BoldCheckBox: TCheckBox; // check for Bold font
    ItalicCheckBox: TCheckBox; // check for Italic font
    UnderCheckBox: TCheckBox; // check for Underline font
    EditText: TEdit; // Edit Box for the TEXT to place on bitmap
    EditAngle: TEdit; // Edit Box for the Angle Rotation of Text
    EditColor: TEdit; // Edit Box for Hex Color of Text
    DragDropText_Button: TButton; {button for starting drag and drop of
        Rectangle for the container of your Text}
    Button_MergeBmp: TButton; // paints the positioned Text on the Bitmap
    GetBmpFile_Button: TButton; // button gets Open Dialog to get a Bitmap
    OpenPictureDialog1: TOpenPictureDialog;

    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject); // will change the sample font on Label1
    procedure BoldCheckBoxClick(Sender: TObject); // all 3 checkboxs call this click evevt
    procedure PaintBox1Paint(Sender: TObject); // draws Bitmap and Text on paintbox
    procedure GetBmpFile_ButtonClick(Sender: TObject); // gets Open dialog for Bitmap to show in paintbox
    procedure FormDestroy(Sender: TObject);
    procedure DragDropText_ButtonClick(Sender: TObject);
    {DragDropText button will create a Meta File and you need to drag your Text recangle on the paintbox}
    procedure Button_MergeBmpClick(Sender: TObject);
    {MergeBmp button will paint the Text on the bitmap, for permanent text}

    {I do a method where the user will drag and drop all text size and placement
    on the bitmap. To start you press down the Main mouse button and draw a
    focus Rectangle on the Paintbox. You can then drag the rectangle anywhere
    on the paintbox to move the text, and you can put the cursor over the focus
    rectangle and it will change to a sizing arrow, so you can drag an edge
    to increase or decrease the size of the Text. So you will need the 3 mouse
    events for the paintbox below}
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);

  private
    { Private declarations }
    hFont: Integer;
    Angle: Cardinal;
    DisplayBmp: TBitmap;
    MetaRec1: TMetaRec;
    Moving, Sizing, Drawing, FirstDraw, NewMeta: Boolean;
    DrawStart, OffSet: TPoint;
    FrameRect: TRect;
    Side: Char;
    function MakeFont: TSIZE;
    procedure setFontStyle;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses Math;


function TForm1.MakeFont: TSIZE;
var
FontLog1: TLogFont;
sDC: Integer;
begin
Result.cx := 0;
Result.cy := 0;
if ComboBox1.ItemIndex < 0 then
  begin
  ShowMessage('ERROR - There is NO font name seleted in the Font Name Combo Box');
  Exit;
  end;

if Length(EditText.Text) < 1 then
  begin
  ShowMessage('ERROR - There is NO Text in the font Text Edit Box');
  Exit;
  end;

DeleteObject(hFont);
hFont := 0;
Angle := abs(StrToIntDef(EditAngle.Text, 0));
Angle := Angle mod 360;

ZeroMemory(@FontLog1, SizeOf(FontLog1));
with FontLog1 do
  begin
  lfHeight := -24;
  if BoldCheckBox.Checked then
    lfWeight := FW_BOLD;
  if ItalicCheckBox.Checked then
    lfItalic := 1;
  if UnderCheckBox.Checked then
    lfUnderline := 1;
  lfPitchAndFamily := VARIABLE_PITCH or FF_SWISS;
  StrCopy(@lfFaceName[0], PChar(ComboBox1.Items[ComboBox1.ItemIndex]));
  end;
hFont := CreateFontIndirect(FontLog1);

sDC := GetDC(0);
SelectObject(sDC, hFont);
GetTextExtentPoint32(sDC, PChar(EditText.Text), Length(EditText.Text), Result);
ReleaseDC(0, sDC);
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
if (FontType and TrueType_FontType) <> 0 then
  begin
  if Form1.ComboBox1.Items.IndexOf(LogFont.lfFaceName) < 0 then
    Form1.ComboBox1.Items.Add(LogFont.lfFaceName);
  end;
  Result := 1;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
sDC: Integer;
LogFont: TLogFont;
begin
hFont := 0;
Moving := False;
Sizing := False;
NewMeta := False;
ZeroMemory(@MetaRec1, SizeOf(MetaRec1));
DisplayBmp := TBitmap.Create;
DisplayBmp.Canvas.Brush.Color := $CCFFFF;
DisplayBmp.Width := PaintBox1.Width;
DisplayBmp.Height := PaintBox1.Height;
DisplayBmp.Canvas.Textout(10,10, 'No Bitmap');
Label1.Font.Height := -24;
Label1.Font.Color := 0;
EditColor.Text := '$000000';
EditAngle.Text := '0';

{the SetWorldTransform only works in windows NT systems}
if not (Win32Platform = VER_PLATFORM_WIN32_NT) then
  EditAngle.Hide;
{so I hide the Angle Edit box in non  NT  systems}

ComboBox1.Items.Clear;
sDC := GetDC(0);
try
  ZeroMemory(@LogFont, sizeof(LogFont));
  LogFont.lfCharset := DEFAULT_CHARSET;
  EnumFontFamiliesEx(sDC, LogFont, @EnumFontsProc, 0, 0);
  // EnumFontFamiliesEx will get the True Type Fonts on system
  finally
  ReleaseDC(0, sDC);
  end;
if ComboBox1.Items.Count < 1 then
  Label1.Caption := 'ERROR - No Vector Fonts avaible'
  else
  begin
  Label1.Caption := 'Text Font Sample';
  ComboBox1.Sorted := True;
  sDC := ComboBox1.Items.IndexOf('Arial');
  if sDC > -1 then
    ComboBox1.ItemIndex := sDC
    else
    begin
    sDC := 0;
    ComboBox1.ItemIndex := 0;
    end;
  Label1.Font.Name := ComboBox1.Items[sDC];
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(hFont);
FreeAndNil(DisplayBmp);
FreeAndNil(MetaRec1.Emf);
end;

procedure TForm1.setFontStyle;
var
fontStyles: TFontStyles;
Color: Cardinal;
begin
//make the Label1 Font as a sample font
Color := StrToIntDef(EditColor.Text, 0);
Label1.Font.Color := Color;
fontStyles := [];
if BoldCheckBox.Checked then
  fontStyles := [fsBold];
if ItalicCheckBox.Checked then
  fontStyles := fontStyles + [fsITalic];
if UnderCheckBox.Checked then
  fontStyles := fontStyles + [fsUnderline];
Label1.Font.Style := fontStyles;

end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
Label1.Font.Name := ComboBox1.Items[ComboBox1.ItemIndex];
setFontStyle;
end;

procedure TForm1.BoldCheckBoxClick(Sender: TObject);
begin
setFontStyle;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
{this will paint the Bitmap on the PaintBox and then draw the Emf for Text}
if DisplayBmp.Empty then
  PaintBox1.Canvas.Rectangle(PaintBox1.ClientRect)
  else
  PaintBox1.Canvas.Draw(0,0, DisplayBmp);
if Assigned(MetaRec1.Emf) then
  begin
  PaintBox1.Canvas.DrawFocusRect(FrameRect);
  PaintBox1.Canvas.Draw(MetaRec1.PosRect.Left, MetaRec1.PosRect.Top, MetaRec1.Emf);
  end;
end;

procedure TForm1.GetBmpFile_ButtonClick(Sender: TObject);
begin
OpenPictureDialog1.Filter := 'Bitmap files (*.bmp)|*.BMP';
if OpenPictureDialog1.Execute then
  begin
  DisplayBmp.LoadFromFile(OpenPictureDialog1.FileName);
  PaintBox1.Width := DisplayBmp.Width;
  PaintBox1.Height := DisplayBmp.Height;
  PaintBox1Paint(PaintBox1);
  end;
end;

procedure TForm1.DragDropText_ButtonClick(Sender: TObject);
var
Size1: TSize;
XForm1: tagXFORM;
A1, Rad, Sin1, Cos1: Extended;
begin
{when you click this button, you start the Drag and Drop Rectangle
method on PaintBox1. This will create a Emf Meta File, and transform the world
coordinates to rotate the Text that is drawn on the Meta File.
You must Draw and drop your Rectangle on the PaintBox to see the Text}
Size1 := MakeFont;
if (Size1.cx = 0) and (Size1.cy = 0) then
  begin
  Showmessage('ERROR - Could NOT Create a font, all operations Canceled');
  Exit;
  end;

FreeAndNil(MetaRec1.Emf);
A1 := Angle;
Rad := DegToRad(A1);
SinCos(Rad, Sin1, Cos1);
MetaRec1.Emf := TMetafile.Create;
MetaRec1.Emf.Enhanced := True;

MetaRec1.Emf.Width := Round(abs(( Cos1 * Size1.cx)) + abs(Sin1 * Size1.cy))+1;
MetaRec1.Emf.Height := Round(abs(Cos1 * Size1.cy) + abs(Sin1 * Size1.cx))+1;

with TMetafileCanvas.Create(MetaRec1.Emf, 0) do
  try
  SelectObject(Handle, hFont);
  SetTextColor(Handle, StrToIntDef(EditColor.Text, 0));

  SetBkMode(Handle, 1);

  XForm1.eM11 :=  Cos1;
  XForm1.eM12 := -Sin1;
  XForm1.eM21 := Sin1;
  XForm1.eM22 := Cos1;
  if Angle < 91 then
    begin
    XForm1.eDx := 0.0;
    XForm1.eDy := Sin1 * Size1.cx;
    end else
    if Angle < 181 then
    begin
    XForm1.eDx := -(Cos1 * Size1.cx);
    XForm1.eDy := -(Cos1 * Size1.cy);
    end else
    if Angle < 271 then
    begin
    XForm1.eDx := -(Cos1 * Size1.cx);
    XForm1.eDy := 0.0;
    end else
    begin
    XForm1.eDy := -(Cos1 * Size1.cx);
    XForm1.eDx := (Cos1 * Size1.cy);
    end;

  SetWorldTransform(Handle,XForm1);

  TextOut(0, 0,EditText.Text);
  finally
  Free;
  end;
MetaRec1.PosRect := Rect(0,0, MetaRec1.Emf.Width, MetaRec1.Emf.Height);

PaintBox1.Cursor := crDrag;
Moving := False;
Sizing := False;
NewMeta := True;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);

var
Pnt1: TPoint;
RectPB: TRect;
begin
RectPB := PaintBox1.ClientRect;
RectPB.TopLeft := PaintBox1.ClientToScreen(RectPB.TopLeft);
RectPB.BottomRight := PaintBox1.ClientToScreen(RectPB.BottomRight);
ClipCursor(@RectPB);

if PaintBox1.Cursor = crSizeWE then
    begin
    Sizing := True;
    if (X < MetaRec1.PosRect.Left+ 6) and (X > MetaRec1.PosRect.Left - 6) then
      Side := 'L'
      else
      Side := 'R';
    Exit;
    end else
    if PaintBox1.Cursor = crSizeNS then
      begin
      Sizing := True;
      if (Y < MetaRec1.PosRect.Top+ 6) and (Y > MetaRec1.PosRect.Top - 6) then
        Side := 'T'
        else
        Side := 'B';
      Exit;
      end;

if NewMeta then
  begin
  DrawStart.x := X;
  DrawStart.y:= Y;
  FrameRect.Left := X;
  FrameRect.Top := Y;
  FrameRect.Right := X+10;
  FrameRect.Bottom := Y+10;
  FirstDraw := True;
  Exit;
  end;

Pnt1.x := X;
Pnt1.y := Y;

if not Assigned(MetaRec1.Emf) then Exit;

if PtInRect(FrameRect, Pnt1) then
  begin
  Moving := True;
  OffSet.X := FrameRect.Left - X;
  OffSet.Y := FrameRect.Top - Y;
  DrawStart.x := FrameRect.Left;
  DrawStart.y := FrameRect.Top;
  end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);

var
H, W: Integer;
begin
ClipCursor(nil);
Drawing := False;
PaintBox1.Cursor := crDefault;

if NewMeta or Sizing then
  begin
  PaintBox1.Canvas.DrawFocusRect(FrameRect);
  MetaRec1.PosRect := FrameRect;
  W := FrameRect.Right - FrameRect.Left;
  H := FrameRect.Bottom - FrameRect.Top;
  if W > 11 then
  MetaRec1.Emf.Width := W else
    begin
    MetaRec1.PosRect.Right := MetaRec1.PosRect.Left + 11;
    MetaRec1.Emf.Width := 11;
    end;
  if H > 10 then
  MetaRec1.Emf.Height := H else
    begin
    MetaRec1.PosRect.Bottom := MetaRec1.PosRect.Top + 10;
    MetaRec1.Emf.Height := 10;
    end;
  PaintBox1Paint(PaintBox1);
  NewMeta := False;
  Sizing := False;
  Exit;
  end;

if Moving then
  begin
  if (DrawStart.x <> FrameRect.Left) and (DrawStart.x <> FrameRect.Top) then
    begin
    MetaRec1.PosRect := FrameRect;
    PaintBox1Paint(PaintBox1);
    end;
  Moving := False;
  Exit;
  end;

NewMeta := False;
FirstDraw := False;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
const
VarDis = 4;
begin
if FirstDraw then
if (X > DrawStart.x+VarDis) or (X < DrawStart.x-VarDis) or (Y > DrawStart.y+VarDis) or (Y < DrawStart.y-VarDis) then
  Drawing := True;

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

if not Assigned(MetaRec1.Emf) then Exit;

if Moving then
  begin
  PaintBox1.Canvas.Brush.Style := bsSolid;
  PaintBox1.Canvas.DrawFocusRect(FrameRect);
  FrameRect.Right := FrameRect.Right - FrameRect.Left + X + OffSet.X;
  FrameRect.Bottom := FrameRect.Bottom - FrameRect.Top + Y+ OffSet.Y;
  FrameRect.Left := X+ OffSet.X;
  FrameRect.Top := Y+ OffSet.Y;
  PaintBox1.Canvas.DrawFocusRect(FrameRect);
  exit;
  end;

if Sizing then
  begin
  PaintBox1.Canvas.Brush.Style := bsSolid;
  PaintBox1.Canvas.DrawFocusRect(FrameRect);
  if Side = 'T' then
    begin
    FrameRect.Top := Y;
    end else
    if Side = 'L' then
    begin
    FrameRect.Left := X;
    end else
    if Side = 'R' then
    begin
    FrameRect.Right := X;
    end else
    if Side = 'B' then
    begin
    FrameRect.Bottom := Y;
    end else FrameRect.Top := Y;

  PaintBox1.Canvas.DrawFocusRect(FrameRect);
  Exit;
  end;

if NewMeta then Exit;
  if (Y > FrameRect.Top-VarDis) and (Y < FrameRect.Bottom +VarDis) and
     ((X < FrameRect.Left+ VarDis) and (X > FrameRect.Left -VarDis) or
     (X < FrameRect.Right+ VarDis) and (X > FrameRect.Right -VarDis)) then
     PaintBox1.Cursor := crSizeWE else

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

procedure TForm1.Button_MergeBmpClick(Sender: TObject);
begin
if not Assigned(MetaRec1.Emf) then Exit;
if not Assigned(DisplayBmp) then Exit;
DisplayBmp.Canvas.Draw(MetaRec1.PosRect.Left, MetaRec1.PosRect.Top, MetaRec1.Emf);
FreeAndNil(MetaRec1.Emf);
PaintBox1Paint(PaintBox1);
end;

end.


 = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
You choose the font name in the combo box, then check any Font checkbox for Bold ect, then click the DragDropText_Button to start the operation, now you have to drag and drop DRAW a rectangle on the paint box, when you release the mouse button the text will be drawn close to the rectangle you have drawn. Now you can drag and move the rectangle anywhere on the Paintbox, , OR drag the edges of the rectangle to change the size of the text. When you are done, click the Merge button to paint the text on the bitmap.
ask questions if you need more info

Hi.

Thanks, is it possible i can download the full source (project)?

Yust copy!!!

program FontOnBmp;

uses
  Forms,
  FontOnBmp1 in 'FontOnBmp1.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

above is the FontOnBmp1.dfm  file

Will this component work?

http://www.leadtools.com

?????
I'm not sure I see any connection to your last comment and the original question?
I do not have any experience with the LeadTools products, so I can not give any input, ,
but your question seems mis-placed, as in, if they charge 995 US for their Raster Imaging, don't you think it would at least work?
I'm sure if you contact them they'll tell you all about it

I take it you can not run the code I have posted?

Hi.

I am going to execute your code tomorrow at work. I just found this link via
Google search for Delphi image component!.

Thanks.

can you get ant results from the code?