summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--tools/imageconvert/frm_main.pas149
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;