Federgraph Meme Builder Source

Of course you would want to build your version of the Meme Builder App from source, so that you can easily change the hardcoded values.

The content below is a snapshot in time, already replaced by updated code, see repository at GitHub. It uses Office fonts on Windows 10.

Design

Meme Builder is a small one-form-only Delphi FMX application. You can add text to an image. I used it with images from the Federgraph App.

( There is no configuration, because it would be overkill. )

It has a drop target where you can drop the image, initially shown.
The drop target can be hidden.
A checker bitmap is shown when no actual image is loaded.
It has an image component, of course.
It has top and bottom text components, always shown.
Both text components have a glow effect.
It has top and bottom edit components to change the text, initially hidden.

You can edit, arrange and style the text, and you should be able to copy the finished image to the clipboard.

Actions

There are 6 actions defined, by means of action constants.

const
  faTopMargin = 1;
  faBottomMargin = 2;
  faTopSize = 3;
  faBottomSize = 4;
  faTopGlow = 5;
  faBottomGlow = 6;

Use the keyboard to trigger the action.
These actions will select the current parameter.
You are supposed to select a parameter and then use the scroll wheel to change the value of that parameter.

Options

Font Name used, choose the font from a limited set of hardcoded font names.
Form Size chosen, you can switch between some standard sizes.
Default Text used, you can play with some hardcoded combinations of top and bottom text.

Keyboard usage

This is a desktop application. You need to use the keyboard.

If it was a tablet app, I would have included touch buttons, and it would have been more complicated.

procedure TFormMain.FormKeyUp(
  Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
  if Key = vkEscape then
  begin
    TopEdit.Visible := not TopEdit.Visible;
    BottomEdit.Visible := TopEdit.Visible;
    Caption := DefaultCaption;
  end;

  if Key = vkC then
  begin
    CopyBitmap;
    Caption := 'Bitmap copied.';
  end

  else if TopEdit.Visible then
    //do nothing when editing

  else if KeyChar = 'd' then
    DropTargetVisible := not DropTargetVisible

  else if KeyChar = 'c' then
    ClearImage

  else if KeyChar = 'f' then
    CycleFontP

  else if KeyChar = 'F' then
    CycleFontM

  else if KeyChar = 'g' then
    UpdateParam(faTopGlow)

  else if KeyChar = 'h' then
    UpdateParam(faBottomGlow)

  else if KeyChar = 't' then
    UpdateParam(faTopSize)

  else if KeyChar = 'b' then
    UpdateParam(faBottomSize)

  else if KeyChar = 'n' then
    UpdateParam(faTopMargin)

  else if KeyChar = 'm' then
    UpdateParam(faBottomMargin)

  else if KeyChar = 'r' then
    Caption := DefaultCaption

  else if KeyChar = 'R' then
    Reset

  else if KeyChar = 'x' then
  begin
    Inc(TestID);
    TestID := TestID mod 2;
    Reset;
  end

  else if KeyChar = '1' then
    UpdateFormat(640, 480)

  else if KeyChar = '2' then
    UpdateFormat(800, 600)

  else if KeyChar = '3' then
    UpdateFormat(1024, 768)

  else if KeyChar = '8' then
    UpdateFormat(800, 800)

  else if KeyChar = '9' then
    UpdateFormat(900, 900)

  else if KeyChar = '0' then
    UpdateFormat(1024, 1024)
end;

Using the keyboard you can

change the visibility of the text edits
show and hide the drop target
change the size of the image (ClientWidth, ClientHeight)
reset the text to hardcoded default
cycle between alternative standard text definitions, if any
cycle the font using a range of predefined font names
select the current parameter, the value of which you want to change with the mouse wheel

Note that when you cycle through the fonts - it will apply the next font to the top or bottom text, depending on the current parameter.

Key mapping recap:

KeyChar(s)	Action
Escape	toggle text edit controls
d	toggle drop target
1, 2, 3, 8, 9, 0	Window Format selection
b, t	param: bottom and top text size
m, n	param: bottom and top text margin
f, F	cycle Font, plus or minus
x	Cycle default Text plus Reset
r	Reset Caption command
R	Reset command
c	clear image command
^c	copy image to clipboard command

At run time

Federgraph Meme Builder App, no image loaded yet.

The App can be used as a companion app to the Federgraph application, just in case you wanted to build a Meme with one of the Federgraph Emoji pictures.

Drop your image onto the drop target, then press Escape key to toggle the visibility of the edit controls for the text as needed.

At design time

Main Form at design time.

( My global CopyBitmapToClipboard procedure is in folder Util. Bitmap here means image, and you need to provide the routine as part of your homework. If you don’t you will be missing a feature, you will need to remove the application frame manually, in Paint. )

In the image above you can see that I have named the File FrmMain.pas, and that it is located in subfolder App, but this is just the convention I use.

Content of FrmMain.fmx:

object FormMain: TFormMain
  Left = 0
  Top = 0
  Caption = 'FMX Meme Builder'
  ClientHeight = 600
  ClientWidth = 800
  Fill.Color = claSlateblue
  Fill.Kind = Solid
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop, iPhone, iPad]
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnKeyUp = FormKeyUp
  OnMouseWheel = FormMouseWheel
  OnResize = FormResize
  DesignerMasterStyle = 0
  object TopText: TText
    Align = Top
    AutoSize = True
    HitTest = False
    Margins.Top = 10.000000000000000000
    Position.Y = 10.000000000000000000
    Size.Width = 800.000000000000000000
    Size.Height = 51.987304687500000000
    Size.PlatformDefault = False
    Text = 'Look'
    TextSettings.Font.Family = 'Showcard Gothic'
    TextSettings.Font.Size = 42.000000000000000000
    TextSettings.FontColor = claWhite
    object TopGlow: TGlowEffect
      Softness = 0.400000005960464500
      GlowColor = claBlack
      Opacity = 0.500000000000000000
    end
  end
  object BottomText: TText
    Align = Bottom
    AutoSize = True
    HitTest = False
    Margins.Bottom = 10.000000000000000000
    Position.Y = 512.437500000000000000
    Size.Width = 800.000000000000000000
    Size.Height = 77.562500000000000000
    Size.PlatformDefault = False
    Text = 'This App is so cool !'
    TextSettings.Font.Family = 'Vladimir Script'
    TextSettings.Font.Size = 64.000000000000000000
    TextSettings.Font.StyleExt = {00070000000000000004000000}
    TextSettings.FontColor = claWhite
    object BottomGlow: TGlowEffect
      Softness = 0.400000005960464500
      GlowColor = claBlack
      Opacity = 0.500000000000000000
    end
  end
  object TopEdit: TEdit
    Touch.InteractiveGestures = [LongTap, DoubleTap]
    TabOrder = 2
    Position.X = 16.000000000000000000
    Position.Y = 336.000000000000000000
    Size.Width = 100.000000000000000000
    Size.Height = 22.000000000000000000
    Size.PlatformDefault = False
    OnKeyUp = TopEditKeyUp
  end
  object BottomEdit: TEdit
    Touch.InteractiveGestures = [LongTap, DoubleTap]
    TabOrder = 3
    Position.X = 16.000000000000000000
    Position.Y = 368.000000000000000000
    Size.Width = 100.000000000000000000
    Size.Height = 22.000000000000000000
    Size.PlatformDefault = False
    OnKeyUp = BottomEditKeyUp
  end
end

On the design surface of the form I have placed 4 components, 2 text components (TText) and the 2 edit controls.

For the text components (TTExt) I have set up the initial glow effect.

And I have set up these event handlers

OnKeyUp for the edit controls and the form.
OnCreate and OnDestroy for the form (setup controls).
OnResize for the form (resize controls).
OnMouseWheel for the form (change param value).

Yes, the images will be created at runtime.

Pascal Source

( Everything else you need to know is in the source as always. )

Complete listing of FrmMain.pas follows:

unit FrmMain;

interface

uses
  System.SysUtils,
  System.Classes,
  System.Types,
  System.UITypes,
  System.UIConsts,
  FMX.Graphics,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.StdCtrls,
  FMX.Effects,
  FMX.Filter.Effects,
  FMX.Objects,
  FMX.ExtCtrls,
  FMX.Edit,
  FMX.Controls.Presentation;

type
  TFormMain = class(TForm)
    TopText: TText;
    BottomText: TText;
    BottomGlow: TGlowEffect;
    TopGlow: TGlowEffect;
    TopEdit: TEdit;
    BottomEdit: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DropTargetDropped(Sender: TObject; const Data: TDragObject;
      const Point: TPointF);
    procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
      Shift: TShiftState);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; var Handled: Boolean);
    procedure TopEditKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
      Shift: TShiftState);
    procedure BottomEditKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
      Shift: TShiftState);
  private
    fa: Integer;
    fo: Integer;
    MaxFont: Integer;
    DropTarget: TDropTarget;
    CheckerBitmap: TBitmap;
    CheckerImage: TImage;
    FDropTargetVisible: Boolean;
    DefaultCaption: string;
    TestID: Integer;
    procedure CopyBitmap;
    procedure CreateCheckerBitmap;
    procedure InitChecker;
    procedure InitDropTarget;
    procedure UpdateChecker;
    procedure SetDropTargetVisible(const Value: Boolean);
    procedure OnDropTargetDropped(fn: string);
    procedure ClearImage;
    procedure CycleFontP;
    procedure CycleFontM;
    procedure HandleWheel(Delta: Integer);
    procedure CycleFont(Value: Integer);
    procedure UpdateFormat(w, h: Integer);
    procedure Reset;
    procedure UpdateParam(afa: Integer);
    property DropTargetVisible: Boolean
      read FDropTargetVisible write SetDropTargetVisible;
  protected
    function FindTarget(P: TPointF; const Data: TDragObject): IControl; override;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

//uses
//  RiggVar.Util.FMX;

const
  faTopMargin = 1;
  faBottomMargin = 2;
  faTopSize = 3;
  faBottomSize = 4;
  faTopGlow = 5;
  faBottomGlow = 6;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;

  fo := 1;
  MaxFont := 9;

  TestID := 0;
  Reset;
  Caption := DefaultCaption;

  InitChecker;

  TopText.BringToFront;
  BottomText.BringToFront;

  TopEdit.Visible := false;
  BottomEdit.Visible := false;

  DropTargetVisible := true;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  CheckerBitmap.Free;
end;

procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
  Shift: TShiftState);
begin
  if Key = vkEscape then
  begin
    TopEdit.Visible := not TopEdit.Visible;
    BottomEdit.Visible := TopEdit.Visible;
    Caption := DefaultCaption;
  end;

  if Key = vkC then
  begin
//    CopyBitmap; // your homework, my implementation is in RiggVar.Util.FMX.pas
//    Caption := 'Bitmap copied.';
    Caption := 'Bitmap was not copied, you need to do your homework first.';
  end

  else if TopEdit.Visible then
    //do nothing when editing

  else if KeyChar = 'd' then
    DropTargetVisible := not DropTargetVisible

  else if KeyChar = 'c' then
    ClearImage

  else if KeyChar = 'f' then
    CycleFontP

  else if KeyChar = 'F' then
    CycleFontM

  else if KeyChar = 'g' then
    UpdateParam(faTopGlow)

  else if KeyChar = 'h' then
    UpdateParam(faBottomGlow)

  else if KeyChar = 't' then
    UpdateParam(faTopSize)

  else if KeyChar = 'b' then
    UpdateParam(faBottomSize)

  else if KeyChar = 'n' then
    UpdateParam(faTopMargin)

  else if KeyChar = 'm' then
    UpdateParam(faBottomMargin)

  else if KeyChar = 'r' then
    Caption := DefaultCaption

  else if KeyChar = 'R' then
    Reset

  else if KeyChar = 'x' then
  begin
    Inc(TestID);
    TestID := TestID mod 2;
    Reset;
  end

  else if KeyChar = '1' then
    UpdateFormat(640, 480)

  else if KeyChar = '2' then
    UpdateFormat(800, 600)

  else if KeyChar = '3' then
    UpdateFormat(1024, 768)

  else if KeyChar = '8' then
    UpdateFormat(800, 800)

  else if KeyChar = '9' then
    UpdateFormat(900, 900)

  else if KeyChar = '0' then
    UpdateFormat(1024, 1024)
end;

procedure TFormMain.UpdateFormat(w, h: Integer);
begin
  ClientWidth := w;
  ClientHeight := h;
  Caption := Format('%d x %d', [ClientWidth, ClientHeight]);
end;

procedure TFormMain.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; var Handled: Boolean);
begin
  if WheelDelta > 0 then
    HandleWheel(1)
  else
    HandleWheel(-1)
end;

procedure TFormMain.FormResize(Sender: TObject);
begin
  BottomText.AutoSize := False;
  BottomText.AutoSize := True;

  TopText.AutoSize := False;
  TopText.AutoSize := True;

  TopEdit.Position.X := 10;
  TopEdit.Width := ClientWidth - 20;

  BottomEdit.Position.X := 10;
  BottomEdit.Width := ClientWidth - 20;

  UpdateChecker;
end;

procedure TFormMain.HandleWheel(Delta: Integer);
var
  f: single;
begin
  case fa of
    faTopSize:
    begin
      f := TopText.Font.Size;
      f := f + Delta;
      if (f > 10) and (f < 150) then
        TopText.Font.Size := Round(f);
      Caption := Format('TopText.Font.Size = %d', [Round(f)]);
    end;

    faBottomSize:
    begin
      f := BottomText.Font.Size;
      f := f + Delta;
      if (f > 10) and (f < 150) then
        BottomText.Font.Size := Round(f);
      Caption := Format('BottomText.Font.Size = %d', [Round(f)]);
    end;

    faTopMargin:
    begin
      f := TopText.Margins.Top;
      f := f + Delta;
      if (f >= 0) and (f <= 30) then
        TopText.Margins.Top := Round(f);
      Caption := Format('TopText.Margins.Top = %d', [Round(f)]);
    end;

    faBottomMargin:
    begin
      f := BottomText.Margins.Bottom;
      f := f + Delta;
      if (f >= 0) and (f <= 30) then
        BottomText.Margins.Bottom := Round(f);
      Caption := Format('BottomText.Margins.Bottom = %d', [Round(f)]);
    end;

    faTopGlow:
    begin
      f := TopGlow.Softness;
      f := f + 0.05 * Delta;
      if f < 0.01 then
        f := 0.01;
      if f > 0.99 then
        f := 0.99;
      TopGlow.Softness := f;
      Caption := Format('TopGlow.Softness = %.1g', [f]);
    end;

    faBottomGlow:
    begin
      f := BottomGlow.Softness;
      f := f + 0.05 * Delta;
      if f < 0.01 then
        f := 0.01;
      if f > 0.99 then
        f := 0.99;
      BottomGlow.Softness := f;
      Caption := Format('BottomGlow.Softness = %.1g', [f]);
    end;

  end;
end;

procedure TFormMain.InitChecker;
begin
  CreateCheckerBitmap;

  CheckerImage := TImage.Create(Self);
  CheckerImage.Parent := Self;
  CheckerImage.Bitmap := CheckerBitmap;
  CheckerImage.WrapMode := TImageWrapMode.Tile;
  CheckerImage.CanFocus := False;
  CheckerImage.SendToBack;

  UpdateChecker;
end;

procedure TFormMain.BottomEditKeyUp(Sender: TObject; var Key: Word;
  var KeyChar: Char; Shift: TShiftState);
begin
  BottomText.Text := BottomEdit.Text;
end;

procedure TFormMain.ClearImage;
begin
  CheckerImage.Bitmap.Clear(claPurple);
end;

procedure TFormMain.CopyBitmap;
var
  bmp: TBitmap;
begin
  bmp := TBitmap.Create(Round(ClientWidth), Round(ClientHeight));
  bmp.Clear(0);
  if bmp.Canvas.BeginScene then
  try
    PaintTo(bmp.Canvas);
  finally
    bmp.Canvas.EndScene;
  end;
  // ToDo: Copy image to clipboard (homework)
  // CopyBitmapToClipboard(bmp);
  bmp.Free;
end;

procedure TFormMain.UpdateChecker;
begin
  CheckerImage.Position.X := 0;
  CheckerImage.Position.Y := 0;
  CheckerImage.Width := ClientWidth;
  CheckerImage.Height := ClientHeight;
end;

procedure TFormMain.InitDropTarget;
begin
  if Assigned(DropTarget) then
  begin
    DropTarget.Width := 180;
    DropTarget.Height := 120;
    DropTarget.Position.X := 10;
    DropTarget.Position.Y := 200;
    DropTarget.Filter := '*.jpeg;*.jpg;*.png';
    DropTarget.Text := 'drop jpg or png';
    DropTarget.OnDropped := DropTargetDropped;
  end;
end;

procedure TFormMain.DropTargetDropped(Sender: TObject; const Data: TDragObject;
  const Point: TPointF);
var
  fn: string;
begin
  if Length(Data.Files) = 1 then
  begin
    fn := Data.Files[0];
    OnDropTargetDropped(fn);
  end;
end;

procedure TFormMain.TopEditKeyUp(Sender: TObject; var Key: Word;
  var KeyChar: Char; Shift: TShiftState);
begin
  TopText.Text := TopEdit.Text;
end;

procedure TFormMain.SetDropTargetVisible(const Value: Boolean);
begin
  FDropTargetVisible := Value;
  if Value then
  begin
    if not Assigned(DropTarget) then
    begin
      DropTarget := TDropTarget.Create(Self);
      DropTarget.Parent := Self;
      InitDropTarget;
    end
    else
    begin
      DropTarget.Visible := True;
      DropTarget.BringToFront;
    end;
  end
  else
  begin
    DropTarget.Visible := False;
  end;
end;

procedure TFormMain.CreateCheckerBitmap;
var
  cb: TBitmap;
  sr, dr: TRectF;
  d: Integer;
begin
  d := 30;
  sr := RectF(0, 0, d, d);

  cb := TBitmap.Create(d, d);
  cb.Canvas.BeginScene;
  cb.Canvas.Clear(claDarkGray);
  cb.Canvas.EndScene;

  CheckerBitmap := TBitmap.Create(2*d, 2*d);
  CheckerBitmap.Canvas.BeginScene;
  CheckerBitmap.Canvas.Clear(claGray);

  dr.Left := 0;
  dr.Top := 0;
  dr.Right := dr.Left + d;
  dr.Bottom := dr.Top + d;

  CheckerBitmap.Canvas.DrawBitmap(cb, sr, dr, 1.0);
  dr.Left := dr.Left + d;
  dr.Top := dr.Top + d;
  dr.Left := dr.Right + d;
  dr.Top := dr.Bottom + d;
  CheckerBitmap.Canvas.DrawBitmap(cb, sr, dr, 1.0);

  CheckerBitmap.Canvas.EndScene;

  cb.Free;
end;

procedure TFormMain.CycleFontP;
begin
  Inc(fo);
  if fo > MaxFont then
    fo := 1;
  CycleFont(fo);
end;

procedure TFormMain.CycleFontM;
begin
  Dec(fo);
  if fo < 1 then
    fo := MaxFont;
  CycleFont(fo);
end;

procedure TFormMain.CycleFont(Value: Integer);
var
  s: string;
begin
  case Value of
    1: s := 'Stencil';
    2: s := 'Showcard Gothic';
    3: s := 'Sitka Text';
    4: s := 'Playbill';
    5: s := 'Old English Text MT';
    6: s := 'Small Fonts';
    7: s := 'Vivaldi';
    8: s := 'Vladimir Script';
    9: s := 'Comic Sans MS';
  end;

  if fa = faTopSize then
    TopText.Font.Family := s;
  if fa = faBottomSize then
    BottomText.Font.Family := s;

  Caption := s;
end;

procedure TFormMain.OnDropTargetDropped(fn: string);
begin
  CheckerBitmap.LoadFromFile(fn);
  CheckerImage.Bitmap := CheckerBitmap;
  CheckerImage.WrapMode := TImageWrapMode.Fit;
end;

function TFormMain.FindTarget(P: TPointF; const Data: TDragObject): IControl;
var
  i: Integer;
  NewObj: IControl;
begin
  Result := nil;
  for i := ChildrenCount - 1 downto 0 do
    if Supports(Children[i], IControl, NewObj)
      and NewObj.Visible and NewObj.HitTest then
    begin
      NewObj := NewObj.FindTarget(P, Data);

      if Assigned(NewObj) then
        Exit(NewObj);
    end;
end;

procedure TFormMain.Reset;
begin
  case TestID of
    0:
    begin
      //DefaultCaption := 'Federgraph Meme Builder App, 2016 Victory Edition';
      DefaultCaption := Application.Title;

      TopText.Text := 'Made with Delphi';
      BottomText.Text := 'FMX Meme Builder !!!';

      TopText.Font.Size := 58;
      BottomText.Font.Size := 84;

      TopText.Font.Family := 'Showcard Gothic';
      BottomText.Font.Family := 'Vladimir Script';
    end;

    1:
    begin
      DefaultCaption := 'Federgraph Meme Builder App';

      // dinghy sailing topic, right of way rules apply
      TopText.Text := 'Hau ab - Mach Platz - Raum !!!';
      BottomText.Text := 'Here comes 420 GER 5XXXX';

      TopText.Font.Size := 70;
      BottomText.Font.Size := 70;

      TopText.Font.Family := 'Vladimir Script';
      BottomText.Font.Family := 'Stencil';
    end;

  end;

  TopEdit.Text := TopText.Text;
  BottomEdit.Text := BottomText.Text;

  TopText.Margins.Top := 10;
  BottomText.Margins.Bottom := 10;

  TopGlow.Softness := 0.4;
  BottomGlow.Softness := 0.4;

  Caption := DefaultCaption;
end;

procedure TFormMain.UpdateParam(afa: Integer);
var
  s: string;
begin
  fa := afa;
  case fa of
    faTopMargin: s := 'Margin Top';
    faBottomMargin: s := 'Margin Bottom';
    faTopSize: s := 'Font Size Top';
    faBottomSize: s := 'Font Size Bottom';
    faTopGlow: s := 'Glow Softness Top';
    faBottomGlow: s := 'Glow Softness Botton';
    else
      s := 'unknown param key';
  end;
  Caption := s;
end;

end.

Just 568 lines of code, not much. Powerful stuff I think but awkward to use as always, you need to know how!