Changeset 568
- Timestamp:
- May 13, 2024, 6:00:06 PM (6 months ago)
- Location:
- trunk
- Files:
-
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/CevoComponents/ButtonA.pas
r554 r568 14 14 procedure SetFont(const Font: TFont); 15 15 protected 16 procedure SetCaption(Text: string); override;16 procedure SetCaption(Text: string); 17 17 procedure Paint; override; 18 18 public -
trunk/Packages/CevoComponents/CevoComponents.lpk
r554 r568 37 37 <Description Value="C-evo components"/> 38 38 <Version Major="1" Minor="2"/> 39 <Files Count="1 7">39 <Files Count="18"> 40 40 <Item1> 41 41 <Filename Value="Area.pas"/> … … 116 116 <UnitName Value="ButtonG"/> 117 117 </Item17> 118 <Item18> 119 <Filename Value="ListBoxEx.pas"/> 120 <HasRegisterProc Value="True"/> 121 <UnitName Value="ListBoxEx"/> 122 </Item18> 118 123 </Files> 119 124 <CompatibilityMode Value="True"/> -
trunk/Packages/CevoComponents/CevoComponents.pas
r554 r568 10 10 uses 11 11 Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg, 12 Sound, BaseWin, AsyncProcess2, GraphicSet, Texture, ButtonG, 12 Sound, BaseWin, AsyncProcess2, GraphicSet, Texture, ButtonG, ListBoxEx, 13 13 LazarusPackageIntf; 14 14 … … 27 27 RegisterUnit('GraphicSet', @GraphicSet.Register); 28 28 RegisterUnit('ButtonG', @ButtonG.Register); 29 RegisterUnit('ListBoxEx', @ListBoxEx.Register); 29 30 end; 30 31 -
trunk/Packages/DpiControls/Dpi.Common.pas
r559 r568 227 227 begin 228 228 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. 230 230 // Without lookup table we would use: 231 231 // Result := Ceil(Value * ScreenInfo.ToNative); -
trunk/Packages/DpiControls/Dpi.Graphics.pas
r560 r568 8 8 const 9 9 clBlack = TColor($000000); 10 clWhite = TColor($ffffff); 10 11 11 12 type … … 92 93 93 94 TBrushStyle = Graphics.TBrushStyle; 95 TPenStyle = Graphics.TPenStyle; 94 96 95 97 { TBrush } … … 131 133 function GetHandle: HDC; 132 134 function GetPixel(X, Y: Integer): TColor; 135 function GetTextStyle: TTextStyle; 133 136 procedure SetBrush(AValue: TBrush); 134 137 procedure SetFont(AValue: TFont); … … 137 140 procedure SetPixel(X, Y: Integer; AValue: TColor); 138 141 procedure SetNativeCanvas(AValue: Graphics.TCanvas); 142 procedure SetTextStyle(AValue: TTextStyle); 139 143 protected 140 144 procedure DoLine(X1, Y1, X2, Y2: Integer); virtual; … … 182 186 function TextExtent(const Text: string): TSize; virtual; 183 187 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; 185 191 procedure MoveTo(X, Y: Integer); 186 192 procedure LineTo(X, Y: Integer); … … 196 202 property Width: Integer read GetWidth; 197 203 property Height: Integer read GetHeight; 204 property TextStyle: TTextStyle read GetTextStyle write SetTextStyle; 198 205 published 199 206 property Brush: TBrush read FBrush write SetBrush; … … 966 973 end; 967 974 975 function TCanvas.GetTextStyle: TTextStyle; 976 begin 977 Result := GetNativeCanvas.TextStyle; 978 end; 979 968 980 function TCanvas.GetWidth: Integer; 969 981 begin … … 1039 1051 end; 1040 1052 1053 procedure TCanvas.SetTextStyle(AValue: TTextStyle); 1054 begin 1055 GetNativeCanvas.TextStyle := AValue; 1056 end; 1057 1041 1058 procedure TCanvas.DoLine(X1, Y1, X2, Y2: Integer); 1042 1059 begin … … 1213 1230 procedure TCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string); 1214 1231 begin 1215 GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X), ScaleToNative(Y), Text); 1232 GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X), 1233 ScaleToNative(Y), Text); 1234 end; 1235 1236 procedure TCanvas.TextRect(ARect: TRect; X, Y: integer; const Text: string; 1237 const Style: TTextStyle); 1238 begin 1239 GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X), 1240 ScaleToNative(Y), Text, TextStyle); 1216 1241 end; 1217 1242 -
trunk/Packages/DpiControls/Dpi.StdCtrls.pas
r503 r568 4 4 5 5 uses 6 Classes, SysUtils, Controls, StdCtrls, Forms, Dpi.Controls ;6 Classes, SysUtils, Controls, StdCtrls, Forms, Dpi.Controls, Dpi.Graphics; 7 7 8 8 type … … 104 104 end; 105 105 106 TDrawItemEvent = procedure(Control: TWinControl; Index: Integer; 107 ARect: TRect; State: TOwnerDrawState) of object; 108 TListBoxStyle = StdCtrls.TListBoxStyle; 109 106 110 { TListBox } 107 111 108 112 TListBox = class(TWinControl) 109 113 private 114 FCanvas: TCanvas; 115 FOnDrawItem: TDrawItemEvent; 110 116 function GetBorderStyle: TBorderStyle; 111 117 function GetCount: Integer; … … 118 124 function GetParentFont: Boolean; 119 125 function GetScrollWidth: Integer; 126 function GetStyle: TListBoxStyle; 120 127 function GetTopIndex: Integer; 121 128 procedure SetBorderStyle(AValue: TBorderStyle); … … 125 132 procedure SetItemIndex(AValue: Integer); 126 133 procedure SetItems(AValue: TStrings); 134 procedure SetOnDrawItem(AValue: TDrawItemEvent); 127 135 procedure SetOnSelectionChange(AValue: TSelectionChangeEvent); 128 136 procedure SetParentFont(AValue: Boolean); 129 137 procedure SetScrollWidth(AValue: Integer); 138 procedure SetStyle(AValue: TListBoxStyle); 130 139 procedure SetTopIndex(AValue: Integer); 140 procedure DoDrawItemNative(Control: Controls.TWinControl; Index: Integer; 141 ARect: TRect; State: TOwnerDrawState); 131 142 protected 132 143 function GetNativeWinControl: Controls.TWinControl; override; … … 134 145 public 135 146 NativeListBox: StdCtrls.TListBox; 147 constructor Create(AOwner: TComponent); override; 136 148 destructor Destroy; override; 137 149 property ItemIndex: Integer read GetItemIndex write SetItemIndex; 138 150 property Items: TStrings read GetItems write SetItems; 139 151 property Count: Integer read GetCount; 152 property Canvas: TCanvas read FCanvas; 140 153 published 141 154 property ParentColor; … … 151 164 property OnSelectionChange: TSelectionChangeEvent read GetOnSelectionChange 152 165 write SetOnSelectionChange; 166 property Style: TListBoxStyle read GetStyle write SetStyle default lbStandard; 167 property OnDrawItem: TDrawItemEvent read FOnDrawItem write SetOnDrawItem; 153 168 end; 154 169 … … 497 512 function TListBox.GetItemHeight: Integer; 498 513 begin 499 Result := GetNativeListBox.ItemHeight;514 Result := ScaleFromNative(GetNativeListBox.ItemHeight); 500 515 end; 501 516 … … 525 540 end; 526 541 542 function TListBox.GetStyle: TListBoxStyle; 543 begin 544 Result := GetNativeListBox.Style; 545 end; 546 527 547 function TListBox.GetTopIndex: Integer; 528 548 begin … … 547 567 procedure TListBox.SetItemHeight(AValue: Integer); 548 568 begin 549 GetNativeListBox.ItemHeight := AValue;569 GetNativeListBox.ItemHeight := ScaleToNative(AValue); 550 570 end; 551 571 … … 560 580 end; 561 581 582 procedure TListBox.SetOnDrawItem(AValue: TDrawItemEvent); 583 begin 584 FOnDrawItem := AValue; 585 if Assigned(AValue) then 586 GetNativeListBox.OnDrawItem := DoDrawItemNative 587 else GetNativeListBox.OnDrawItem := nil; 588 end; 589 562 590 procedure TListBox.SetOnSelectionChange(AValue: TSelectionChangeEvent); 563 591 begin … … 575 603 end; 576 604 605 procedure TListBox.SetStyle(AValue: TListBoxStyle); 606 begin 607 GetNativeListBox.Style := AValue; 608 end; 609 577 610 procedure TListBox.SetTopIndex(AValue: Integer); 578 611 begin 579 612 GetNativeListBox.TopIndex := AValue; 613 end; 614 615 procedure TListBox.DoDrawItemNative(Control: Controls.TWinControl; 616 Index: Integer; ARect: TRect; State: TOwnerDrawState); 617 begin 618 if Assigned(FOnDrawItem) then 619 FOnDrawItem(Self, Index, ScaleRectFromNative(ARect), State); 580 620 end; 581 621 … … 591 631 end; 592 632 633 constructor TListBox.Create(AOwner: TComponent); 634 begin 635 inherited; 636 FCanvas := TCanvas.Create; 637 FCanvas.NativeCanvas := GetNativeListBox.Canvas; 638 end; 639 593 640 destructor TListBox.Destroy; 594 641 begin 642 FreeAndNil(FCanvas); 595 643 FreeAndNil(NativeListBox); 596 644 inherited; -
trunk/Settings.lfm
r565 r568 9 9 ClientWidth = 483 10 10 Color = clBtnFace 11 DesignTimePPI = 144 11 12 Font.Color = clWindowText 12 13 Font.Height = -11 13 14 Font.Name = 'MS Sans Serif' 14 DesignTimePPI = 14415 15 FormStyle = fsStayOnTop 16 16 OnClose = FormClose … … 22 22 LCLVersion = '2.2.6.0' 23 23 Scaled = False 24 object ListLanguages: TListBox 24 object ListLanguages: TListBoxEx 25 25 Tag = 15360 26 26 Left = 16 … … 36 36 Font.Style = [fsBold] 37 37 IntegralHeight = True 38 ItemHeight = 038 ItemHeight = 20 39 39 ParentFont = False 40 40 ScrollWidth = 144 … … 93 93 ButtonIndex = 0 94 94 end 95 object ListKeyBindings: TListBox 95 object ListKeyBindings: TListBoxEx 96 96 Tag = 15360 97 97 Left = 176 … … 107 107 Font.Style = [fsBold] 108 108 IntegralHeight = True 109 ItemHeight = 0 110 OnSelectionChange = ListKeyBindingsSelectionChange 109 ItemHeight = 20 111 110 ParentFont = False 112 111 ScrollWidth = 288 … … 114 113 TabStop = False 115 114 TopIndex = -1 115 OnSelectionChange = ListKeyBindingsSelectionChange 116 116 end 117 117 object EditShortCutPrimary: TEdit … … 127 127 Font.Name = 'Times New Roman' 128 128 Font.Style = [fsBold] 129 OnKeyUp = EditShortCutPrimaryKeyUp130 129 ParentFont = False 131 130 TabOrder = 2 131 OnKeyUp = EditShortCutPrimaryKeyUp 132 132 end 133 133 object EditShortCutSecondary: TEdit … … 143 143 Font.Name = 'Times New Roman' 144 144 Font.Style = [fsBold] 145 OnKeyUp = EditShortCutSecondaryKeyUp146 145 ParentFont = False 147 146 TabOrder = 3 147 OnKeyUp = EditShortCutSecondaryKeyUp 148 148 end 149 149 object ButtonReset: TButtonA -
trunk/Settings.pas
r565 r568 5 5 uses 6 6 Classes, SysUtils, FileUtil, Dialogs, LCLProc, ScreenTools, Messg, ButtonA, 7 Directories, DrawDlg, ButtonC, KeyBindings, Languages, 7 Directories, DrawDlg, ButtonC, KeyBindings, Languages, ListBoxEx, 8 8 {$IFDEF DPI}Dpi.Forms, Dpi.Controls, Dpi.Graphics, Dpi.StdCtrls, System.UITypes{$ELSE} 9 9 Forms, Controls, Graphics, StdCtrls{$ENDIF}; … … 19 19 EditShortCutPrimary: TEdit; 20 20 EditShortCutSecondary: TEdit; 21 ListLanguages: TListBox ;22 ListKeyBindings: TListBox ;21 ListLanguages: TListBoxEx; 22 ListKeyBindings: TListBoxEx; 23 23 ButtonOk: TButtonA; 24 24 ButtonCancel: TButtonA; -
trunk/Start.lfm
r565 r568 180 180 ButtonIndex = 19 181 181 end 182 object List: TListBox 182 object List: TListBoxEx 183 183 Tag = 15360 184 184 Left = 45 … … 194 194 Font.Style = [fsBold] 195 195 IntegralHeight = True 196 ItemHeight = 0196 ItemHeight = 20 197 197 OnClick = ListClick 198 198 OnDblClick = StartBtnClick -
trunk/Start.pas
r566 r568 6 6 uses 7 7 GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Types, 8 LCLIntf, LCLType, SysUtils, Classes, BaseWin, 8 LCLIntf, LCLType, SysUtils, Classes, BaseWin, ListBoxEx, 9 9 Registry, DrawDlg, Generics.Collections, Protocol, MiniMap, Brain, Translator, 10 10 {$IFDEF DPI}System.UITypes, Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.StdCtrls, … … 47 47 Down1Btn: TButtonC; 48 48 Up1Btn: TButtonC; 49 List: TListBox ;49 List: TListBoxEx; 50 50 RenameBtn: TButtonB; 51 51 DeleteBtn: TButtonB; … … 1799 1799 ShowTab := Tab; 1800 1800 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 := ''; 1802 1804 end; 1803 1805
Note:
See TracChangeset
for help on using the changeset viewer.