Changeset 181
- Timestamp:
- Apr 11, 2018, 11:35:38 AM (7 years ago)
- Location:
- trunk
- Files:
-
- 1 added
- 20 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/Common.lpk
r174 r181 40 40 <License Value="GNU/GPL"/> 41 41 <Version Minor="7"/> 42 <Files Count="2 1">42 <Files Count="22"> 43 43 <Item1> 44 44 <Filename Value="StopWatch.pas"/> … … 134 134 <UnitName Value="UTheme"/> 135 135 </Item21> 136 <Item22> 137 <Filename Value="UStringTable.pas"/> 138 <UnitName Value="UStringTable"/> 139 </Item22> 136 140 </Files> 137 141 <i18n> -
trunk/Packages/Common/Common.pas
r174 r181 5 5 unit Common; 6 6 7 {$warn 5023 off : no warning about unused units} 7 8 interface 8 9 9 10 uses 10 StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading, 11 UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 12 UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 13 UPersistentForm, UFindFile, UScaleDPI, UTheme, LazarusPackageIntf; 11 StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading, 12 UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 13 UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 14 UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, 15 LazarusPackageIntf; 14 16 15 17 implementation -
trunk/Packages/Common/Languages/UJobProgressView.cs.po
r79 r181 24 24 msgstr "Dokončené" 25 25 26 #: ujobprogressview.soperations27 msgid "Operations"28 msgstr "Operace"29 30 26 #: ujobprogressview.spleasewait 31 27 msgid "Please wait..." -
trunk/Packages/Common/Languages/UJobProgressView.po
r54 r181 14 14 msgstr "" 15 15 16 #: ujobprogressview.soperations17 msgid "Operations"18 msgstr ""19 20 16 #: ujobprogressview.spleasewait 21 17 msgid "Please wait..." -
trunk/Packages/Common/UApplicationInfo.pas
r169 r181 6 6 7 7 uses 8 SysUtils, Registry, Classes, Forms, URegistry;8 SysUtils, Classes, Forms, URegistry, Controls; 9 9 10 10 type … … 14 14 TApplicationInfo = class(TComponent) 15 15 private 16 FDescription: string;16 FDescription: TCaption; 17 17 FIdentification: Byte; 18 18 FLicense: string; … … 57 57 58 58 implementation 59 59 60 60 procedure Register; 61 61 begin -
trunk/Packages/Common/UCommon.pas
r169 r181 28 28 unfDNSDomainName = 11); 29 29 30 TFilterMethodMethod = function (FileName: string): Boolean of object; 30 31 var 31 32 ExceptionHandler: TExceptionEvent; … … 71 72 function MergeArray(A, B: array of string): TArrayOfString; 72 73 function LoadFileToStr(const FileName: TFileName): AnsiString; 74 procedure SearchFiles(AList: TStrings; Dir: string; 75 FilterMethod: TFilterMethodMethod); 76 function GetStringPart(var Text: string; Separator: string): string; 73 77 74 78 … … 514 518 end; 515 519 520 function DefaultSearchFilter(const FileName: string): Boolean; 521 begin 522 Result := True; 523 end; 524 525 procedure SearchFiles(AList: TStrings; Dir: string; 526 FilterMethod: TFilterMethodMethod); 527 var 528 SR: TSearchRec; 529 begin 530 Dir := IncludeTrailingPathDelimiter(Dir); 531 if FindFirst(Dir + '*', faAnyFile, SR) = 0 then 532 try 533 repeat 534 if (SR.Name = '.') or (SR.Name = '..') or not FilterMethod(SR.Name) or 535 not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name) then Continue; 536 AList.Add(Dir + SR.Name); 537 if (SR.Attr and faDirectory) <> 0 then 538 SearchFiles(AList, Dir + SR.Name, FilterMethod); 539 until FindNext(SR) <> 0; 540 finally 541 FindClose(SR); 542 end; 543 end; 544 545 function GetStringPart(var Text: string; Separator: string): string; 546 var 547 P: Integer; 548 begin 549 P := Pos(Separator, Text); 550 if P > 0 then begin 551 Result := Copy(Text, 1, P - 1); 552 Delete(Text, 1, P - 1 + Length(Separator)); 553 end else begin 554 Result := Text; 555 Text := ''; 556 end; 557 Result := Trim(Result); 558 Text := Trim(Text); 559 end; 560 516 561 517 562 -
trunk/Packages/Common/UDebugLog.pas
r3 r181 104 104 if ExtractFileDir(FileName) <> '' then 105 105 ForceDirectories(ExtractFileDir(FileName)); 106 if FileExists(FileName) then LogFile := TFileStream.Create( UTF8Decode(FileName), fmOpenWrite)107 else LogFile := TFileStream.Create( UTF8Decode(FileName), fmCreate);106 if FileExists(FileName) then LogFile := TFileStream.Create(FileName, fmOpenWrite) 107 else LogFile := TFileStream.Create(FileName, fmCreate); 108 108 LogFile.Seek(0, soFromEnd); 109 109 Text := FormatDateTime('hh:nn:ss.zzz', Now) + ': ' + Text + LineEnding; -
trunk/Packages/Common/UFindFile.pas
r106 r181 24 24 25 25 uses 26 SysUtils, Classes, Graphics, Controls, Forms, Dialogs , FileCtrl;26 SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 27 27 28 28 type … … 117 117 Attr := 0; 118 118 if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly; 119 if ffaHidden in FileAttr then Attr := Attr + faHidden;120 if ffaSysFile in FileAttr then Attr := Attr + faSysFile;121 if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;119 if ffaHidden in FileAttr then Attr := Attr + 2; //faHidden; use constant to avoid platform warning 120 if ffaSysFile in FileAttr then Attr := Attr + 4; //faSysFile; use constant to avoid platform warning 121 // Deprecated: if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID; 122 122 if ffaDirectory in FileAttr then Attr := Attr + faDirectory; 123 123 if ffaArchive in FileAttr then Attr := Attr + faArchive; 124 124 if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile; 125 125 126 if SysUtils.FindFirst( UTF8Decode(inPath + FileMask), Attr, Rec) = 0 then126 if SysUtils.FindFirst(inPath + FileMask, Attr, Rec) = 0 then 127 127 try 128 128 repeat 129 s.Add(inPath + UTF8Encode(Rec.Name));129 s.Add(inPath + Rec.Name); 130 130 until SysUtils.FindNext(Rec) <> 0; 131 131 finally … … 135 135 If not InSubFolders then Exit; 136 136 137 if SysUtils.FindFirst( UTF8Decode(inPath + FilterAll), faDirectory, Rec) = 0 then137 if SysUtils.FindFirst(inPath + FilterAll, faDirectory, Rec) = 0 then 138 138 try 139 139 repeat 140 140 if ((Rec.Attr and faDirectory) > 0) and (Rec.Name <> '.') 141 141 and (Rec.Name <> '..') then 142 FileSearch(IncludeTrailingBackslash(inPath + UTF8Encode(Rec.Name)));142 FileSearch(IncludeTrailingBackslash(inPath + Rec.Name)); 143 143 until SysUtils.FindNext(Rec) <> 0; 144 144 finally -
trunk/Packages/Common/UJobProgressView.lfm
r55 r181 1 1 object FormJobProgressView: TFormJobProgressView 2 Left = 6562 Left = 467 3 3 Height = 246 4 Top = 3544 Top = 252 5 5 Width = 328 6 6 BorderIcons = [biSystemMenu] 7 7 ClientHeight = 246 8 8 ClientWidth = 328 9 DesignTimePPI = 120 9 10 Font.Height = -11 10 11 Font.Name = 'MS Sans Serif' … … 14 15 OnDestroy = FormDestroy 15 16 Position = poScreenCenter 16 LCLVersion = '1. 6.0.4'17 LCLVersion = '1.8.2.0' 17 18 object PanelOperationsTitle: TPanel 18 19 Left = 0 -
trunk/Packages/Common/UJobProgressView.pas
r54 r181 166 166 STotalEstimatedTime = 'Total estimated time: %s'; 167 167 SFinished = 'Finished'; 168 SOperations = 'Operations';169 168 170 169 procedure Register; -
trunk/Packages/Common/ULastOpenedList.pas
r3 r181 6 6 7 7 uses 8 Classes, SysUtils, Registry, URegistry, Menus, XMLConf ;8 Classes, SysUtils, Registry, URegistry, Menus, XMLConf, DOM; 9 9 10 10 type … … 139 139 OpenKey(Context.Key, True); 140 140 for I := 0 to Items.Count - 1 do 141 WriteString('File' + IntToStr(I), UTF8Decode(Items[I]));141 WriteString('File' + IntToStr(I), Items[I]); 142 142 finally 143 143 Free; … … 153 153 begin 154 154 with XMLConfig do begin 155 Count := GetValue( Path + '/Count', 0);155 Count := GetValue(DOMString(Path + '/Count'), 0); 156 156 if Count > MaxCount then Count := MaxCount; 157 157 Items.Clear; 158 158 for I := 0 to Count - 1 do begin 159 Value := GetValue(Path + '/File' + IntToStr(I), '');159 Value := string(GetValue(DOMString(Path + '/File' + IntToStr(I)), '')); 160 160 if Trim(Value) <> '' then Items.Add(Value); 161 161 end; … … 170 170 begin 171 171 with XMLConfig do begin 172 SetValue( Path + '/Count', Items.Count);172 SetValue(DOMString(Path + '/Count'), Items.Count); 173 173 for I := 0 to Items.Count - 1 do 174 SetValue( Path + '/File' + IntToStr(I), Items[I]);174 SetValue(DOMString(Path + '/File' + IntToStr(I)), DOMString(Items[I])); 175 175 Flush; 176 176 end; -
trunk/Packages/Common/UListViewSort.pas
r177 r181 384 384 ItemLeft := Item.Left; 385 385 ItemLeft := 23; // Windows 7 workaround 386 386 387 387 Rect1.Left := ItemLeft - CheckWidth - BiasLeft + 1 + XBias; 388 388 //ShowMessage(IntToStr(Tp1.Y) + ', ' + IntToStr(BiasTop) + ', ' + IntToStr(XBias)); … … 483 483 FHeaderHandle := ListView_GetHeader(FListView.Handle); 484 484 for I := 0 to FListView.Columns.Count - 1 do begin 485 {$push}{$warn 5057 off} 485 486 FillChar(Item, SizeOf(THDItem), 0); 487 {$pop} 486 488 Item.Mask := HDI_FORMAT; 487 489 Header_GetItem(FHeaderHandle, I, Item); -
trunk/Packages/Common/UPersistentForm.pas
r123 r181 56 56 I: Integer; 57 57 WinControl: TWinControl; 58 Count: Integer;59 58 begin 60 59 if Control is TListView then begin … … 217 216 218 217 procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False); 219 var220 LoadDefaults: Boolean;221 218 begin 222 219 Self.Form := Form; … … 230 227 231 228 if not EqualRect(FormNormalSize, FormRestoredSize) or 232 (LoadDefaults and DefaultMaximized)then begin229 DefaultMaximized then begin 233 230 // Restore to maximized state 234 231 Form.WindowState := wsNormal; -
trunk/Packages/Common/UResetableThread.pas
r3 r181 156 156 FThread.Name := 'ResetableThread'; 157 157 FThread.Parent := Self; 158 FThread. Resume;158 FThread.Start; 159 159 end; 160 160 -
trunk/Packages/Common/UScaleDPI.pas
r169 r181 215 215 I: Integer; 216 216 begin 217 ImgList.BeginUpdate; 217 218 NewWidth := ScaleX(ImgList.Width, FromDPI.X); 218 219 NewHeight := ScaleY(ImgList.Height, FromDPI.Y); … … 248 249 Temp[i].Free; 249 250 end; 251 ImgList.EndUpdate; 250 252 end; 251 253 -
trunk/Packages/Common/UTheme.pas
r175 r181 132 132 I: Integer; 133 133 begin 134 for I := 0 to Component.ComponentCount - 1 do 135 ApplyTheme(Component.Components[I]); 134 if Component is TWinControl then begin 135 for I := 0 to TWinControl(Component).ControlCount - 1 do 136 ApplyTheme(TWinControl(Component).Controls[I]); 137 end; 136 138 137 139 if Component is TControl then begin … … 139 141 if (Control is TEdit) or (Control is TSpinEdit) or (Control is TComboBox) and 140 142 (Control is TMemo) or (Control is TListView) or (Control is TCustomDrawGrid) or 141 (Control is TCheckBox) then begin143 (Control is TCheckBox) or (Control is TPageControl) or (Control is TRadioButton) then begin 142 144 Control.Color := FTheme.ColorWindow; 143 145 Control.Font.Color := FTheme.ColorWindowText; … … 150 152 (Control as TCustomDrawGrid).Editor.Color := FTheme.ColorWindow; 151 153 (Control as TCustomDrawGrid).Editor.Font.Color := FTheme.ColorWindowText; 154 end; 155 156 if Control is TPageControl then begin 157 for I := 0 to TPageControl(Component).PageCount - 1 do 158 ApplyTheme(TPageControl(Component).Pages[I]); 152 159 end; 153 160 end; -
trunk/Packages/Common/UThreading.pas
r3 r181 30 30 Name: string; 31 31 procedure Execute; virtual; abstract; 32 procedure Resume; virtual; abstract;33 procedure Suspend; virtual; abstract;34 32 procedure Start; virtual; abstract; 35 33 procedure Terminate; virtual; abstract; … … 81 79 procedure Sleep(Delay: Integer); override; 82 80 procedure Execute; override; 83 procedure Resume; override;84 procedure Suspend; override;85 81 procedure Start; override; 86 82 procedure Terminate; override; … … 134 130 Thread.FreeOnTerminate := False; 135 131 Thread.Method := Method; 136 Thread. Resume;132 Thread.Start; 137 133 while (Thread.State = ttsRunning) or (Thread.State = ttsReady) do begin 138 134 if MainThreadID = ThreadID then Application.ProcessMessages; … … 155 151 Thread.Method := Method; 156 152 Thread.OnFinished := CallBack; 157 Thread. Resume;153 Thread.Start; 158 154 //if Thread.State = ttsExceptionOccured then 159 155 // raise Exception.Create(Thread.ExceptionMessage); … … 313 309 procedure TListedThread.Execute; 314 310 begin 315 end;316 317 procedure TListedThread.Resume;318 begin319 FThread.Resume;320 end;321 322 procedure TListedThread.Suspend;323 begin324 FThread.Suspend;325 311 end; 326 312 -
trunk/Packages/Common/UURI.pas
r3 r181 89 89 function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean; 90 90 var 91 I , J: Integer;91 I: Integer; 92 92 Matched: Boolean; 93 93 begin … … 113 113 function RightCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean; 114 114 var 115 I , J: Integer;115 I: Integer; 116 116 Matched: Boolean; 117 117 begin … … 202 202 203 203 procedure TURI.SetAsString(Value: string); 204 var205 HostAddr: string;206 HostPort: string;207 204 begin 208 205 LeftCutString(Value, Scheme, ':'); -
trunk/Packages/Common/UXMLUtils.pas
r54 r181 7 7 uses 8 8 {$IFDEF WINDOWS}Windows,{$ENDIF} 9 Classes, SysUtils, DateUtils, XMLRead, XMLWrite,DOM;9 Classes, SysUtils, DateUtils, DOM; 10 10 11 11 function XMLTimeToDateTime(XMLDateTime: string): TDateTime; 12 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;12 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string; 13 13 procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer); 14 14 procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64); … … 30 30 TimeZoneInfo: TTimeZoneInformation; 31 31 begin 32 {$push}{$warn 5057 off} 32 33 case GetTimeZoneInformation(TimeZoneInfo) of 33 TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias;34 TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias;34 TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias; 35 TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias; 35 36 else 36 37 Result := 0; 37 38 end; 39 {$pop} 38 40 end; 39 41 {$ELSE} … … 45 47 function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean; 46 48 var 47 I , J: Integer;49 I: Integer; 48 50 Matched: Boolean; 49 51 begin … … 99 101 if Pos('Z', XMLDateTime) > 0 then 100 102 LeftCutString(XMLDateTime, Part, 'Z'); 101 SecondFraction := StrToFloat('0' + De cimalSeparator + Part);103 SecondFraction := StrToFloat('0' + DefaultFormatSettings.DecimalSeparator + Part); 102 104 Millisecond := Trunc(SecondFraction * 1000); 103 105 end else begin … … 118 120 end; 119 121 120 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;122 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string; 121 123 const 122 124 Neg: array[Boolean] of string = ('+', '-'); … … 139 141 NewNode: TDOMNode; 140 142 begin 141 NewNode := Node.OwnerDocument.CreateElement( Name);142 NewNode.TextContent := IntToStr(Value);143 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 144 NewNode.TextContent := DOMString(IntToStr(Value)); 143 145 Node.AppendChild(NewNode); 144 146 end; … … 148 150 NewNode: TDOMNode; 149 151 begin 150 NewNode := Node.OwnerDocument.CreateElement( Name);151 NewNode.TextContent := IntToStr(Value);152 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 153 NewNode.TextContent := DOMString(IntToStr(Value)); 152 154 Node.AppendChild(NewNode); 153 155 end; … … 157 159 NewNode: TDOMNode; 158 160 begin 159 NewNode := Node.OwnerDocument.CreateElement( Name);160 NewNode.TextContent := BoolToStr(Value);161 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 162 NewNode.TextContent := DOMString(BoolToStr(Value)); 161 163 Node.AppendChild(NewNode); 162 164 end; … … 166 168 NewNode: TDOMNode; 167 169 begin 168 NewNode := Node.OwnerDocument.CreateElement( Name);169 NewNode.TextContent := Value;170 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 171 NewNode.TextContent := DOMString(Value); 170 172 Node.AppendChild(NewNode); 171 173 end; … … 175 177 NewNode: TDOMNode; 176 178 begin 177 NewNode := Node.OwnerDocument.CreateElement( Name);178 NewNode.TextContent := D ateTimeToXMLTime(Value);179 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 180 NewNode.TextContent := DOMString(DateTimeToXMLTime(Value)); 179 181 Node.AppendChild(NewNode); 180 182 end; … … 185 187 begin 186 188 Result := DefaultValue; 187 NewNode := Node.FindNode( Name);188 if Assigned(NewNode) then 189 Result := StrToInt( NewNode.TextContent);189 NewNode := Node.FindNode(DOMString(Name)); 190 if Assigned(NewNode) then 191 Result := StrToInt(string(NewNode.TextContent)); 190 192 end; 191 193 … … 195 197 begin 196 198 Result := DefaultValue; 197 NewNode := Node.FindNode( Name);198 if Assigned(NewNode) then 199 Result := StrToInt64( NewNode.TextContent);199 NewNode := Node.FindNode(DOMString(Name)); 200 if Assigned(NewNode) then 201 Result := StrToInt64(string(NewNode.TextContent)); 200 202 end; 201 203 … … 205 207 begin 206 208 Result := DefaultValue; 207 NewNode := Node.FindNode( Name);208 if Assigned(NewNode) then 209 Result := StrToBool( NewNode.TextContent);209 NewNode := Node.FindNode(DOMString(Name)); 210 if Assigned(NewNode) then 211 Result := StrToBool(string(NewNode.TextContent)); 210 212 end; 211 213 … … 215 217 begin 216 218 Result := DefaultValue; 217 NewNode := Node.FindNode( Name);218 if Assigned(NewNode) then 219 Result := NewNode.TextContent;219 NewNode := Node.FindNode(DOMString(Name)); 220 if Assigned(NewNode) then 221 Result := string(NewNode.TextContent); 220 222 end; 221 223 … … 226 228 begin 227 229 Result := DefaultValue; 228 NewNode := Node.FindNode( Name);229 if Assigned(NewNode) then 230 Result := XMLTimeToDateTime( NewNode.TextContent);230 NewNode := Node.FindNode(DOMString(Name)); 231 if Assigned(NewNode) then 232 Result := XMLTimeToDateTime(string(NewNode.TextContent)); 231 233 end; 232 234 -
trunk/UCore.lfm
r176 r181 4 4 OldCreateOrder = False 5 5 Height = 648 6 HorizontalOffset = 5 967 VerticalOffset = 3788 Width = 6966 HorizontalOffset = 535 7 VerticalOffset = 220 8 Width = 701 9 9 PPI = 120 10 10 object CoolTranslator1: TCoolTranslator … … 3443 3443 EmailContact = 'robie@centrum.cz' 3444 3444 AppName = 'Acronym Decoder' 3445 Description = ' Simple tool for quick searching of meaning for various acronyms and abbreviations.'3446 ReleaseDate = 43 1743445 Description = 'A simple tool for quick searching of meaning for various acronyms and abbreviations.' 3446 ReleaseDate = 43201 3447 3447 RegistryKey = '\Software\' 3448 3448 RegistryRoot = rrKeyCurrentUser 3449 3449 License = 'CC0' 3450 left = 1003451 top = 303450 left = 96 3451 top = 40 3452 3452 end 3453 3453 end
Note:
See TracChangeset
for help on using the changeset viewer.