Changeset 568 for trunk


Ignore:
Timestamp:
May 13, 2024, 6:00:06 PM (6 months ago)
Author:
chronos
Message:
  • Fixed: Custom draw ListBox items to keep consistent style on Linux.
  • Fixed: Last game name index error if no saved games.
Location:
trunk
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/CevoComponents/ButtonA.pas

    r554 r568  
    1414    procedure SetFont(const Font: TFont);
    1515  protected
    16     procedure SetCaption(Text: string); override;
     16    procedure SetCaption(Text: string);
    1717    procedure Paint; override;
    1818  public

  • trunk/Packages/CevoComponents/CevoComponents.lpk

    r554 r568  
    3737    <Description Value="C-evo components"/>
    3838    <Version Major="1" Minor="2"/>
    39     <Files Count="17">
     39    <Files Count="18">
    4040      <Item1>
    4141        <Filename Value="Area.pas"/>
    … …  
    116116        <UnitName Value="ButtonG"/>
    117117      </Item17>
     118      <Item18>
     119        <Filename Value="ListBoxEx.pas"/>
     120        <HasRegisterProc Value="True"/>
     121        <UnitName Value="ListBoxEx"/>
     122      </Item18>
    118123    </Files>
    119124    <CompatibilityMode Value="True"/>

  • trunk/Packages/CevoComponents/CevoComponents.pas

    r554 r568  
    1010uses
    1111  Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg,
    12   Sound, BaseWin, AsyncProcess2, GraphicSet, Texture, ButtonG,
     12  Sound, BaseWin, AsyncProcess2, GraphicSet, Texture, ButtonG, ListBoxEx,
    1313  LazarusPackageIntf;
    1414
    … …  
    2727  RegisterUnit('GraphicSet', @GraphicSet.Register);
    2828  RegisterUnit('ButtonG', @ButtonG.Register);
     29  RegisterUnit('ListBoxEx', @ListBoxEx.Register);
    2930end;
    3031

  • trunk/Packages/DpiControls/Dpi.Common.pas

    r559 r568  
    227227begin
    228228  Result := ScreenInfo.Lookup[Value];
    229   // Round and Trunc are fast. Ceil and Floor slow.
     229  // Round and Trunc are fast. Ceil and Floor are slow.
    230230  // Without lookup table we would use:
    231231  // Result := Ceil(Value * ScreenInfo.ToNative);

  • trunk/Packages/DpiControls/Dpi.Graphics.pas

    r560 r568  
    88const
    99  clBlack = TColor($000000);
     10  clWhite = TColor($ffffff);
    1011
    1112type
    … …  
    9293
    9394  TBrushStyle = Graphics.TBrushStyle;
     95  TPenStyle = Graphics.TPenStyle;
    9496
    9597  { TBrush }
    … …  
    131133    function GetHandle: HDC;
    132134    function GetPixel(X, Y: Integer): TColor;
     135    function GetTextStyle: TTextStyle;
    133136    procedure SetBrush(AValue: TBrush);
    134137    procedure SetFont(AValue: TFont);
    … …  
    137140    procedure SetPixel(X, Y: Integer; AValue: TColor);
    138141    procedure SetNativeCanvas(AValue: Graphics.TCanvas);
     142    procedure SetTextStyle(AValue: TTextStyle);
    139143  protected
    140144    procedure DoLine(X1, Y1, X2, Y2: Integer); virtual;
    … …  
    182186    function TextExtent(const Text: string): TSize; virtual;
    183187    procedure TextOut(X, Y: Integer; const Text: string); virtual;
    184     procedure TextRect(ARect: TRect; X, Y: Integer; Text: string);
     188    procedure TextRect(ARect: TRect; X, Y: Integer; Text: string); overload;
     189    procedure TextRect(ARect: TRect; X, Y: integer; const Text: string;
     190      const Style: TTextStyle); overload;
    185191    procedure MoveTo(X, Y: Integer);
    186192    procedure LineTo(X, Y: Integer);
    … …  
    196202    property Width: Integer read GetWidth;
    197203    property Height: Integer read GetHeight;
     204    property TextStyle: TTextStyle read GetTextStyle write SetTextStyle;
    198205  published
    199206    property Brush: TBrush read FBrush write SetBrush;
    … …  
    966973end;
    967974
     975function TCanvas.GetTextStyle: TTextStyle;
     976begin
     977  Result := GetNativeCanvas.TextStyle;
     978end;
     979
    968980function TCanvas.GetWidth: Integer;
    969981begin
    … …  
    10391051end;
    10401052
     1053procedure TCanvas.SetTextStyle(AValue: TTextStyle);
     1054begin
     1055  GetNativeCanvas.TextStyle := AValue;
     1056end;
     1057
    10411058procedure TCanvas.DoLine(X1, Y1, X2, Y2: Integer);
    10421059begin
    … …  
    12131230procedure TCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string);
    12141231begin
    1215   GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X), ScaleToNative(Y), Text);
     1232  GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X),
     1233    ScaleToNative(Y), Text);
     1234end;
     1235
     1236procedure TCanvas.TextRect(ARect: TRect; X, Y: integer; const Text: string;
     1237  const Style: TTextStyle);
     1238begin
     1239  GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X),
     1240    ScaleToNative(Y), Text, TextStyle);
    12161241end;
    12171242

  • trunk/Packages/DpiControls/Dpi.StdCtrls.pas

    r503 r568  
    44
    55uses
    6   Classes, SysUtils, Controls, StdCtrls, Forms, Dpi.Controls;
     6  Classes, SysUtils, Controls, StdCtrls, Forms, Dpi.Controls, Dpi.Graphics;
    77
    88type
    … …  
    104104  end;
    105105
     106  TDrawItemEvent = procedure(Control: TWinControl; Index: Integer;
     107    ARect: TRect; State: TOwnerDrawState) of object;
     108  TListBoxStyle = StdCtrls.TListBoxStyle;
     109
    106110  { TListBox }
    107111
    108112  TListBox = class(TWinControl)
    109113  private
     114    FCanvas: TCanvas;
     115    FOnDrawItem: TDrawItemEvent;
    110116    function GetBorderStyle: TBorderStyle;
    111117    function GetCount: Integer;
    … …  
    118124    function GetParentFont: Boolean;
    119125    function GetScrollWidth: Integer;
     126    function GetStyle: TListBoxStyle;
    120127    function GetTopIndex: Integer;
    121128    procedure SetBorderStyle(AValue: TBorderStyle);
    … …  
    125132    procedure SetItemIndex(AValue: Integer);
    126133    procedure SetItems(AValue: TStrings);
     134    procedure SetOnDrawItem(AValue: TDrawItemEvent);
    127135    procedure SetOnSelectionChange(AValue: TSelectionChangeEvent);
    128136    procedure SetParentFont(AValue: Boolean);
    129137    procedure SetScrollWidth(AValue: Integer);
     138    procedure SetStyle(AValue: TListBoxStyle);
    130139    procedure SetTopIndex(AValue: Integer);
     140    procedure DoDrawItemNative(Control: Controls.TWinControl; Index: Integer;
     141      ARect: TRect; State: TOwnerDrawState);
    131142  protected
    132143    function GetNativeWinControl: Controls.TWinControl; override;
    … …  
    134145  public
    135146    NativeListBox: StdCtrls.TListBox;
     147    constructor Create(AOwner: TComponent); override;
    136148    destructor Destroy; override;
    137149    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    138150    property Items: TStrings read GetItems write SetItems;
    139151    property Count: Integer read GetCount;
     152    property Canvas: TCanvas read FCanvas;
    140153  published
    141154    property ParentColor;
    … …  
    151164    property OnSelectionChange: TSelectionChangeEvent read GetOnSelectionChange
    152165                                                      write SetOnSelectionChange;
     166    property Style: TListBoxStyle read GetStyle write SetStyle default lbStandard;
     167    property OnDrawItem: TDrawItemEvent read FOnDrawItem write SetOnDrawItem;
    153168  end;
    154169
    … …  
    497512function TListBox.GetItemHeight: Integer;
    498513begin
    499   Result := GetNativeListBox.ItemHeight;
     514  Result := ScaleFromNative(GetNativeListBox.ItemHeight);
    500515end;
    501516
    … …  
    525540end;
    526541
     542function TListBox.GetStyle: TListBoxStyle;
     543begin
     544  Result := GetNativeListBox.Style;
     545end;
     546
    527547function TListBox.GetTopIndex: Integer;
    528548begin
    … …  
    547567procedure TListBox.SetItemHeight(AValue: Integer);
    548568begin
    549   GetNativeListBox.ItemHeight := AValue;
     569  GetNativeListBox.ItemHeight := ScaleToNative(AValue);
    550570end;
    551571
    … …  
    560580end;
    561581
     582procedure TListBox.SetOnDrawItem(AValue: TDrawItemEvent);
     583begin
     584  FOnDrawItem := AValue;
     585  if Assigned(AValue) then
     586    GetNativeListBox.OnDrawItem := DoDrawItemNative
     587    else GetNativeListBox.OnDrawItem := nil;
     588end;
     589
    562590procedure TListBox.SetOnSelectionChange(AValue: TSelectionChangeEvent);
    563591begin
    … …  
    575603end;
    576604
     605procedure TListBox.SetStyle(AValue: TListBoxStyle);
     606begin
     607  GetNativeListBox.Style := AValue;
     608end;
     609
    577610procedure TListBox.SetTopIndex(AValue: Integer);
    578611begin
    579612  GetNativeListBox.TopIndex := AValue;
     613end;
     614
     615procedure TListBox.DoDrawItemNative(Control: Controls.TWinControl;
     616  Index: Integer; ARect: TRect; State: TOwnerDrawState);
     617begin
     618  if Assigned(FOnDrawItem) then
     619    FOnDrawItem(Self, Index, ScaleRectFromNative(ARect), State);
    580620end;
    581621
    … …  
    591631end;
    592632
     633constructor TListBox.Create(AOwner: TComponent);
     634begin
     635  inherited;
     636  FCanvas := TCanvas.Create;
     637  FCanvas.NativeCanvas := GetNativeListBox.Canvas;
     638end;
     639
    593640destructor TListBox.Destroy;
    594641begin
     642  FreeAndNil(FCanvas);
    595643  FreeAndNil(NativeListBox);
    596644  inherited;

  • trunk/Settings.lfm

    r565 r568  
    99  ClientWidth = 483
    1010  Color = clBtnFace
     11  DesignTimePPI = 144
    1112  Font.Color = clWindowText
    1213  Font.Height = -11
    1314  Font.Name = 'MS Sans Serif'
    14   DesignTimePPI = 144
    1515  FormStyle = fsStayOnTop
    1616  OnClose = FormClose
    … …  
    2222  LCLVersion = '2.2.6.0'
    2323  Scaled = False
    24   object ListLanguages: TListBox
     24  object ListLanguages: TListBoxEx
    2525    Tag = 15360
    2626    Left = 16
    … …  
    3636    Font.Style = [fsBold]
    3737    IntegralHeight = True
    38     ItemHeight = 0
     38    ItemHeight = 20
    3939    ParentFont = False
    4040    ScrollWidth = 144
    … …  
    9393    ButtonIndex = 0
    9494  end
    95   object ListKeyBindings: TListBox
     95  object ListKeyBindings: TListBoxEx
    9696    Tag = 15360
    9797    Left = 176
    … …  
    107107    Font.Style = [fsBold]
    108108    IntegralHeight = True
    109     ItemHeight = 0
    110     OnSelectionChange = ListKeyBindingsSelectionChange
     109    ItemHeight = 20
    111110    ParentFont = False
    112111    ScrollWidth = 288
    … …  
    114113    TabStop = False
    115114    TopIndex = -1
     115    OnSelectionChange = ListKeyBindingsSelectionChange
    116116  end
    117117  object EditShortCutPrimary: TEdit
    … …  
    127127    Font.Name = 'Times New Roman'
    128128    Font.Style = [fsBold]
    129     OnKeyUp = EditShortCutPrimaryKeyUp
    130129    ParentFont = False
    131130    TabOrder = 2
     131    OnKeyUp = EditShortCutPrimaryKeyUp
    132132  end
    133133  object EditShortCutSecondary: TEdit
    … …  
    143143    Font.Name = 'Times New Roman'
    144144    Font.Style = [fsBold]
    145     OnKeyUp = EditShortCutSecondaryKeyUp
    146145    ParentFont = False
    147146    TabOrder = 3
     147    OnKeyUp = EditShortCutSecondaryKeyUp
    148148  end
    149149  object ButtonReset: TButtonA

  • trunk/Settings.pas

    r565 r568  
    55uses
    66  Classes, SysUtils, FileUtil, Dialogs, LCLProc, ScreenTools, Messg, ButtonA,
    7   Directories, DrawDlg, ButtonC, KeyBindings, Languages,
     7  Directories, DrawDlg, ButtonC, KeyBindings, Languages, ListBoxEx,
    88  {$IFDEF DPI}Dpi.Forms, Dpi.Controls, Dpi.Graphics, Dpi.StdCtrls, System.UITypes{$ELSE}
    99  Forms, Controls, Graphics, StdCtrls{$ENDIF};
    … …  
    1919    EditShortCutPrimary: TEdit;
    2020    EditShortCutSecondary: TEdit;
    21     ListLanguages: TListBox;
    22     ListKeyBindings: TListBox;
     21    ListLanguages: TListBoxEx;
     22    ListKeyBindings: TListBoxEx;
    2323    ButtonOk: TButtonA;
    2424    ButtonCancel: TButtonA;

  • trunk/Start.lfm

    r565 r568  
    180180    ButtonIndex = 19
    181181  end
    182   object List: TListBox
     182  object List: TListBoxEx
    183183    Tag = 15360
    184184    Left = 45
    … …  
    194194    Font.Style = [fsBold]
    195195    IntegralHeight = True
    196     ItemHeight = 0
     196    ItemHeight = 20
    197197    OnClick = ListClick
    198198    OnDblClick = StartBtnClick

  • trunk/Start.pas

    r566 r568  
    66uses
    77  GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Types,
    8   LCLIntf, LCLType, SysUtils, Classes, BaseWin,
     8  LCLIntf, LCLType, SysUtils, Classes, BaseWin, ListBoxEx,
    99  Registry, DrawDlg, Generics.Collections, Protocol, MiniMap, Brain, Translator,
    1010  {$IFDEF DPI}System.UITypes, Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.StdCtrls,
    … …  
    4747    Down1Btn: TButtonC;
    4848    Up1Btn: TButtonC;
    49     List: TListBox;
     49    List: TListBoxEx;
    5050    RenameBtn: TButtonB;
    5151    DeleteBtn: TButtonB;
    … …  
    17991799  ShowTab := Tab;
    18001800  Background.Enabled := True;
    1801   LastGame := FormerGames[ListIndex[tbPrevious]];
     1801  if (ListIndex[tbPrevious] >= 0) and (ListIndex[tbPrevious] < FormerGames.Count) then
     1802    LastGame := FormerGames[ListIndex[tbPrevious]]
     1803    else LastGame := '';
    18021804end;
    18031805
Note: See TracChangeset for help on using the changeset viewer.