Renate Schaaf

No thanks 🙂. But I've already translated parts of C++-code to Delphi. They could use stuff like Break_On_Fail(hr) and more, made me a bit jealous. You wouldn't per chance know why I can't mux any audio into an HEVC-encoded video? The video stream is all there, but it seems to be missing the correct stream header. So only the audio is being played.

You are right. But then I have to think about whether or not a call is likely to produce havoc, and declare several new variables. BTW: WriteSample pushes the sample to the sinkwriter and does not just set an index. What do you think about the following construct instead: procedure TBitmapEncoderWMF.WriteOneFrame; var pSample: IMFSample; Count: integer; const ProcName = 'TBitmapEncoderWMF.WriteOneFrame'; procedure CheckFail(hr: HResult); begin inc(Count); if not succeeded(hr) then raise Exception.Create('Fail in call nr. ' + IntToStr(Count) + ' of ' + ProcName + ' with result ' + IntToStr(hr)); end; begin Count := 0; // Create a media sample and add the buffer to the sample. CheckFail(MFCreateSample(pSample)); CheckFail(pSample.AddBuffer(pSampleBuffer)); CheckFail(pSample.SetSampleTime(fWriteStart)); CheckFail(pSample.SetSampleDuration(fSampleDuration)); // Send the sample to the Sink Writer. CheckFail(pSinkWriter.WriteSample(fstreamIndex, pSample)); inc(fWriteStart, fSampleDuration); fVideoTime := fWriteStart div 10000; inc(fFrameCount); end;

@programmerdelphi2k What if hrSampleBuffer is not S_Ok, causing pSinkWriter.WriteSample to fail with an AV or such? You would get an exception the source of which would be harder to trace. Or am I just too dense to understand :). (It's late)

Thanks, sounds like it's just the thing needed. Just need to figure out how. Error: uToolsWMF uses a unit Z_prof. Entry can be safely deleted. Comes from having too much stuff in the path. Meanwhile I think I figured out how to improve the encoding quality. Around line 270 in uBitmaps2VideoWMF.pas make the following changes: if succeeded(hr) then hr := MFCreateAttributes(attribs, 4); //<--------- change to 4 here // this enables hardware encoding, if the GPU supports it if succeeded(hr) then hr := attribs.SetUINT32(MF_READWRITE_ENABLE_HARDWARE_TRANSFORMS, UInt32(True)); // this seems to improve the quality of H264 and H265-encodings: {*************** add this *********************************} // this enables the encoder to use quality based settings if succeeded(hr) then hr := attribs.SetUINT32(CODECAPI_AVEncCommonRateControlMode, 3); {**************** /add this *******************************} if succeeded(hr) then hr := attribs.SetUINT32(CODECAPI_AVEncCommonQuality, 100); if succeeded(hr) then hr := attribs.SetUINT32(CODECAPI_AVEncCommonQualityVsSpeed, 100); Besides, I'm getting sick and tired of all those if succeeded...

I'm building a Directory-tree for FMX as a descendent of TTreeview. Because reading in the full directory-tree of a root-directory takes way too long, I only read in the first 2 levels. After that I only want to create sub-items as necessary for any item that the user selects or expands. In the VCL-version this can be done by overriding TTreeview.Change and TTreeview.CanExpand. For the FMX-version I can override TTreeview.DoChange, but I can't find an analogue of CanExpand. So I tried to override MouseDown. But the Treeview never gets the MouseDown when the user clicks the expand-button. Is there anything else I could do? Here some of the relevant code: procedure TDirectoryTree.CreateSubNodesToLevel2(aItem: TTreeViewItem); var DirArraySize1, DirArraySize2, i, j: integer; DirArray1, DirArray2: TStringDynArray; TreeItem, TreeItem2: TTreeViewItem; NewName: string; begin DirArray1 := TDirectory.GetDirectories(GetFullFolderName(aItem)); DirArraySize1 := Length(DirArray1); if DirArraySize1 > 0 then begin for i := 0 to DirArraySize1 - 1 do begin NewName := DirArray1[i]; if aItem.Count = i then begin TreeItem := TTreeViewItem.Create(self); fDirectoryDict.Add(NativeUInt(TreeItem), NewName); TreeItem.Text := ExtractFilename(NewName); TreeItem.ImageIndex := 0; TreeItem.Parent := aItem; end else TreeItem := aItem.Items[i]; DirArray2 := TDirectory.GetDirectories(NewName); DirArraySize2 := Length(DirArray2); for j := 0 to DirArraySize2 - 1 do begin if TreeItem.Count = j then begin TreeItem2 := TTreeViewItem.Create(self); fDirectoryDict.Add(NativeUInt(TreeItem2), DirArray2[j]); TreeItem2.Text := ExtractFilename(DirArray2[j]); TreeItem2.ImageIndex := 0; TreeItem2.Parent := TreeItem; end; end; end; end; end; function TDirectoryTree.GetFullFolderName(aItem: TTreeViewItem): string; begin Result := fDirectoryDict.Items[NativeUInt(aItem)]; end; procedure TDirectoryTree.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin if (HoveredItem <> nil) then CreateSubNodesToLevel2(HoveredItem); inherited; end;

Good idea. Going back to FindFirst/FindNext might have been the better design right from the beginning, but right now I'm satisfied with the speed. I just had to fix the VCL-tree, because I forgot that the darn thing recreates its Window-handle on any DPI-change. Arghh!

You can see the brandnew explorer-trees in action here: https://github.com/rmesch/Parallel-Bitmap-Resampler. See the demos ThreadsInThreads* Renate

Yes, it works, but it is still too slow to be useable as an explorer tree. Let me make a bold statement: You will never be able to create a functioning explorer tree with the plain TTreeview in FMX, if you insist on reading in the full directory tree of a root directory. Yes, that's why I want to scan 2 levels at a time, so the correct expand buttons are always shown. But for this I need to also know when the user expands a node without actually selecting it. By defining an interposer class for TTreeViewItem, which overrides TTreeViewItem.SetIsExpanded, I can now intercept this event. I would have been interested in learning, whether anybody sees a problem with this approach. I don't see any in the use case I need it for. Renate

Nevermind, I have it working my way, it's fast, and I can also avoid all those errors. But thanks for your time. Renate

The speed isn't too bad, certainly better than filling the nodes recursively. But it still takes several minutes to display the content of my personal folder, whereas in my version you'd see it almost instantly. There must be something wrong with the logic in your MyFillTreeView. It never displays sibling nodes right. This is for example the output I get when I choose the Embarcadero folder under documents as root: I also really want to avoid reading in all directories in the root.

There was a reason I didn't do that, but I can't remember :). What do you think about using the interposer class for TTreeViewItem? Meanwhile I excluded Directories which have faHidden or faSystem, because that was creating errors. Other than that it seems to be working OK, unless you try to expand something like the Windows-folder, that still takes forever. I would have liked to use TTreeView.ItemExpanded, but as you say, I can't.

I got it to "work" by defining an interposer class for TTreeViewItem type TTreeViewItem = class(FMX.TreeView.TTreeViewItem) protected procedure SetIsExpanded(const Value: Boolean); override; end; ... procedure TTreeViewItem.SetIsExpanded(const Value: Boolean); begin inherited; if IsExpanded then if TreeView is TDirectoryTree then TDirectoryTree(TreeView).CreateSubNodesToLevel2(self); end; It doesn't seem to interfere with the inner workings of TTreeView, but it makes me feel a bit uneasy. Also whenever you now use an item of the treeview you have to do a typecast TTreeviewItem(aTreeviewItem). I have attached the a small test project. Tested for Windows platforms only. DirectoryTest.zip

I'm not all that familiar with FMX. So I'm trying to have a TImage display a TBitmap so I see the "exact" original, and I also want the image to resize to the correct dimensions of the bitmap. This is what I have come up with, but it seems overly complicated: procedure DisplayInOriginalSize_AndSizeToFit(const bmp: TBitmap; im: TImage); var ScaleInv: single; begin im.WrapMode := TImageWrapMode.Original; ScaleInv := 1 / im.Scene.GetSceneScale; // ScaleInv:=1/Screen.Displays[0].Scale; im.SetBounds(im.Position.X, im.Position.Y, bmp.Width * ScaleInv, bmp.Height * ScaleInv); im.Bitmap.Assign(bmp); im.Bitmap.BitmapScale := 1; end; The commented line works too for me, but it wouldn't in a multiple-monitor-setting. There must be an easier way to set the exact pixel dimensions of a control. Thanks, Renate

This will scale the image by the desktop-DPI. For example my desktop-display is set at 200%. The bitmap is displayed in original size because of im.Wrapmode = Orignal. But the Image will be twice as large as its bitmap, and the scrollbox it's in will have a scrollbar-range which is too big . I have corrected that by dividing the width by im.scene.scale, which works. I was just wondering, whether there isn't a simpler way.

How does this relate to my question?

Well, if one could get one's hands on the DirectDraw-Canvas, and the DirectDraw-RenderingContext, one could write a descendent of FMX-TBitmap which uses the higher-quality setting possible with DirectDraw. I just can't see how, but I'm a newbie.

Your handcrafted routine isn't *that* slow, just turn on compiler-optimization. As for resampling, I had started to port my parallel bitmap-resampler to fmx, but then I thought, hey, these guys can use DirectDraw, there won't be a demand. Now, seeing how poor the quality is for (supposedly) bilinear rescaling, I have continued working on it. A first version is usable on Windows only for the time being. I just have to add some demos, and I'll probably upload it later today to https://github.com/rmesch/Parallel-Bitmap-Resampler Just in case you might be interested.

It looks like you want to use the component list of a TForm, so you should pass that form as a parameter: function SetDBSessionNames(const AForm: TForm; const sSessionName: string): boolean; begin // for var i := 0 to AForm.ComponentCount - 1 do begin // if AForm.Components[i] is TEDBSession then (AForm.Components[i] as TEDBSession).SessionName := sSessionName; .. Then you can call it in the code of a form as SetDBSessionNames(self, sSessionName);

A new version is available at https://github.com/rmesch/Repository-R.Schaaf. The parallel resampler can now be used in concurrent threads. You can define more than one thread pool for the resampling and tell the parallel procedure which pool to use. A new demo "ThreadsInThreads" has been added. Initially I had the problem that this demo would sometimes hang waiting for an event, but that has hopefully been fixed. I'd much appreciate a feedback if it still occurs. Thanks, Renate

Well, the test clearly shows it, or doesn't it? Because I could step on the toes of some other code, I guess. Thanks, I'll keep it in mind. Anyway, for the time being I feel safer with just creating a TWICImage in initialization.

Is has to do with COM, ActiveX, don't ask me to explain, I know next to nothing about these things. But I browsed QC a bit, in which this or similar bugs have been reported multiple times (almost all closed), but I got the idea that a CoInitialize call could be missing. Look at this simple test: uses System.Threading, WinApi.ActiveX; procedure TForm2.Button1Click(Sender: TObject); var task: iTask; begin task := TTask.Run( procedure var WIC: TWICImage; begin //CoInitializeEx(nil,COINIT_MULTITHREADED); WIC := TWICImage.Create; try finally WIC.Free; end; end); end; As it is, this gives an error in VCL.Graphics in the line marked: constructor TWICImage.Create; var LResult: HResult; begin inherited; FInterpolationMode := wipmNone; EnterCriticalSection(WicImageLock); try if FImagingFactory = nil then begin LResult := CoCreateInstance(CLSID_WICImagingFactory, nil, CLSCTX_INPROC_SERVER or //<--------------------------- CLSCTX_LOCAL_SERVER, IUnknown, FImagingFactory); if Failed(LResult) then raise EInvalidGraphicOperation.CreateFmt(SWinRTInstanceError + ' (%X)', ['CLSID_WICImagingFactory', LResult]); end else FImagingFactory._AddRef; finally LeaveCriticalSection(WicImageLock); end; Uncommenting the line with CoInitializeEx in the test, seems to fix the error in the test procedure. Renate

The TWICImage-factory-bug in threads is still present in 11.3 (I just got the new community-edition 🙂)

It could still work, since the weights only run from -$100 to $100. So a 3-dimensional table would work. Let's try. Edit: No, such a table would just be too big. Edit2: shr 2 doesn't work, because the result of the multiplication could be negative. Thanks for the idea!

I just managed to get the routine for the pre-multiplication much faster. I naively assumed that MulDiv is faster than multiplication and subsequent div. So I used this (PremultPrecision is a constant of value 4): if ps.rgbReserved > 0 then begin alpha := Weight * ps.rgbReserved; inc(Cache.b, MulDiv(ps.rgbBlue, alpha, PreMultPrecision)); inc(Cache.g, MulDiv(ps.rgbGreen, alpha, PreMultPrecision)); inc(Cache.r, MulDiv(ps.rgbRed, alpha, PreMultPrecision)); inc(Cache.a, alpha); end; But this is in fact faster (with compiler-optimization turned on): if ps.rgbReserved > 0 then begin alpha := Weight * ps.rgbReserved; inc(Cache.b, ps.rgbBlue*alpha div PreMultPrecision); inc(Cache.g, ps.rgbGreen*alpha div PreMultPrecision); inc(Cache.r, ps.rgbRed*alpha div PreMultPrecision); inc(Cache.a, alpha); end; And now I remember that Anders even explained that behavior to me before: If the div is by a constant that is a power of 2, the optimizer is smart enough to turn div into a shift. Guess the optimizer isn't smart enough to do this in MulDiv.

Wow, it was indeed very easy, and even the previous link still works! Thanks!