Jump to content

programmerdelphi2k

Members
 View Profile  See their activity

  • Content Count

    1406

  • Joined

  • Last visited

  • Days Won

    22

Posts posted by programmerdelphi2k

  2. Posted · Edited by programmerdelphi2k

    5 minutes ago, Jud said:

    and the source code for the system unit shows it as an integer function

    in my RAD 11.3 patch 1 ... I DONT HAVE any reference to sources for BlockWrite/BlockRead function!... Find Declaration show nothing!!!

     

    System.pas, line 12283,  function _BlockWrite(var F: TFileRec; Buffer: Pointer; RecCnt: Integer; RecsWritten: PInteger): Integer;

  3. Posted · Edited by programmerdelphi2k

    @Jud

     

    I think that this is +1 error on current Documentation ...

    in https://www.delphibasics.co.uk/RTL.php?Name=BlockWrite  / BlockRead  you'll see that BlockWrite/BlockRead is a "PROCEDURE"... not a function!

    including in FreePascal  https://www.freepascal.org/docs-html/rtl/system/blockwrite.html // blockread.html

    Quote
    Description
    The BlockWrite procedure is used to write to RecordCount data records from Buffer to an untyped binary file given by the FileHandle.

     

    The BlockRead procedure is used to read RecordCount data records into Buffer from an untyped binary file given by the FileHandle.

     

  5. Posted · Edited by programmerdelphi2k

    12 hours ago, Jud said:

    s this a bug or am I wrong?

    better read the "warning" and decide if "you should really still with it"

    Quote

    https://docwiki.embarcadero.com/Libraries/Alexandria/en/System.BlockWrite

    • Warning: This is an older method that is particularly dangerous to use because of the untyped parameter, leading to potential memory corruption.
    • The record size used by BlockWrite and BlockRead is governed by the optional 2nd parameter to the Reset or Rewrite calls used to open the file being written.
    • It is preferable to use streams in your applications. For example, a user procedure involving a stream can use both TMemoryStreams as well as TFileStreams, instead of being limited to using files as happens with these older routines.

     

  7. Posted

    1 hour ago, Uwe Raabe said:

    If the specification were sufficient, I wouldn't have asked my questions.

    I can also interpret that, with advancing age, many things become difficult to interpret or "accept", so, to finish the succinct question and disagreements: YOU WON and I lost! Period!

     

    the said for the unspoken, and, we're all going to have a smooth and cold beer to cool the neurons!

  9. Posted · Edited by programmerdelphi2k

    12 minutes ago, Uwe Raabe said:

    So unless the specification isn't refined any solution

    I think that is "well refined" not? any way...

     

    On 6/23/2023 at 9:40 AM, Henry Olive said:

    I need to find out if there is SUNDAY between 2 dates 

    • For example :
    • StartDate = 06/23/2023 , EndDate = 06/26/2023 ( Result = 1 , Because 06/25/2023 = Sunday )
    • StartDate = 06/23/2023 , EndDate = 07/03/2023 ( Result = 2 , Because there are 2 Sundays )
    • StartDate = 06/23/2023 , EndDate = 06/24/2023 ( Result = 0 )

     

  10. Posted · Edited by programmerdelphi2k

    On 6/23/2023 at 10:53 AM, Uwe Raabe said:

    This is another approach without any loops:

    @Henry Olive

    When evaluating how many "Sundays" between two dates, we must take into account the following:

    • sundays between the two dates: 25, 26, 27, 28, 29, 30, 01, 02 = 0 sundays between 2 dates
    • D1 = Jun/25 2023 = Sunday
    • D2 = Jul/02 2023 = Sunday

    How many "Sundays" are there "BETWEEN" the two dates?
    A: 0 sundays

     

    Using AWE's answer, then, I think it needs revision, no?  *answer = 2 sundays
    That is, as we want to know "how many Sundays exist between two dates, then, we could not take into account the initial and final date, even if they were Sundays, because we are looking for "Sundays between dates", not "Sundays in dates ".

     

    image.png.5d404c7d5b5b95e95cbe6a075a232f8b.png

  11. Posted · Edited by programmerdelphi2k

    here you can study how do it in Android, BUT ... in Android some changes was implemented for new versions, mainly "disk access/folders".

     

    you can use "compiler directives" to separate Android / iOS / WINDOWS  codes.

    https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Conditional_compilation_(Delphi)

     

     

    https://en.delphipraxis.net/topic/4168-fmx-android-using-cam-on-mobile-to-capture-video-and-target-to-timage-permissions-use/?tab=comments#comment-35707

     

  12. Posted

    4 hours ago, dummzeuch said:

    You could simply use Notepad++ to change the line break to Unix and back to Windows.

    another way, you can try this:

    1. copy your problematic text in a any new unit (.PAS) --> you can create using your Notepad/Notepad++/ etc...  or saving your "pasted text" in your current unit in the Editor
    2. now, try open this file in your IDE
      1. normally, the RAD identify that exists some line-feeds non-default (like used in Unix files) and try solve it!

    image.thumb.png.3acc694e487e0ca95e03d37a9389eafe.png

  14. Posted · Edited by programmerdelphi2k

    @kaarigar

     

    you can try some like this:  FIXED 

    implementation

{$R *.fmx}

procedure TForm1.Btn_Create_ItemsClick(Sender: TObject);
const
  LHeaders: array [0 .. 2] of string = ('Header1', 'Header2', 'Header3');
var
  LBGHeader      : TListBoxGroupHeader;
  LBGHeaderHeight: single;
  LBItem         : TListBoxItem;
  LBItemHeight   : single;
  LItemHeight    : single;
  LHowManyItems  : integer;
begin
  // reset all default values...
  ListBox1.Clear;
  ListBox1.ItemHeight := 0;
  ListBox1.ListStyle  := TListStyle.Vertical;
  ListBox1.Columns    := 1;
  //
  LBGHeaderHeight := 19; // default values
  LBItemHeight    := 19;
  LHowManyItems   := 1;
  //
  for var i: integer := 0 to high(LHeaders) do // if headers with distinct height, then needs some calc...
    begin
      LBGHeader      := TListBoxGroupHeader.Create(Self);
      LBGHeader.Text := LHeaders[i];
      ListBox1.AddObject(LBGHeader);
      LBGHeaderHeight := LBGHeader.Height; // here you can verify if a Header is > than before
      //
      LHowManyItems := Trunc(SpinBox1.Value);
      //
      for var j: integer := 1 to LHowManyItems do
        begin
          LBItem      := TListBoxItem.Create(Self);
          LBItem.Text := '... Item' + j.ToString;
          ListBox1.AddObject(LBItem);
          LBItemHeight := LBItem.Height; // if Item with distinct height, then needs some calc...
        end;
    end;
  //
  LItemHeight := ListBox1.ClientHeight - (LBGHeaderHeight + 1); // (LBGHeaderHeight + 1 = line-separator
  LItemHeight := (LItemHeight / (LHowManyItems + 1));           // LHowManyItems + Header
  //
  ListBox1.ItemHeight := LItemHeight;
  ListBox1.ListStyle  := TListStyle.Horizontal;
end;

initialization

ReportMemoryLeaksOnShutdown := true;

end.

     

     

     

    bds_HNxsUzs3zr.gif

    • Like 2

  16. Posted · Edited by programmerdelphi2k

    @Johansy

     

    in fact, you dont needs any 3rd components, you can use native controls in FMX RAD..

    • RAD 11.3
      • 1 TImage to load original image / 1 to preview / 1 to cropping (for my tests)
      • 1 TSelection to "select your area" on screen (in case, in my TImage Original image)
      • a little code to work! if needs more actions, just do it...
        • for example: rotations, Image1.RotationAngle := 90;  ... when cropping you needs rotate the values in Rect( L,T, R, B) etc... nothing complicated at all.
        • for "Position" on Preview or Cropping TImage, just use the coordenates X,Y... not "0,0" ...
        • to Mobiles, use  (in Selection control) a TGestureManager + events as Mouse events!

      

    type
  TForm1 = class(TForm)
    imgOriginal: TImage;
    Selection1: TSelection;
    Rectangle1: TRectangle;
    imgPreview: TImage;
    Label1: TLabel;
    Rectangle2: TRectangle;
    imgCropping: TImage;
    Label2: TLabel;
    Btn_Cropping: TButton;
    procedure Btn_CroppingClick(Sender: TObject);
    procedure Selection1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure FormCreate(Sender: TObject);
    procedure Selection1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure Selection1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
  private
  public
  end;

var
  Form1: TForm1;

implementation

uses
  FMX.MultiResBitmap;

{$R *.fmx}

var
  LRect       : TRect;
  LMovingMouse: boolean = false;

procedure MyCroppingBitmap(ASelX, ASelY, ASelW, ASelH: Single; AImgSrc, AImgTrg: TImage);
var
  LCBItem: TCustomBitmapItem;
begin
  LRect := Rect(Trunc(ASelX), Trunc(ASelY), Trunc(ASelW), Trunc(ASelH));
  //
  if AImgTrg.MultiResBitmap.Count > 1 then
    AImgTrg.MultiResBitmap.Clear; // always you'll have 1 Item!!!
  //
  LCBItem               := AImgTrg.MultiResBitmap.Items[0]; // note: Always exists 1 item!!!
  LCBItem.Bitmap.Width  := Trunc(ASelX + ASelW);
  LCBItem.Bitmap.Height := Trunc(ASelY + ASelH);
  LCBItem.Bitmap.CopyFromBitmap(AImgSrc.Bitmap, LRect, 0, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  imgOriginal.WrapMode := TImageWrapMode.Original; // ?
  imgPreview.WrapMode  := TImageWrapMode.Original; // ?
  imgCropping.WrapMode := TImageWrapMode.Original; // ?
end;

procedure TForm1.Selection1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  LMovingMouse := true;
end;

procedure TForm1.Selection1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  LMovingMouse := false;
end;

procedure TForm1.Selection1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  if LMovingMouse then
    MyCroppingBitmap(                            { }
      Selection1.Position.X,                     { }
      Selection1.Position.Y,                     { }
      Selection1.Position.X + Selection1.Width,  { }
      Selection1.Position.Y + Selection1.Height, { }
      imgOriginal,                               { }
      imgPreview                                 { }
      );
end;

procedure TForm1.Btn_CroppingClick(Sender: TObject);
begin
  MyCroppingBitmap(                            { }
    Selection1.Position.X,                     { }
    Selection1.Position.Y,                     { }
    Selection1.Position.X + Selection1.Width,  { }
    Selection1.Position.Y + Selection1.Height, { }
    imgOriginal,                               { }
    imgCropping                                { }
    );
end;

initialization

ReportMemoryLeaksOnShutdown := true;

end.

    image.png.9ec789ec086b74bb1c4e874d3618c53d.png         image.png.251558665dca32b24d335facf42f4cd5.png

     

    bds_4CK1tgo89c.gif

    • Like 2
    • Thanks 2

  18. Posted · Edited by programmerdelphi2k

    @Uwe Raabe

    • https://community.embarcadero.com/blogs/entry/using-app-tethering-to-enable-codesite-for-tracing-mobile-apps-with-bob-swart
    • Quote

      Delphi App Tethering allows interaction between two applications that can exist on different devices (but must be connected on the same subnet or Bluetooth). Using this technique, I've enabled the CodeSite logging tools to be available for cross-platform app development with Delphi.

       

      Bob Swart Developer Bob Swart Training & Consultancy Bob Swart is a Delphi developer who started programming in Turbo Pascal in 1982. He has written hundreds of technical articles on Delphi software development, and has spoken at developer conferences since 1991. His main areas of interest are DataSnap and Mobile Development with Delphi, but Bob is also quite experienced in helping developers to move legacy applications to recent versions of Delphi, specifically BDE and Unicode related.

       

    Look this:

     

    • Thanks 1

  19. Posted · Edited by programmerdelphi2k

    I think that no really needs "MyReCreatingMyString( ... )" at all...    you can delete it!!!

    • Now, let's study "Natural Sort Order..." ...  🙂 

      

    unit uMyTools;

interface

function MyNormalizeString(AStr: string; AValLength: byte = 10): string;

implementation

uses
  System.SysUtils,
  System.StrUtils;

const
  LMyDigits: TSysCharSet = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];

function MyNormalizeString(AStr: string; AValLength: byte = 10): string;
var
  LStr: string;
  LVal: string;
  LEnd: integer;
begin
  LStr := '';
  LVal := '';
  LEnd := AStr.Length;
  //
  { ex. Text1 and Text1234567890 and Text123456789012345 = part complex!!!  AValLength := ?
    Text0000000001
    Text1234567890
    Text123456789012345
    //
    ... we can have it with distinct length, then we use an arbitrary value!
  }
  if (AValLength < 10) then
    AValLength := 10
  else
    if (AValLength > 20) then
      AValLength := 20;
  //
  for var i: integer := 1 to LEnd do
    begin
      if CharInSet(AStr[i], LMyDigits) then
        begin
          LVal := LVal + AStr[i];
          //
          if ((i + 1) <= LEnd) and not(CharInSet(AStr[i + 1], LMyDigits)) then
            begin
              LStr := LStr + DupeString('0', AValLength - LVal.Length) + LVal;
              LVal := '';
            end;
        end
      else
        LStr := LStr + AStr[i];
    end;
  //
  if not LVal.IsEmpty then
    LVal := DupeString('0', AValLength - LVal.Length) + LVal;
  //
  result := LStr + LVal;
end;

end.

      

    function MyStringListCustomSort(SL: TStringList; ALeft, ARight: integer): integer;
var
  LCLeft, LCRight  : string;
  CmpLeft, CmpRight: string;
begin
  LCLeft  := LowerCase(SL[ALeft]);
  LCRight := LowerCase(SL[ARight]);
  //
  CmpLeft  := MyNormalizeString(LCLeft);
  CmpRight := MyNormalizeString(LCRight);
  //
  result := CompareStr(CmpLeft, CmpRight);
  //
  if (result = 0) then
    result := CompareStr(LCLeft, LCRight);
end;

     

    • Like 1

  21. Posted · Edited by programmerdelphi2k

    @Bart Verbakel

     

    did you see this:  https://docwiki.embarcadero.com/RADStudio/Alexandria/en/W1057_Implicit_string_cast_from_'%s'_to_'%s'_(Delphi) 

    <your_target_string> := string(<your_ansi_source); // explicitly before usage, avoid implicity convertion

    NOTE: See too https://docwiki.embarcadero.com/RADStudio/Alexandria/en/W1059_Explicit_string_cast_from_'%s'_to_'%s'_(Delphi)   (Explictiy: warning )

     

    As rule: avoid ShortString in new IDE! or use "compiler directives" {$IFDEF VER350} xxxx {$ELSE} wwww {$ENDIF}

    https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions

    https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Conditional_compilation_(Delphi)

  23. Posted · Edited by programmerdelphi2k

    Please don't be harsh with the comments...

     

    • The principle is to identify the digits (numbers) contained in the text, add a bunch of "zeros" (to imitate the conversion into numerical values, but avoiding an "overflow" if using any text-to-number conversion function) and then represent them as their numerical value through the "ORD()" function.
    • In this way, we avoid a possible "overflow exception", and we will be able to compare the strings (re-created for comparison purposes only) that are stored in a StringList or similar...

     

    I don't know if I managed to explain it well, but it needs testing... maybe in other languages.

     

      

    unit uMyTools;

interface

function MyNormalizeString(AStr: string; ASizeValue: byte = 10): string;
function MyReCreatingMyString(AString: string): string;

implementation

uses
  System.SysUtils,
  System.StrUtils;

const
  LMyDigits: TSysCharSet = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];

function MyNormalizeString(AStr: string; ASizeValue: byte = 10): string;
var
  LStr: string;
  LVal: string;
  LEnd: integer;
begin
  LStr := '';
  LVal := '';
  LEnd := AStr.Length;
  //
  if not(ASizeValue in [10 .. 20]) then
    ASizeValue := 10;
  //
  for var i: integer := 1 to LEnd do
    begin
      if CharInSet(AStr[i], LMyDigits) then
        begin
          LVal := LVal + AStr[i];
          //
          if ((i + 1) <= LEnd) then
            begin
              if not(CharInSet(AStr[i + 1], LMyDigits)) then
                begin
                  LStr := LStr + DupeString('0', ASizeValue - LVal.Length) + LVal;
                  LVal := '';
                end;
            end;
        end
      else
        begin
          LStr := LStr + AStr[i];
        end;
    end;
  //
  if not LVal.IsEmpty then
    LVal := DupeString('0', ASizeValue - LVal.Length) + LVal;
  //
  result := LStr + LVal;
end;

function MyReCreatingMyString(AString: string): string;
var
  LStr: string;
begin
  result := '';
  //
  LStr := MyNormalizeString(AString);
  //
  for var C in LStr do
    begin
      if CharInSet(C, LMyDigits) then
        result := result + ord(C).ToString
      else
        result := result + C;
    end;
end;

end.

     

    Testing....

      

    implementation

{$R *.dfm}

uses
  uMyTools;

function MyStringListCustomSort(SL: TStringList; ALeft, ARight: integer): integer;
var
  LCLeft, LCRight  : string;
  CmpLeft, CmpRight: string;
begin
  LCLeft  := LowerCase(SL[ALeft]);
  LCRight := LowerCase(SL[ARight]);
  //
  CmpLeft  := MyReCreatingMyString(LCLeft);
  CmpRight := MyReCreatingMyString(LCRight);
  //
  result := CompareStr(CmpLeft, CmpRight);
  //
  if (result = 0) then
    result := CompareStr(LCLeft, LCRight);
end;

procedure TForm1.Btn_CustomSortClick(Sender: TObject);
var
  SL: TStringList;
begin
  Memo1.Lines.Clear;
  //
  SL := TStringList.Create;
  try
    SL.Sorted     := false;
    SL.Duplicates := TDuplicates.dupAccept;
    //
    SL.Add('Delphi1World1Hello Windows'); // 1 space
    SL.Add('hello2');
    SL.Add('hello10');
    SL.Add('hello1');
    SL.Add('hello4');
    SL.Add('delphi  2'); // 2 spaces
    SL.Add('hello 000'); // 1 space
    SL.Add('delphi');
    SL.Add('hello3');
    SL.Add('Delphi3 World2023'); // 1 space
    SL.Add('Custom');
    SL.Add('delphi 2');            // 1 space
    SL.Add('Delphi1.5World10 11'); // 1.5 - 1 space
    SL.Add('World');
    SL.Add('Delphi 1'); // 1 space
    SL.Add('A B C');    // 1 space + 1 space
    SL.Add('hello000'); // 0 space
    SL.Add('abc');
    SL.Add('delphi 2'); // 1 space
    SL.Add('');         // EMPTY!!!
    SL.Add('Delphi10');
    SL.Add('Delphi1');
    SL.Add('Delphi13');
    SL.Add('Delphi1.5World10 21'); // 1.5 - 1 space
    SL.Add('Delphi001');
    SL.Add('Delphi3');
    SL.Add('Delphi3World2023');
    SL.Add('Delphi3 Hi!');                  // 1 space
    SL.Add('Delphi 5');                     // 1 space
    SL.Add('Delphi1.2World1Hello Windows'); // 1 space
    SL.Add('Delphi2');
    SL.Add('Delphi01');
    SL.Add('Delphi 3World2023'); // 1 space
    SL.Add('Delphi 1');          // 1 space
    SL.Add('Delphi12');
    SL.Add('Delphi4');
    SL.Add('Delphi2.5World2022'); // 2.5
    SL.Add('Hello3.5');
    //
    SL.CustomSort(@MyStringListCustomSort);
    //
    Memo1.Lines.AddStrings(SL);
  finally
    SL.Free;
  end;
end;

initialization

ReportMemoryLeaksOnShutdown := true;

end.

    image.thumb.png.e3d579337bb0189f623af820f3e39fb1.png

     

    • Like 1

  24. Posted

    @amit

     

    you can try this way:

    1. create a bat file with your logic  ( you'll need define a enviroment var with your new-name, for example...)
    2. using the Post-Build event you can call it 
    rem --- OldName = full path + filename = c:\...\MyOldName.exe
set OldName=%1

rem --- NewName =  new file name       =  MyNewName.txt
set NewName=MyNewName.exe

rem ---------- renaming file -----------
ren  %OldName%  %NewName%  > texto.txt

     

     

    image.thumb.png.a6cf7f5b0550132d854ebfe5b6bc145c.png

×