Jump to content

Leaderboard


Popular Content

Showing content with the highest reputation on 02/06/25 in all areas

  1. When using VarSameValue(), you can get a conversion failure if the 2 Variants are not holding compatible types. This is even stated in the documentation: So, you should first make sure the 2 Variants have the same type before comparing their values. This is just logical to do anyway, since if you know they have different types then there is no point in wasting resources to compare the values. When I make these small changes to TTestComponent, the "Could not convert variant" error goes away: procedure TTestComponent.SetCheckedValue(const Value: Variant); begin if (VarType(FCheckedValue) <> VarType(Value)) or // <-- ADD THIS! (not VarSameValue(FCheckedValue, Value)) then begin FCheckedValue := Value; CheckedValueChanged(); end; end; function TTestComponent.IsCheckedValueStored: Boolean; begin Result := (VarType(FCheckedValue) <> varBoolean) or // <-- ADD THIS! (not VarSameValue(FCheckedValue, True)); end; Now, that just leaves the problem of the 'CheckedValue.Type' property displaying "Unknown" for string values. That is indeed a bug in the default Variant property editor, which I have now reported to Embarcadero: RSS-2844; TVariantTypeProperty is broken for string values You can easily work around the bug, either directly in your component's property setter: procedure TTestComponent.SetCheckedValue(const Value: Variant); begin if (VarType(FCheckedValue) <> VarType(Value)) or (not VarSameValue(FCheckedValue, Value)) then begin FCheckedValue := Value; if VarType(FCheckedValue) = varString then FCheckedValue := VarToStr(Value); // <-- change the VarType to varUString CheckedValueChanged(); end; end; Or by deriving a custom property editor in your component's design-time package (if you don't have one, make one) to fix the bug directly: uses Variants, DesignIntf, DesignEditors, DesignConst; //... { TMyVariantTypeProperty } // unfortunately, TVariantTypeProperty is hidden in the implementation // of the DesignEditors unit, so we have to copy the entire class just // to change a couple of lines! const VarTypeNames: array[varEmpty..varInt64] of string = ( 'Unassigned', // varEmpty 'Null', // varNull 'Smallint', // varSmallint 'Integer', // varInteger 'Single', // varSingle 'Double', // varDouble 'Currency', // varCurrency 'Date', // varDate 'OleStr', // varOleStr '', // varDispatch '', // varError 'Boolean', // varBoolean '', // varVariant '', // varUnknown '', // [varDecimal] '', // [undefined] 'Shortint', // varShortInt 'Byte', // varByte 'Word', // varWord 'LongWord', // varLongWord 'Int64'); // varInt64 type TMyVariantTypeProperty = class(TNestedProperty) public function AllEqual: Boolean; override; function GetAttributes: TPropertyAttributes; override; function GetName: string; override; function GetValue: string; override; procedure GetValues(Proc: TGetStrProc); override; procedure SetValue(const Value: string); override; end; function TMyVariantTypeProperty.AllEqual: Boolean; var i: Integer; V1, V2: Variant; begin Result := False; if PropCount > 1 then begin V1 := GetVarValue; for i := 1 to PropCount - 1 do begin V2 := GetVarValueAt(i); if VarType(V1) <> VarType(V2) then Exit; end; end; Result := True; end; function TMyVariantTypeProperty.GetAttributes: TPropertyAttributes; begin Result := [paMultiSelect, paValueList, paSortList]; end; function TMyVariantTypeProperty.GetName: string; begin Result := 'Type'; end; function TMyVariantTypeProperty.GetValue: string; begin case VarType(GetVarValue) and varTypeMask of Low(VarTypeNames)..High(VarTypeNames): Result := VarTypeNames[VarType(GetVarValue) and varTypeMask]; varString,varUString: // <-- FIX HERE! Result := SString; else Result := SUnknown; end; end; procedure TMyVariantTypeProperty.GetValues(Proc: TGetStrProc); var i: Integer; begin for i := 0 to High(VarTypeNames) do if VarTypeNames[i] <> '' then Proc(VarTypeNames[i]); Proc(SString); end; procedure TMyVariantTypeProperty.SetValue(const Value: string); function GetSelectedType: Integer; var i: Integer; begin Result := -1; for i := 0 to High(VarTypeNames) do if VarTypeNames[i] = Value then begin Result := i; break; end; if (Result = -1) and (Value = SString) then Result := varUString; // <-- FIX HERE! end; var NewType: Integer; V: Variant; begin NewType := GetSelectedType; case NewType of varEmpty: VarClear(V); varNull: V := NULL; -1: raise EDesignPropertyError.CreateRes(@SUnknownType); else V := GetVarValue; // <-- move here for good measure... try VarCast(V, V, NewType); except { If it cannot cast, clear it and then cast again. } VarClear(V); VarCast(V, V, NewType); end; end; SetVarValue(V); end; { TMyVariantProperty } // fortunately, TVariantProperty is public in the DesignEditors unit, // so we need to override only 1 method in it... type TMyVariantProperty = class(TVariantProperty) procedure GetProperties(Proc: TGetPropProc); override; end; procedure TMyVariantProperty.GetProperties(Proc: TGetPropProc); begin Proc(TMyVariantTypeProperty.Create(Self)); end; procedure Register; begin //... // change the 2nd and 3rd properties if you want to reuse this editor for all Variant properties, eg: // RegisterPropertyEditor(TypeInfo(Variant), nil, '', TMyVariantProperty); RegisterPropertyEditor(TypeInfo(Variant), TTestComponent, 'CheckedValue', TMyVariantProperty); end;
  2. Anders Melander

    Enable Discussions on github ?

    One thing you can do, to direct activity to the discussions, is to convert issues to discussion unless they actually pertain to an acknowledged bug or an accepted change/feature/enhancement. That way the issue list becomes a list of work items and the discussions everything else.
  3. Remy Lebeau

    Enable Discussions on github ?

    I went ahead and enabled Discussions on GitHub. We'll see how it works out. I'll still monitor this forum and others, of course.
  4. George Bairaktaris

    Wordpress upload media

    Final Code that works with TSslHttpRest procedure TForm1.UploadImageToWordPress(const URL, Username, Password, FilePath: string); var HttpRest: TSslHttpRest; ResponseCode: Integer; ResponseText: string; begin HttpRest := TSslHttpRest.Create(nil); try HttpRest.OnHttpRestProg := onSslHttpRestProg ; HttpRest.ServerAuth := httpAuthBasic; HttpRest.Username := Username; HttpRest.Password := Password; HttpRest.RestParams.PContent:=PContFormData; HttpRest.ExtraHeaders.Add('form-data; filename="anyname.jpg"'); HttpRest.ExtraHeaders.Add('application/json; charset= UTF-8'); HttpRest.RestParams.AddItemFile('file', FilePath, 0); HttpRest.HttpUploadStrat := HttpUploadNone; ResponseCode := HttpRest.RestRequest(httpPOST, URL, False, ''); ResponseText := HttpRest.ResponseRaw; LogWin.Lines.Add('Response Code: ' + IntToStr(ResponseCode)); LogWin.Lines.Add('Response Text: ' + ResponseText); finally HttpRest.Free; end; end; The tricky part was in HttpRest.RestParams.AddItemFile('file', FilePath, 0); First parameter needs to say "file". Thank you all for your time.
  5. I ended up using the code from this page, and it seems to be working https://docwiki.embarcadero.com/RADStudio/Athens/en/Taking_Pictures_Using_FireMonkey_Interfaces
  6. Is there any way to train an AI model with Remy's brain?
  7. You keep demonstrating for us that you do not even understand the API. Your original question would have been answered by just looking at the documentation for ShowModal, or by examining the source code to see how the modal loop is implemented. You wouldn't bother to do that, and you feel qualified to make pronouncements on the overall design quality. Maybe let it go.
  8. To improve rendering performance, set StorePaintBuffer to True on parent controls from the package. By default it is True in some controls, in some False.
  9. Or make fewer circular references. Moving everything in the code to interface section is wrong. It is well known fact that the uses are only for those units that are required in the interface section, everything else must go into the implementation section. Other crucial thing is to remove the Unit Scope names and in code use only fully qualified unit names. This was important in older versions of Delphi (there were problems with unit name caching).
  10. Alexander Halser

    Loading a JPEG into FMX.TBitmap honoring EXIF orientation

    I wonder if anyone is interested in a solution... 😉 Just in case you are, here is what I did. Neither FMX nor VCL will honor the orientation information in the EXIF header inside the JPEG. For FMX: neither on Windows nor on macOS. And probably not on iOS, either. For Android and Linus, you need to test for yourself, maybe they do. The only solution is to read the EXIF header, extract the Orientation tag and apply the necessary transformations to the image after loading. There are several components for Delphi to read EXIF headers, some do work, some don't. The best known unit is CCR-Exif (https://github.com/Wolfcast/ccr-exif), which does everything and works quite well. It can read and write EXIF tags. I've created my own, because CCR-Exif seems like overkill (after all, I just want to know 1 single byte in the JPEG) If you want to display JPEG images correctly in your FMX application, I have published my little unit on SourceForge, It's as small and fast as possible with really minimal overhead. The first function JPEGRotationFromStream() will work for VCL as well! So you can adapt it and use it for your VCL app, too. But FMX has this nice little class called TBitmapSurface, which easily does the Rotate, Mirror and Flip transformations that are required to display the JPEG correctly. So, for FMX this unit goes the full length and delivers a TBitmap that's just right. The unit might be useful for VCL as well, but you have to go an extra mile to apply the transformations. SourceForge Download: https://sourceforge.net/projects/delphi-fmx-jpeg-loader-exif/
  11. Well it's a good opportunity to have time to learn Delphi at somone elses expense. Great to have a project to work on where anything you do that isn't a complete failure is considered a good result. I can't think of a better project to learn on !
  12. ioan

    Enable Discussions on github ?

    I love this forum, but I believe discussions about an open-source project should take place where the sources are. As long as the project remains of interest, it will always be easy for anyone to read the archives and find solutions.
  13. One. Generics allow the tags to be quickly set to the Sims IC initial conditions, adjusted with the various faceplates and output to the UI chart and legends. as so TsimUIout = Record faceplate: Tform; Controller:Tsimcontroller; Value: Pdouble; Span, Min: Integer; end; procedure Update; Compute; var UIstuff := TList<^TmyUIout>; for var ui in UIstuff do update; end; Two. Use a transpiler pas2js can emit JS that runs on a browser. Three. Value = validity, number of seats , subject matter. If the simulator can increase interaction and communication between the crew members during training-- knowledge transfer plus teamwork can happen 🙂
×