

Renate Schaaf
Members-
Content Count
136 -
Joined
-
Last visited
-
Days Won
5
Everything posted by Renate Schaaf
-
MAP2PDB - Profiling with VTune
Renate Schaaf replied to Anders Melander's topic in Delphi Third-Party
Confirmed: Works with uProf now. Great Job. I get the same info as with VTune: hotspot timings, processor use, stack graph. -
Parallel Algorithm for resampling bitmaps - very infrequent fails
Renate Schaaf posted a topic in Algorithms, Data Structures and Class Design
I've tried to divide the work for resizing bitmaps into 4 parallel tasks. The result is, on average, a speed improvement by 60%, the bicubic resampler gets close to StretchBlt/Halftone. I'm using the routine for writing videos, where it is called at least once for every video frame. So, in my tests I must have called it at least 100 000 times. Problem is, that 3 times there was a timeout in TTask.WaitForAll. I'm not using any synchronization, because The tasks are completely independent of each other, i.e. none alters anything that the other uses. They write to memory chunks, which do not overlap. They don't use any VCL-code, not even VCL.Graphics. The memory they read does overlap, but I thought that was OK, but after reading up a bit, I get the impression that I am wrong here. From what I gather, I have a "race condition" caused by "not atomic reads" (this is all very new to me, sorry, if I'm talking rubbish). The threads are (among other things) all reading from two contributor-arrays, which contain records of varying size, so could that be it? What can I do to prevent the error? Maybe I should make copies of the arrays for each task? Here is the unit, it only uses a bicubic filter to make things a little simpler: unit uResample; interface uses WinApi.Windows, System.Types, VCL.Graphics, System.SysUtils, System.Classes, System.Math; type TZoomProcedure = procedure(const Source, Target: TBitmap; SourceRect: TRectF; Radius: single); // "bicubic" resampler based on ideas by Anders Melander, Mike Lischke // and Eric Grange. It supports float values for filter radii and float-valued // zoom rectangles. Source, Target should be pf32bit. Target must be set to the // correct size. procedure ZoomResample(const Source, Target: TBitmap; SourceRect: TRectF; Radius: single); // Same as above divided into 4 parallel tasks procedure ZoomResampleParallel(const Source, Target: TBitmap; SourceRect: TRectF; Radius: single); implementation uses WinApi.MMSystem, VCL.Dialogs, System.SyncObjs, System.Threading; type TContributor = record min, High: integer; // Min: start source pixel // High+1: number of source pixels to contribute to the result Weights: array of integer; // doubles scaled by $800 end; TContribArray = array of TContributor; TBGRAInt = record b, g, r, a: integer; end; PBGRAInt = ^TBGRAInt; TBGRAIntArray = array of TBGRAInt; const beta = 0.525; // f(beta)=0 beta2 = beta * beta; alpha = 105 / (16 - 112 * beta2); aa = 1 / 7 * alpha; bb = -1 / 5 * alpha * (2 + beta2); cc = 1 / 3 * alpha * (1 + 2 * beta2); dd = -alpha * beta2; // constants computed with maple for polynomial fit function AntiFilter(X: double): double; inline; // Antiderivative of a filter function similar to bicubic, but I like it better begin if X < -1 then Result := -0.5 else if X < 1 then Result := aa * X * X * X * X * X * X * X + bb * X * X * X * X * X + cc * X * X * X + dd * X else Result := 0.5; end; procedure MakeContributors(r: single; SourceSize, TargetSize: integer; SourceStart, SourceFloatwidth: double; var Contribs: TContribArray); // r: Filterradius var xCenter, scale, rr: double; X, j: integer; x1, x2, delta: double; TrueMin, TrueMax, Mx: integer; begin Assert(TargetSize > 0); if SourceFloatwidth = 0 then SourceFloatwidth := SourceSize; scale := SourceFloatwidth / TargetSize; SetLength(Contribs, TargetSize); if scale > 1 then // downsampling rr := r * scale else rr := r; delta := 1 / rr; for X := 0 to TargetSize - 1 do begin xCenter := (X + 0.5) * scale; TrueMin := Ceil(xCenter - rr + SourceStart - 1); TrueMax := Floor(xCenter + rr + SourceStart); Contribs[X].min := min(max(TrueMin, 0), SourceSize - 1); // make sure not to read in negative pixel locations Mx := max(min(TrueMax, SourceSize - 1), 0); // make sure not to read past w-1 in the source Contribs[X].High := Mx - Contribs[X].min; Assert(Contribs[X].High >= 0); // High=Number of contributing pixels minus 1 SetLength(Contribs[X].Weights, Contribs[X].High + 1); with Contribs[X] do begin x1 := delta * (min - SourceStart - xCenter); for j := 0 to High do begin x2 := x1 + delta; Weights[j] := round($800 * (AntiFilter(x2) - AntiFilter(x1))); x1 := x2; end; for j := TrueMin - min to -1 do begin // assume the first pixel to be repeated x1 := delta * (min + j - SourceStart - xCenter); x2 := x1 + delta; Weights[0] := Weights[0] + round($800 * (AntiFilter(x2) - AntiFilter(x1))); end; for j := High + 1 to TrueMax - min do begin // assume the last pixel to be repeated x1 := delta * (min + j - SourceStart - xCenter); x2 := x1 + delta; Weights[High] := Weights[High] + round($800 * (AntiFilter(x2) - AntiFilter(x1))); end; end; { with Contribs[x] } end; { for x } end; // This writes one column in the target procedure ProcessColumn(X, ymin, ymax, Sbps, Tbps, NewHeight: integer; rStart, rTStart: PByte; runstart: PBGRAInt; const ContribsX, ContribsY: TContribArray); inline; var ps, pT: PRGBQuad; rs, rT: PByte; y, xs, ys: integer; highx, highy, minx, miny: integer; WeightxStart, Weightx, Weighty: PInteger; Total: TBGRAInt; run: PBGRAInt; begin rs := rStart; highx := ContribsX[X].High; minx := ContribsX[X].min; inc(rs, 4 * minx); WeightxStart := @ContribsX[X].Weights[0]; run := runstart; // runstart points to Columnx[0] // Colmnx stores the result of the resampling in x-direction for y := ymin to ymax do begin // For each source line at y // Sum up weighted color values at source pixels ContribsX[x].Min+xs // 0<=xs<=ContribsX[x].High // and store the results in Columnx[y-ymin] etc. ps := PRGBQuad(rs); Weightx := WeightxStart; FillChar(run^, SizeOf(run^), 0); for xs := 0 to highx do begin inc(run.b, Weightx^ * ps.rgbBlue); inc(run.g, Weightx^ * ps.rgbGreen); inc(run.r, Weightx^ * ps.rgbRed); inc(run.a, Weightx^ * ps.rgbReserved); inc(Weightx); inc(ps); end; inc(run); dec(rs, Sbps); end; // Average in y-direction: // For each target line y sum up weighted colors in // Columnx[ys+ContribsY[y].Min-ymin], 0<=ys<=ContribsY[y].High // Store result in Total // round and assign to TargetPixel pt at [x,y] rT := rTStart; for y := 0 to NewHeight - 1 do begin pT := PRGBQuad(rT); inc(pT, X); highy := ContribsY[y].High; miny := ContribsY[y].min - ymin; Weighty := @ContribsY[y].Weights[0]; run := runstart; inc(run, miny); FillChar(Total, SizeOf(Total), 0); for ys := 0 to highy do begin inc(Total.b, Weighty^ * run.b); inc(Total.g, Weighty^ * run.g); inc(Total.r, Weighty^ * run.r); inc(Total.a, Weighty^ * run.a); inc(Weighty); inc(run); end; Total.r := max(Total.r, 0); Total.g := max(Total.g, 0); Total.b := max(Total.b, 0); Total.a := max(Total.a, 0); // results could be negative, filter has negative values Total.r := (Total.r + $1FFFFF) shr 22; // "round" the result Total.g := (Total.g + $1FFFFF) shr 22; Total.b := (Total.b + $1FFFFF) shr 22; Total.a := (Total.a + $1FFFFF) shr 22; pT.rgbBlue := min(Total.b, 255); pT.rgbGreen := min(Total.g, 255); pT.rgbRed := min(Total.r, 255); pT.rgbReserved := min(Total.a, 255); dec(rT, Tbps); end; // for y end; procedure ZoomResampleParallel(const Source, Target: TBitmap; SourceRect: TRectF; Radius: single); var ContribsX, ContribsY: TContribArray; OldWidth, OldHeight: integer; NewWidth, NewHeight: integer; Sbps, Tbps: integer; rStart, rTStart: PByte; // Row start in Source, Target ymin, ymax, i: integer; tasks: array [0 .. 3] of ITask; Chunk: integer; begin Source.PixelFormat := pf32bit; Target.PixelFormat := pf32bit; // for safety // Target needs to have been set to correct size NewWidth := Target.Width; NewHeight := Target.Height; OldWidth := Source.Width; OldHeight := Source.Height; Tbps := ((NewWidth * 32 + 31) and not 31) div 8; // BytesPerScanline Target Sbps := ((OldWidth * 32 + 31) and not 31) div 8; // BytesPerScanline Source MakeContributors(Radius, OldWidth, NewWidth, SourceRect.Left, SourceRect.Right - SourceRect.Left, ContribsX); MakeContributors(Radius, OldHeight, NewHeight, SourceRect.Top, SourceRect.Bottom - SourceRect.Top, ContribsY); ymin := ContribsY[0].min; ymax := ContribsY[NewHeight - 1].High + ContribsY[NewHeight - 1].min; rStart := Source.ScanLine[ymin]; rTStart := Target.ScanLine[0]; Chunk := NewWidth div 4; // stupid repetion! tasks[0] := TTask.create( procedure begin var Columnx: TBGRAIntArray; // Stores averaged x-Contributors var X, xmin, xmax: integer; var runstart: PBGRAInt; SetLength(Columnx, ymax - ymin + 1); runstart := @Columnx[0]; xmin := 0; xmax := Chunk - 1; for X := xmin to xmax do ProcessColumn(X, ymin, ymax, Sbps, Tbps, NewHeight, rStart, rTStart, runstart, ContribsX, ContribsY); end); tasks[1] := TTask.create( procedure begin var Columnx: TBGRAIntArray; var X, xmin, xmax: integer; var runstart: PBGRAInt; SetLength(Columnx, ymax - ymin + 1); runstart := @Columnx[0]; xmin := Chunk; xmax := 2 * Chunk - 1; for X := xmin to xmax do ProcessColumn(X, ymin, ymax, Sbps, Tbps, NewHeight, rStart, rTStart, runstart, ContribsX, ContribsY); end); tasks[2] := TTask.create( procedure begin var Columnx: TBGRAIntArray; var X, xmin, xmax: integer; var runstart: PBGRAInt; SetLength(Columnx, ymax - ymin + 1); runstart := @Columnx[0]; xmin := 2 * Chunk; xmax := 3 * Chunk - 1; for X := xmin to xmax do ProcessColumn(X, ymin, ymax, Sbps, Tbps, NewHeight, rStart, rTStart, runstart, ContribsX, ContribsY); end); tasks[3] := TTask.create( procedure begin var Columnx: TBGRAIntArray; var X, xmin, xmax: integer; var runstart: PBGRAInt; SetLength(Columnx, ymax - ymin + 1); runstart := @Columnx[0]; xmin := 3 * Chunk; xmax := NewWidth - 1; for X := xmin to xmax do ProcessColumn(X, ymin, ymax, Sbps, Tbps, NewHeight, rStart, rTStart, runstart, ContribsX, ContribsY); end); for i := 0 to 3 do tasks[i].start; if not TTask.WaitForAll(tasks, 10000) then Raise exception.create('Time out for parallel resampling threads'); end; procedure ZoomResample(const Source, Target: TBitmap; SourceRect: TRectF; Radius: single); var ContribsX, ContribsY: TContribArray; OldWidth, OldHeight: integer; NewWidth, NewHeight: integer; // Target needs to be set to correct size Sbps, Tbps: integer; rStart, rTStart: PByte; // Row start in Source, Target Columnx: TBGRAIntArray; // cache array, records for better memory layout X, ymin, ymax: integer; runstart: PBGRAInt; begin Source.PixelFormat := pf32bit; Target.PixelFormat := pf32bit; // for safety NewWidth := Target.Width; NewHeight := Target.Height; OldWidth := Source.Width; OldHeight := Source.Height; Tbps := ((NewWidth * 32 + 31) and not 31) div 8; // BytesPerScanline Target Sbps := ((OldWidth * 32 + 31) and not 31) div 8; // BytesPerScanline Source MakeContributors(Radius, OldWidth, NewWidth, SourceRect.Left, SourceRect.Right - SourceRect.Left, ContribsX); MakeContributors(Radius, OldHeight, NewHeight, SourceRect.Top, SourceRect.Bottom - SourceRect.Top, ContribsY); ymin := ContribsY[0].min; ymax := ContribsY[NewHeight - 1].High + ContribsY[NewHeight - 1].min; rStart := Source.ScanLine[ymin]; rTStart := Target.ScanLine[0]; SetLength(Columnx, ymax - ymin + 1); runstart := @Columnx[0]; // Compute colors for each target column at x for X := 0 to NewWidth - 1 do begin ProcessColumn(X, ymin, ymax, Sbps, Tbps, NewHeight, rStart, rTStart, runstart, ContribsX, ContribsY); end; // for x end; end. -
Parallel Algorithm for resampling bitmaps - very infrequent fails
Renate Schaaf replied to Renate Schaaf's topic in Algorithms, Data Structures and Class Design
Meanwhile I've followed your suggestions and rewrote the algorithm so it writes one line at a time. Sadly, I couldn't give SuperDuper a chance to shine, as I would need to transpose memory in chunks of 16 Bytes instead of 4. Still, it got a little faster, and since both unthreaded routines are faster than Graphics32, I don't think I'm doing so badly. For the threaded version I used with a minimum of 2 and a maximum of 8 threads. Is rather fast if it works. Sadly the fails for the tasks version became, if anything, more frequent, and a Tparallel.for version hung indefinitely a few times. I failed to completely recover from the timeouts, after a fail the next call would likely fail again. So, finally I just set up 8 oldfashioned threads which wake up as needed, do a chunk of the work as needed and signal that they're done. I didn't even bother to put in checks for timeouts. It's the fastest yet and has never failed so far. Guess that is a strong indication that the culprit was TTask. If you are curious, here is a 720x540 video that got written at 40 FPS, a new record for me 🙂. Once I do similar optimizations for the transitions, the writing speed might be acceptable. Thanks again to all! -
Parallel Algorithm for resampling bitmaps - very infrequent fails
Renate Schaaf replied to Renate Schaaf's topic in Algorithms, Data Structures and Class Design
W and Height are the size in byte of the memory chunk? Do you transpose byte by byte, I guess not, wouldn't make any sense for bgra-records. Well, I need to play around with it. Pity I don't read ASM. Is this for 32bit only? Thanks 🙂 -
Parallel Algorithm for resampling bitmaps - very infrequent fails
Renate Schaaf replied to Renate Schaaf's topic in Algorithms, Data Structures and Class Design
It isn't, the creation of the threads takes too long, in the end the procedure takes about twice the time of the unthreaded one. I would really hate to have to use the approach with waking up existing threads to do the resampling ... I introduced the timeout, because the first time this happened, I had to kill the application. I am right to assume then, that there isn't anything obviously wrong in my approach which would cause the timeout? This is true for the target, and to a degree of the source, too. But the intermediate Columnx is in fact a "row" the way it's allocated. But you are right; and maybe one can get away without the transposing. Also, if the intermediate storage is a TBitmap, the algorithms wouldn't be "symmetric" anymore, the transpose of the target wouldn't be the same as the target of the transpose, but that's probably just nitpick. Anyway, if you'd care to share the code for the transposing, I'd be glad. I didn't know that. Thanks. Another point in favor of doing complete rows first, or to have the threads compute chunks of full rows. Thank you all, I have a lot to do. -
Parallel Algorithm for resampling bitmaps - very infrequent fails
Renate Schaaf replied to Renate Schaaf's topic in Algorithms, Data Structures and Class Design
Good idea, but I'm doing zoom-pans, the fixed resizing I leave to the video-encoder to do. I want to be reasonably sure that this runs on any system, not just mine .. Time to do some more stress tests 🙂 -
Parallel Algorithm for resampling bitmaps - very infrequent fails
Renate Schaaf replied to Renate Schaaf's topic in Algorithms, Data Structures and Class Design
Thanks, I will try this. I've also tried to change to TParallel.for, which hasn't bugged out so far, but is more erratic timing wise. Problem is, that the error occurs so very rarely, it's hard to say whether or not it's fixed. I wish I had more insight into what could go wrong. Thx Renate -
Parallel Algorithm for resampling bitmaps - very infrequent fails
Renate Schaaf replied to Renate Schaaf's topic in Algorithms, Data Structures and Class Design
I agree that it isn't very nice to just dump the source code here. So here is the explanation: In the routines, nevermind SourceRect, imagine it to be the full rect of the source bitmap. The Radius isn't important either. Contributors: For pixel(x,y) in the target, ContribsX[x] is a record, that defines the range of x-Values of pixels in the source, which contribute to the value of p(x,y). The record also contains the weights which have to be applied before summing up. The further away from the center of the range, the lower the weight (simplified). The range and the weights are independent of y, so the array ContribsX is computed in advance. ContribsY[y] does the same for the source pixels in y-direction. The way the contributors are computed isn't important here, it's done outside of the tasks. Pseudo-Code for computing p(x,y): (ps is a source pixel) (Imagine the weights to be floats, and results being rounded) p(x,y) := 0; for i:=0 to ContribsX[x].high do for j:= 0 to ContribsY[y].high do p(x,y) := p(x,y) + ContribsX[x].Weights[i] * ContribsY[y].Weights[j] * ps(ContribsX[x].min + i, ContribsY[y].min + j); Since this isn't very efficient and can't well be divided into tasks, the averaging in x- and y-direction is done separately. Here's where the routine ProcessColumn comes in, it's the most important procedure, and it writes one column of the target bitmap's memory in 2 steps: PseudoCode for ProcessColumn: (x is given, Compute Column at x) Step 1: resample to intermediate array ColumnX: for ys:= 0 to OldHeight-1 do begin ColumnX[ys] := 0; for i:=0 to ContribsX[x].high do ColumnX[ys] := ColumnX[ys] + ContribsX[x].Weights[i]*ps(ContribsX[x].min +i, ys); end; Step 2: resample ColumnX to the target column: for y := 0 to NewHeight-1 do begin p(x,y):=0; for j := 0 to ContribsY[y].high do p(x,y) := p(x,y) + ContribsY[y].Weights[j]*ColumnX[ContribsY[y].min + j]; end; The tasks just write 4 different chunks of colums, but they all read from the same source-bitmap-memory and from the same contributor-arrays. The original source code is obfuscated by (at least:) 2 things: Values that should be float have been scaled to integers Pointers are used to walk along the arrays I'm afraid that's still too long. ..Make it shorter ...Again, half the size Gruß, Renate -
Parallel Algorithm for resampling bitmaps - very infrequent fails
Renate Schaaf replied to Renate Schaaf's topic in Algorithms, Data Structures and Class Design
I'll try but it ain't easy. More than 10 years ago I spent days reading your code, before I understood what made it tick 🙂 -
MAP2PDB - Profiling with VTune
Renate Schaaf replied to Anders Melander's topic in Delphi Third-Party
That would be great. Here are some relevant lines of the log file, I doubt they are of any use, though: 2021.04.08 14:23:10.909 #DEBUG #PeFile::Open #PeFile.cpp(111) #Executable (PE) C:\Windows\SysWOW64\ntdll.dll opened 2021.04.08 14:23:10.137 #DEBUG #PeFile::InitializeSymbolEngine #PeFile.cpp(699) #Executable (PE) C:\Windows\SysWOW64\ntdll.dll started Symbol Engine initialization 2021.04.08 14:23:10.752 #DEBUG #PeFile::InitializeSymbolEngine #PeFile.cpp(751) #Executable (PE) C:\Windows\SysWOW64\ntdll.dll initialized Symbol Engine: PDB 2021.04.08 14:23:10.662 #DEBUG #PeFile::Open #PeFile.cpp(111) #Executable (PE) D:\DelphiSource\DelphiRio\mystuffR\uProfTest\Win32\Debug\uProfTest.exe opened 2021.04.08 14:23:10.945 #DEBUG #PeFile::InitializeSymbolEngine #PeFile.cpp(699) #Executable (PE) D:\DelphiSource\DelphiRio\mystuffR\uProfTest\Win32\Debug\uProfTest.exe started Symbol Engine initialization 2021.04.08 14:23:10.113 #DEBUG #PeFile::InitializeSymbolEngine #PeFile.cpp(758) #Executable (PE) D:\DelphiSource\DelphiRio\mystuffR\uProfTest\Win32\Debug\uProfTest.exe failed to initialize Symbol Engine: PDB 2021.04.08 14:23:10.740 #DEBUG #PeFile::InitializeSymbolEngine #PeFile.cpp(778) #Executable (PE) D:\DelphiSource\DelphiRio\mystuffR\uProfTest\Win32\Debug\uProfTest.exe initialized Symbol Engine: COFF -
MAP2PDB - Profiling with VTune
Renate Schaaf replied to Anders Melander's topic in Delphi Third-Party
I have tried to make the pdb of a simple console application to work with AMD uProf, but it fails, no matter what I try. But the hotspot feature of VTune works on my AMD system, so I am happy right now. Thanks! Renate -
Just a note: Flickering when using styles can almost completely be eliminated by removing seBorder from the form's style elements. But if you prefer to see the buggy styled caption bar, you're out of luck:)
-
Ok, here is the installable component. The dimming is not tied to visible anymore, but to a property Active, which can only be set at runtime. The control to be dimmed isn't tied to the parent at design time, instead there is a published property DimmedControl, which the parent will be set to at runtime (unless it's nil, then no dimming is possible). At design time the component can be dropped anywhere to design the child controls. DimmedControl can be changed at runtime. The attachment contains packages for runtime and design and a crude demo. I haven't changed aehimself's unit- and class names, which I should have done, but I'm too tired now. I'm using Delphi 10.3.3, it should work for 10.4.*, too. Instructions: Load BuildandDemo.groupproj Build DimPanel.bpl (runtime) for both Win32 and Win64 Build DimPanelD.bpl (design) Install DimPanelD.bpl Open and run DemoDim The component is on the "Additional" tab. If TDimPanel is grayed under Win64, try to close and reopen the IDE. Hope it roughly works 🙂 Edit: Bug in previous attachment The size was not set right initially, has been fixed by an override to Loaded DimPanel.zip
-
If you drop a component, the owner is always the form. That's one of the things. You could of course always drop it on the control you want to dim, then you've got the parent right. But some things need to be disabled at design time, the VisibleChanging for once. I'm working on something that doesn't blow up in your face, lets you design the child controls, and also allows you to specify a dimmed control other than what you can drop it on at design time ... say, a listbox or a pagecontrol. Much of this works really nicely with your runtime-only version. I want to get this done without having to write a designer. Maybe it's not worth the trouble and placing the controls at runtime is easy enough 🙂
-
I would remove the Register-procedure for the time being, it needs a quite a few changes to make it play nicely in the IDE, one sore point is e.g. the re-introduced constructor.
-
MAP2PDB - Profiling with VTune
Renate Schaaf replied to Anders Melander's topic in Delphi Third-Party
Is there any chance that AMD uProf can be used with this? -
Good idea, also it's possible to parent the panel to the pagecontrol (I hadn't thought that it would work, but...). Then you also have the pagecontrol tabs disabled. https://imgur.com/48gzWCX (how do you get images in here?) But for this some small changes must be made: Constructor TDimPanel.Create(inOwner: TWinControl); Begin .......... //******Width/Height instead of ClientWidth/ClientHeight Self.Width := Self.Parent.Width; Self.Height := Self.Parent.Height; Self.Anchors := [akLeft, akTop, akRight, akBottom]; Self.BevelOuter := bvNone; End; Procedure TDimPanel.VisibleChanging; Begin inherited; If Not Self.Visible Then Begin Self.Resize; Self.UpdateBitmap; // UpdateBitmap is not called if Self.Visible is false... //******** Self.BringToFront; //BringToFront isn't called either, necessary for parent is TPageControl End Else _bitmap.SetSize(0, 0); // clear bitmap to free up memory End; Now it would be really nice if one could use it as a component so one can design the controls on it...
-
Dang! That's like the sample I posted and then deleted. There's nothing one can think of without you guys having thought of it before...
-
For very simple forms I use a Fake-Style, which improves drawing immensely. One could call RemoveStyle(self) in OnCreate and FakeStyle(self) in OnCreate or whenever the style changes: uses ... VCL.Controls, VCL.ComCtrls, VCL.Forms, VCL.Themes; //and what I forgot type TCrackControl = class(Vcl.Controls.TControl); procedure RemoveStyle(aControl: TControl); var i: integer; begin if (csDesigning in aControl.ComponentState) then exit; // I like to keep the style of the buttons and TabControls if not((aControl is TButton) or (aControl is TCustomTabControl)) then aControl.StyleElements := []; //keep the scrollbars of scrollboxes but get rid of the form's styled caption bar if (aControl is TScrollingWinControl) and (not(aControl is TForm)) then aControl.StyleElements:=[seBorder]; if aControl is TWinControl then with TWinControl(aControl) do for i := 0 to ControlCount - 1 do RemoveStyle(Controls[i]); end; procedure FakeStyle(aControl: TControl); var BGColor, FontColor { , SelectedColor, SelectedFontColor } : TColor; i: integer; begin if (csDesigning in aControl.ComponentState) then exit; BGColor := StyleServices.GetStyleColor(scWindow); FontColor := StyleServices.GetStyleFontColor(sfWindowTextNormal); TCrackControl(aControl).Font.Color := FontColor; TCrackControl(aControl).Color := BGColor; if aControl is TWinControl then with TWinControl(aControl) do for i := 0 to ControlCount - 1 do FakeStyle(Controls[i]); end;
-
Maybe the bottom half gets alphablended away? I noticed that black vanishes, which I don't understand. Everything is fine, when drawing a colored background first. On resize: You can send the panel to back, redraw its parent, capture the parent's bitmap, send the panel back to front. Surprisingly, there's hardly any flicker when doing this. ------------------------------- unless you use styles
-
Here's a different kind of hack: Design another form with a completely transparent background (transparentColor = true) and borderless. Place the controls you would have on the semitransparent panel on this form instead. When you want to dim your tabsheet, place a blank semitransparent panel as before. Then place the second form on top of the tabsheet and show it. If so desired, you can have the transparent form size and move (WM_Move) with the main form. (In the handler for WM_Move check that the transparent form is assigned, as it is called very early for the main form) Event handlers for the controls on the 2nd form can be assigned in the code of the main form to avoid circular reference. It works so far for me, you can certainly figure out how to deal with the rest of the nooks and crannies. This is fun! Edit: I forgot the styles: you need to remove seClient and seBorder from the style elements of the transparent form
-
As you see, the code I referred to isn't mine, I just found it useful. But let me try 🙂 Edit: The short answer seems to be that it isn't supported. When one tries to remove the layered style from the child controls of the panel they either get invisible or one gets a Win-Error. For the long answer I guess you have to go back to your bitmap-idea. This: https://www.codeguru.com/csharp/csharp/cs_controls/tutorials/article.php/c12323/Creating-NonTransparent-Controls-on-a-SemiTransparent-Window.htm is old, but looks good.
-
Hi, You can use the code in https://www.delphipraxis.net/1486219-post6.html to make a TWincontrol (semi)transparent (not just a stringgrid). Use it for a black panel, set its parentbackground to false and alignClient it on the tabsheet. I tried it with Delphi 10.3.3 CE.
-
How to compare performance between Delphi versions?
Renate Schaaf replied to Mike Torrettinni's topic in General Help
I have 2006 running on Windows 10. As far as I remember it just worked by using disk images of the install disks and running setup.exe manually. I think I also had to run the .net SDK-setup before, separately. -
What are your compiler settings for debug builds?
Renate Schaaf replied to dummzeuch's topic in Delphi IDE and APIs
What is the reason for turning optimization off? Are there any pitfalls when having it on? Edit: I remember now, there are problems with the debugger not showing stuff that's optimized out, is that all?