Changeset 447 for trunk/Packages/Common
- Timestamp:
- May 19, 2022, 10:39:34 PM (2 years ago)
- Location:
- trunk/Packages/Common
- Files:
-
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/Common.pas
r396 r447 37 37 RegisterPackage('Common', @Register); 38 38 end. 39 -
trunk/Packages/Common/StopWatch.pas
r424 r447 35 35 implementation 36 36 37 constructor TStopWatch.Create(const startOnCreate : boolean = false) ;37 constructor TStopWatch.Create(const startOnCreate : Boolean = False) ; 38 38 begin 39 39 inherited Create; … … 72 72 begin 73 73 dt := ElapsedMiliseconds / MSecsPerSec / SecsPerDay; 74 result := Format('%d days, %s', [Trunc(dt), FormatDateTime('hh:nn:ss.z', Frac(dt))]) ;74 Result := Format('%d days, %s', [Trunc(dt), FormatDateTime('hh:nn:ss.z', Frac(dt))]) ; 75 75 end; 76 76 … … 93 93 94 94 end. 95 -
trunk/Packages/Common/UAboutDialog.pas
r424 r447 51 51 end. 52 52 53 -
trunk/Packages/Common/UCommon.pas
r424 r447 42 42 clLightRed = TColor($8080FF); 43 43 44 function AddLeadingZeroes(const aNumber, Length : integer) : string;44 function AddLeadingZeroes(const aNumber, Length : Integer) : string; 45 45 function BinToInt(BinStr: string): Int64; 46 46 function BinToHexString(Source: AnsiString): string; … … 96 96 function BinToInt(BinStr : string) : Int64; 97 97 var 98 i : byte;98 I : Byte; 99 99 RetVar : Int64; 100 100 begin 101 101 BinStr := UpperCase(BinStr); 102 if BinStr[ length(BinStr)] = 'B' then Delete(BinStr,length(BinStr),1);102 if BinStr[Length(BinStr)] = 'B' then Delete(BinStr,Length(BinStr),1); 103 103 RetVar := 0; 104 for i := 1 to length(BinStr) do begin105 if not (BinStr[ i] in ['0','1']) then begin104 for I := 1 to Length(BinStr) do begin 105 if not (BinStr[I] in ['0','1']) then begin 106 106 RetVar := 0; 107 107 Break; 108 108 end; 109 RetVar := (RetVar shl 1) + ( byte(BinStr[i]) and 1) ;109 RetVar := (RetVar shl 1) + (Byte(BinStr[I]) and 1) ; 110 110 end; 111 111 … … 435 435 end; 436 436 437 function AddLeadingZeroes(const aNumber, Length : integer) : string;437 function AddLeadingZeroes(const aNumber, Length : Integer) : string; 438 438 begin 439 439 Result := SysUtils.Format('%.*d', [Length, aNumber]) ; … … 614 614 begin 615 615 for J := ReadFrom to Len do 616 if (S[ j] = C) then616 if (S[J] = C) then 617 617 begin 618 618 Result := J; … … 631 631 Inc(I); 632 632 APos := ReadUntil(I, '<'); 633 Result := Result + Copy(S, I, APos - i);633 Result := Result + Copy(S, I, APos - I); 634 634 I := ReadUntil(APos + 1, '>'); 635 635 end; -
trunk/Packages/Common/UFindFile.pas
r424 r447 6 6 Tired of using FindFirst, Next and Close? 7 7 Come see how to encapsulate all those functions 8 in a single "find-files-recursively" component.8 in A Single "find-files-recursively" component. 9 9 It's easy to use, free and with code. 10 10 … … 34 34 TFindFile = class(TComponent) 35 35 private 36 s: TStringList;37 fSubFolder : boolean;36 S : TStringList; 37 fSubFolder : Boolean; 38 38 fAttr: TFileAttrib; 39 39 fPath : string; … … 47 47 published 48 48 property FileAttr: TFileAttrib read fAttr write fAttr; 49 property InSubFolders : boolean read fSubFolder write fSubFolder;49 property InSubFolders : Boolean read fSubFolder write fSubFolder; 50 50 property Path : string read fPath write SetPath; 51 51 property FileMask : string read fFileMask write fFileMask ; … … 79 79 FileMask := FilterAll; 80 80 FileAttr := [ffaAnyFile]; 81 s:= TStringList.Create;81 S := TStringList.Create; 82 82 end; 83 83 84 84 destructor TFindFile.Destroy; 85 85 begin 86 s.Free;86 S.Free; 87 87 inherited Destroy; 88 88 end; … … 101 101 function TFindFile.SearchForFiles: TStringList; 102 102 begin 103 s.Clear;103 S.Clear; 104 104 try 105 105 FileSearch(Path); 106 106 finally 107 Result := s;107 Result := S; 108 108 end; 109 109 end; … … 111 111 procedure TFindFile.FileSearch(const InPath : string); 112 112 var Rec : TSearchRec; 113 Attr : integer;113 Attr : Integer; 114 114 begin 115 115 Attr := 0; … … 125 125 try 126 126 repeat 127 s.Add(inPath + Rec.Name);127 S.Add(inPath + Rec.Name); 128 128 until SysUtils.FindNext(Rec) <> 0; 129 129 finally -
trunk/Packages/Common/UFormAbout.pas
r423 r447 83 83 end. 84 84 85 -
trunk/Packages/Common/UGeometric.pas
r424 r447 52 52 function PointToLineDistance(const P, V, W: TPoint): Integer; 53 53 var 54 l2, t: Double;54 l2, T: Double; 55 55 tt: TPoint; 56 56 begin … … 165 165 end. 166 166 167 -
trunk/Packages/Common/UJobProgressView.pas
r424 r447 221 221 for I := 0 to ListViewJobs.Items.Count - 1 do 222 222 begin 223 ItemRect := ListViewJobs.Items[ i].DisplayRect(drBounds);223 ItemRect := ListViewJobs.Items[I].DisplayRect(drBounds); 224 224 Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top)); 225 225 end; -
trunk/Packages/Common/UMetaCanvas.pas
r424 r447 124 124 procedure SetWidth(AValue: Integer); override; 125 125 function GetWidth: Integer; override; 126 procedure DoLine (x1,y1,x2,y2: integer); override;126 procedure DoLine (x1,y1,x2,y2:Integer); override; 127 127 procedure DoTextOut(X, Y: Integer; Text: string); override; 128 128 procedure DoRectangle(const Bounds: TRect); override; … … 451 451 end; 452 452 453 procedure TMetaCanvas.DoLine(x1, y1, x2, y2: integer);453 procedure TMetaCanvas.DoLine(x1, y1, x2, y2: Integer); 454 454 var 455 455 NewObj: TCanvasLine; … … 665 665 end. 666 666 667 -
trunk/Packages/Common/UPrefixMultiplier.pas
r423 r447 30 30 BasePrefixMultipliers: TPrefixMultiplierDef = 31 31 ( 32 (ShortText: 'y'; FullText: 'yocto'; Value: 1 e-24),33 (ShortText: 'z'; FullText: 'zepto'; Value: 1 e-21),34 (ShortText: 'a'; FullText: 'atto'; Value: 1 e-18),35 (ShortText: 'f'; FullText: 'femto'; Value: 1 e-15),36 (ShortText: 'p'; FullText: 'piko'; Value: 1 e-12),37 (ShortText: 'n'; FullText: 'nano'; Value: 1 e-9),38 (ShortText: 'u'; FullText: 'mikro'; Value: 1 e-6),39 (ShortText: 'm'; FullText: 'mili'; Value: 1 e-3),32 (ShortText: 'y'; FullText: 'yocto'; Value: 1E-24), 33 (ShortText: 'z'; FullText: 'zepto'; Value: 1E-21), 34 (ShortText: 'a'; FullText: 'atto'; Value: 1E-18), 35 (ShortText: 'f'; FullText: 'femto'; Value: 1E-15), 36 (ShortText: 'p'; FullText: 'piko'; Value: 1E-12), 37 (ShortText: 'n'; FullText: 'nano'; Value: 1E-9), 38 (ShortText: 'u'; FullText: 'mikro'; Value: 1E-6), 39 (ShortText: 'm'; FullText: 'mili'; Value: 1E-3), 40 40 (ShortText: ''; FullText: ''; Value: 1e0), 41 41 (ShortText: 'k'; FullText: 'kilo'; Value: 1e3), … … 51 51 TimePrefixMultipliers: TPrefixMultiplierDef = 52 52 ( 53 (ShortText: 'ys'; FullText: 'yocto'; Value: 1 e-24),54 (ShortText: 'zs'; FullText: 'zepto'; Value: 1 e-21),55 (ShortText: 'as'; FullText: 'atto'; Value: 1 e-18),56 (ShortText: 'fs'; FullText: 'femto'; Value: 1 e-15),57 (ShortText: 'ps'; FullText: 'piko'; Value: 1 e-12),58 (ShortText: 'ns'; FullText: 'nano'; Value: 1 e-9),59 (ShortText: 'us'; FullText: 'mikro'; Value: 1 e-6),60 (ShortText: 'ms'; FullText: 'mili'; Value: 1 e-3),53 (ShortText: 'ys'; FullText: 'yocto'; Value: 1E-24), 54 (ShortText: 'zs'; FullText: 'zepto'; Value: 1E-21), 55 (ShortText: 'as'; FullText: 'atto'; Value: 1E-18), 56 (ShortText: 'fs'; FullText: 'femto'; Value: 1E-15), 57 (ShortText: 'ps'; FullText: 'piko'; Value: 1E-12), 58 (ShortText: 'ns'; FullText: 'nano'; Value: 1E-9), 59 (ShortText: 'us'; FullText: 'mikro'; Value: 1E-6), 60 (ShortText: 'ms'; FullText: 'mili'; Value: 1E-3), 61 61 (ShortText: 's'; FullText: 'sekunda'; Value: 1), 62 62 (ShortText: 'min'; FullText: 'minuta'; Value: 60), -
trunk/Packages/Common/UResetableThread.pas
r423 r447 296 296 end. 297 297 298 -
trunk/Packages/Common/UScaleDPI.pas
r424 r447 259 259 begin 260 260 ImgList.Add(Temp[I], nil); 261 Temp[ i].Free;261 Temp[I].Free; 262 262 end; 263 263 finally -
trunk/Packages/Common/UStringTable.pas
r424 r447 39 39 function TStringTable.GetColCount: Integer; 40 40 begin 41 Result := Size. x;41 Result := Size.X; 42 42 end; 43 43 -
trunk/Packages/Common/UTheme.pas
r424 r447 188 188 189 189 end. 190 -
trunk/Packages/Common/UTranslator.pas
r424 r447 420 420 421 421 if Lang = '' then begin 422 for i:= 1 to Paramcount - 1 do423 if (ParamStr( i) = '--LANG') or (ParamStr(i) = '-l') or424 (ParamStr( i) = '--lang') then425 Lang := ParamStr( i+ 1);422 for I := 1 to Paramcount - 1 do 423 if (ParamStr(I) = '--LANG') or (ParamStr(I) = '-l') or 424 (ParamStr(I) = '--lang') then 425 Lang := ParamStr(I + 1); 426 426 end; 427 427 if Lang = '' then begin … … 473 473 DirectorySeparator + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 474 474 if FileExistsUTF8(Result) then 475 exit;475 Exit; 476 476 477 477 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + DirectorySeparator + LangID + 478 478 DirectorySeparator + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 479 479 if FileExistsUTF8(Result) then 480 exit;480 Exit; 481 481 482 482 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator 483 483 + LangID + DirectorySeparator + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 484 484 if FileExistsUTF8(Result) then 485 exit;485 Exit; 486 486 487 487 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator … … 489 489 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 490 490 if FileExistsUTF8(Result) then 491 exit;491 Exit; 492 492 493 493 {$IFDEF UNIX} … … 496 496 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 497 497 if FileExistsUTF8(Result) then 498 exit;498 Exit; 499 499 {$ENDIF} 500 500 // Let us search for reducted files 501 LangShortID := copy(LangID, 1, 2);501 LangShortID := Copy(LangID, 1, 2); 502 502 // At first, check all was checked 503 503 Result := ExtractFilePath(ParamStrUTF8(0)) + LangShortID + 504 504 DirectorySeparator + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 505 505 if FileExistsUTF8(Result) then 506 exit;506 Exit; 507 507 508 508 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + DirectorySeparator + … … 510 510 ExtractFileName(ParamStrUTF8(0)), LCExt); 511 511 if FileExistsUTF8(Result) then 512 exit;512 Exit; 513 513 514 514 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator … … 516 516 ExtractFileName(ParamStrUTF8(0)), LCExt); 517 517 if FileExistsUTF8(Result) then 518 exit;518 Exit; 519 519 520 520 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator … … 522 522 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 523 523 if FileExistsUTF8(Result) then 524 exit;524 Exit; 525 525 526 526 // Full language in file name - this will be default for the project … … 529 529 Result := ExtractFilePath(ParamStrUTF8(0)) + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangID])) + LCExt; 530 530 if FileExistsUTF8(Result) then 531 exit;531 Exit; 532 532 // Common location (like in Lazarus) 533 533 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator + 534 534 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangID])) + LCExt; 535 535 if FileExistsUTF8(Result) then 536 exit;536 Exit; 537 537 538 538 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + 539 539 DirectorySeparator + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangID])) + LCExt; 540 540 if FileExistsUTF8(Result) then 541 exit;541 Exit; 542 542 except 543 543 Result := ''; // Or do something else (useless) … … 548 548 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 549 549 if FileExistsUTF8(Result) then 550 exit;550 Exit; 551 551 {$ENDIF} 552 552 Result := ExtractFilePath(ParamStrUTF8(0)) + ChangeFileExt( 553 553 ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangShortID])) + LCExt; 554 554 if FileExistsUTF8(Result) then 555 exit;555 Exit; 556 556 557 557 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator + 558 558 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangShortID])) + LCExt; 559 559 if FileExistsUTF8(Result) then 560 exit;560 Exit; 561 561 562 562 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + DirectorySeparator + 563 563 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangShortID])) + LCExt; 564 564 if FileExistsUTF8(Result) then 565 exit;565 Exit; 566 566 end; 567 567
Note:
See TracChangeset
for help on using the changeset viewer.