Implemented image conversion via Drag-n-Drop

* Single files can be dropped one-by-one on the text area
* Multiple files can be dropped at once on the text area

1 files changed, 142 insertions, 7 deletions

diff --git a/tools/imageconvert/frm_main.pas b/tools/imageconvert/frm_main.pas
index 0dc3f755..0dc77299 100644
--- a/tools/imageconvert/frm_main.pas
+++ b/tools/imageconvert/frm_main.pas
@@ -6,7 +6,7 @@ interface
 
 uses
   SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_memo, fpg_menu,
-  fpg_button, fpg_editbtn;
+  fpg_button, fpg_editbtn, fpg_label;
 
 type
 
@@ -18,8 +18,16 @@ type
     memImages: TfpgMemo;
     Button1: TfpgButton;
     pmFile: TfpgPopupMenu;
+    btnClear: TfpgButton;
+    Label1: TfpgLabel;
     {@VFD_HEAD_END: MainForm}
     procedure miFileQuit(Sender: TObject);
+    procedure MemoDragEnter(Sender, Source: TObject; AMimeList: TStringList;
+      var AMimeChoice: TfpgString; var ADropAction: TfpgDropAction;
+      var Accept: Boolean);
+    procedure MemoDragDrop(Sender, Source: TObject; X, Y: integer; AData: variant);
+    function ConvertImage(const AFileName: string): string;
+    procedure btnClearClicked(Sender: TObject);
   public
     procedure AfterCreate; override;
   end;
@@ -28,6 +36,9 @@ type
 
 implementation
 
+uses
+  fpg_utils;
+
 {@VFD_NEWFORM_IMPL}
 
 procedure TMainForm.miFileQuit(Sender: TObject);
@@ -35,21 +46,116 @@ begin
   Close;
 end;
 
+procedure TMainForm.MemoDragEnter(Sender, Source: TObject;
+  AMimeList: TStringList; var AMimeChoice: TfpgString;
+  var ADropAction: TfpgDropAction; var Accept: Boolean);
+var
+  s: string;
+begin
+  s := 'text/uri-list';  // 'text/plain';
+  Accept := AMimeList.IndexOf(s) > -1;
+  if Accept then
+  begin
+    if AMimeChoice <> s then
+      AMimeChoice := s;
+  end;
+end;
+
+procedure TMainForm.MemoDragDrop(Sender, Source: TObject; X, Y: integer;
+  AData: variant);
+var
+  fileName: string;
+  sl: TStringList;
+  i: integer;
+begin
+  sl := TStringList.Create;
+  try
+    sl.Text := AData;
+    memImages.BeginUpdate;
+    for i := 0 to sl.Count-1 do
+    begin
+      fileName := sl[i];
+      fileName := StringReplace(fileName, 'file://', '', []);
+      memImages.Text := memImages.Text + ConvertImage(fileName);
+    end;
+  finally
+    memImages.EndUpdate;
+    sl.Free;
+  end;
+end;
+
+function TMainForm.ConvertImage(const AFileName: string): string;
+const
+  Prefix = '     ';
+  MaxLineLength = 72;
+var
+  InStream: TFileStream;
+  I, Count: longint;
+  b: byte;
+  Line, ToAdd: String;
+  ConstName: string;
+
+  procedure WriteStr(const St: string);
+  begin
+    Result := Result + St;
+  end;
+
+  procedure WriteStrLn(const St: string);
+  begin
+    Result := Result + St + LineEnding;
+  end;
+
+begin
+  InStream := TFileStream.Create(AFileName, fmOpenRead);
+  try
+    ConstName := 'newimg_' + ChangeFileExt(fpgExtractFileName(AFileName), '');
+    WriteStrLn('');
+    WriteStrLn('const');
+
+    InStream.Seek(0, soFromBeginning);
+    Count := InStream.Size;
+    WriteStrLn(Format('  %s: array[0..%d] of byte = (',[ConstName, Count-1]));
+    Line := Prefix;
+    for I := 1 to Count do
+    begin
+      InStream.Read(B, 1);
+      ToAdd := Format('%3d',[b]);
+      if I < Count then
+        ToAdd := ToAdd + ',';
+      Line := Line + ToAdd;
+      if Length(Line) >= MaxLineLength then
+      begin
+        WriteStrLn(Line);
+        Line := PreFix;
+      end;
+    end; { for }
+    WriteStrln(Line+');');
+    WriteStrLn('');
+  finally
+    InStream.Free;
+  end;
+end;
+
+procedure TMainForm.btnClearClicked(Sender: TObject);
+begin
+  memImages.Text := '';
+end;
+
 procedure TMainForm.AfterCreate;
 begin
   {%region 'Auto-generated GUI code' -fold}
   {@VFD_BODY_BEGIN: MainForm}
   Name := 'MainForm';
-  SetPosition(357, 227, 484, 378);
-  WindowTitle := 'MainForm';
+  SetPosition(357, 227, 630, 378);
+  WindowTitle := 'Image Conversion Tool';
   Hint := '';
-  AcceptDrops := True;
+  DNDEnabled := True;
 
   MainMenu := TfpgMenuBar.Create(self);
   with MainMenu do
   begin
     Name := 'MainMenu';
-    SetPosition(0, 0, 484, 24);
+    SetPosition(0, 0, 630, 24);
     Anchors := [anLeft,anRight,anTop];
   end;
 
@@ -69,10 +175,14 @@ begin
   with memImages do
   begin
     Name := 'memImages';
-    SetPosition(4, 88, 476, 286);
-    FontDesc := '#Edit1';
+    SetPosition(4, 88, 622, 286);
+    Anchors := [anLeft,anRight,anTop,anBottom];
+    FontDesc := '#Edit2';
     Hint := '';
     TabOrder := 5;
+    AcceptDrops := True;
+    OnDragEnter  := @MemoDragEnter;
+    OnDragDrop  := @MemoDragDrop;
   end;
 
   Button1 := TfpgButton.Create(self);
@@ -97,6 +207,31 @@ begin
     AddMenuItem('Quit', 'Ctrl+Q', @miFileQuit);
   end;
 
+  btnClear := TfpgButton.Create(self);
+  with btnClear do
+  begin
+    Name := 'btnClear';
+    SetPosition(543, 44, 80, 24);
+    Anchors := [anRight,anTop];
+    Text := 'Clear';
+    FontDesc := '#Label1';
+    Hint := '';
+    ImageName := '';
+    TabOrder := 6;
+    OnClick  := @btnClearClicked;
+  end;
+
+  Label1 := TfpgLabel.Create(self);
+  with Label1 do
+  begin
+    Name := 'Label1';
+    SetPosition(4, 72, 619, 16);
+    Anchors := [anLeft,anRight,anTop];
+    FontDesc := '#Label1';
+    Hint := '';
+    Text := 'Drop one or more images on the text area below:';
+  end;
+
   {@VFD_BODY_END: MainForm}
 
   MainMenu.AddMenuItem('File', nil).SubMenu := pmFile;