Changeset 420
- Timestamp:
- Dec 28, 2021, 4:46:47 PM (3 years ago)
- Location:
- trunk
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/GameServer.pas
r414 r420 1810 1810 end; 1811 1811 end; 1812 exit1812 Exit; 1813 1813 end; 1814 1814 … … 1826 1826 dec(Research, Cost); 1827 1827 Happened := Happened or phTech; 1828 ResearchTech := -1 1828 ResearchTech := -1; 1829 1829 end 1830 1830 else if (ResearchTech = -2) and (nCity > 0) then … … 1859 1859 if 1 shl p1 and GWatching <> 0 then 1860 1860 CallPlayer(cShowShipChange, p1, ShowShipChange); 1861 end 1861 end; 1862 1862 end; 1863 1863 if WinOnAlone and (GAlive and not(1 shl pTurn or 1) = 0) then … … 1871 1871 if (p1 <> pTurn) and ((GAlive or GWatching) and (1 shl p1) <> 0) then 1872 1872 RW[p1].EnemyReport[pTurn].Government := gDespotism; 1873 inc(Happened, phChangeGov) 1873 inc(Happened, phChangeGov); 1874 1874 end; 1875 1875 end; // if Difficulty[pTurn]>0 … … 2611 2611 end; 2612 2612 end; 2613 end; // with2614 end; { MoveUnit }2613 end; 2614 end; 2615 2615 2616 2616 function Server(Command, Player, Subject: integer; var Data): integer; stdcall; … … 2698 2698 ShowShipChange: TShowShipChange; 2699 2699 ShowNegoData: TShowNegoData; 2700 logged, ok, HasShipChanged, AllHumansDead, OfferFullySupported: boolean; 2701 2702 begin { >>>server } 2700 logged, ok, HasShipChanged, AllHumansDead, OfferFullySupported: Boolean; 2701 begin 2703 2702 if Command = sTurn then 2704 2703 begin … … 3566 3565 ChangeClientWhenDone(scDipOffer, pDipActive, LastOffer, 3567 3566 SizeOf(LastOffer)); 3568 end 3569 end 3567 end; 3568 end; 3570 3569 end 3571 3570 else -
trunk/LocalPlayer/Term.pas
r419 r420 4419 4419 end; 4420 4420 MyUn[uix].Status := MyUn[uix].Status or usToldNoReturn; 4421 end 4421 end; 4422 4422 end; 4423 4423 … … 4434 4434 ShowModal; 4435 4435 if ModalResult <> mrOK then 4436 exit 4436 exit; 4437 4437 end; 4438 4438 … … 4503 4503 begin // zoom to city 4504 4504 ZoomToCity(Loc); 4505 exit4506 end 4505 Exit; 4506 end; 4507 4507 end; 4508 4508 … … 4510 4510 (MyData.FarTech <> adNexus) then 4511 4511 if not ChooseResearch then 4512 exit;4512 Exit; 4513 4513 end; 4514 4514 … … 4557 4557 end 4558 4558 else 4559 PanelPaint 4560 end; // EndTurn4559 PanelPaint; 4560 end; 4561 4561 4562 4562 procedure TMainScreen.EndNego; -
trunk/Packages/Common/Common.lpk
r398 r420 41 41 Source: https://svn.zdechov.net/PascalClassLibrary/Common/"/> 42 42 <License Value="Copy left."/> 43 <Version Minor=" 8"/>43 <Version Minor="9"/> 44 44 <Files Count="29"> 45 45 <Item1> -
trunk/Packages/Common/UAboutDialog.pas
r396 r420 16 16 private 17 17 FApplicationInfo: TApplicationInfo; 18 F CoolTranslator: TTranslator;18 FTranslator: TTranslator; 19 19 FThemeManager: TThemeManager; 20 20 public … … 22 22 procedure Show; 23 23 published 24 property CoolTranslator: TTranslator read FCoolTranslator write FCoolTranslator;24 property Translator: TTranslator read FTranslator write FTranslator; 25 25 property ThemeManager: TThemeManager read FThemeManager write FThemeManager; 26 26 property ApplicationInfo: TApplicationInfo read FApplicationInfo write -
trunk/Packages/Common/UCommon.pas
r396 r420 40 40 {$ENDIF} 41 41 42 function IntToBin(Data: Int64; Count: Byte): string;42 function AddLeadingZeroes(const aNumber, Length : integer) : string; 43 43 function BinToInt(BinStr: string): Int64; 44 function TryHexToInt(Data: string; var Value: Integer): Boolean;45 function TryBinToInt(Data: string; var Value: Integer): Boolean;46 44 function BinToHexString(Source: AnsiString): string; 47 45 //function DelTree(DirName : string): Boolean; … … 49 47 function BCDToInt(Value: Byte): Byte; 50 48 function CompareByteArray(Data1, Data2: TArrayOfByte): Boolean; 49 procedure CopyStringArray(Dest: TStringArray; Source: array of string); 50 function CombinePaths(Path1, Path2: string): string; 51 function ComputerName: string; 52 procedure DeleteFiles(APath, AFileSpec: string); 53 procedure ExecuteProgram(Executable: string; Parameters: array of string); 54 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog); 55 procedure FreeThenNil(var Obj); 56 function GetDirCount(Dir: string): Integer; 51 57 function GetUserName: string; 52 function LoggedOnUserNameEx(Format: TUserNameFormat): string;53 function SplitString(var Text: string; Count: Word): string;54 58 function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer; 55 59 function GetBit(Variable: QWord; Index: Byte): Boolean; 60 function GetStringPart(var Text: string; Separator: string): string; 61 function GenerateNewName(OldName: string): string; 62 function GetFileFilterItemExt(Filter: string; Index: Integer): string; 63 function IntToBin(Data: Int64; Count: Byte): string; 64 function LastPos(const SubStr: String; const S: String): Integer; 65 function LoadFileToStr(const FileName: TFileName): AnsiString; 66 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 67 function MergeArray(A, B: array of string): TArrayOfString; 68 function OccurenceOfChar(What: Char; Where: string): Integer; 69 procedure OpenWebPage(URL: string); 70 procedure OpenFileInShell(FileName: string); 71 function PosFromIndex(SubStr: string; Text: string; 72 StartIndex: Integer): Integer; 73 function PosFromIndexReverse(SubStr: string; Text: string; 74 StartIndex: Integer): Integer; 75 function RemoveQuotes(Text: string): string; 76 procedure SaveStringToFile(S, FileName: string); 56 77 procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload; 57 78 procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload; 58 79 procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload; 59 80 procedure SetBit(var Variable: Word; Index: Byte; State: Boolean); overload; 60 function AddLeadingZeroes(const aNumber, Length : integer) : string;61 function LastPos(const SubStr: String; const S: String): Integer;62 function GenerateNewName(OldName: string): string;63 function GetFileFilterItemExt(Filter: string; Index: Integer): string;64 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog);65 procedure DeleteFiles(APath, AFileSpec: string);66 procedure OpenWebPage(URL: string);67 procedure OpenFileInShell(FileName: string);68 procedure ExecuteProgram(Executable: string; Parameters: array of string);69 procedure FreeThenNil(var Obj);70 function RemoveQuotes(Text: string): string;71 function ComputerName: string;72 function OccurenceOfChar(What: Char; Where: string): Integer;73 function GetDirCount(Dir: string): Integer;74 function MergeArray(A, B: array of string): TArrayOfString;75 function LoadFileToStr(const FileName: TFileName): AnsiString;76 procedure SaveStringToFile(S, FileName: string);77 81 procedure SearchFiles(AList: TStrings; Dir: string; 78 82 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil); 79 function GetStringPart(var Text: string; Separator: string): string;83 function SplitString(var Text: string; Count: Word): string; 80 84 function StripTags(const S: string): string; 81 function PosFromIndex(SubStr: string; Text: string; 82 StartIndex: Integer): Integer; 83 function PosFromIndexReverse(SubStr: string; Text: string; 84 StartIndex: Integer): Integer; 85 procedure CopyStringArray(Dest: TStringArray; Source: array of string); 85 function TryHexToInt(Data: string; var Value: Integer): Boolean; 86 function TryBinToInt(Data: string; var Value: Integer): Boolean; 87 procedure SortStrings(Strings: TStrings); 86 88 87 89 … … 669 671 end; 670 672 673 function CombinePaths(Path1, Path2: string): string; 674 begin 675 Result := Path1; 676 if Result <> '' then Result := Result + DirectorySeparator + Path2 677 else Result := Path2; 678 end; 679 680 procedure SortStrings(Strings: TStrings); 681 var 682 Tmp: TStringList; 683 begin 684 Strings.BeginUpdate; 685 try 686 if Strings is TStringList then begin 687 TStringList(Strings).Sort; 688 end else begin 689 Tmp := TStringList.Create; 690 try 691 Tmp.Assign(Strings); 692 Tmp.Sort; 693 Strings.Assign(Tmp); 694 finally 695 Tmp.Free; 696 end; 697 end; 698 finally 699 Strings.EndUpdate; 700 end; 701 end; 702 671 703 672 704 initialization -
trunk/Packages/Common/UFormAbout.pas
r396 r420 50 50 if Assigned(AboutDialog) then 51 51 with TAboutDialog(AboutDialog) do begin 52 if Assigned( CoolTranslator) then53 CoolTranslator.TranslateComponentRecursive(Self);52 if Assigned(Translator) then 53 Translator.TranslateComponentRecursive(Self); 54 54 if Assigned(ThemeManager) then 55 55 ThemeManager.UseTheme(Self); -
trunk/Packages/Common/UListViewSort.pas
r396 r420 81 81 FOnChange: TNotifyEvent; 82 82 FStringGrid1: TStringGrid; 83 procedure DoOnChange; 83 84 procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 84 85 procedure GridDoOnResize(Sender: TObject); … … 90 91 function TextEnteredColumn(Index: Integer): Boolean; 91 92 function GetColValue(Index: Integer): string; 93 procedure Reset; 92 94 property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1; 93 95 published … … 152 154 { TListViewFilter } 153 155 156 procedure TListViewFilter.DoOnChange; 157 begin 158 if Assigned(FOnChange) then FOnChange(Self); 159 end; 160 154 161 procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word; 155 162 Shift: TShiftState); 156 163 begin 157 if Assigned(FOnChange) then 158 FOnChange(Self); 164 DoOnChange; 159 165 end; 160 166 … … 227 233 Result := StringGrid.Cells[Index, 0] 228 234 else Result := ''; 235 end; 236 237 procedure TListViewFilter.Reset; 238 var 239 I: Integer; 240 begin 241 with StringGrid do 242 for I := 0 to ColCount - 1 do 243 Cells[I, 0] := ''; 244 DoOnChange; 229 245 end; 230 246 -
trunk/Packages/Common/UMetaCanvas.pas
r396 r420 6 6 7 7 uses 8 Classes, SysUtils, Graphics, Contnrs,Types, fgl;8 Classes, SysUtils, Graphics, Types, fgl; 9 9 10 10 type -
trunk/Packages/Common/UPixelPointer.pas
r396 r420 138 138 var 139 139 SrcPtr, DstPtr: TPixelPointer; 140 SubPtr: TPixelPointer;141 140 X, Y: Integer; 142 141 XX, YY: Integer; -
trunk/Packages/Common/UScaleDPI.pas
r396 r420 227 227 Temp[I] := TBitmap.Create; 228 228 Temp[I].SetSize(NewWidth, NewHeight); 229 {$IFDEF Linux} 230 Temp[I].PixelFormat := pf24bit; 231 {$ELSE} 229 232 Temp[I].PixelFormat := pf32bit; 233 {$ENDIF} 230 234 Temp[I].TransparentColor := TempBmp.TransparentColor; 231 235 //Temp[I].TransparentMode := TempBmp.TransparentMode; -
trunk/Packages/Common/UTheme.pas
r396 r420 5 5 uses 6 6 Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls, 7 Spin, Forms, Contnrs, Grids;7 Spin, Forms, fgl, Grids; 8 8 9 9 type … … 19 19 { TThemes } 20 20 21 TThemes = class(T ObjectList)21 TThemes = class(TFPGObjectList<TTheme>) 22 22 function AddNew(Name: string): TTheme; 23 23 function FindByName(Name: string): TTheme; … … 74 74 procedure TThemes.LoadToStrings(Strings: TStrings); 75 75 var 76 Theme: TTheme;76 I: Integer; 77 77 begin 78 Strings.Clear; 79 for Theme in Self do 80 Strings.AddObject(Theme.Name, Theme); 78 Strings.BeginUpdate; 79 try 80 while Strings.Count < Count do Strings.Add(''); 81 while Strings.Count > Count do Strings.Delete(Strings.Count - 1); 82 for I := 0 to Count - 1 do begin 83 Strings[I] := Items[I].Name; 84 Strings.Objects[I] := Items[I]; 85 end; 86 finally 87 Strings.EndUpdate; 88 end; 81 89 end; 82 90 … … 123 131 destructor TThemeManager.Destroy; 124 132 begin 125 Themes.Free;126 inherited Destroy;133 FreeAndNil(Themes); 134 inherited; 127 135 end; 128 136 -
trunk/Packages/Common/UThreading.pas
r396 r420 6 6 7 7 uses 8 Classes, SysUtils, Forms, Contnrs, SyncObjs;8 Classes, SysUtils, Forms, fgl, SyncObjs; 9 9 10 10 type … … 22 22 function GetSuspended: Boolean; virtual; abstract; 23 23 function GetTerminated: Boolean; virtual; abstract; 24 function GetThreadId: Integer; virtual; abstract;24 function GetThreadId: TThreadID; virtual; abstract; 25 25 procedure SetFreeOnTerminate(const AValue: Boolean); virtual; abstract; 26 26 procedure SetPriority(const AValue: TThreadPriority); virtual; abstract; … … 42 42 property Terminated: Boolean read GetTerminated write SetTerminated; 43 43 property Finished: Boolean read GetFinished; 44 property ThreadId: Integerread GetThreadId;44 property ThreadId: TThreadID read GetThreadId; 45 45 end; 46 46 … … 68 68 function GetSuspended: Boolean; override; 69 69 function GetTerminated: Boolean; override; 70 function GetThreadId: Integer; override;70 function GetThreadId: TThreadID; override; 71 71 procedure SetFreeOnTerminate(const AValue: Boolean); override; 72 72 procedure SetPriority(const AValue: TThreadPriority); override; … … 102 102 { TThreadList } 103 103 104 TThreadList = class(T ObjectList)105 function FindById(Id: Integer): TVirtualThread;104 TThreadList = class(TFPGObjectList<TVirtualThread>) 105 function FindById(Id: TThreadID): TVirtualThread; 106 106 constructor Create; virtual; 107 107 end; … … 164 164 if MainThreadID = ThreadID then Method 165 165 else begin 166 Thread := ThreadList.FindById(ThreadID); 166 try 167 ThreadListLock.Acquire; 168 Thread := ThreadList.FindById(ThreadID); 169 finally 170 ThreadListLock.Release; 171 end; 167 172 if Assigned(Thread) then begin 168 173 Thread.Synchronize(Method); … … 173 178 { TThreadList } 174 179 175 function TThreadList.FindById(Id: Integer): TVirtualThread;180 function TThreadList.FindById(Id: TThreadID): TVirtualThread; 176 181 var 177 182 I: Integer; 178 183 begin 179 184 I := 0; 180 while (I < ThreadList.Count) and (T VirtualThread(ThreadList[I]).ThreadID <> Id) do185 while (I < ThreadList.Count) and (ThreadList[I].ThreadID <> Id) do 181 186 Inc(I); 182 if I < ThreadList.Count then Result := T VirtualThread(ThreadList[I])187 if I < ThreadList.Count then Result := ThreadList[I] 183 188 else Result := nil; 184 189 end; … … 233 238 end; 234 239 235 function TListedThread.GetThreadId: Integer;240 function TListedThread.GetThreadId: TThreadID; 236 241 begin 237 242 Result := FThread.ThreadID; … … 356 361 ThreadListLock := TCriticalSection.Create; 357 362 ThreadList := TThreadList.Create; 358 ThreadList. OwnsObjects := False;363 ThreadList.FreeObjects := False; 359 364 360 365 finalization -
trunk/Protocol.pas
r401 r420 1943 1943 else 1944 1944 result := 0; 1945 end 1945 end; 1946 1946 end; 1947 1947 end;
Note:
See TracChangeset
for help on using the changeset viewer.