diff --git a/2.10/Project/delphi6/FlameSS.cfg b/2.10/Project/delphi6/FlameSS.cfg new file mode 100644 index 0000000..619a827 --- /dev/null +++ b/2.10/Project/delphi6/FlameSS.cfg @@ -0,0 +1,41 @@ +-$A8 +-$B- +-$C- +-$D- +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L- +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$Y- +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-E"../../out" +-N"../../out/dcu" +-LE"x:\programs\borland\delphi6\Projects\Bpl" +-LN"x:\programs\borland\delphi6\Projects\Bpl" +-U"../../source" +-O"../../source" +-I"../../source" +-R"../../source" diff --git a/2.10/Project/delphi6/FlameSS.dof b/2.10/Project/delphi6/FlameSS.dof new file mode 100644 index 0000000..437106a --- /dev/null +++ b/2.10/Project/delphi6/FlameSS.dof @@ -0,0 +1,108 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=0 +D=0 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=0 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=0 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir=../../out +UnitOutputDir=../../out/dcu +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=../../source +Packages=vcl;rtl;dbrtl;adortl;vcldb;vclx;bdertl;vcldbx;ibxpress;dsnap;cds;bdecds;qrpt;teeui;teedb;tee;dss;teeqr;visualclx;visualdbclx;dsnapcrba;dsnapcon;VclSmp;vclie;xmlrtl;inet;inetdbbde;inetdbxpress;inetdb;nmfast;webdsnap;websnap;dbexpress;dbxcds;indy;dclOffice2k;FlatStyle_D6;rae;S303_R60;S303BR60;dxmdsd6;dxForumLibD6;RzLPDB60;RzLPND60;B301vr60;B301cr60;o401_r60;o401br60;vclshlctrls;LTEffects;B301_r60;gllib +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir=X:\Code\Delphi\Apophysis\2.02h\ScreenSaver\ +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1033 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[Excluded Packages] +W:\Lib\O403_d60.bpl=TurboPower Orpheus 4.03 Components - VCL60 +W:\Lib\S303_d60.bpl=SysTools 3 Components +W:\Lib\dgmr_60.bpl=Dgmr bibliotheek 6.1 +c:\proj32\gl\out\gllib.bpl=GL bibliotheek +x:\programs\borland\delphi6\Projects\Bpl\dclusr60.bpl=Borland User Components +C:\Program Files\Indy 10 for Delphi 6\LibD6\dclIndyCore60.bpl=Indy 10 Core Design Time +C:\Program Files\Indy 10 for Delphi 6\LibD6\dclIndyProtocols60.bpl=Indy 10 Protocols Design Time +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=2 +Item0=../../source +Item1=../../src +[HistoryLists\hlUnitOutputDirectory] +Count=1 +Item0=../../out/dcu +[HistoryLists\hlOutputDirectorry] +Count=1 +Item0=../../out diff --git a/2.10/Project/delphi6/FlameSS.dpr b/2.10/Project/delphi6/FlameSS.dpr new file mode 100644 index 0000000..40fad48 --- /dev/null +++ b/2.10/Project/delphi6/FlameSS.dpr @@ -0,0 +1,214 @@ +program FlameSS; + +uses + Forms, + Dialogs, + SysUtils, + Render, + controlpoint, + windows, + graphics, + messages, + ScrConfig in '..\..\ScreenSaver\ScrConfig.pas' {frmConfig}, + ScrMain in '..\..\ScreenSaver\ScrMain.pas' {frmMain}, + FlameIO in '..\..\ScreenSaver\FlameIO.pas'; + +{$E SCR} + +{$R *.res} + +type TSSMode = (ssSetPwd,ssPreview,ssConfig,ssRun); + +var + MySem: THandle; + +function GetScreenSaverMode: TSSMode; +var + ParamChar: Char; +begin + Result := ssRun; + if ParamCount = 0 then + Exit; + + if Length(ParamStr(1)) = 1 then + ParamChar := ParamStr(1)[1] + else + ParamChar := ParamStr(1)[2]; + + Case ParamChar of + 'A', 'a': + Result := ssSetPwd; + 'P', 'p': + Result := ssPreview; + 'C', 'c': + Result := ssConfig; + else + Result := ssRun; + end; +end; + +procedure SetPassWord; +var + SysDir: string; + NewLen: integer; + MyMod: THandle; + PwdFunc: function (a : PChar; ParentHandle : THandle; b, c : Integer) : + Integer; stdcall; +begin + SetLength(SysDir,MAX_PATH); + NewLen := GetSystemDirectory(PChar(SysDir),MAX_PATH); + SetLength(SysDir,NewLen); + + MyMod := LoadLibrary(PChar(IncludeTrailingPathDelimiter(SysDir) + 'MPR.DLL')); + if MyMod <> 0 then begin + PwdFunc := GetProcAddress(MyMod,'PwdChangePasswordA'); + if Assigned(PwdFunc) then + PwdFunc('SCRSAVE',StrToInt(paramstr(2)),0,0); + FreeLibrary(MyMod); + end; +end; + +function WindowProc(Wnd: HWnd; Msg: Integer; wParam: Word; lParam: Integer): Integer; far; stdcall; +begin + + { Window procedure for the saver preview. Only used for terminating the preview + version of the saver. } + if (Msg = WM_DESTROY) or (Msg = WM_CLOSE) then PostMessage(Wnd, WM_QUIT, 0, 0); + Result := DefWindowProc(Wnd, Msg, wParam, lParam); + +end; + +procedure Preview; +var + PreviewCanvas: TCanvas; + PreviewRect: TRect; + WndClass: TWndClass; + DC: hDC; + MyWnd: hWnd; + Msg: TMsg; + ParentHandle: THandle; + cp : TControlPoint; + Render: TRenderer; + bm: TBitmap; +begin + { To run the preview, you need to create a window class corresponding with the + little display in the screensaver control panel. This doesn't look very + elegant in a Delphi project, but I don't think you can use VCL functionality + to do this... } + with WndClass do + begin + style := CS_PARENTDC; + lpfnWndProc := @WindowProc; + cbClsExtra := 0; + cbWndExtra := 0; + hIcon := 0; + hCursor := 0; + hbrBackground := 0; + lpszMenuName := nil; + lpszClassName := 'DeskSpin'; + end; + WndClass.hInstance := hInstance; + Windows.RegisterClass(WndClass); + + ParentHandle := StrToInt(ParamStr(2)); + + // Initialize a Rect that matches the preview area: + GetWindowRect(Parenthandle, PreviewRect); + PreviewRect.Right := PreviewRect.Right - PreviewRect.Left; + PreviewRect.Bottom := PreviewRect.Bottom - PreviewRect.Top; + PreviewRect.Left := 0; + PreviewRect.Top := 0; + + // Instantiate the window class so we can draw to the preview area: + MyWnd := CreateWindow('DeskSpin', 'DeskSpin', + WS_CHILD or WS_DISABLED or WS_VISIBLE, 0, 0, + PreviewRect.Right, PreviewRect.Bottom, ParentHandle, + 0, hInstance, nil); + + // We need a DC before we can draw: + DC := GetDC(MyWnd); + { We can create a TCanvas matching the DC, so we can draw the preview with + familiar functions: } + PreviewCanvas := TCanvas.Create; + PreviewCanvas.Handle := DC; + + randomize; + cp := TControlPoint.Create; + Render := TRenderer.Create; + + cp.ParseString('pixels_per_unit 277.456647 center -1.0982659 0 gamma 2 spatial_filter_radius' + + ' 0.5 contrast 1 brightness 1.5 zoom 0 spatial_oversample 1 sample_density 1 nbatches' + + ' 1 white_level 200 cmap_inter 0 time 0 cmap 33 xform 0 density 1 color 0 var 0 0 0 1 0' + + ' 0 0 coefs 0.466381997 -0.0618700013 0.0792416036 0.610638022 -0.475656986 -0.28115499'+ + ' xform 1 density 1 color 1 var 0 0 0 0 1 0 0 coefs -0.513867021 0.271649003 -0.254521996' + + ' -0.550984025 -0.674094975 -0.600323975'); + + cp.sample_density := 1; + cp.Width := PreviewRect.Right - PreviewRect.Left; + cp.Height := PreviewRect.Bottom - PreviewRect.Top; + cp.spatial_oversample := 2; + cp.spatial_filter_radius := 0.1; + cp.Gamma := 4; + cp.brightness := 4; + cp.CalcBoundbox; + Render.SetCP(cp); + Render.Render; + BM := Render.GetImage; + PreviewCanvas.Draw(0,0,bm); + + + { Enter a message loop to keep the preview going. I've kept the preview simple + (plain text output), but if you wanted, you could initialize OpenGL for the + DC you already have, and actually let your saver render to that. } + while GetMessage(Msg, 0, 0, 0) do + begin + PreviewCanvas.Draw(0,0,bm); + +// PreviewCanvas.FillRect(PreviewRect); +// PreviewCanvas.TextOut(5, 5, 'Your preview here.'); + TranslateMessage(Msg); + DispatchMessage(Msg); + end; + PreviewCanvas.Free; + + // Close and destroy the preview window: + CloseWindow(MyWnd); + DestroyWindow(MyWnd); + + Render.Free; + cp.Free; +end; + +begin + Case GetScreenSaverMode of + ssSetPwd: + begin + Application.Initialize; + SetPassWord; + end; + ssConfig: + begin + Application.Initialize; + Application.Title := 'Flame Screensaver'; + Application.CreateForm(TfrmConfig, frmConfig); + Application.Run; + end; + ssPreview: + Preview; + else // ssrun + // Test if screen save was already started + MySem := CreateSemaphore(nil,0,1,'ESDSaverSemaphore'); + if (MySem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS) then begin + CloseHandle(MySem); + Exit; + end; + + Application.Initialize; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; + + if (MySem <> 0) then + CloseHandle(MySem); + end; // Case GetScreenSaverMode of + +end. diff --git a/2.10/Project/delphi6/FlameSS.dsk b/2.10/Project/delphi6/FlameSS.dsk new file mode 100644 index 0000000..f968def --- /dev/null +++ b/2.10/Project/delphi6/FlameSS.dsk @@ -0,0 +1,280 @@ +[Closed Files] +File_0=SourceModule,'C:\PROJ32\gl\src\catalog.pas',0,1,561,1,585,0,0 +File_1=SourceModule,'C:\PROJ32\gl\src\CatFilter.pas',0,1,57,24,71,0,0 +File_2=SourceModule,'C:\PROJ32\gl\src\FCatFilter.pas',0,1,1,1,12,0,0 +File_3=SourceModule,'C:\PROJ32\gl\src\glStrConst.pas',0,1,1,39,1,0,0 +File_4=SourceModule,'C:\PROJ32\gl\src\Project.pas',0,1,498,1,520,0,0 +File_5=SourceModule,'C:\PROJ32\gl\src\MainForm.pas',0,1,212,27,215,0,0 +File_6=SourceModule,'C:\PROJ32\gl\src\Material.pas',0,1,912,111,947,0,0 +File_7=SourceModule,'C:\PROJ32\gl\src\FArea.pas',0,1,202,111,219,0,0 +File_8=SourceModule,'C:\PROJ32\gl\src\FCatalog.pas',0,1,582,6,610,0,0 +File_9=SourceModule,'C:\PROJ32\gl\src\kierterm.pas',0,1,622,1,647,0,0 + +[Modules] +Module0=X:\Code\Delphi\Apophysis\2.02h\Project\delphi6\FlameSS.dpr +Count=1 +EditWindowCount=1 + +[X:\Code\Delphi\Apophysis\2.02h\Project\delphi6\FlameSS.dpr] +ModuleType=SourceModule +FormState=0 +FormOnTop=0 + +[X:\Programs\Borland\Delphi6\Projects\ProjectGroup1.bpg] +FormState=0 +FormOnTop=0 + +[EditWindow0] +ViewCount=1 +CurrentView=0 +View0=0 +CodeExplorer=CodeExplorer@EditWindow0 +MessageView=MessageView@EditWindow0 +Create=1 +Visible=1 +State=0 +Left=266 +Top=111 +Width=1016 +Height=880 +MaxLeft=-4 +MaxTop=108 +ClientWidth=1008 +ClientHeight=846 +LeftPanelSize=0 +RightPanelSize=0 +BottomPanelSize=52 +BottomPanelClients=MessageView@EditWindow0 +BottomPanelData=000004000000000000000000000000000000000000000000000100000000000000000B0000004D65737361676556696577FFFFFFFF + +[View0] +Module=X:\Code\Delphi\Apophysis\2.02h\Project\delphi6\FlameSS.dpr +CursorX=46 +CursorY=16 +TopLine=1 +LeftCol=1 + +[Watches] +Count=0 + +[Breakpoints] +Count=0 + +[AddressBreakpoints] +Count=0 + +[Main Window] +Create=1 +Visible=1 +State=0 +Left=0 +Top=0 +Width=1280 +Height=112 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1272 +ClientHeight=78 + +[ProjectManager] +Create=1 +Visible=1 +State=0 +Left=0 +Top=0 +Width=231 +Height=843 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=231 +ClientHeight=843 +TBDockHeight=305 +LRDockWidth=438 +Dockable=1 + +[CPUWindow] +Create=1 +Visible=0 +State=0 +Left=373 +Top=335 +Width=533 +Height=353 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=525 +ClientHeight=319 +DumpPane=79 +DisassemblyPane=187 +RegisterPane=231 +FlagPane=64 + +[AlignmentPalette] +Create=1 +Visible=0 +State=0 +Left=200 +Top=114 +Width=156 +Height=84 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=150 +ClientHeight=60 + +[PropertyInspector] +Create=1 +Visible=1 +State=0 +Left=0 +Top=0 +Width=231 +Height=843 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=231 +ClientHeight=843 +TBDockHeight=527 +LRDockWidth=190 +Dockable=1 +SplitPos=85 +ArrangeBy=Name +SelectedItem= +ExpandedItems= +HiddenCategories= + +[WatchWindow] +Create=1 +Visible=0 +State=0 +Left=232 +Top=872 +Width=1048 +Height=165 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1040 +ClientHeight=139 +TBDockHeight=149 +LRDockWidth=421 +Dockable=1 + +[CallStackWindow] +Create=1 +Visible=1 +State=0 +Left=0 +Top=0 +Width=231 +Height=843 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=231 +ClientHeight=843 +TBDockHeight=161 +LRDockWidth=294 +Dockable=1 + +[ObjectTree] +Create=1 +Visible=0 +State=0 +Left=0 +Top=112 +Width=190 +Height=350 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=182 +ClientHeight=324 +TBDockHeight=350 +LRDockWidth=190 +Dockable=1 + +[DebugLogView] +Create=1 +Visible=0 +State=0 +Left=232 +Top=872 +Width=1048 +Height=165 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1040 +ClientHeight=139 +TBDockHeight=291 +LRDockWidth=417 +Dockable=1 + +[LocalVarsWindow] +Create=1 +Visible=0 +State=0 +Left=27 +Top=127 +Width=194 +Height=891 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=186 +ClientHeight=865 +TBDockHeight=110 +LRDockWidth=421 +Dockable=1 + +[CodeExplorer@EditWindow0] +Create=1 +Visible=1 +State=0 +Left=0 +Top=0 +Width=231 +Height=843 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=231 +ClientHeight=843 +TBDockHeight=305 +LRDockWidth=140 +Dockable=1 + +[MessageView@EditWindow0] +Create=1 +Visible=1 +State=0 +Left=12 +Top=0 +Width=996 +Height=52 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=996 +ClientHeight=52 +TBDockHeight=52 +LRDockWidth=443 +Dockable=1 + +[DockHosts] +DockHostCount=1 + +[DockSite0] +DockSiteType=1 +Create=1 +Visible=1 +State=0 +Left=0 +Top=112 +Width=266 +Height=877 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=258 +ClientHeight=851 +TBDockHeight=451 +LRDockWidth=177 +Dockable=1 +TabPosition=2 +ActiveTab=Project Manager +TabDockClients=ProjectManager,CodeExplorer@EditWindow0,CallStackWindow,PropertyInspector + diff --git a/2.10/Project/delphi6/FlameSS.res b/2.10/Project/delphi6/FlameSS.res new file mode 100644 index 0000000..e1bec2c Binary files /dev/null and b/2.10/Project/delphi6/FlameSS.res differ diff --git a/2.10/ScreenSaver/FlameIO.pas b/2.10/ScreenSaver/FlameIO.pas new file mode 100644 index 0000000..4374d13 --- /dev/null +++ b/2.10/ScreenSaver/FlameIO.pas @@ -0,0 +1,146 @@ +unit FlameIO; + +interface + +uses + Controlpoint; + +function FlameToXML(const cp1: TControlPoint; sheep: boolean; compact: boolean = false): string; + +implementation + +uses + Classes, SysUtils, xForm; + +function NumXForms(const cp: TControlPoint): integer; +var + i: integer; +begin + Result := NXFORMS; + for i := 0 to NXFORMS - 1 do begin + if cp.xform[i].density = 0 then + begin + Result := i; + Break; + end; + end; +end; + +function CleanXMLName(ident: string): string; +var + i: integer; +begin + for i := 0 to Length(ident) do + begin + if ident[i] = '*' then + ident[i] := '_' + else if ident[i] = '"' then + ident[i] := #39; + end; + Result := ident; +end; + + +function ColorToXmlCompact(cp1: TControlPoint): string; +var + i: integer; +begin + Result := ' '; +end; + + +function ColorToXml(cp1: TControlPoint): string; +var + i: integer; +begin + Result := ''; + for i := 0 to 255 do begin + Result := Result + ' ' + #13#10; + end; +end; + + +function FlameToXML(const cp1: TControlPoint; sheep: boolean; compact: boolean = false): string; +var + t, i, j: integer; + FileList: TStringList; + x, y, a, b, cc, d, e, f: double; + varlist, nick, url, pal, hue: string; +begin + FileList := TStringList.create; + x := cp1.center[0]; + y := cp1.center[1]; + pal := ''; hue := ''; + if sheep then + begin + pal := 'palette="' + IntToStr(cp1.cmapindex) + '" '; + hue := 'hue="' + format('%g', [cp1.hue_rotation]) + '" '; + end; +// if Trim(SheepNick) <> '' then nick := 'nick="' + Trim(SheepNick) + '"'; +// if Trim(SheepURL) <> '' then url := 'url="' + Trim(SheepURL) + '" '; + try + FileList.Add(''); + { Write transform parameters } + t := NumXForms(cp1); + for i := 0 to t - 1 do + begin + with cp1.xform[i] do + begin + a := c[0][0]; + b := c[1][0]; + cc := c[0][1]; + d := c[1][1]; + e := c[2][0]; + f := c[2][1]; + varlist := ''; + for j := 0 to NRVAR - 1 do + begin + if vars[j] <> 0 then + begin + varlist := varlist + varnames[j] + format('="%f" ', [vars[j]]); + end; + end; + FileList.Add(Format(' ', [a, cc, b, d, e, f])); + end; + end; + { Write palette data } + if not sheep then begin + if not compact then + FileList.Add(ColorToXml(cp1)); + FileList.Add(ColorToXmlcompact(cp1)); + end; + + FileList.Add(''); + result := FileList.text; + finally + FileList.free + end; +end; + +end. diff --git a/2.10/ScreenSaver/ScrConfig.dfm b/2.10/ScreenSaver/ScrConfig.dfm new file mode 100644 index 0000000..aae18de --- /dev/null +++ b/2.10/ScreenSaver/ScrConfig.dfm @@ -0,0 +1,163 @@ +object frmConfig: TfrmConfig + Left = 422 + Top = 262 + BorderStyle = bsToolWindow + Caption = 'Configure' + ClientHeight = 330 + ClientWidth = 201 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Panel2: TPanel + Left = 0 + Top = 299 + Width = 201 + Height = 31 + Align = alBottom + BevelOuter = bvLowered + TabOrder = 0 + object btnOk: TButton + Left = 40 + Top = 5 + Width = 75 + Height = 21 + Caption = '&Ok' + Default = True + ModalResult = 1 + TabOrder = 0 + OnClick = btnOkClick + end + object btnCancel: TButton + Left = 120 + Top = 5 + Width = 75 + Height = 21 + Cancel = True + Caption = '&Cancel' + ModalResult = 2 + TabOrder = 1 + OnClick = btnCancelClick + end + end + object Panel3: TPanel + Left = 0 + Top = 200 + Width = 201 + Height = 99 + Align = alBottom + BevelOuter = bvLowered + TabOrder = 1 + object Label1: TLabel + Left = 8 + Top = 10 + Width = 92 + Height = 13 + Caption = 'Oversample <1 - 3>' + end + object Label2: TLabel + Left = 8 + Top = 30 + Width = 76 + Height = 13 + Caption = 'Filter <0.2 - 2.0>' + end + object Label3: TLabel + Left = 8 + Top = 50 + Width = 62 + Height = 13 + Caption = 'Filter in pixels' + end + object Label4: TLabel + Left = 8 + Top = 70 + Width = 71 + Height = 13 + Caption = 'Sample density' + end + object edtOversample: TEdit + Left = 152 + Top = 8 + Width = 41 + Height = 21 + TabOrder = 0 + Text = '1' + OnExit = edtOversampleExit + end + object edtFiltersize: TEdit + Left = 152 + Top = 28 + Width = 41 + Height = 21 + TabOrder = 1 + Text = '0.1' + OnExit = edtFiltersizeExit + end + object edtDensity: TEdit + Left = 152 + Top = 68 + Width = 41 + Height = 21 + TabOrder = 2 + Text = '10' + OnExit = edtDensityExit + end + object pnlFilterpixels: TPanel + Left = 152 + Top = 48 + Width = 41 + Height = 21 + Alignment = taLeftJustify + BevelOuter = bvLowered + BorderWidth = 2 + Caption = '1' + TabOrder = 3 + end + end + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 201 + Height = 137 + Align = alTop + BevelOuter = bvLowered + TabOrder = 2 + object chkSave: TCheckBox + Left = 8 + Top = 8 + Width = 97 + Height = 17 + Caption = 'Save images' + TabOrder = 0 + end + object chkShowOtherImages: TCheckBox + Left = 8 + Top = 24 + Width = 177 + Height = 17 + Caption = 'Show previous rendered images' + TabOrder = 1 + end + object rgQuality: TRadioGroup + Left = 8 + Top = 48 + Width = 185 + Height = 81 + Caption = 'Quality' + Items.Strings = ( + 'Low' + 'Medium' + 'High' + 'User defined') + TabOrder = 2 + OnClick = rgQualityClick + end + end +end diff --git a/2.10/ScreenSaver/ScrConfig.pas b/2.10/ScreenSaver/ScrConfig.pas new file mode 100644 index 0000000..5620b49 --- /dev/null +++ b/2.10/ScreenSaver/ScrConfig.pas @@ -0,0 +1,181 @@ +unit ScrConfig; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls; + +type + TfrmConfig = class(TForm) + btnCancel: TButton; + btnOk: TButton; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + chkSave: TCheckBox; + chkShowOtherImages: TCheckBox; + rgQuality: TRadioGroup; + edtOversample: TEdit; + edtFiltersize: TEdit; + edtDensity: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + pnlFilterpixels: TPanel; + procedure btnCancelClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure btnOkClick(Sender: TObject); + procedure rgQualityClick(Sender: TObject); + procedure edtDensityExit(Sender: TObject); + procedure edtFiltersizeExit(Sender: TObject); + procedure edtOversampleExit(Sender: TObject); + private + procedure SetFilterPixels; + { Private declarations } + public + { Public declarations } + end; + +var + frmConfig: TfrmConfig; + +implementation + +{$R *.dfm} + +uses + ControlPoint, Registry; + +procedure TfrmConfig.FormCreate(Sender: TObject); +var + Registry: TRegistry; +begin + Registry := TRegistry.Create; + try + Registry.RootKey := HKEY_CURRENT_USER; + if Registry.OpenKey('\Software\BobsFreubels\FlameSS', False) then begin + if Registry.ValueExists('SaveImage') then begin + chkSave.Checked := Registry.ReadBool('SaveImage'); + end else begin + chkSave.Checked := False; + end; + if Registry.ValueExists('ShowOtherImages') then begin + chkShowOtherImages.Checked := Registry.ReadBool('ShowOtherImages'); + end else begin + chkShowOtherImages.Checked := False; + end; + if Registry.ValueExists('Quality') then begin + rgQuality.itemindex := Registry.ReadInteger('Quality'); + end else begin + rgQuality.itemindex := 1; + end; + if Registry.ValueExists('Oversample') then begin + edtOversample.Text := IntToStr(Registry.ReadInteger('Oversample')); + end else begin + edtOversample.Text := '1'; + end; + if Registry.ValueExists('Filter') then begin + edtFiltersize.Text := FloatToStr(Registry.ReadFloat('Filter')); + end else begin + edtFiltersize.Text := '0.1'; + end; + if Registry.ValueExists('Density') then begin + edtDensity.Text := FloatToStr(Registry.ReadFloat('Density')); + end else begin + edtDensity.Text := '100'; + end; + end else begin + chkSave.Checked := False; + chkShowOtherImages.Checked := False; + rgQuality.itemindex := 1; + edtOversample.Text := '1'; + edtFiltersize.Text := '0.1'; + edtDensity.Text := '100'; + end; + finally + Registry.Free; + end; + SetFilterPixels; + rgQualityClick(nil); +end; + + +procedure TfrmConfig.btnCancelClick(Sender: TObject); +begin + Close +end; + +procedure TfrmConfig.btnOkClick(Sender: TObject); +var + Registry: TRegistry; +begin + Registry := TRegistry.Create; + try + Registry.RootKey := HKEY_CURRENT_USER; + if Registry.OpenKey('\Software\BobsFreubels\FlameSS', True) then begin + Registry.WriteBool('SaveImage', chkSave.Checked); + Registry.WriteBool('ShowOtherImages', chkShowOtherImages.Checked); + Registry.WriteInteger('Quality', rgQuality.itemindex); + Registry.WriteInteger('Oversample', StrToInt(edtOversample.Text)); + Registry.WriteFloat('Filter', StrToFloat(edtFiltersize.Text)); + Registry.WriteFloat('Density', StrToFloat(edtDensity.Text)); + end; + finally + Registry.Free; + end; + + Close +end; + +procedure TfrmConfig.edtOversampleExit(Sender: TObject); +begin + try + StrToInt(edtOversample.Text); + except + edtOversample.Text := '1'; + end; + + SetFilterPixels +end; + +procedure TfrmConfig.edtFiltersizeExit(Sender: TObject); +begin + try + StrToFloat(edtFiltersize.Text); + except + edtFiltersize.Text := '0.1'; + end; + + SetFilterPixels +end; + +procedure TfrmConfig.edtDensityExit(Sender: TObject); +begin + try + StrToFloat(edtDensity.Text); + except + edtDensity.Text := '10'; + end; +end; + +procedure TfrmConfig.SetFilterPixels; +var + filter_width: integer; +begin + filter_width := Round(2.0 * FILTER_CUTOFF * StrToFloat(edtFiltersize.Text) * StrToInt(edtOversample.Text) ); + if odd(filter_width + StrToInt(edtOversample.Text)) then + inc(filter_width); + pnlFilterpixels.Caption := IntToStr(filter_width); +end; + +procedure TfrmConfig.rgQualityClick(Sender: TObject); +begin + if rgQuality.ItemIndex = 3 then + ClientHeight := panel1.Height + Panel2.Height + panel3.Height + else + ClientHeight := panel1.Height + Panel2.Height; +end; + +end. diff --git a/2.10/ScreenSaver/ScrMain.dfm b/2.10/ScreenSaver/ScrMain.dfm new file mode 100644 index 0000000..9d7748c --- /dev/null +++ b/2.10/ScreenSaver/ScrMain.dfm @@ -0,0 +1,25 @@ +object frmMain: TfrmMain + Left = 223 + Top = 103 + BorderStyle = bsNone + Caption = 'Main' + ClientHeight = 146 + ClientWidth = 231 + Color = clBlack + Font.Charset = ANSI_CHARSET + Font.Color = clWindow + Font.Height = -21 + Font.Name = 'Times New Roman' + Font.Style = [fsBold, fsItalic] + OldCreateOrder = False + WindowState = wsMaximized + OnActivate = FormActivate + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + OnMouseDown = FormMouseDown + OnPaint = FormPaint + PixelsPerInch = 96 + TextHeight = 24 +end diff --git a/2.10/ScreenSaver/ScrMain.pas b/2.10/ScreenSaver/ScrMain.pas new file mode 100644 index 0000000..28d7c7f --- /dev/null +++ b/2.10/ScreenSaver/ScrMain.pas @@ -0,0 +1,444 @@ +unit ScrMain; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Gauges, Render64, ControlPoint; + +type + TfrmMain = class(TForm) + procedure FormMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormPaint(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + private + cp : TControlPoint; + Render: TRenderer64; + bStop : boolean; + bm: TBitmap; + + Quality: integer; + bSave: boolean; + bShowOtherImages: boolean; + Oversample: Integer; + FilterSize: double; + Density: double; + + SaveIndex: integer; + SavePath: string; + ImageList: TStringList; + ShowNextImage: TDateTime; + StartTime: TDateTime; + Remainder: TDateTime; + + procedure ReadSettings; + procedure PrePareSave; + procedure Save; + public + procedure Onprogress(prog: double); + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.dfm} + +uses + math, jpeg, registry, FlameIO, + rndFlame, regstry, global; + +procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + Close; +end; + +procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + Close; +end; + +procedure TfrmMain.FormActivate(Sender: TObject); +begin + DecimalSeparator := '.'; + + OnActivate := nil; + + ShowCursor(False); + + ReadSettings; + + Remainder := 1; + + // first one quickly + cp.ParseString( 'pixels_per_unit 277.456647 center -1.0982659 0 gamma 2 spatial_filter_radius' + + ' 0.5 contrast 1 brightness 1.5 zoom 0 spatial_oversample 1 sample_density 1 nbatches' + + ' 1 white_level 200 cmap_inter 0 time 0 cmap 33 xform 0 density 1 color 0 var 0 0 0 1 0' + + ' 0 0 coefs 0.466381997 -0.0618700013 0.0792416036 0.610638022 -0.475656986 -0.28115499'+ + ' xform 1 density 1 color 1 var 0 0 0 0 1 0 0 coefs -0.513867021 0.271649003 -0.254521996' + + ' -0.550984025 -0.674094975 -0.600323975'); +(* +'center 0.01 1.96 pixels_per_unit 145.24' + +'spatial_oversample 3 spatial_filter_radius 0.30' + +'sample_density 200.00' + +'nbatches 1 white_level 200 background 0.00 0.00 0.00' + +'brightness 4.00 gamma 4.00 vibrancy 1.00 hue_rotation 0.68 cmap_inter 0' + +'xform 0 density 0.17 color 1.00' + +'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' + +'coefs 0.94 0.69 -0.27 0.75 1.67 0.29' + +'xform 1 density 0.17 color 0.00' + +'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' + +'coefs -0.07 -0.94 0.69 -0.15 1.93 -1.57' + +'xform 2 density 0.17 color 0.00' + +'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' + +'coefs 0.42 -0.37 -0.88 -0.25 -0.65 0.22' + +'xform 3 density 0.17 color 0.00' + +'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' + +'coefs 0.61 0.99 0.06 0.51 -1.59 -1.58' + +'xform 4 density 0.17 color 0.00' + +'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' + +'coefs -0.77 0.12 -0.36 -0.69 -0.74 1.53' + +'xform 5 density 0.17 color 0.00 ' + +'var 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00' + +'coefs 0.58 -0.20 -0.92 0.60 -0.29 1.30'); +*) + cp.sample_density := 2; + cp.Width := ClientWidth; + cp.Height := ClientHeight; + cp.spatial_oversample := 1; + cp.spatial_filter_radius := 0.3; + cp.Gamma := 4; + cp.brightness := 4; + cp.CalcBoundbox; + Render.SetCP(cp); + + StartTime := Now; + Render.Render; + if bstop then + Exit; + BM.Assign(Render.GetImage); + Canvas.StretchDraw(Rect(0,0,ClientWidth, ClientHeight),bm); + + PrepareSave; + if bstop then + Exit; + + ShowNextImage := Now + EncodeTime(0,0,5,0); + + cp.Width := ClientWidth; + cp.Height := ClientHeight; + cp.spatial_filter_radius := 0.2; + cp.Gamma := 4; + cp.brightness := 4; + cp.spatial_oversample := 1; + + Case Quality of + 0: + begin + cp.sample_density := 10; + end; + 1: + begin + cp.sample_density := 100; + end; + 2: + begin + cp.sample_density := 1000; + end; + else + begin + cp.sample_density := Density; + cp.spatial_oversample := Oversample; + cp.spatial_filter_radius := FilterSize; + end; + end; + + // APO setting for randomflame + regstry.ReadSettings; + Global.MainSeed := Round(Random(100000)); + + while true do begin + Remainder := 0; +// cp.RandomCP; +(* + cp2 := cp.Clone; + cp2.pixels_per_unit := (cp.pixels_per_unit * 128)/cp.Width; + cp2.width := 256; + cp2.height := 256; + cp2.spatial_oversample := 1; + cp2.spatial_filter_radius := 0.1; + cp2.sample_density := 1; + cp2.gamma := 2; + cp2.brightness := 1; + cp2.contrast := 1; + + Render.SetCP(cp2); + Render.Test(fracBlack, fracWhite, avgColor); + cp2.Free; +*) +// Canvas.Draw(0,100,Render.GetImage); + +// if (fracBlack > 0.990) or ((avgColor/(fracBlack + 1E-6)) < 0.35) then +// Continue; + + cp := RandomFlame(cp,0); + cp.Width := ClientWidth; + cp.Height := ClientHeight; + cp.spatial_filter_radius := 0.2; + cp.Gamma := 4; + cp.brightness := 4; + cp.spatial_oversample := 1; + + Case Quality of + 0: + begin + cp.sample_density := 10; + end; + 1: + begin + cp.sample_density := 100; + end; + 2: + begin + cp.sample_density := 1000; + end; + else + begin + cp.sample_density := Density; + cp.spatial_oversample := Oversample; + cp.spatial_filter_radius := FilterSize; + end; + end; + cp.CalcBoundbox; + + Remainder := 1; + Render.SetCP(cp); + StartTime := Now; + + Render.Render; + + if bstop then + Exit; + + bm.assign(Render.GetImage); +// bm.Canvas.Font.Color := ClWhite; +// bm.Canvas.Brush.Color := CLBlack; +// bm.Canvas.TextOut(10,10, Format('fracBlack : %.4f',[fracBlack] )); +// bm.Canvas.TextOut(10,26, Format('fracWhite : %.4f',[fracWhite] )); +// bm.Canvas.TextOut(10,42, Format('avgColor : %.4f',[avgColor] )); +// bm.Canvas.TextOut(10,58, Format('ColorValue: %.4f',[avgColor/fracBlack] )); + + Canvas.Draw(0,0,bm); + Save; + ShowNextImage := Now + EncodeTime(0,0,30,0); + end; +end; + +procedure TfrmMain.Onprogress(prog: double); +var + JPeg: TJPEGImage; + NewIndex: Integer; + Elapsed: TDateTime; +begin + if bstop then + Exit; + + if bShowOtherImages and (Now > ShowNextImage) and (ImageList.Count > 0) then begin + NewIndex := Random(ImageList.Count); + + JPeg := TJPEGImage.Create; + JPeg.LoadFromFile(SavePath + ImageList[NewIndex]); + + bm.Assign(JPeg); + JPeg.Free; + + repaint; + + SetbkMode(Canvas.Handle, TRANSPARENT); + Canvas.TextOut(ClientWidth - 150, 10, ImageList[NewIndex]); + ShowNextImage := Now + EncodeTime(0,0,10,0); + end; + + prog := (Render.Slice + Prog)/Render.NrSlices; + +// Canvas.Brush.Color := clBlack; +// Canvas.Fillrect(Rect(7, ClientHeight - 13, ClientWidth - 7, ClientHeight - 7)); + +// Canvas.Brush.Color := clBlack; +// Canvas.Fillrect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5)); + + + Canvas.Brush.Color := clYellow; + Canvas.FrameRect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5)); + Canvas.Brush.Color := clYellow; + Canvas.Fillrect(Rect(7, ClientHeight - 13, 7 + Round(prog * (ClientWidth - 14)), ClientHeight - 7)); + Canvas.Brush.Color := clBlack; + Canvas.Fillrect(Rect(7 + Round(prog * (ClientWidth - 14)), ClientHeight - 13, ClientWidth - 7, ClientHeight - 7)); + + Elapsed := Now - StartTime; + Canvas.Brush.Color := clBlack; + Canvas.TextOut(5, ClientHeight - 25 - 2 * Canvas.TextHeight('X'), Format('Elapsed %2.2d:%2.2d:%2.2d.%2.2d', + [Trunc(Elapsed * 24), + Trunc((Elapsed * 24 - Trunc(Elapsed * 24)) * 60), + Trunc((Elapsed * 24 * 60 - Trunc(Elapsed * 24 * 60)) * 60), + Trunc((Elapsed * 24 * 60 * 60 - Trunc(Elapsed * 24 * 60 * 60)) * 100)])); + + if prog > 0 then + Remainder := Min(Remainder, Elapsed * (power(1/prog, 1.2) - 1)); + + Canvas.TextOut(5, ClientHeight - 20 - Canvas.TextHeight('X'), Format('Remainder %2.2d:%2.2d:%2.2d.%2.2d', + [Trunc(Remainder * 24), + Trunc((Remainder * 24 - Trunc(Remainder * 24)) * 60), + Trunc((Remainder * 24 * 60 - Trunc(Remainder * 24 * 60)) * 60), + Trunc((Remainder * 24 * 60 * 60 - Trunc(Remainder * 24 * 60 * 60)) * 100)])); + + Canvas.TextOut(5, ClientHeight - 50 - Canvas.TextHeight('X'), IncludeTrailingPathDelimiter(ExtractFileDir(paramstr(0))) + 'images'); + + Application.ProcessMessages; +end; + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + bm:= TBitmap.create; + randomize; + cp := TControlPoint.Create; + Render := TRenderer64.Create; + Render.OnProgress := Onprogress; + ImageList := TStringList.Create; +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + ShowCursor(true); + cp.Free; + render.Free; + ImageList.Free; +end; + +procedure TfrmMain.FormPaint(Sender: TObject); +begin + if assigned(bm) then + Canvas.Draw(0,0,bm); +end; + +procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + bm.Free; + Render.Stop; + bStop := True; +end; + +procedure TfrmMain.ReadSettings; +var + Registry: TRegistry; +begin + Registry := TRegistry.Create; + try + Registry.RootKey := HKEY_CURRENT_USER; + if Registry.OpenKey('\Software\BobsFreubels\FlameSS', False) then begin + if Registry.ValueExists('SaveImage') then begin + bSave := Registry.ReadBool('SaveImage'); + end else begin + bSave := False; + end; + if Registry.ValueExists('ShowOtherImages') then begin + bShowOtherImages := Registry.ReadBool('ShowOtherImages'); + end else begin + bShowOtherImages := False; + end; + if Registry.ValueExists('Quality') then begin + Quality := Registry.ReadInteger('Quality'); + end else begin + Quality := 1; + end; + if Registry.ValueExists('Oversample') then begin + Oversample := Registry.ReadInteger('Oversample'); + end else begin + Oversample := 1; + end; + if Registry.ValueExists('Filter') then begin + Filtersize := Registry.ReadFloat('Filter'); + end else begin + Filtersize := 0.1; + end; + if Registry.ValueExists('Density') then begin + Density := Registry.ReadFloat('Density'); + end else begin + Density := 100; + end; + + end else begin + bSave := False; + Quality := 1; + end; + finally + Registry.Free; + end; +end; + +procedure TfrmMain.PrePareSave; +var + sr: TSearchRec; +begin +// if not bSave then +// Exit; + + SaveIndex := 1; + + SavePath := IncludeTrailingPathDelimiter(ExtractFileDir(paramstr(0))) + 'images'; + SavePath := IncludeTrailingPathDelimiter(SavePath); + + ForceDirectories(SavePath); + + if FindFirst(SavePath + '*.jpg', faAnyFile, sr) = 0 then begin + repeat + ImageList.Add(UpperCase(sr.Name)); + until FindNext(sr) <> 0; + FindClose(sr); + end; +end; + +procedure TfrmMain.Save; +var + sl: TStringlist; + ImageName: string; + jpeg : TJPegImage; +begin + if not bSave then + Exit; + + repeat + ImageName := Format('FL_%5.5d.JPG',[SaveIndex]); + Inc(SaveIndex); + until (ImageList.IndexOf(ImageName) < 0); + + jpeg := TJPegImage.Create; + jpeg.assign(bm); + jpeg.CompressionQuality := 80; + jpeg.SaveToFile(SavePath+ImageName); + jpeg.free; + + ImageList.Add(ImageName); + + sl := TStringlist.Create; + + Cp.name := ChangeFileExt(ImageName,''); + sl.add(FlameToXML(cp,False, True)); + + sl.SaveToFile(ChangeFileExt(SavePath+ImageName,'.flame')); + sl.Free; + +// cp.SaveToFile(ChangeFileExt(SavePath+ImageName,'.TXT')); +end; + +end. +