Changeset 548
- Timestamp:
- Feb 12, 2021, 12:03:11 AM (4 years ago)
- Location:
- Common
- Files:
-
- 3 added
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/Common.lpk
r542 r548 39 39 <Description Value="Various libraries"/> 40 40 <License Value="GNU/GPL"/> 41 <Version Minor=" 7"/>42 <Files Count="2 6">41 <Version Minor="8"/> 42 <Files Count="28"> 43 43 <Item1> 44 44 <Filename Value="StopWatch.pas"/> … … 156 156 <UnitName Value="ULanguages"/> 157 157 </Item26> 158 <Item27> 159 <Filename Value="UFormAbout.pas"/> 160 <UnitName Value="UFormAbout"/> 161 </Item27> 162 <Item28> 163 <Filename Value="UAboutDialog.pas"/> 164 <HasRegisterProc Value="True"/> 165 <UnitName Value="UAboutDialog"/> 166 </Item28> 158 167 </Files> 159 168 <i18n> -
Common/Common.pas
r545 r548 12 12 UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 13 13 UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 14 UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UAboutDialog, 15 UTranslator, ULanguages, UFormAbout, LazarusPackageIntf; 14 UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UMetaCanvas, 15 UGeometric, UTranslator, ULanguages, UFormAbout, UAboutDialog, 16 LazarusPackageIntf; 16 17 17 18 implementation … … 29 30 RegisterUnit('UScaleDPI', @UScaleDPI.Register); 30 31 RegisterUnit('UTheme', @UTheme.Register); 32 RegisterUnit('UTranslator', @UTranslator.Register); 31 33 RegisterUnit('UAboutDialog', @UAboutDialog.Register); 32 RegisterUnit('UTranslator', @UTranslator.Register);33 34 end; 34 35 -
Common/UApplicationInfo.pas
r545 r548 6 6 7 7 uses 8 SysUtils, Classes, Forms, URegistry, Controls, Graphics ;8 SysUtils, Classes, Forms, URegistry, Controls, Graphics, LCLType; 9 9 10 10 type … … 14 14 TApplicationInfo = class(TComponent) 15 15 private 16 FDescription: T Caption;16 FDescription: TTranslateString; 17 17 FIcon: TBitmap; 18 18 FIdentification: Byte; … … 49 49 property EmailContact: string read FEmailContact write FEmailContact; 50 50 property AppName: string read FAppName write FAppName; 51 property Description: string read FDescription write FDescription;51 property Description: TTranslateString read FDescription write FDescription; 52 52 property ReleaseDate: TDateTime read FReleaseDate write FReleaseDate; 53 53 property RegistryKey: string read FRegistryKey write FRegistryKey; -
Common/UFormAbout.lfm
r545 r548 11 11 OnShow = FormShow 12 12 Position = poScreenCenter 13 LCLVersion = '2.0. 2.0'13 LCLVersion = '2.0.10.0' 14 14 object LabelDescription: TLabel 15 15 Left = 30 16 Height = 2 616 Height = 24 17 17 Top = 135 18 18 Width = 642 … … 28 28 object LabelContent: TLabel 29 29 Left = 30 30 Height = 2 631 Top = 1 9130 Height = 24 31 Top = 189 32 32 Width = 642 33 33 Align = alTop … … 50 50 TabOrder = 0 51 51 object LabelAppName: TLabel 52 Left = 9653 Height = 10052 Left = 108 53 Height = 84 54 54 Top = 20 55 Width = 5 7255 Width = 564 56 56 Anchors = [akTop, akLeft, akRight] 57 57 AutoSize = False … … 68 68 Top = 30 69 69 Width = 72 70 Proportional = True 71 Stretch = True 70 72 end 71 73 end -
Common/UMetaCanvas.pas
r542 r548 6 6 7 7 uses 8 Classes, SysUtils, Graphics, Contnrs, Types ;8 Classes, SysUtils, Graphics, Contnrs, Types, fgl; 9 9 10 10 type … … 17 17 procedure Zoom(Factor: Double); virtual; 18 18 procedure Move(Delta: TPoint); virtual; 19 end; 20 21 TCanvasObjects = class(TFPGObjectList<TCanvasObject>) 19 22 end; 20 23 … … 133 136 procedure DoLineTo(X, Y: Integer); override; 134 137 public 135 Objects: T ObjectList;138 Objects: TCanvasObjects; 136 139 procedure FillRect(const ARect: TRect); overload; override; 137 140 procedure FillRect(X1,Y1,X2,Y2: Integer); overload; … … 145 148 procedure Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, 146 149 StartX, StartY, EndX, EndY: Integer); override; 147 procedure SetSize(Size: TPoint);148 150 procedure Reset; 149 151 procedure DrawTo(Canvas: TCanvas); … … 152 154 constructor Create; 153 155 destructor Destroy; override; 154 end; 156 property Size: TPoint read FSize write FSize; 157 end; 158 155 159 156 160 implementation … … 198 202 Pen.Free; 199 203 Brush.Free; 200 inherited Destroy;204 inherited; 201 205 end; 202 206 … … 228 232 destructor TCanvasStretchDraw.Destroy; 229 233 begin 230 inherited Destroy;234 inherited; 231 235 end; 232 236 … … 264 268 Pen.Free; 265 269 Brush.Free; 266 inherited Destroy;270 inherited; 267 271 end; 268 272 … … 304 308 Brush.Free; 305 309 Pen.Free; 306 inherited Destroy;310 inherited; 307 311 end; 308 312 … … 336 340 begin 337 341 Pen.Free; 338 inherited Destroy;342 inherited; 339 343 end; 340 344 … … 375 379 Pen.Free; 376 380 Brush.Free; 377 inherited Destroy;381 inherited; 378 382 end; 379 383 … … 408 412 Brush.Free; 409 413 Font.Free; 410 inherited Destroy;414 inherited; 411 415 end; 412 416 … … 618 622 end; 619 623 620 procedure TMetaCanvas.SetSize(Size: TPoint);621 begin622 FSize := Size;623 end;624 625 624 procedure TMetaCanvas.Reset; 626 625 begin … … 633 632 begin 634 633 for I := 0 to Objects.Count - 1 do 635 TCanvasObject(Objects[I]).Paint(Canvas);634 Objects[I].Paint(Canvas); 636 635 end; 637 636 … … 641 640 begin 642 641 for I := 0 to Objects.Count - 1 do 643 TCanvasObject(Objects[I]).Zoom(Factor);642 Objects[I].Zoom(Factor); 644 643 end; 645 644 … … 649 648 begin 650 649 for I := 0 to Objects.Count - 1 do 651 TCanvasObject(Objects[I]).Move(Delta);650 Objects[I].Move(Delta); 652 651 end; 653 652 … … 656 655 inherited; 657 656 FPenPos := Point(0, 0); 658 Objects := T ObjectList.Create;657 Objects := TCanvasObjects.Create; 659 658 end; 660 659 … … 662 661 begin 663 662 Objects.Free; 664 inherited Destroy;663 inherited; 665 664 end; 666 665 -
Common/UPersistentForm.pas
r515 r548 3 3 {$mode delphi} 4 4 5 // Date: 20 15-04-185 // Date: 2020-11-26 6 6 7 7 interface … … 9 9 uses 10 10 Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls, 11 ExtCtrls ;11 ExtCtrls, LCLType; 12 12 13 13 type … … 26 26 FormRestoredSize: TRect; 27 27 FormWindowState: TWindowState; 28 FormFullScreen: Boolean; 28 29 Form: TForm; 29 30 procedure LoadFromRegistry(RegistryContext: TRegistryContext); … … 31 32 function CheckEntireVisible(Rect: TRect): TRect; 32 33 function CheckPartVisible(Rect: TRect; Part: Integer): TRect; 33 procedure Load(Form: TForm; DefaultMaximized: Boolean = False); 34 procedure Load(Form: TForm; DefaultMaximized: Boolean = False; 35 DefaultFullScreen: Boolean = False); 34 36 procedure Save(Form: TForm); 35 37 constructor Create(AOwner: TComponent); override; 38 procedure SetFullScreen(State: Boolean); 36 39 property RegistryContext: TRegistryContext read FRegistryContext 37 40 write FRegistryContext; … … 43 46 procedure Register; 44 47 48 45 49 implementation 46 47 50 48 51 procedure Register; … … 169 172 + FormRestoredSize.Top; 170 173 // Other state 171 FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal))); 174 FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(FormWindowState))); 175 FormFullScreen := ReadBoolWithDefault('FullScreen', FormFullScreen); 172 176 finally 173 177 Free; … … 193 197 // Other state 194 198 WriteInteger('WindowState', Integer(FormWindowState)); 199 WriteBool('FullScreen', FormFullScreen); 195 200 finally 196 201 Free; … … 250 255 end; 251 256 252 procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False); 257 procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False; 258 DefaultFullScreen: Boolean = False); 253 259 begin 254 260 Self.Form := Form; … … 258 264 FormRestoredSize := Bounds((Screen.Width - Form.Width) div 2, 259 265 (Screen.Height - Form.Height) div 2, Form.Width, Form.Height); 266 FormWindowState := Form.WindowState; 267 FormFullScreen := DefaultFullScreen; 260 268 261 269 LoadFromRegistry(RegistryContext); … … 277 285 Form.BoundsRect := FormNormalSize; 278 286 end; 287 if FormFullScreen then SetFullScreen(True); 279 288 LoadControl(Form); 280 289 end; … … 284 293 Self.Form := Form; 285 294 FormNormalSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height); 286 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 287 Form.RestoredHeight); 295 if not FormFullScreen then 296 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 297 Form.RestoredHeight); 288 298 FormWindowState := Form.WindowState; 289 299 SaveToRegistry(RegistryContext); … … 300 310 end; 301 311 312 procedure TPersistentForm.SetFullScreen(State: Boolean); 313 begin 314 if State then begin 315 FormFullScreen := True; 316 FormNormalSize := Form.BoundsRect; 317 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 318 Form.RestoredHeight); 319 FormWindowState := Form.WindowState; 320 ShowWindow(Form.Handle, SW_SHOWFULLSCREEN); 321 {$IFDEF WINDOWS} 322 Form.BorderStyle := bsNone; 323 {$ENDIF} 324 end else begin 325 FormFullScreen := False; 326 {$IFDEF WINDOWS} 327 Form.BorderStyle := bsSizeable; 328 {$ENDIF} 329 ShowWindow(Form.Handle, SW_SHOWNORMAL); 330 if FormWindowState = wsNormal then begin 331 Form.BoundsRect := FormNormalSize; 332 end else 333 if FormWindowState = wsMaximized then begin 334 Form.BoundsRect := FormRestoredSize; 335 Form.WindowState := wsMaximized; 336 end; 337 end; 338 end; 339 302 340 end. 303 341
Note:
See TracChangeset
for help on using the changeset viewer.