uses Process, SysUtils, App, Dialogs, Objects, Menus, Drivers, Views, MsgBox, utils, constants; type PGenerateData = ^TGenerateData; TGenerateData = record path: string[128]; width: string[16]; height: string[16]; power: string[64]; zoom: string[64]; centerX: string[64]; centerY: string[64]; end; PGeneratorWindow = ^TGeneratorWindow; TGeneratorWindow = object(TDialog) winRect: TRect; curY: integer; constructor Init; procedure addField(caption: string; maxLength: integer); procedure addButton(caption: string; command: integer); end; TMSApp = object(TApplication) GeneratorWindow: PGeneratorWindow; procedure InitStatusLine; virtual; procedure InitMenuBar; virtual; procedure HandleEvent(var Event: TEvent); virtual; procedure NewWindow(); procedure GenerateMandelbrotSetImage(); procedure ShowAbout(); procedure ShowSuccess(fname: string; t: extended); end; var MSApp: TMSApp; GenerateData: TGenerateData; procedure TMSApp.GenerateMandelbrotSetImage(); var s: AnsiString; startTime: int64; success: boolean; begin GeneratorWindow^.GetData(GenerateData); startTime := getTimestamp(); with GenerateData do begin success := RunCommand('../main', [ width, height, power, zoom, centerX, centerY, path ], s); end; if (success) then begin ShowSuccess(s, (getTimestamp() - startTime) / 1000); end; end; procedure TGeneratorWindow.addField(caption: string; maxLength: integer); var il: PInputLine; r: TRect; begin caption := wrapFirstLetter(caption, '~'); r.assign(14, curY, winRect.b.x - 2, curY + 1); il := New(PInputLine, Init(r, maxLength)); Insert(il); r.assign(2, curY, 13, curY + 1); Insert(New(PLabel, Init(r, caption, il))); curY := curY + 2; end; procedure TGeneratorWindow.addButton(caption: string; command: integer); var r: TRect; begin r.assign(3, curY, winRect.b.x - 1, curY + 1); Insert(New(PButton, Init(r, caption, command, bfNormal))); curY := curY + 2; end; constructor TGeneratorWindow.Init(); var wr: TRect; begin wr.assign(0, 0, 60, 19); inherited Init(wr, 'Generator'); Options := Options or ofCentered; HelpCtx := $F000; winRect := wr; curY := 2; with GenerateData do begin path := './images'; width := '512'; height := '512'; power := '2'; zoom := '1'; centerX := '0'; centerY := '0'; end; addField('Path:', 128); addField('Width:', 16); addField('Height:', 16); addField('Power:', 64); addField('Zoom:', 64); addField('Center X:', 64); addField('Center Y:', 64); addButton('Generate', cmGenerate); end; procedure TMSApp.NewWindow(); begin GeneratorWindow := New(PGeneratorWindow, Init); GeneratorWindow^.SetData(GenerateData); InsertWindow(GeneratorWindow); end; procedure TMSApp.ShowAbout(); begin MessageBox( #3'Multibrot Set Generator GUI'#13 + #3'Developed by Artem K.'#13 + #3'MF BMSTU 2019', nil, mfInformation or mfOkButton ); end; procedure TMSApp.ShowSuccess(fname: string; t: extended); begin MessageBox( #3'Set image was generated!'#13 + 'File name: ' + fname + #13 + 'Time spent: ' + FloatToStr(t) + ' s', nil, mfInformation or mfOkButton ); end; procedure TMSApp.HandleEvent(var Event: TEvent); begin inherited HandleEvent(Event); if Event.What = evCommand then begin case Event.Command of cmNew: begin NewWindow(); ClearEvent(Event); end; cmAbout: begin ShowAbout(); ClearEvent(Event); end; cmGenerate: begin GenerateMandelbrotSetImage(); ClearEvent(Event); end; end; end; end; procedure TMSApp.InitStatusLine(); var r: TRect; begin GetExtent(r); r.a.y := r.b.y - 1; New(StatusLine, Init(r, NewStatusDef(0, $EFFF, NewStatusKey('~Alt+X~ Exit', kbAltX, cmQuit, NewStatusKey('~F3~ New', kbF3, cmNew, nil )), nil) )); end; procedure TMSApp.InitMenuBar(); var r: TRect; begin GetExtent(r); r.b.y := r.a.y + 1; MenuBar := New(PMenuBar, Init(r, NewMenu( NewItem('~N~ew', '', kbNoKey, cmNew, hcNew, NewItem('~A~bout', '', kbNoKey, cmAbout, hcNoContext, NewItem('~E~xit', 'Alt+X', kbAltX, cmQuit, hcExit, nil))))) ); end; begin MSApp.Init(); MSApp.Run(); MSApp.Done(); end.