Changeset 420 for trunk


Ignore:
Timestamp:
Dec 28, 2021, 4:46:47 PM (3 years ago)
Author:
chronos
Message:
  • Modified: Updated Common package to version 0.9.
  • Modified: Code cleanup.
Location:
trunk
Files:
13 edited

Legend:

Unmodified
Added
Removed

  • trunk/GameServer.pas

    r414 r420  
    18101810            end;
    18111811          end;
    1812         exit
     1812        Exit;
    18131813      end;
    18141814
    … …  
    18261826        dec(Research, Cost);
    18271827        Happened := Happened or phTech;
    1828         ResearchTech := -1
     1828        ResearchTech := -1;
    18291829      end
    18301830      else if (ResearchTech = -2) and (nCity > 0) then
    … …  
    18591859            if 1 shl p1 and GWatching <> 0 then
    18601860              CallPlayer(cShowShipChange, p1, ShowShipChange);
    1861           end
     1861          end;
    18621862      end;
    18631863      if WinOnAlone and (GAlive and not(1 shl pTurn or 1) = 0) then
    … …  
    18711871          if (p1 <> pTurn) and ((GAlive or GWatching) and (1 shl p1) <> 0) then
    18721872            RW[p1].EnemyReport[pTurn].Government := gDespotism;
    1873         inc(Happened, phChangeGov)
     1873        inc(Happened, phChangeGov);
    18741874      end;
    18751875    end; // if Difficulty[pTurn]>0
    … …  
    26112611      end;
    26122612    end;
    2613   end; // with
    2614 end; { MoveUnit }
     2613  end;
     2614end;
    26152615
    26162616function Server(Command, Player, Subject: integer; var Data): integer; stdcall;
    … …  
    26982698  ShowShipChange: TShowShipChange;
    26992699  ShowNegoData: TShowNegoData;
    2700   logged, ok, HasShipChanged, AllHumansDead, OfferFullySupported: boolean;
    2701 
    2702 begin { >>>server }
     2700  logged, ok, HasShipChanged, AllHumansDead, OfferFullySupported: Boolean;
     2701begin
    27032702  if Command = sTurn then
    27042703  begin
    … …  
    35663565              ChangeClientWhenDone(scDipOffer, pDipActive, LastOffer,
    35673566                SizeOf(LastOffer));
    3568             end
    3569           end
     3567            end;
     3568          end;
    35703569        end
    35713570      else

  • trunk/LocalPlayer/Term.pas

    r419 r420  
    44194419            end;
    44204420            MyUn[uix].Status := MyUn[uix].Status or usToldNoReturn;
    4421           end
     4421          end;
    44224422        end;
    44234423
    … …  
    44344434        ShowModal;
    44354435        if ModalResult <> mrOK then
    4436           exit
     4436          exit;
    44374437      end;
    44384438
    … …  
    45034503            begin // zoom to city
    45044504              ZoomToCity(Loc);
    4505               exit
    4506             end
     4505              Exit;
     4506            end;
    45074507          end;
    45084508
    … …  
    45104510      (MyData.FarTech <> adNexus) then
    45114511      if not ChooseResearch then
    4512         exit;
     4512        Exit;
    45134513  end;
    45144514
    … …  
    45574557  end
    45584558  else
    4559     PanelPaint
    4560 end; // EndTurn
     4559    PanelPaint;
     4560end;
    45614561
    45624562procedure TMainScreen.EndNego;

  • trunk/Packages/Common/Common.lpk

    r398 r420  
    4141Source: https://svn.zdechov.net/PascalClassLibrary/Common/"/>
    4242    <License Value="Copy left."/>
    43     <Version Minor="8"/>
     43    <Version Minor="9"/>
    4444    <Files Count="29">
    4545      <Item1>

  • trunk/Packages/Common/UAboutDialog.pas

    r396 r420  
    1616  private
    1717    FApplicationInfo: TApplicationInfo;
    18     FCoolTranslator: TTranslator;
     18    FTranslator: TTranslator;
    1919    FThemeManager: TThemeManager;
    2020  public
    … …  
    2222    procedure Show;
    2323  published
    24     property CoolTranslator: TTranslator read FCoolTranslator write FCoolTranslator;
     24    property Translator: TTranslator read FTranslator write FTranslator;
    2525    property ThemeManager: TThemeManager read FThemeManager write FThemeManager;
    2626    property ApplicationInfo: TApplicationInfo read FApplicationInfo write

  • trunk/Packages/Common/UCommon.pas

    r396 r420  
    4040{$ENDIF}
    4141
    42 function IntToBin(Data: Int64; Count: Byte): string;
     42function AddLeadingZeroes(const aNumber, Length : integer) : string;
    4343function BinToInt(BinStr: string): Int64;
    44 function TryHexToInt(Data: string; var Value: Integer): Boolean;
    45 function TryBinToInt(Data: string; var Value: Integer): Boolean;
    4644function BinToHexString(Source: AnsiString): string;
    4745//function DelTree(DirName : string): Boolean;
    … …  
    4947function BCDToInt(Value: Byte): Byte;
    5048function CompareByteArray(Data1, Data2: TArrayOfByte): Boolean;
     49procedure CopyStringArray(Dest: TStringArray; Source: array of string);
     50function CombinePaths(Path1, Path2: string): string;
     51function ComputerName: string;
     52procedure DeleteFiles(APath, AFileSpec: string);
     53procedure ExecuteProgram(Executable: string; Parameters: array of string);
     54procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog);
     55procedure FreeThenNil(var Obj);
     56function GetDirCount(Dir: string): Integer;
    5157function GetUserName: string;
    52 function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    53 function SplitString(var Text: string; Count: Word): string;
    5458function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer;
    5559function GetBit(Variable: QWord; Index: Byte): Boolean;
     60function GetStringPart(var Text: string; Separator: string): string;
     61function GenerateNewName(OldName: string): string;
     62function GetFileFilterItemExt(Filter: string; Index: Integer): string;
     63function IntToBin(Data: Int64; Count: Byte): string;
     64function LastPos(const SubStr: String; const S: String): Integer;
     65function LoadFileToStr(const FileName: TFileName): AnsiString;
     66function LoggedOnUserNameEx(Format: TUserNameFormat): string;
     67function MergeArray(A, B: array of string): TArrayOfString;
     68function OccurenceOfChar(What: Char; Where: string): Integer;
     69procedure OpenWebPage(URL: string);
     70procedure OpenFileInShell(FileName: string);
     71function PosFromIndex(SubStr: string; Text: string;
     72  StartIndex: Integer): Integer;
     73function PosFromIndexReverse(SubStr: string; Text: string;
     74  StartIndex: Integer): Integer;
     75function RemoveQuotes(Text: string): string;
     76procedure SaveStringToFile(S, FileName: string);
    5677procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload;
    5778procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload;
    5879procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload;
    5980procedure 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);
    7781procedure SearchFiles(AList: TStrings; Dir: string;
    7882  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
    79 function GetStringPart(var Text: string; Separator: string): string;
     83function SplitString(var Text: string; Count: Word): string;
    8084function 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);
     85function TryHexToInt(Data: string; var Value: Integer): Boolean;
     86function TryBinToInt(Data: string; var Value: Integer): Boolean;
     87procedure SortStrings(Strings: TStrings);
    8688
    8789
    … …  
    669671end;
    670672
     673function CombinePaths(Path1, Path2: string): string;
     674begin
     675  Result := Path1;
     676  if Result <> '' then Result := Result + DirectorySeparator + Path2
     677    else Result := Path2;
     678end;
     679
     680procedure SortStrings(Strings: TStrings);
     681var
     682  Tmp: TStringList;
     683begin
     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;
     701end;
     702
    671703
    672704initialization

  • trunk/Packages/Common/UFormAbout.pas

    r396 r420  
    5050  if Assigned(AboutDialog) then
    5151  with TAboutDialog(AboutDialog) do begin
    52     if Assigned(CoolTranslator) then
    53       CoolTranslator.TranslateComponentRecursive(Self);
     52    if Assigned(Translator) then
     53      Translator.TranslateComponentRecursive(Self);
    5454    if Assigned(ThemeManager) then
    5555      ThemeManager.UseTheme(Self);

  • trunk/Packages/Common/UListViewSort.pas

    r396 r420  
    8181    FOnChange: TNotifyEvent;
    8282    FStringGrid1: TStringGrid;
     83    procedure DoOnChange;
    8384    procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    8485    procedure GridDoOnResize(Sender: TObject);
    … …  
    9091    function TextEnteredColumn(Index: Integer): Boolean;
    9192    function GetColValue(Index: Integer): string;
     93    procedure Reset;
    9294    property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1;
    9395  published
    … …  
    152154{ TListViewFilter }
    153155
     156procedure TListViewFilter.DoOnChange;
     157begin
     158  if Assigned(FOnChange) then FOnChange(Self);
     159end;
     160
    154161procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word;
    155162  Shift: TShiftState);
    156163begin
    157   if Assigned(FOnChange) then
    158     FOnChange(Self);
     164  DoOnChange;
    159165end;
    160166
    … …  
    227233    Result := StringGrid.Cells[Index, 0]
    228234    else Result := '';
     235end;
     236
     237procedure TListViewFilter.Reset;
     238var
     239  I: Integer;
     240begin
     241  with StringGrid do
     242  for I := 0 to ColCount - 1 do
     243    Cells[I, 0] := '';
     244  DoOnChange;
    229245end;
    230246

  • trunk/Packages/Common/UMetaCanvas.pas

    r396 r420  
    66
    77uses
    8   Classes, SysUtils, Graphics, Contnrs, Types, fgl;
     8  Classes, SysUtils, Graphics, Types, fgl;
    99
    1010type

  • trunk/Packages/Common/UPixelPointer.pas

    r396 r420  
    138138var
    139139  SrcPtr, DstPtr: TPixelPointer;
    140   SubPtr: TPixelPointer;
    141140  X, Y: Integer;
    142141  XX, YY: Integer;

  • trunk/Packages/Common/UScaleDPI.pas

    r396 r420  
    227227    Temp[I] := TBitmap.Create;
    228228    Temp[I].SetSize(NewWidth, NewHeight);
     229    {$IFDEF Linux}
     230    Temp[I].PixelFormat := pf24bit;
     231    {$ELSE}
    229232    Temp[I].PixelFormat := pf32bit;
     233    {$ENDIF}
    230234    Temp[I].TransparentColor := TempBmp.TransparentColor;
    231235    //Temp[I].TransparentMode := TempBmp.TransparentMode;

  • trunk/Packages/Common/UTheme.pas

    r396 r420  
    55uses
    66  Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls,
    7   Spin, Forms, Contnrs, Grids;
     7  Spin, Forms, fgl, Grids;
    88
    99type
    … …  
    1919  { TThemes }
    2020
    21   TThemes = class(TObjectList)
     21  TThemes = class(TFPGObjectList<TTheme>)
    2222    function AddNew(Name: string): TTheme;
    2323    function FindByName(Name: string): TTheme;
    … …  
    7474procedure TThemes.LoadToStrings(Strings: TStrings);
    7575var
    76   Theme: TTheme;
     76  I: Integer;
    7777begin
    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;
    8189end;
    8290
    … …  
    123131destructor TThemeManager.Destroy;
    124132begin
    125   Themes.Free;
    126   inherited Destroy;
     133  FreeAndNil(Themes);
     134  inherited;
    127135end;
    128136

  • trunk/Packages/Common/UThreading.pas

    r396 r420  
    66
    77uses
    8   Classes, SysUtils, Forms, Contnrs, SyncObjs;
     8  Classes, SysUtils, Forms, fgl, SyncObjs;
    99
    1010type
    … …  
    2222    function GetSuspended: Boolean; virtual; abstract;
    2323    function GetTerminated: Boolean; virtual; abstract;
    24     function GetThreadId: Integer; virtual; abstract;
     24    function GetThreadId: TThreadID; virtual; abstract;
    2525    procedure SetFreeOnTerminate(const AValue: Boolean); virtual; abstract;
    2626    procedure SetPriority(const AValue: TThreadPriority); virtual; abstract;
    … …  
    4242    property Terminated: Boolean read GetTerminated write SetTerminated;
    4343    property Finished: Boolean read GetFinished;
    44     property ThreadId: Integer read GetThreadId;
     44    property ThreadId: TThreadID read GetThreadId;
    4545  end;
    4646
    … …  
    6868    function GetSuspended: Boolean; override;
    6969    function GetTerminated: Boolean; override;
    70     function GetThreadId: Integer; override;
     70    function GetThreadId: TThreadID; override;
    7171    procedure SetFreeOnTerminate(const AValue: Boolean); override;
    7272    procedure SetPriority(const AValue: TThreadPriority); override;
    … …  
    102102  { TThreadList }
    103103
    104   TThreadList = class(TObjectList)
    105     function FindById(Id: Integer): TVirtualThread;
     104  TThreadList = class(TFPGObjectList<TVirtualThread>)
     105    function FindById(Id: TThreadID): TVirtualThread;
    106106    constructor Create; virtual;
    107107  end;
    … …  
    164164  if MainThreadID = ThreadID then Method
    165165  else begin
    166     Thread := ThreadList.FindById(ThreadID);
     166    try
     167      ThreadListLock.Acquire;
     168      Thread := ThreadList.FindById(ThreadID);
     169    finally
     170      ThreadListLock.Release;
     171    end;
    167172    if Assigned(Thread) then begin
    168173      Thread.Synchronize(Method);
    … …  
    173178{ TThreadList }
    174179
    175 function TThreadList.FindById(Id: Integer): TVirtualThread;
     180function TThreadList.FindById(Id: TThreadID): TVirtualThread;
    176181var
    177182  I: Integer;
    178183begin
    179184  I := 0;
    180   while (I < ThreadList.Count) and (TVirtualThread(ThreadList[I]).ThreadID <> Id) do
     185  while (I < ThreadList.Count) and (ThreadList[I].ThreadID <> Id) do
    181186    Inc(I);
    182   if I < ThreadList.Count then Result := TVirtualThread(ThreadList[I])
     187  if I < ThreadList.Count then Result := ThreadList[I]
    183188    else Result := nil;
    184189end;
    … …  
    233238end;
    234239
    235 function TListedThread.GetThreadId: Integer;
     240function TListedThread.GetThreadId: TThreadID;
    236241begin
    237242  Result := FThread.ThreadID;
    … …  
    356361ThreadListLock := TCriticalSection.Create;
    357362ThreadList := TThreadList.Create;
    358 ThreadList.OwnsObjects := False;
     363ThreadList.FreeObjects := False;
    359364
    360365finalization

  • trunk/Protocol.pas

    r401 r420  
    19431943      else
    19441944        result := 0;
    1945     end
     1945    end;
    19461946  end;
    19471947end;
Note: See TracChangeset for help on using the changeset viewer.