Changeset 562
- Timestamp:
- May 27, 2023, 11:00:20 AM (18 months ago)
- Location:
- Common
- Files:
-
- 26 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/UAboutDialog.pas
r558 r562 50 50 51 51 end. 52 -
Common/UDataFile.pas
r559 r562 109 109 110 110 end. 111 -
Common/UDebugLog.pas
r558 r562 1 unit UDebugLog; 1 unit UDebugLog; 2 2 3 3 interface … … 134 134 135 135 end. 136 -
Common/UDelay.pas
r558 r562 71 71 72 72 end. 73 -
Common/UFindFile.pas
r560 r562 143 143 SysUtils.FindClose(Rec); 144 144 end; 145 end; 145 end; 146 146 147 147 end. 148 -
Common/UFormAbout.lfm
r548 r562 1 1 object FormAbout: TFormAbout 2 2 Left = 1014 3 Height = 4023 Height = 349 4 4 Top = 577 5 Width = 7025 Width = 609 6 6 Caption = 'About' 7 ClientHeight = 402 8 ClientWidth = 702 9 DesignTimePPI = 144 10 OnCreate = FormCreate 7 ClientHeight = 349 8 ClientWidth = 609 9 DesignTimePPI = 125 11 10 OnShow = FormShow 12 11 Position = poScreenCenter 13 LCLVersion = '2. 0.10.0'12 LCLVersion = '2.2.4.0' 14 13 object LabelDescription: TLabel 15 Left = 3016 Height = 2 417 Top = 1 3518 Width = 64214 Left = 26 15 Height = 22 16 Top = 117 17 Width = 557 19 18 Align = alTop 20 BorderSpacing.Left = 3021 BorderSpacing.Right = 3022 BorderSpacing.Bottom = 3019 BorderSpacing.Left = 26 20 BorderSpacing.Right = 26 21 BorderSpacing.Bottom = 26 23 22 Caption = 'Description' 24 23 ParentColor = False … … 27 26 end 28 27 object LabelContent: TLabel 29 Left = 3030 Height = 2 431 Top = 1 8932 Width = 64228 Left = 26 29 Height = 22 30 Top = 165 31 Width = 557 33 32 Align = alTop 34 BorderSpacing.Around = 3033 BorderSpacing.Around = 26 35 34 Caption = ' ' 36 35 ParentColor = False … … 39 38 object PanelTop: TPanel 40 39 Left = 0 41 Height = 1 3540 Height = 117 42 41 Top = 0 43 Width = 70242 Width = 609 44 43 Align = alTop 45 44 BevelOuter = bvNone 46 ClientHeight = 1 3547 ClientWidth = 70245 ClientHeight = 117 46 ClientWidth = 609 48 47 FullRepaint = False 49 48 ParentFont = False 50 49 TabOrder = 0 51 50 object LabelAppName: TLabel 52 Left = 10853 Height = 8454 Top = 2055 Width = 56451 Left = 94 52 Height = 73 53 Top = 17 54 Width = 489 56 55 Anchors = [akTop, akLeft, akRight] 57 56 AutoSize = False 58 BorderSpacing.Around = 3057 BorderSpacing.Around = 26 59 58 Caption = 'Title' 60 Font.Height = - 6059 Font.Height = -52 61 60 ParentColor = False 62 61 ParentFont = False … … 64 63 end 65 64 object ImageLogo: TImage 66 Left = 2 467 Height = 7468 Top = 3069 Width = 7265 Left = 21 66 Height = 64 67 Top = 26 68 Width = 62 70 69 Proportional = True 71 70 Stretch = True … … 74 73 object PanelButtons: TPanel 75 74 Left = 0 76 Height = 7577 Top = 32778 Width = 70275 Height = 65 76 Top = 284 77 Width = 609 79 78 Align = alBottom 80 79 BevelOuter = bvNone 81 ClientHeight = 7582 ClientWidth = 70280 ClientHeight = 65 81 ClientWidth = 609 83 82 TabOrder = 1 84 83 object ButtonHomePage: TButton 85 Left = 2 486 Height = 3 887 Top = 2 488 Width = 2 6484 Left = 21 85 Height = 33 86 Top = 21 87 Width = 229 89 88 Anchors = [akLeft, akBottom] 90 89 Caption = 'Home page' … … 94 93 end 95 94 object ButtonClose: TButton 96 Left = 53297 Height = 3 898 Top = 2 499 Width = 1 4095 Left = 461 96 Height = 33 97 Top = 21 98 Width = 122 100 99 Anchors = [akRight, akBottom] 101 100 Caption = 'Close' -
Common/UFormAbout.pas
r560 r562 75 75 76 76 end. 77 -
Common/UGenerics.pas
r560 r562 77 77 78 78 end. 79 -
Common/UGeometric.pas
r558 r562 8 8 type 9 9 TPointArray = array of TPoint; 10 11 { TVector } 12 13 TVector = record 14 Position: TPoint; 15 Direction: TPoint; 16 function GetLength: Double; 17 function GetAngle: Double; 18 procedure SetLength(Value: Double); 19 class function Create(P1, P2: TPoint): TVector; static; 20 end; 10 21 11 22 function Distance(P1, P2: TPoint): Integer; … … 13 24 function AddPoint(const P1, P2: TPoint): TPoint; 14 25 function SubPoint(const P1, P2: TPoint): TPoint; 15 function PointToLineDistance(const P, V, W: TPoint ): Integer;26 function PointToLineDistance(const P, V, W: TPoint; out Intersect: TPoint): Integer; 16 27 function ComparePoint(P1, P2: TPoint): Boolean; 17 28 function RotatePoint(Center, P: TPoint; Angle: Double): TPoint; … … 50 61 end; 51 62 52 function PointToLineDistance(const P, V, W: TPoint ): Integer;63 function PointToLineDistance(const P, V, W: TPoint; out Intersect: TPoint): Integer; 53 64 var 54 65 l2, t: Double; … … 68 79 if T < 0 then begin 69 80 Result := Distance(P, V); // Beyond the 'v' end of the segment 70 exit; 81 Intersect := V; 82 Exit; 71 83 end 72 84 else if T > 1 then begin 73 85 Result := Distance(P, W); // Beyond the 'w' end of the segment 86 Intersect := W; 74 87 Exit; 75 88 end; … … 77 90 TT.Y := Trunc(V.Y + T * (W.Y - V.Y)); 78 91 Result := Distance(P, TT); 92 Intersect := TT; 79 93 end; 80 94 … … 162 176 end; 163 177 178 { TVector } 179 180 function TVector.GetLength: Double; 181 begin 182 Result := Sqrt(Sqr(Direction.X) + Sqr(Direction.Y)); 183 end; 184 185 function TVector.GetAngle: Double; 186 begin 187 Result := ArcTan2(Direction.Y, Direction.X); 188 end; 189 190 procedure TVector.SetLength(Value: Double); 191 var 192 Angle: Double; 193 begin 194 Angle := GetAngle; 195 Direction := Point(Round(Cos(Angle) * Value), 196 Round(Sin(Angle) * Value)); 197 end; 198 199 class function TVector.Create(P1, P2: TPoint): TVector; 200 begin 201 Result.Position := P1; 202 Result.Direction := Point(P2.X - P1.X, P2.Y - P1.Y); 203 end; 164 204 165 205 end. 166 -
Common/ULanguages.pas
r558 r562 443 443 444 444 end. 445 -
Common/ULastOpenedList.pas
r558 r562 194 194 195 195 end. 196 -
Common/UMemory.pas
r560 r562 120 120 121 121 end. 122 -
Common/UMetaCanvas.pas
r558 r562 63 63 64 64 TCanvasPolygon = class(TCanvasObject) 65 Pen: TPen; 66 Brush: TBrush; 67 Points: array of TPoint; 68 procedure Paint(Canvas: TCanvas); override; 69 procedure Zoom(Factor: Double); override; 70 procedure Move(Delta: TPoint); override; 71 constructor Create; 72 destructor Destroy; override; 73 end; 74 75 { TCanvasPolyline } 76 77 TCanvasPolyline = class(TCanvasObject) 78 Pen: TPen; 79 Brush: TBrush; 80 Points: array of TPoint; 81 procedure Paint(Canvas: TCanvas); override; 82 procedure Zoom(Factor: Double); override; 83 procedure Move(Delta: TPoint); override; 84 constructor Create; 85 destructor Destroy; override; 86 end; 87 88 { TCanvasPolyBezier } 89 90 TCanvasPolyBezier = class(TCanvasObject) 65 91 Pen: TPen; 66 92 Brush: TBrush; … … 133 159 procedure DoMoveTo(X, Y: Integer); override; 134 160 procedure DoLineTo(X, Y: Integer); override; 161 procedure DoPolyline(const Points: array of TPoint); override; 162 procedure DoPolyBezier(Points: PPoint; NumPts: Integer; 163 Filled: Boolean = False; Continuous: Boolean = False); override; 135 164 public 136 165 Objects: TCanvasObjects; … … 141 170 procedure TextOut(X,Y: Integer; const Text: String); override; 142 171 procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); override; 172 procedure Polyline(Points: PPoint; NumPts: Integer); override; 173 procedure PolyBezier(Points: PPoint; NumPts: Integer; 174 Filled: Boolean = False; Continuous: Boolean = True); override; 143 175 procedure Ellipse(x1, y1, x2, y2: Integer); override; 144 176 procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override; … … 161 193 UGeometric, LCLIntf; 162 194 195 { TCanvasPolyBezier } 196 197 procedure TCanvasPolyBezier.Paint(Canvas: TCanvas); 198 begin 199 Canvas.Pen.Assign(Pen); 200 Canvas.Brush.Assign(Brush); 201 Canvas.PolyBezier(Points); 202 end; 203 204 procedure TCanvasPolyBezier.Zoom(Factor: Double); 205 var 206 I: Integer; 207 begin 208 for I := 0 to High(Points) do 209 Points[I] := Point(Trunc(Points[I].X * Factor), 210 Trunc(Points[I].Y * Factor)); 211 Pen.Width := Trunc(Pen.Width * Factor); 212 end; 213 214 procedure TCanvasPolyBezier.Move(Delta: TPoint); 215 var 216 I: Integer; 217 begin 218 for I := 0 to High(Points) do 219 Points[I] := AddPoint(Points[I], Delta); 220 end; 221 222 constructor TCanvasPolyBezier.Create; 223 begin 224 Pen := TPen.Create; 225 Brush := TBrush.Create; 226 end; 227 228 destructor TCanvasPolyBezier.Destroy; 229 begin 230 FreeAndNil(Brush); 231 FreeAndNil(Pen); 232 inherited; 233 end; 234 235 { TCanvasPolyline } 236 237 procedure TCanvasPolyline.Paint(Canvas: TCanvas); 238 begin 239 Canvas.Pen.Assign(Pen); 240 Canvas.Brush.Assign(Brush); 241 Canvas.Polyline(Points); 242 end; 243 244 procedure TCanvasPolyline.Zoom(Factor: Double); 245 var 246 I: Integer; 247 begin 248 for I := 0 to High(Points) do 249 Points[I] := Point(Trunc(Points[I].X * Factor), 250 Trunc(Points[I].Y * Factor)); 251 Pen.Width := Trunc(Pen.Width * Factor); 252 end; 253 254 procedure TCanvasPolyline.Move(Delta: TPoint); 255 var 256 I: Integer; 257 begin 258 for I := 0 to High(Points) do 259 Points[I] := AddPoint(Points[I], Delta); 260 end; 261 262 constructor TCanvasPolyline.Create; 263 begin 264 Pen := TPen.Create; 265 Brush := TBrush.Create; 266 end; 267 268 destructor TCanvasPolyline.Destroy; 269 begin 270 FreeAndNil(Brush); 271 FreeAndNil(Pen); 272 inherited; 273 end; 274 163 275 { TCanvasPie } 164 276 … … 304 416 destructor TCanvasPolygon.Destroy; 305 417 begin 306 Brush.Free;307 Pen.Free;418 FreeAndNil(Brush); 419 FreeAndNil(Pen); 308 420 inherited; 309 421 end; … … 511 623 APoints[I] := Points[I]; 512 624 DoPolygon(APoints); 625 end; 626 627 procedure TMetaCanvas.Polyline(Points: PPoint; NumPts: Integer); 628 var 629 APoints: array of TPoint; 630 I: Integer; 631 begin 632 APoints := nil; 633 SetLength(APoints, NumPts); 634 for I := 0 to High(APoints) do 635 APoints[I] := Points[I]; 636 DoPolyline(APoints); 637 end; 638 639 procedure TMetaCanvas.PolyBezier(Points: PPoint; NumPts: Integer; 640 Filled: Boolean; Continuous: Boolean); 641 begin 642 DoPolyBezier(Points, NumPts, Filled, Continuous); 513 643 end; 514 644 … … 580 710 end; 581 711 712 procedure TMetaCanvas.DoPolyline(const Points: array of TPoint); 713 var 714 NewObj: TCanvasPolyline; 715 I: Integer; 716 begin 717 NewObj := TCanvasPolyline.Create; 718 NewObj.Brush.Assign(Brush); 719 NewObj.Pen.Assign(Pen); 720 SetLength(NewObj.Points, Length(Points)); 721 for I := 0 to High(Points) do 722 NewObj.Points[I] := Points[I]; 723 Objects.Add(NewObj); 724 end; 725 726 procedure TMetaCanvas.DoPolyBezier(Points: PPoint; NumPts: Integer; 727 Filled: Boolean; Continuous: Boolean); 728 var 729 NewObj: TCanvasPolyBezier; 730 I: Integer; 731 begin 732 NewObj := TCanvasPolyBezier.Create; 733 NewObj.Brush.Assign(Brush); 734 NewObj.Pen.Assign(Pen); 735 SetLength(NewObj.Points, NumPts); 736 for I := 0 to High(NewObj.Points) do 737 NewObj.Points[I] := Points[I]; 738 Objects.Add(NewObj); 739 end; 740 582 741 procedure TMetaCanvas.FillRect(const ARect: TRect); 583 742 begin … … 664 823 665 824 end. 666 -
Common/UPersistentForm.pas
r558 r562 1 1 unit UPersistentForm; 2 3 // Date: 2020-11-264 2 5 3 interface … … 21 19 procedure SaveControl(Control: TControl); 22 20 public 23 FormNormalSize: TRect;24 21 FormRestoredSize: TRect; 25 22 FormWindowState: TWindowState; … … 155 152 RootKey := RegistryContext.RootKey; 156 153 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True); 157 // Normal size 158 FormNormalSize.Left := ReadIntegerWithDefault('NormalLeft', FormNormalSize.Left); 159 FormNormalSize.Top := ReadIntegerWithDefault('NormalTop', FormNormalSize.Top); 160 FormNormalSize.Right := ReadIntegerWithDefault('NormalWidth', FormNormalSize.Right - FormNormalSize.Left) 161 + FormNormalSize.Left; 162 FormNormalSize.Bottom := ReadIntegerWithDefault('NormalHeight', FormNormalSize.Bottom - FormNormalSize.Top) 163 + FormNormalSize.Top; 154 164 155 // Restored size 165 156 FormRestoredSize.Left := ReadIntegerWithDefault('RestoredLeft', FormRestoredSize.Left); … … 169 160 FormRestoredSize.Bottom := ReadIntegerWithDefault('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top) 170 161 + FormRestoredSize.Top; 162 171 163 // Other state 172 164 FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(FormWindowState))); … … 183 175 RootKey := RegistryContext.RootKey; 184 176 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True); 185 // Normal state 186 WriteInteger('NormalWidth', FormNormalSize.Right - FormNormalSize.Left); 187 WriteInteger('NormalHeight', FormNormalSize.Bottom - FormNormalSize.Top); 188 WriteInteger('NormalTop', FormNormalSize.Top); 189 WriteInteger('NormalLeft', FormNormalSize.Left); 190 // Restored state 177 178 // Restored size 191 179 WriteInteger('RestoredWidth', FormRestoredSize.Right - FormRestoredSize.Left); 192 180 WriteInteger('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top); 193 181 WriteInteger('RestoredTop', FormRestoredSize.Top); 194 182 WriteInteger('RestoredLeft', FormRestoredSize.Left); 183 195 184 // Other state 196 185 WriteInteger('WindowState', Integer(FormWindowState)); … … 257 246 begin 258 247 Self.Form := Form; 248 259 249 // Set default 260 FormNormalSize := Bounds((Screen.Width - Form.Width) div 2,261 (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);262 250 FormRestoredSize := Bounds((Screen.Width - Form.Width) div 2, 263 251 (Screen.Height - Form.Height) div 2, Form.Width, Form.Height); … … 267 255 LoadFromRegistry(RegistryContext); 268 256 269 if not EqualRect(FormNormalSize, FormRestoredSize) or 270 DefaultMaximized then begin 257 if (FormWindowState = wsMaximized) or DefaultMaximized then begin 271 258 // Restore to maximized state 272 259 Form.WindowState := wsNormal; … … 277 264 // Restore to normal state 278 265 Form.WindowState := wsNormal; 279 if FEntireVisible then Form NormalSize := CheckEntireVisible(FormNormalSize)266 if FEntireVisible then FormRestoredSize := CheckEntireVisible(FormRestoredSize) 280 267 else if FMinVisiblePart > 0 then 281 FormNormalSize := CheckPartVisible(FormNormalSize, FMinVisiblePart);282 if not EqualRect(Form NormalSize, Form.BoundsRect) then283 Form.BoundsRect := Form NormalSize;268 FormRestoredSize := CheckPartVisible(FormRestoredSize, FMinVisiblePart); 269 if not EqualRect(FormRestoredSize, Form.BoundsRect) then 270 Form.BoundsRect := FormRestoredSize; 284 271 end; 285 272 if FormFullScreen then SetFullScreen(True); … … 290 277 begin 291 278 Self.Form := Form; 292 FormNormalSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height); 293 if not FormFullScreen then 294 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 295 Form.RestoredHeight); 296 FormWindowState := Form.WindowState; 279 if not FormFullScreen then begin 280 FormWindowState := Form.WindowState; 281 if FormWindowState = wsMaximized then begin 282 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 283 Form.RestoredHeight); 284 end else 285 if FormWindowState = wsNormal then begin 286 FormRestoredSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height); 287 end; 288 end; 297 289 SaveToRegistry(RegistryContext); 298 290 SaveControl(Form); … … 312 304 if State then begin 313 305 FormFullScreen := True; 314 FormNormalSize := Form.BoundsRect; 315 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 316 Form.RestoredHeight); 306 if Form.WindowState = wsMaximized then begin 307 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 308 Form.RestoredHeight); 309 end else 310 if Form.WindowState = wsNormal then begin 311 FormRestoredSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height); 312 end; 317 313 FormWindowState := Form.WindowState; 314 Form.WindowState := wsMaximized; 315 Form.WindowState := wsNormal; 318 316 ShowWindow(Form.Handle, SW_SHOWFULLSCREEN); 319 317 {$IFDEF WINDOWS} … … 327 325 ShowWindow(Form.Handle, SW_SHOWNORMAL); 328 326 if FormWindowState = wsNormal then begin 329 Form.BoundsRect := FormNormalSize; 327 Form.WindowState := wsNormal; 328 Form.BoundsRect := FormRestoredSize; 330 329 end else 331 330 if FormWindowState = wsMaximized then begin … … 337 336 338 337 end. 339 -
Common/UPixelPointer.pas
r558 r562 15 15 private 16 16 procedure SetRGB(AValue: Cardinal); 17 function GetRGB: Cardinal; 17 function GetRGB: Cardinal; 18 18 public 19 19 property RGB: Cardinal read GetRGB write SetRGB; … … 310 310 end; 311 311 312 313 312 end. 314 -
Common/UPool.pas
r560 r562 199 199 200 200 end. 201 -
Common/UPrefixMultiplier.pas
r558 r562 31 31 ( 32 32 (ShortText: 'y'; FullText: 'yocto'; Value: 1e-24), 33 33 (ShortText: 'z'; FullText: 'zepto'; Value: 1e-21), 34 34 (ShortText: 'a'; FullText: 'atto'; Value: 1e-18), 35 35 (ShortText: 'f'; FullText: 'femto'; Value: 1e-15), … … 52 52 ( 53 53 (ShortText: 'ys'; FullText: 'yocto'; Value: 1e-24), 54 54 (ShortText: 'zs'; FullText: 'zepto'; Value: 1e-21), 55 55 (ShortText: 'as'; FullText: 'atto'; Value: 1e-18), 56 56 (ShortText: 'fs'; FullText: 'femto'; Value: 1e-15), … … 124 124 125 125 end. 126 -
Common/UResetableThread.pas
r560 r562 295 295 296 296 end. 297 -
Common/UStringTable.pas
r558 r562 69 69 end; 70 70 71 72 71 end. 73 -
Common/USyncCounter.pas
r560 r562 78 78 79 79 end. 80 -
Common/UTestCase.pas
r559 r562 127 127 128 128 end. 129 -
Common/UTheme.pas
r558 r562 186 186 end; 187 187 188 189 188 end. -
Common/UThreading.pas
r560 r562 366 366 367 367 end. 368 -
Common/UTranslator.pas
r558 r562 569 569 end; 570 570 571 572 571 end. 573 -
Common/UURI.pas
r560 r562 347 347 348 348 end. 349 -
Common/UXMLUtils.pas
r558 r562 14 14 procedure WriteString(Node: TDOMNode; Name: string; Value: string); 15 15 procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime); 16 procedure WriteDouble(Node: TDOMNode; Name: string; Value: Double); 16 17 function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer; 17 18 function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64; … … 19 20 function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string; 20 21 function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime; 22 function ReadDouble(Node: TDOMNode; Name: string; DefaultValue: Double): Double; 21 23 procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string); 22 24 23 25 24 26 implementation 27 28 function ReadDouble(Node: TDOMNode; Name: string; DefaultValue: Double): Double; 29 var 30 NewNode: TDOMNode; 31 begin 32 Result := DefaultValue; 33 NewNode := Node.FindNode(DOMString(Name)); 34 if Assigned(NewNode) then 35 Result := StrToFloat(string(NewNode.TextContent)); 36 end; 25 37 26 38 procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string); … … 200 212 end; 201 213 214 procedure WriteDouble(Node: TDOMNode; Name: string; Value: Double); 215 var 216 NewNode: TDOMNode; 217 begin 218 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 219 NewNode.TextContent := DOMString(FloatToStr(Value)); 220 Node.AppendChild(NewNode); 221 end; 222 202 223 function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer; 203 224 var … … 252 273 253 274 end. 254
Note:
See TracChangeset
for help on using the changeset viewer.