diff options
author | Graeme Geldenhuys <graeme@mastermaths.co.za> | 2012-04-04 23:45:51 +0200 |
---|---|---|
committer | Graeme Geldenhuys <graeme@mastermaths.co.za> | 2012-04-04 23:45:51 +0200 |
commit | 437412f9b6478c1c6738d29ee01650fd28464dcc (patch) | |
tree | ff03f992b549729b78c084d5e976acdfe8bef3d0 /tools/imageconvert/frm_main.pas | |
parent | c4ca437a3318d55dd5f692776b924b3ad7a558bc (diff) | |
download | fpGUI-437412f9b6478c1c6738d29ee01650fd28464dcc.tar.xz |
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
Diffstat (limited to 'tools/imageconvert/frm_main.pas')
-rw-r--r-- | tools/imageconvert/frm_main.pas | 149 |
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; |