Changeset 536 for DpiControls
- Timestamp:
- May 30, 2019, 11:58:04 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
DpiControls/UDpiControls.pas
r535 r536 7 7 uses 8 8 Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf, 9 Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType; 9 Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType, 10 Types; 10 11 11 12 type … … 39 40 protected 40 41 procedure ScreenChanged; 42 function GetVclFont: TFont; virtual; 41 43 public 42 44 VclFont: TFont; … … 67 69 FWidth: Integer; 68 70 FParent: TDpiWinControl; 71 function GetAlign: TAlign; 69 72 function GetBoundsRect: TRect; 70 73 function GetClientHeight: Integer; 71 74 function GetClientWidth: Integer; 72 75 function GetEnabled: Boolean; 76 function GetHint: string; 73 77 function GetOnClick: TNotifyEvent; 74 78 function GetShowHint: Boolean; 75 79 function GetVisible: Boolean; 80 procedure SetAlign(AValue: TAlign); 76 81 procedure SetBoundsRect(AValue: TRect); 82 procedure SetClientHeight(AValue: Integer); 83 procedure SetClientWidth(AValue: Integer); 77 84 procedure SetEnabled(AValue: Boolean); 78 85 procedure SetFont(AValue: TDpiFont); 86 procedure SetHint(AValue: string); 79 87 procedure SetOnChangeBounds(AValue: TNotifyEvent); 80 88 procedure SetOnClick(AValue: TNotifyEvent); … … 110 118 procedure Invalidate; 111 119 procedure Repaint; 120 procedure Update; 112 121 constructor Create(TheOwner: TComponent); override; 113 122 destructor Destroy; override; 114 123 property Parent: TDpiWinControl read FParent write SetParent; 115 124 property BoundsRect: TRect read GetBoundsRect write SetBoundsRect; 116 property ClientWidth: Integer read GetClientWidth ;117 property ClientHeight: Integer read GetClientHeight ;125 property ClientWidth: Integer read GetClientWidth write SetClientWidth; 126 property ClientHeight: Integer read GetClientHeight write SetClientHeight; 118 127 published 128 property Hint: string read GetHint write SetHint; 119 129 property Top: Integer read FTop write SetTop; 120 130 property Left: Integer read FLeft write SetLeft; … … 126 136 property ShowHint: Boolean read GetShowHint write SetShowHint; 127 137 property Font: TDpiFont read FFont write SetFont; 138 property Align: TAlign read GetAlign write SetAlign; 128 139 property OnResize: TNotifyEvent read FOnResize write SetOnResize; 129 140 property OnChangeBounds: TNotifyEvent read FOnChangeBounds write SetOnChangeBounds; … … 132 143 133 144 TDpiControls = specialize TFPGObjectList<TDpiControl>; 145 146 { TDpiGraphic } 147 148 TDpiGraphic = class(TPersistent) 149 protected 150 function GetVclGraphic: TGraphic; virtual; 151 public 152 procedure LoadFromFile(const Filename: string); 153 end; 154 155 { TDpiRasterImage } 156 157 TDpiRasterImage = class(TDpiGraphic) 158 private 159 function GetRawImage: TRawImage; 160 protected 161 function GetVclGraphic: TGraphic; override; 162 function GetVclRasterImage: TRasterImage; virtual; 163 public 164 property RawImage: TRawImage read GetRawImage; 165 end; 134 166 135 167 { TDpiCanvas } … … 149 181 procedure SetPen(AValue: TPen); 150 182 procedure SetPixel(X, Y: Integer; AValue: TColor); 183 protected 184 function GetVclCanvas: TCanvas; virtual; 151 185 public 152 186 VclCanvas: TCanvas; 153 187 procedure FrameRect(Rect: TRect); 188 procedure Rectangle(X1, Y1, X2, Y2: Integer); 154 189 function TextWidth(Text: string): Integer; 155 190 function TextHeight(Text: string): Integer; 191 function TextExtent(Text: string): TSize; 156 192 procedure TextOut(X, Y: Integer; Text: string); 193 procedure TextRect(ARect: TRect; X, Y: Integer; Text: string); 157 194 procedure MoveTo(X, Y: Integer); 158 195 procedure LineTo(X, Y: Integer); 159 196 procedure FillRect(ARect: TRect); 160 197 procedure FillRect(X1, Y1, X2, Y2: Integer); 198 procedure Draw(X, Y: Integer; Source: TDpiGraphic); 199 procedure CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas; Source: TRect); 161 200 constructor Create; 162 201 destructor Destroy; override; … … 176 215 private 177 216 FCanvas: TDpiCanvas; 217 function GetOnPaint: TNotifyEvent; 178 218 procedure SetCanvas(AValue: TDpiCanvas); 219 procedure SetOnPaint(AValue: TNotifyEvent); 179 220 protected 180 221 procedure Paint; virtual; 222 function GetVclControl: TControl; override; 223 function GetVclGraphicControl: TGraphicControl; virtual; 181 224 public 182 225 constructor Create(TheOwner: TComponent); override; … … 184 227 published 185 228 property Canvas: TDpiCanvas read FCanvas write SetCanvas; 229 property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint; 186 230 end; 187 231 … … 191 235 private 192 236 function GetHandle: HWND; 237 function GetOnKeyDown: TKeyEvent; 238 function GetOnKeyPress: TKeyPressEvent; 239 function GetOnKeyUp: TKeyEvent; 193 240 procedure SetHandle(AValue: HWND); 241 procedure SetOnKeyDown(AValue: TKeyEvent); 242 procedure SetOnKeyPress(AValue: TKeyPressEvent); 243 procedure SetOnKeyUp(AValue: TKeyEvent); 194 244 protected 245 function GetVclControl: TControl; override; 195 246 function GetVclWinControl: TWinControl; virtual; 196 247 public … … 202 253 property Handle: HWND read GetHandle write SetHandle; 203 254 published 255 property OnKeyDown: TKeyEvent read GetOnKeyDown write SetOnKeyDown; 256 property OnKeyPress: TKeyPressEvent read GetOnKeyPress write SetOnKeyPress; 257 property OnKeyUp: TKeyEvent read GetOnKeyUp write SetOnKeyUp; 258 end; 259 260 { TDpiCustomControl } 261 262 TDpiCustomControl = class(TDpiWinControl) 263 private 264 function GetOnPaint: TNotifyEvent; 265 procedure SetOnPaint(AValue: TNotifyEvent); 266 protected 267 function GetVclWinControl: TWinControl; override; 268 function GetVclCustomControl: TCustomControl; virtual; 269 published 270 property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint; 204 271 end; 205 272 206 273 { TDpiForm } 207 274 208 TDpiForm = class(TDpi WinControl)275 TDpiForm = class(TDpiCustomControl) 209 276 private 277 function GetBorderIcons: TBorderIcons; 210 278 function GetBorderStyle: TBorderStyle; 211 279 function GetCanvas: TDpiCanvas; 280 function GetFormState: TFormState; 281 function GetModalResult: TModalResult; 282 function GetOnClose: TCloseEvent; 212 283 function GetOnCreate: TNotifyEvent; 284 function GetOnDeactivate: TNotifyEvent; 213 285 function GetOnDestroy: TNotifyEvent; 214 286 function GetOnHide: TNotifyEvent; 215 287 function GetOnShow: TNotifyEvent; 288 procedure SetBorderIcons(AValue: TBorderIcons); 216 289 procedure SetBorderStyle(AValue: TBorderStyle); 290 procedure SetModalResult(AValue: TModalResult); 291 procedure SetOnClose(AValue: TCloseEvent); 217 292 procedure SetOnCreate(AValue: TNotifyEvent); 293 procedure SetOnDeactivate(AValue: TNotifyEvent); 218 294 procedure SetOnDestroy(AValue: TNotifyEvent); 219 295 procedure SetOnHide(AValue: TNotifyEvent); … … 221 297 procedure DoOnCreate; 222 298 protected 299 procedure CreateParams(var p: TCreateParams); virtual; 223 300 procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; 224 function GetVclC ontrol: TControl; override;225 function GetVcl WinControl: TWinControl; override;301 function GetVclCustomControl: TCustomControl; override; 302 function GetVclForm: TForm; virtual; 226 303 public 227 304 VclForm: TForm; 228 305 property Canvas: TDpiCanvas read GetCanvas; 306 property ModalResult: TModalResult read GetModalResult write SetModalResult; 307 function ShowModal: Integer; virtual; 308 procedure Close; 309 procedure BringToFront; 229 310 constructor Create(TheOwner: TComponent); override; 230 311 destructor Destroy; override; 231 312 published 313 property FormState: TFormState read GetFormState; 232 314 property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle; 315 property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons; 233 316 property OnShow: TNotifyEvent read GetOnShow write SetOnShow; 234 317 property OnHide: TNotifyEvent read GetOnHide write SetOnHide; 235 318 property OnCreate: TNotifyEvent read GetOnCreate write SetOnCreate; 236 319 property OnDestroy: TNotifyEvent read GetOnDestroy write SetOnDestroy; 320 property OnDeactivate: TNotifyEvent read GetOnDeactivate write SetOnDeactivate; 321 property OnClose: TCloseEvent read GetOnClose write SetOnClose; 237 322 end; 238 323 … … 262 347 end; 263 348 349 { TDpiScrollBar } 350 351 TDpiScrollBar = class(TDpiControl) 352 private 353 function GetBorderSpacing: TControlBorderSpacing; 354 function GetKind: TScrollBarKind; 355 function GetMax: Integer; 356 function GetMin: Integer; 357 function GetOnChange: TNotifyEvent; 358 function GetPageSize: Integer; 359 function GetPosition: Integer; 360 procedure SetBorderSpacing(AValue: TControlBorderSpacing); 361 procedure SetKind(AValue: TScrollBarKind); 362 procedure SetMax(AValue: Integer); 363 procedure SetMin(AValue: Integer); 364 procedure SetOnChange(AValue: TNotifyEvent); 365 procedure SetPageSize(AValue: Integer); 366 procedure SetPosition(AValue: Integer); 367 protected 368 function GetVclControl: TControl; override; 369 public 370 VclScrollBar: TScrollBar; 371 destructor Destroy; override; 372 published 373 property PageSize: Integer read GetPageSize write SetPageSize; 374 property Min: Integer read GetMin write SetMin; 375 property Max: Integer read GetMax write SetMax; 376 property Position: Integer read GetPosition write SetPosition; 377 property BorderSpacing: TControlBorderSpacing read GetBorderSpacing write SetBorderSpacing; 378 property Kind: TScrollBarKind read GetKind write SetKind; 379 property OnChange: TNotifyEvent read GetOnChange write SetOnChange; 380 end; 381 264 382 { TDpiBitmap } 265 383 266 TDpiBitmap = class 384 TDpiBitmap = class(TDpiRasterImage) 267 385 private 268 386 FCanvas: TDpiCanvas; 387 function GetCanvas: TDpiCanvas; 388 function GetHeight: Integer; 389 function GetPixelFormat: TPixelFormat; 390 function GetScanLine(Row: Integer): Pointer; 391 function GetWidth: Integer; 392 procedure SetHeight(AValue: Integer); 393 procedure SetPixelFormat(AValue: TPixelFormat); 394 procedure SetWidth(AValue: Integer); 395 protected 396 function GetVclBitmap: TCustomBitmap; virtual; 397 function GetVclRasterImage: TRasterImage; override; 398 public 399 VclBitmap: TBitmap; 400 procedure BeginUpdate; 401 procedure EndUpdate; 402 procedure SetSize(Width, Height: Integer); 403 constructor Create; 404 destructor Destroy; override; 405 property ScanLine[Row: Integer]: Pointer read GetScanLine; 269 406 published 270 property Canvas: TDpiCanvas read FCanvas; 407 property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat; 408 property Height: Integer read GetHeight write SetHeight; 409 property Width: Integer read GetWidth write SetWidth; 410 property Canvas: TDpiCanvas read GetCanvas; 271 411 end; 272 412 … … 312 452 destructor Destroy; override; 313 453 published 314 property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;315 454 end; 316 455 … … 320 459 private 321 460 FDpi: Integer; 461 FActiveForm: TDpiForm; 462 function GetActiveForm: TDpiForm; 463 function GetFormCount: Integer; 322 464 function GetHeight: Integer; 323 465 function GetWidth: Integer; … … 328 470 constructor Create; 329 471 destructor Destroy; override; 472 property FormCount: Integer read GetFormCount; 473 property ActiveForm: TDpiForm read GetActiveForm; 330 474 published 331 475 property Dpi: Integer read FDpi write SetDpi; … … 334 478 end; 335 479 480 { TDpiJpegImage } 481 482 TDpiJpegImage = class(TDpiBitmap) 483 protected 484 function GetVclBitmap: TCustomBitmap; override; 485 function GetVclJpeg: TJPEGImage; virtual; 486 public 487 VclJpeg: TJPEGImage; 488 end; 489 490 { TDpiPortableNetworkGraphic } 491 492 TDpiPortableNetworkGraphic = class(TDpiBitmap) 493 protected 494 function GetVclBitmap: TCustomBitmap; override; 495 function GetVclPng: TPortableNetworkGraphic; virtual; 496 public 497 VclPng: TPortableNetworkGraphic; 498 end; 499 336 500 var 337 501 DpiFormFileDesc: TDpiFormFileDesc; … … 379 543 Result.Right := ScaleFromVcl(Value.Right); 380 544 Result.Bottom := ScaleFromVcl(Value.Bottom); 545 end; 546 547 { TDpiJpegImage } 548 549 function TDpiJpegImage.GetVclBitmap: TCustomBitmap; 550 begin 551 Result := GetVclJpeg; 552 end; 553 554 function TDpiJpegImage.GetVclJpeg: TJPEGImage; 555 begin 556 if not Assigned(VclJpeg) then VclJpeg := TJPEGImage.Create; 557 Result := VclJpeg; 558 end; 559 560 { TDpiPortableNetworkGraphic } 561 562 function TDpiPortableNetworkGraphic.GetVclBitmap: TCustomBitmap; 563 begin 564 Result := GetVclPng; 565 end; 566 567 function TDpiPortableNetworkGraphic.GetVclPng: TPortableNetworkGraphic; 568 begin 569 if not Assigned(VclPng) then VclPng := TPortableNetworkGraphic.Create; 570 Result := VclPng; 571 end; 572 573 { TDpiCustomControl } 574 575 function TDpiCustomControl.GetOnPaint: TNotifyEvent; 576 begin 577 Result := GetVclCustomControl.OnPaint; 578 end; 579 580 procedure TDpiCustomControl.SetOnPaint(AValue: TNotifyEvent); 581 begin 582 GetVclCustomControl.OnPaint := AValue; 583 end; 584 585 function TDpiCustomControl.GetVclWinControl: TWinControl; 586 begin 587 Result := GetVclCustomControl; 588 end; 589 590 function TDpiCustomControl.GetVclCustomControl: TCustomControl; 591 begin 592 Result := nil; 593 end; 594 595 { TDpiScrollBar } 596 597 function TDpiScrollBar.GetBorderSpacing: TControlBorderSpacing; 598 begin 599 Result := VclScrollBar.BorderSpacing; 600 end; 601 602 function TDpiScrollBar.GetKind: TScrollBarKind; 603 begin 604 Result := VclScrollBar.Kind; 605 end; 606 607 function TDpiScrollBar.GetMax: Integer; 608 begin 609 Result := VclScrollBar.Max; 610 end; 611 612 function TDpiScrollBar.GetMin: Integer; 613 begin 614 Result := VclScrollBar.Min; 615 end; 616 617 function TDpiScrollBar.GetOnChange: TNotifyEvent; 618 begin 619 Result := VclScrollBar.OnChange; 620 end; 621 622 function TDpiScrollBar.GetPageSize: Integer; 623 begin 624 Result := VclScrollBar.PageSize; 625 end; 626 627 function TDpiScrollBar.GetPosition: Integer; 628 begin 629 Result := VclScrollBar.Position; 630 end; 631 632 procedure TDpiScrollBar.SetBorderSpacing(AValue: TControlBorderSpacing); 633 begin 634 VclScrollBar.BorderSpacing := AValue; 635 end; 636 637 procedure TDpiScrollBar.SetKind(AValue: TScrollBarKind); 638 begin 639 VclScrollBar.Kind := AValue; 640 end; 641 642 procedure TDpiScrollBar.SetMax(AValue: Integer); 643 begin 644 VclScrollBar.Max := AValue; 645 end; 646 647 procedure TDpiScrollBar.SetMin(AValue: Integer); 648 begin 649 VclScrollBar.Min := Avalue; 650 end; 651 652 procedure TDpiScrollBar.SetOnChange(AValue: TNotifyEvent); 653 begin 654 VclScrollBar.OnChange := AValue; 655 end; 656 657 procedure TDpiScrollBar.SetPageSize(AValue: Integer); 658 begin 659 VclScrollBar.PageSize := AValue; 660 end; 661 662 procedure TDpiScrollBar.SetPosition(AValue: Integer); 663 begin 664 VclScrollBar.Position := AValue; 665 end; 666 667 function TDpiScrollBar.GetVclControl: TControl; 668 begin 669 if not Assigned(VclScrollBar) then VclScrollBar := TScrollBar.Create(nil); 670 Result := VclScrollBar; 671 end; 672 673 destructor TDpiScrollBar.Destroy; 674 begin 675 FreeAndNil(VclScrollBar); 676 inherited Destroy; 677 end; 678 679 { TDpiRasterImage } 680 681 function TDpiRasterImage.GetRawImage: TRawImage; 682 begin 683 Result := GetVclRasterImage.RawImage; 684 end; 685 686 function TDpiRasterImage.GetVclRasterImage: TRasterImage; 687 begin 688 Result := GetVclRasterImage; 689 end; 690 691 function TDpiRasterImage.GetVclGraphic: TGraphic; 692 begin 693 Result := GetVclRasterImage; 694 end; 695 696 { TDpiGraphic } 697 698 function TDpiGraphic.GetVclGraphic: TGraphic; 699 begin 700 Result := nil; 701 end; 702 703 procedure TDpiGraphic.LoadFromFile(const Filename: string); 704 begin 705 GetVclGraphic.LoadFromFile(FileName); 706 end; 707 708 { TDpiBitmap } 709 710 function TDpiBitmap.GetHeight: Integer; 711 begin 712 Result := ScaleFromVcl(GetVclBitmap.Height); 713 end; 714 715 function TDpiBitmap.GetCanvas: TDpiCanvas; 716 begin 717 if not Assigned(FCanvas) then FCanvas := TDpiCanvas.Create; 718 Result := FCanvas; 719 end; 720 721 function TDpiBitmap.GetPixelFormat: TPixelFormat; 722 begin 723 Result := GetVclBitmap.PixelFormat; 724 end; 725 726 function TDpiBitmap.GetScanLine(Row: Integer): Pointer; 727 begin 728 Result := GetVclBitmap.ScanLine[Row]; 729 end; 730 731 function TDpiBitmap.GetWidth: Integer; 732 begin 733 Result := ScaleFromVcl(GetVclBitmap.Width); 734 end; 735 736 procedure TDpiBitmap.SetHeight(AValue: Integer); 737 begin 738 GetVclBitmap.Height := ScaleToVcl(AValue); 739 end; 740 741 procedure TDpiBitmap.SetPixelFormat(AValue: TPixelFormat); 742 begin 743 GetVclBitmap.PixelFormat := AValue; 744 end; 745 746 procedure TDpiBitmap.SetWidth(AValue: Integer); 747 begin 748 GetVclBitmap.Width := ScaleToVcl(AValue); 749 end; 750 751 function TDpiBitmap.GetVclBitmap: TCustomBitmap; 752 begin 753 if not Assigned(VclBitmap) then begin 754 VclBitmap := TBitmap.Create; 755 Canvas.VclCanvas := VclBitmap.Canvas; 756 end; 757 Result := VclBitmap; 758 end; 759 760 procedure TDpiBitmap.BeginUpdate; 761 begin 762 GetVclBitmap.BeginUpdate; 763 end; 764 765 procedure TDpiBitmap.EndUpdate; 766 begin 767 GetVclBitmap.EndUpdate; 768 end; 769 770 procedure TDpiBitmap.SetSize(Width, Height: Integer); 771 begin 772 GetVclBitmap.SetSize(ScaleToVcl(Width), ScaleToVcl(Height)); 773 end; 774 775 constructor TDpiBitmap.Create; 776 begin 777 end; 778 779 destructor TDpiBitmap.Destroy; 780 begin 781 FreeAndNil(FCanvas); 782 FreeAndNil(VclBitmap); 783 inherited; 784 end; 785 786 function TDpiBitmap.GetVclRasterImage: TRasterImage; 787 begin 788 Result := GetVclBitmap; 381 789 end; 382 790 … … 446 854 function TDpiCanvas.GetBrush: TBrush; 447 855 begin 448 Result := VclCanvas.Brush;856 Result := GetVclCanvas.Brush; 449 857 end; 450 858 451 859 function TDpiCanvas.GetHandle: HDC; 452 860 begin 453 Result := VclCanvas.Handle;861 Result := GetVclCanvas.Handle; 454 862 end; 455 863 456 864 function TDpiCanvas.GetHeight: Integer; 457 865 begin 458 Result := ScaleFromVcl( VclCanvas.Height);866 Result := ScaleFromVcl(GetVclCanvas.Height); 459 867 end; 460 868 461 869 function TDpiCanvas.GetPen: TPen; 462 870 begin 463 Result := VclCanvas.Pen;871 Result := GetVclCanvas.Pen; 464 872 end; 465 873 466 874 function TDpiCanvas.GetPixel(X, Y: Integer): TColor; 467 875 begin 468 Result := VclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)];876 Result := GetVclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)]; 469 877 end; 470 878 471 879 function TDpiCanvas.GetWidth: Integer; 472 880 begin 473 Result := ScaleFromVcl( VclCanvas.Width);881 Result := ScaleFromVcl(GetVclCanvas.Width); 474 882 end; 475 883 476 884 procedure TDpiCanvas.SetBrush(AValue: TBrush); 477 885 begin 478 VclCanvas.Brush := AValue;886 GetVclCanvas.Brush := AValue; 479 887 end; 480 888 … … 487 895 procedure TDpiCanvas.SetHandle(AValue: HDC); 488 896 begin 489 VclCanvas.Handle := AValue;897 GetVclCanvas.Handle := AValue; 490 898 end; 491 899 492 900 procedure TDpiCanvas.SetPen(AValue: TPen); 493 901 begin 494 VclCanvas.Pen := AValue;902 GetVclCanvas.Pen := AValue; 495 903 end; 496 904 497 905 procedure TDpiCanvas.SetPixel(X, Y: Integer; AValue: TColor); 498 906 begin 499 VclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)] := AValue; 907 GetVclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)] := AValue; 908 end; 909 910 function TDpiCanvas.GetVclCanvas: TCanvas; 911 begin 912 if not Assigned(VclCanvas) then VclCanvas := TCanvas.Create; 913 Result := VclCanvas; 500 914 end; 501 915 502 916 procedure TDpiCanvas.FrameRect(Rect: TRect); 503 917 begin 504 VclCanvas.FrameRect(ScaleRectToVcl(Rect)); 918 GetVclCanvas.FrameRect(ScaleRectToVcl(Rect)); 919 end; 920 921 procedure TDpiCanvas.Rectangle(X1, Y1, X2, Y2: Integer); 922 begin 923 GetVclCanvas.Rectangle(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2)); 505 924 end; 506 925 507 926 function TDpiCanvas.TextWidth(Text: string): Integer; 508 927 begin 509 Result := ScaleFromVcl( VclCanvas.TextWidth(Text));928 Result := ScaleFromVcl(GetVclCanvas.TextWidth(Text)); 510 929 end; 511 930 512 931 function TDpiCanvas.TextHeight(Text: string): Integer; 513 932 begin 514 Result := ScaleFromVcl(VclCanvas.TextHeight(Text)); 933 Result := ScaleFromVcl(GetVclCanvas.TextHeight(Text)); 934 end; 935 936 function TDpiCanvas.TextExtent(Text: string): TSize; 937 begin 938 Result := GetVclCanvas.TextExtent(Text); 515 939 end; 516 940 517 941 procedure TDpiCanvas.TextOut(X, Y: Integer; Text: string); 518 942 begin 519 VclCanvas.TextOut(ScaleToVcl(X), ScaleToVcl(Y), Text); 943 GetVclCanvas.TextOut(ScaleToVcl(X), ScaleToVcl(Y), Text); 944 end; 945 946 procedure TDpiCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string); 947 begin 948 GetVclCanvas.TextRect(ARect, X, Y, Text); 520 949 end; 521 950 522 951 procedure TDpiCanvas.MoveTo(X, Y: Integer); 523 952 begin 524 VclCanvas.MoveTo(ScaleToVcl(X), ScaleToVcl(Y));953 GetVclCanvas.MoveTo(ScaleToVcl(X), ScaleToVcl(Y)); 525 954 end; 526 955 527 956 procedure TDpiCanvas.LineTo(X, Y: Integer); 528 957 begin 529 VclCanvas.LineTo(ScaleToVcl(X), ScaleToVcl(Y));958 GetVclCanvas.LineTo(ScaleToVcl(X), ScaleToVcl(Y)); 530 959 end; 531 960 532 961 procedure TDpiCanvas.FillRect(ARect: TRect); 533 962 begin 534 VclCanvas.FillRect(ScaleRectToVcl(ARect));963 GetVclCanvas.FillRect(ScaleRectToVcl(ARect)); 535 964 end; 536 965 537 966 procedure TDpiCanvas.FillRect(X1, Y1, X2, Y2: Integer); 538 967 begin 539 VclCanvas.FillRect(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2)); 968 GetVclCanvas.FillRect(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2)); 969 end; 970 971 procedure TDpiCanvas.Draw(X, Y: Integer; Source: TDpiGraphic); 972 begin 973 GetVclCanvas.Draw(ScaleToVcl(X), ScaleToVcl(Y), Source.GetVclGraphic); 974 end; 975 976 procedure TDpiCanvas.CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas; 977 Source: TRect); 978 begin 979 GetVclCanvas.CopyRect(Dest, SrcCanvas.VclCanvas, Source); 540 980 end; 541 981 … … 559 999 end; 560 1000 1001 function TDpiGraphicControl.GetOnPaint: TNotifyEvent; 1002 begin 1003 Result := nil; 1004 end; 1005 1006 procedure TDpiGraphicControl.SetOnPaint(AValue: TNotifyEvent); 1007 begin 1008 1009 end; 1010 561 1011 procedure TDpiGraphicControl.Paint; 562 1012 begin 1013 end; 1014 1015 function TDpiGraphicControl.GetVclControl: TControl; 1016 begin 1017 Result := GetVclGraphicControl; 1018 end; 1019 1020 function TDpiGraphicControl.GetVclGraphicControl: TGraphicControl; 1021 begin 1022 Result := nil; 563 1023 end; 564 1024 … … 619 1079 procedure TDpiFont.SetStyle(AValue: TFontStyles); 620 1080 begin 621 VclFont.Style := AValue;1081 GetVclFont.Style := AValue; 622 1082 end; 623 1083 … … 625 1085 begin 626 1086 DoChange; 1087 end; 1088 1089 function TDpiFont.GetVclFont: TFont; 1090 begin 1091 if not Assigned(VclFont) then VclFont := TFont.Create; 1092 Result := VclFont; 627 1093 end; 628 1094 … … 635 1101 procedure TDpiFont.SetPixelsPerInch(AValue: Integer); 636 1102 begin 637 VclFont.PixelsPerInch := PixelsPerInch;1103 GetVclFont.PixelsPerInch := PixelsPerInch; 638 1104 end; 639 1105 640 1106 function TDpiFont.GetName: string; 641 1107 begin 642 Result := VclFont.Name;1108 Result := GetVclFont.Name; 643 1109 end; 644 1110 645 1111 function TDpiFont.GetColor: TColor; 646 1112 begin 647 Result := VclFont.Color;1113 Result := GetVclFont.Color; 648 1114 end; 649 1115 650 1116 function TDpiFont.GetPixelsPerInch: Integer; 651 1117 begin 652 Result := VclFont.PixelsPerInch;1118 Result := GetVclFont.PixelsPerInch; 653 1119 end; 654 1120 655 1121 function TDpiFont.GetStyle: TFontStyles; 656 1122 begin 657 Result := VclFont.Style;1123 Result := GetVclFont.Style; 658 1124 end; 659 1125 660 1126 procedure TDpiFont.SetColor(AValue: TColor); 661 1127 begin 662 VclFont.Color := AValue;1128 GetVclFont.Color := AValue; 663 1129 end; 664 1130 665 1131 procedure TDpiFont.SetName(AValue: string); 666 1132 begin 667 VclFont.Name := AValue;1133 GetVclFont.Name := AValue; 668 1134 end; 669 1135 … … 680 1146 procedure TDpiFont.Assign(Source: TDpiFont); 681 1147 begin 682 VclFont.Assign(Source.VclFont);1148 GetVclFont.Assign(Source.GetVclFont); 683 1149 Size := Source.Size; 684 1150 FOnChange := Source.FOnChange; … … 692 1158 end; 693 1159 1160 function TDpiWinControl.GetOnKeyDown: TKeyEvent; 1161 begin 1162 Result := GetVclWinControl.OnKeyDown; 1163 end; 1164 1165 function TDpiWinControl.GetOnKeyPress: TKeyPressEvent; 1166 begin 1167 Result := GetVclWinControl.OnKeyPress; 1168 end; 1169 1170 function TDpiWinControl.GetOnKeyUp: TKeyEvent; 1171 begin 1172 Result := GetVclWinControl.OnKeyUp; 1173 end; 1174 694 1175 procedure TDpiWinControl.SetHandle(AValue: HWND); 695 1176 begin 696 1177 GetVclWinControl.Handle := AValue; 1178 end; 1179 1180 procedure TDpiWinControl.SetOnKeyDown(AValue: TKeyEvent); 1181 begin 1182 GetVclWinControl.OnKeyDown := AValue; 1183 end; 1184 1185 procedure TDpiWinControl.SetOnKeyPress(AValue: TKeyPressEvent); 1186 begin 1187 GetVclWinControl.OnKeyPress := AValue; 1188 end; 1189 1190 procedure TDpiWinControl.SetOnKeyUp(AValue: TKeyEvent); 1191 begin 1192 GetVclWinControl.OnKeyUp := AValue; 1193 1194 end; 1195 1196 function TDpiWinControl.GetVclControl: TControl; 1197 begin 1198 Result := GetVclWinControl; 697 1199 end; 698 1200 … … 746 1248 begin 747 1249 Result := ScaleFromVcl(Screen.Height); 1250 end; 1251 1252 function TDpiScreen.GetFormCount: Integer; 1253 begin 1254 Result := Forms.Count; 1255 end; 1256 1257 function TDpiScreen.GetActiveForm: TDpiForm; 1258 begin 1259 Result := FActiveForm; 748 1260 end; 749 1261 … … 868 1380 begin 869 1381 GetVclControl.Repaint; 1382 end; 1383 1384 procedure TDpiControl.Update; 1385 begin 1386 GetVclControl.Update; 870 1387 end; 871 1388 … … 922 1439 end; 923 1440 1441 procedure TDpiControl.SetHint(AValue: string); 1442 begin 1443 GetVclControl.Hint := AValue; 1444 end; 1445 924 1446 function TDpiControl.GetBoundsRect: TRect; 925 1447 begin … … 930 1452 end; 931 1453 1454 function TDpiControl.GetAlign: TAlign; 1455 begin 1456 Result := GetVclControl.Align; 1457 end; 1458 932 1459 function TDpiControl.GetClientHeight: Integer; 933 1460 begin … … 945 1472 end; 946 1473 1474 function TDpiControl.GetHint: string; 1475 begin 1476 Result := GetVclControl.Hint; 1477 end; 1478 947 1479 function TDpiControl.GetOnClick: TNotifyEvent; 948 1480 begin … … 960 1492 end; 961 1493 1494 procedure TDpiControl.SetAlign(AValue: TAlign); 1495 begin 1496 GetVclControl.Align := AValue; 1497 end; 1498 962 1499 procedure TDpiControl.SetBoundsRect(AValue: TRect); 963 1500 begin 964 1501 SetBounds(AValue.Left, AValue.Top, AValue.Right - AValue.Left, AValue.Bottom - AValue.Top); 1502 end; 1503 1504 procedure TDpiControl.SetClientHeight(AValue: Integer); 1505 begin 1506 GetVclControl.ClientHeight := ScaletoVcl(AValue); 1507 end; 1508 1509 procedure TDpiControl.SetClientWidth(AValue: Integer); 1510 begin 1511 GetVclControl.ClientWidth := ScaletoVcl(AValue); 965 1512 end; 966 1513 … … 1064 1611 { TDpiForm } 1065 1612 1613 function TDpiForm.GetBorderIcons: TBorderIcons; 1614 begin 1615 Result := VclForm.BorderIcons; 1616 end; 1617 1066 1618 function TDpiForm.GetBorderStyle: TBorderStyle; 1067 1619 begin … … 1074 1626 end; 1075 1627 1628 function TDpiForm.GetFormState: TFormState; 1629 begin 1630 Result := VclForm.FormState; 1631 end; 1632 1633 function TDpiForm.GetModalResult: TModalResult; 1634 begin 1635 Result := VclForm.ModalResult; 1636 end; 1637 1638 function TDpiForm.GetOnClose: TCloseEvent; 1639 begin 1640 Result := VclForm.OnClose; 1641 end; 1642 1076 1643 function TDpiForm.GetOnCreate: TNotifyEvent; 1077 1644 begin … … 1079 1646 end; 1080 1647 1648 function TDpiForm.GetOnDeactivate: TNotifyEvent; 1649 begin 1650 Result := VclForm.OnDeactivate; 1651 end; 1652 1081 1653 function TDpiForm.GetOnDestroy: TNotifyEvent; 1082 1654 begin … … 1094 1666 end; 1095 1667 1668 procedure TDpiForm.SetBorderIcons(AValue: TBorderIcons); 1669 begin 1670 VclForm.BorderIcons := AValue; 1671 end; 1672 1096 1673 procedure TDpiForm.SetBorderStyle(AValue: TBorderStyle); 1097 1674 begin … … 1099 1676 end; 1100 1677 1678 procedure TDpiForm.SetModalResult(AValue: TModalResult); 1679 begin 1680 VclForm.ModalResult := AValue; 1681 end; 1682 1683 procedure TDpiForm.SetOnClose(AValue: TCloseEvent); 1684 begin 1685 VclForm.OnClose := AValue; 1686 end; 1687 1101 1688 procedure TDpiForm.SetOnCreate(AValue: TNotifyEvent); 1102 1689 begin 1103 1690 VclForm.OnCreate := AValue; 1691 end; 1692 1693 procedure TDpiForm.SetOnDeactivate(AValue: TNotifyEvent); 1694 begin 1695 VclForm.OnDeactivate := AValue; 1104 1696 end; 1105 1697 … … 1123 1715 if Assigned(VclForm.OnCreate) then 1124 1716 VclForm.OnCreate(Self); 1717 end; 1718 1719 procedure TDpiForm.CreateParams(var p: TCreateParams); 1720 begin 1721 // TODO: VclForm.CreateParams(P); 1125 1722 end; 1126 1723 … … 1141 1738 end; 1142 1739 1143 function TDpiForm.GetVclC ontrol: TControl;1144 begin 1145 Result := GetVcl WinControl;1146 end; 1147 1148 function TDpiForm.GetVcl WinControl: TWinControl;1740 function TDpiForm.GetVclCustomControl: TCustomControl; 1741 begin 1742 Result := GetVclForm; 1743 end; 1744 1745 function TDpiForm.GetVclForm: TForm; 1149 1746 begin 1150 1747 if not Assigned(VclForm) then VclForm := TForm.Create(nil); 1151 1748 Result := VclForm; 1749 end; 1750 1751 function TDpiForm.ShowModal: Integer; 1752 begin 1753 Result := GetVclForm.ShowModal; 1754 end; 1755 1756 procedure TDpiForm.Close; 1757 begin 1758 GetVclForm.Close; 1759 end; 1760 1761 procedure TDpiForm.BringToFront; 1762 begin 1763 GetVclForm.BringToFront; 1152 1764 end; 1153 1765
Note:
See TracChangeset
for help on using the changeset viewer.