Jump to content

Leaderboard


Popular Content

Showing content with the highest reputation on 02/10/23 in all areas

  1. Anders Melander

    Resize PNG in Delphi 11

    Just so you know, while all the code in this thread might be fine for "I'm a hobbyist and I don't know what the hell I'm doing"-level programming, it's nowhere near the best or correct way to solve your problem. With that said, the reason you're losing transparency is that you are operating on the rendered visual representation of the image. Therefore the transparency has been replaced with a background color. In order to resize a PNG without losing transparency you will need to use a method that supports alpha transparency. This means: Convert the PNG to a 32-bit RGBA bitmap. Resample (resize) this bitmap to the desired size. Convert the bitmap to PNG. There are various libraries that can do these steps for you. For example Graphics32 and probably also Image32. I'm guessing Image32 will probably be the easiest for you to understand.
  2. David Heffernan

    Nested TParallel.For: Immediate deadlock

    Likely because it has been properly designed by skilled practitioners in this field.
  3. programmerdelphi2k

    Resize PNG in Delphi 11

    not for that
  4. programmerdelphi2k

    Resize PNG in Delphi 11

  5. programmerdelphi2k

    Resize PNG in Delphi 11

    sorry Melander, as you know my knowledge is not near your, but it's the life!!! Luck for us "have someone like you" for fix our error! go ahead... in my test, the "Ironman - result.png" have background transparent
  6. programmerdelphi2k

    Error in module rtl200.bpl

    I have this too! sometimes... but I dont know what do it... RAD 11.2 ( sometimes I see that LSP stop, then, maybe be this )
  7. david_navigator

    Converting Python code to Delphi

    why didn't I think of asking #AI ?? can you explain what this python code does ? def marsaglia_xorshift_128(x = 123456789, y = 362436069, z = 521288629, w = 88675123): while True: t = (x ^ (x << 11)) & 0xffffffff x, y, z = y, z, w w = (w ^ (w >> 19) ^ (t ^ (t >> 8))) yield w This is a Python function that implements the Marsaglia Xorshift 128 random number generator algorithm. The function takes four parameters x, y, z, and w which serve as the seed values for the generator. The function contains an infinite loop that generates random numbers using the Xorshift 128 algorithm. The loop uses bitwise operations to perform the necessary calculations to generate a new random number on each iteration. The t variable is calculated by performing a bitwise XOR operation on x shifted left by 11 bits and x, and then taking the result and performing a bitwise AND with the hexadecimal value 0xffffffff. The purpose of this calculation is to produce a new value for t that is used in the calculation of the next random number. Next, x, y, and z are updated by taking the previous values of y, z, and w. w is then calculated by performing a series of bitwise XOR and right-shift operations. The yield statement returns the new value of w on each iteration of the loop. This allows the function to be used as a generator that can be used to produce an infinite sequence of random numbers. Each time the function is called with the same seed values, it will produce the same sequence of random numbers. To get a different sequence, the seed values must be changed.
  8. Anders Melander

    Nested TParallel.For: Immediate deadlock

    Okay so I've looked into this some more and I've got good news and bad news: The bad news is that this is probably "as designed". The good news, well I lied; There isn't any good news. If we look at other thread pool implementations "properly designed by skilled practitioners", the old Win32 thread pools also had a hard upper limit on the number of threads in a pool and suffered from the exact same problem. The newer Vista thread pools are a bit more clever but it still has an upper limit (I believe the default max is 500 threads) and suffered from the exact same problem. Same with .NET thread pools (which are a rewrite of Win32 thread pools); For CLR 2.0 the max is 25 threads per core and for 2.0SP1 the max is 250 per core. The reason for this tenfold increase in default max is actually to avoid experiencing deadlocks caused by running out of threads quite so often. Thus .NET too suffers from the exact same problem. See Concurrent Programming on Windows, chapter 7 for a discussion on all this. So the problem is that the RTL thread pool imposes a hard upper limit on the number of threads in it and that the limit is way too small. Ideally what we'd like, in this case, is for the growth algorithm to be a bit more intelligent and flexible but I doubt that will happen. The easy solution is probably to just increase the max and hope for the best 😕 . I still believe that the library should detect (and fail on) the simple case when all threads are blocked waiting for a thread to become available. It's relatively unlikely that this will occur in real code (there are many other things, not controlled by the PPL, that a thread can wait on) but it's so simple to implement that I believe it's worth the effort.
  9. Dalija Prasnikar

    Nested TParallel.For: Immediate deadlock

    The problem happens when outer For loop consumes all available threads and hits maximum where no new threads are being allocated for newly requested task. And then if inner tasks cannot get free thread to run, they cannot complete their job. I have test case that will break more easily as number of needed threads is higher, and sleep also increases the time inner thread runs and gives more time for outer for loop to consume all available threads. Using separate pool for inner for loop solves the problem. This can still be an issue if you have code that indirectly uses nested parallel loops. begin var counter := 0; var pool := TThreadPool.Create; const COUNT = TThreadPool.Default.MaxWorkerThreads * 4; TParallel.For( 0, Pred(count), procedure(i: Int64) begin TParallel.For( 0, Pred(count), procedure(i: Int64) begin TInterlocked.Increment(counter); Sleep(10); end , pool); end ); Writeln(counter); Readln; end. Probably the best solution for parallel for loops that can spawn too many tasks would be to create dedicated thread pool for each loop. The cost of creating a thread pool is not big when dealing with longer running tasks. And for fast running tasks, like in this example, parallel loop is overkill anyway as it can run slower than simple for loop in single task.
  10. Fr0sT.Brutal

    Move objects to a second Data Module

    In fact, Delphi teaches us bad things with all this visual & RAD button-dropping. It's good for small apps but when they grow, old habits remain and lead to these nightmare. I was in the same situation with an app started when I started learning Delphi so it's evolving with me. In that app I significantly reduced the number of objects in datamodules by changind all temporary queries (that is, those which do not have any datasource attached) from design-time components to temporary objects created at run-time. Their SQLs are defined as literals in datamodule unit and field list is generated dynamically. And with interface-based wrapper the code is pretty simple with GetTempQuery(Database).Q do begin SQL.Text := SQL_Insert; Params ... ExecSQL; end;
  11. you can try some like this: your JSON have 3 levels, then, you can see the values to store on table fields using the JSON class from Delphi of course, the "RECURSIVE" procedure would help here! {$R *.dfm} uses System.Generics.Collections, System.JSON; procedure TForm1.Button1Click(Sender: TObject); var LJSvalueLvl1: TJSONValue; LJSvalueLvl2: TJSONValue; LJSvalueLvl3: TJSONValue; LJSarrayLvl1: TJSONArray; LJSarrayLvl2: TJSONArray; LJSarrayLvl3: TJSONArray; LJSobjLvl1 : TJSONObject; LJSobjLvl2 : TJSONObject; LJSobjLvl3 : TJSONObject; begin // considering your JSON with 3 levels = 3 arrays! // 3 levels = Master-Details tables! // // LJSobjLvlXXX.Pairs[ xxx ].JsonString = field-names // LJSobjLvlXXX.Pairs[ xxx ].JsonValue = field-values // // TableXXX.FieldByName( LJSobjLvlXXX.Pairs[ xxx ].JsonString.ToString ).AsXXXXX := valueXXXX // valueXXXX = LJSobjLvlXXX.Pairs[ xxx ].JsonValue.ToString / "asType<T>" = "value-as-type-XXXX" // LJSvalueLvl1 := TJSONObject.ParseJSONValue(Memo1.Text, true, true); // if well-formed go ahead... // if LJSvalueLvl1 is TJSONArray then begin LJSarrayLvl1 := TJSONArray(LJSvalueLvl1); // for var I: integer := 0 to LJSarrayLvl1.Count - 1 do begin LJSvalueLvl1 := TJSONValue(LJSarrayLvl1[I]); // if LJSvalueLvl1 is TJSONObject then begin LJSobjLvl1 := TJSONObject(LJSvalueLvl1); // for var j: integer := 0 to (LJSobjLvl1.Count - 1) do begin Memo2.Lines.Add('Lvl 1 = ' + LJSobjLvl1.Pairs[j].JsonString.ToString); // if LJSobjLvl1.Pairs[j].JsonValue is TJSONArray then begin LJSarrayLvl2 := TJSONArray(LJSobjLvl1.Pairs[j].JsonValue); // for var k: integer := 0 to (LJSarrayLvl2.Count - 1) do begin LJSvalueLvl2 := TJSONValue(LJSarrayLvl2[I]); // if LJSvalueLvl2 is TJSONObject then begin LJSobjLvl2 := TJSONObject(LJSvalueLvl2); // for var l: integer := 0 to (LJSobjLvl2.Count - 1) do begin Memo2.Lines.Add('______Lvl 2 = ' + LJSobjLvl2.Pairs[l].JsonString.ToString); // if LJSobjLvl2.Pairs[l].JsonValue is TJSONArray then begin LJSarrayLvl3 := TJSONArray(LJSobjLvl2.Pairs[l].JsonValue); // for var m: integer := 0 to (LJSarrayLvl3.Count - 1) do begin LJSvalueLvl3 := TJSONValue(LJSarrayLvl3[m]); // if LJSvalueLvl3 is TJSONObject then begin LJSobjLvl3 := TJSONObject(LJSvalueLvl3); // for var n: integer := 0 to (LJSobjLvl3.Count - 1) do begin // TJSONObject = values from Lvl3 Memo2.Lines.Add('____________Lvl 3 = ' + LJSobjLvl3.Pairs[n].JsonString.ToString + '=' + LJSobjLvl3.Pairs[n].JsonValue.ToString); end; end; end; end else // TJSONObject = values from Lvl2 begin LJSobjLvl3 := TJSONObject(LJSobjLvl2.Pairs[l].JsonValue); Memo2.Lines.Add('_________Lvl 2 = value = ' + LJSobjLvl3.ToString); end; end; end; end; end else // TJSONObject = values from Lvl1 Memo2.Lines.Add('___Lvl 1 = value = ' + LJSobjLvl1.Pairs[j].JsonValue.ToString); end; end; end; end; end; end.
  12. Use this project to create some delphi objects that will make it easy to read the file https://github.com/PKGeorgiev/Delphi-JsonToDelphiClass
  13. KodeZwerg

    More precise countdown

    @programmerdelphi2k updated to the method you mentioned, thanks @aehimself updated to a more stable version that can run multiple times unit kz.Windows.Timer; interface uses Winapi.Windows, Winapi.Messages, Vcl.Forms, System.Classes; type TkzTimer = class(TComponent) strict private FEnabled: Boolean; FInterval: DWORD; FOnTimer: TNotifyEvent; FHandle: THandle; private FHWND: HWND; private procedure EnableTimer; procedure DisableTimer; procedure SetEnabled(const AValue: Boolean); procedure SetInterval(const AValue: DWORD); protected procedure WndProc(var Message: TMessage); procedure DoTimer; virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Enabled: Boolean read FEnabled write SetEnabled default False; property Interval: DWORD read FInterval write SetInterval default 1000; property OnTimer: TNotifyEvent read FOnTimer write FOnTimer; end; implementation procedure TimerCallback(lpParameter: TkzTimer; TimerOrWaitFired: Boolean); StdCall; begin Winapi.Windows.PostMessage(lpParameter.FHWND, (WM_APP + 666), 0, 0); end; procedure TkzTimer.DoTimer; begin if Assigned(FOnTimer) then FOnTimer(Self); end; procedure TkzTimer.WndProc(var Message: TMessage); begin case Message.Msg of (WM_APP + 666): try DoTimer; except Vcl.Forms.Application.HandleException(Self); end else Message.Result := Winapi.Windows.DefWindowProc(FHWND, Message.Msg, Message.WParam, Message.LParam); end; end; constructor TkzTimer.Create(AOwner: TComponent); begin inherited Create(AOwner); FEnabled := False; FInterval := 1000; FOnTimer := nil; FHandle := Winapi.Windows.INVALID_HANDLE_VALUE; FHWND := System.Classes.AllocateHWnd(WndProc); end; destructor TkzTimer.Destroy; begin FOnTimer := nil; DisableTimer; System.Classes.DeallocateHWnd(FHWND); inherited Destroy; end; procedure TkzTimer.SetEnabled(const AValue: Boolean); begin if AValue then EnableTimer else DisableTimer; end; procedure TkzTimer.SetInterval(const AValue: DWORD); begin FInterval := AValue; if (FInterval < 1) then FInterval := 1; if FEnabled then EnableTimer; end; procedure TkzTimer.EnableTimer; begin if (FHandle <> Winapi.Windows.INVALID_HANDLE_VALUE) then DisableTimer; FEnabled := Winapi.Windows.CreateTimerQueueTimer(FHandle, 0, @TimerCallback, Self, FInterval, FInterval, Winapi.Windows.WT_EXECUTEDEFAULT or Winapi.Windows.WT_EXECUTELONGFUNCTION); end; procedure TkzTimer.DisableTimer; begin if Winapi.Windows.DeleteTimerQueueTimer(0, FHandle, 0) then begin FHandle := Winapi.Windows.INVALID_HANDLE_VALUE; FEnabled := False; end; end; end. Alpha version 🙂
  14. limelect

    More precise countdown

    Found on my disk microsecnd timer.zip
  15. programmerdelphi2k

    More precise countdown

    try this for verify your time: implementation {$R *.dfm} uses System.DateUtils; var LOldNow: TDateTime = 0; LText : string; procedure TForm1.FormCreate(Sender: TObject); begin Timer1.Interval := 1 { ms }; // 15ms mininum to return a value! end; procedure TForm1.Button1Click(Sender: TObject); begin LText := ''; LOldNow := now; Timer1.Enabled := true; end; procedure TForm1.Button2Click(Sender: TObject); begin Timer1.Enabled := false; // Memo1.Lines.Delimiter := '='; Memo1.Lines.DelimitedText := LText.Remove(0, 1); end; procedure TForm1.Timer1Timer(Sender: TObject); begin // processing time "without" visual interference!!! in release mode LText := LText + '=' + MilliSecondSpan(now, LOldNow).ToString; // LOldNow := now; end; end. I think that you'll need some "library" 3rd-party for that or you can read this article https://www.thedelphigeek.com/2007/10/calculating-accurate.html
  16. david_navigator

    Does ChatAI make StackOverflow obsolete ?

    That's the experience I've had. Each sample of code has not compiled out of the box, but fixing it has given me an understanding of the code or pointed me in the direction of something I didn't know about.
×