Changeset 585


Ignore:
Timestamp:
Jan 13, 2026, 4:12:03 PM (16 hours ago)
Author:
chronos
Message:
Location:
DpiControls
Files:
13 added
1 deleted
8 edited

Legend:

Unmodified
Added
Removed

  • DpiControls/Demo

    • Property svn:ignore

      •  

        old new  
        33DpiComponentsDemo.res
        44lib
         5heaptrclog.trc

  • DpiControls/Demo/DpiComponentsDemo.lpi

    r535 r585  
    22<CONFIG>
    33  <ProjectOptions>
    4     <Version Value="11"/>
     4    <Version Value="12"/>
    55    <General>
     6      <Flags>
     7        <CompatibilityMode Value="True"/>
     8      </Flags>
    69      <SessionStorage Value="InProjectDir"/>
    7       <MainUnit Value="0"/>
    810      <Title Value="DpiComponentsDemo"/>
    911      <Scaled Value="True"/>
    … …  
    6365    <RunParams>
    6466      <FormatVersion Value="2"/>
    65       <Modes Count="0"/>
    6667    </RunParams>
    6768    <RequiredPackages Count="2">
    … …  
    122123    <Linking>
    123124      <Debugging>
     125        <DebugInfoType Value="dsDwarf3"/>
    124126        <UseHeaptrc Value="True"/>
    125127      </Debugging>

  • DpiControls/Demo/UDpiFormMain.lfm

    r537 r585  
    11object DpiFormMain: TDpiFormMain
     2  ClientHeight = 1
     3  ClientWidth = 1
    24  Top = 504
    35  Left = 865
    46  Width = 1
    57  Height = 1
    6   Visible = True
    78  Enabled = True
    89  ShowHint = False
    … …  
    1112  Align = alNone
    1213  Color = clDefault
     14  HorzScrollBar.Visible = False
     15  VertScrollBar.Visible = False
    1316  DesignTimePPI = 96
     17  FormStyle = fsNormal
    1418  BorderStyle = Controls
    1519  BorderIcons = [biSystemMenu, biMinimize, biMaximize]
    1620  OnCreate = DpiFormMainCreate
    1721  OnDestroy = DpiFormMainDestroy
    18   object DpiPaintBox1: TDpiPaintBox
    19     Top = 248
    20     Left = 88
    21     Width = 100
    22     Height = 100
    23     Visible = True
    24     Enabled = True
    25     ShowHint = False
    26     Font.Color = clDefault
    27     Font.Name = 'jjjdefault'
    28     Font.PixelsPerInch = 144
    29     Align = alNone
    30     Color = clDefault
    31   end
    3222end

  • DpiControls/Demo/UDpiFormMain.pas

    r537 r585  
    66
    77uses
    8   Classes, SysUtils, UDpiControls, Dialogs, Graphics;
     8  Classes, SysUtils, Dpi.Controls, Dpi.ExtCtrls, Dialogs, Dpi.Graphics, Dpi.Forms,
     9  Types;
    910
    1011type
    … …  
    1213  { TDpiFormMain }
    1314
    14   TDpiFormMain = class(TDpiForm)
    15     DpiPaintBox1: TDpiPaintBox;
     15  TDpiFormMain = class(TForm)
     16    DpiPaintBox1: TPaintBox;
    1617    procedure DpiButton1Click(Sender: TObject);
    1718    procedure DpiFormMainCreate(Sender: TObject);
    … …  
    1920    procedure DpiPaintBox1Paint(Sender: TObject);
    2021  private
    21     Button: TDpiButton;
    22     Image: TDpiImage;
    23     ListBox: TDpiListBox;
    24     PaintBox: TDpiPaintBox;
     22    Button: TButton;
     23    ButtonClose: TButton;
     24    Image: TImage;
     25    ListBox: TListBox;
     26    PaintBox: TPaintBox;
     27    Bitmap: TBitmap;
     28    procedure ButtonCloseClick(Sender: TObject);
    2529  public
    26 
    2730  end;
    2831
    … …  
    3942var
    4043  I: Integer;
     44  X, Y: Integer;
    4145begin
    4246  Button := TDpiButton.Create(DpiFormMain);
    … …  
    4549  Button.Caption := 'Click me';
    4650  Button.Visible := True;
     51  Button.OnClick := @DpiButton1Click;
     52
     53  ButtonClose := TDpiButton.Create(DpiFormMain);
     54  ButtonClose.Parent := Self;
     55  ButtonClose.SetBounds(120, 10, 100, 30);
     56  ButtonClose.Caption := 'Close';
     57  ButtonClose.Visible := True;
     58  ButtonClose.OnClick := @ButtonCloseClick;
    4759
    4860  Image := TDpiImage.Create(DpiFormMain);
    … …  
    6173  ListBox.Visible := True;
    6274
    63   DpiPaintBox1.BoundsRect := Rect(0, 0, 100, 100);
    64   DpiPaintBox1.VclPaintBox.Parent := VclForm;
    65   DpiPaintBox1.Repaint;
     75  PaintBox := TDpiPaintBox.Create(DpiFormMain);
     76  PaintBox.Parent := Self;
     77  PaintBox.BoundsRect := Bounds(0, 100, 200, 200);
     78  PaintBox.OnPaint := @DpiPaintBox1Paint;
     79  PaintBox.Visible := True;
     80
     81  Bitmap := TDpiBitmap.Create;
     82  Bitmap.PixelFormat := pf24bit;
     83  Bitmap.SetSize(120, 50);
     84  for Y := 0 to Bitmap.Height - 1 do
     85    for X := 0 to Bitmap.Width - 1 do
     86      Bitmap.Canvas.Pixels[X, Y] := X mod 255;
     87  Bitmap.LoadFromFile('dance.bmp');
    6688end;
    6789
    … …  
    7496
    7597procedure TDpiFormMain.DpiPaintBox1Paint(Sender: TObject);
     98var
     99  X, Y: Integer;
    76100begin
    77   with DpiPaintBox1.Canvas do begin
     101  with PaintBox.Canvas do begin
    78102    Brush.Color := clWhite;
    79103    Brush.Style := bsSolid;
    80     FillRect(Rect(0, 0, 100, 100));
     104    FillRect(Bounds(0, 0, PaintBox.Width, PaintBox.Height));
    81105    Caption := IntToStr(Width);
    82106    Pen.Color := clGreen;
    … …  
    85109    LineTo(100, 100);
    86110    Font.Color := clRed;
    87     TextOut(40, 10, 'Scaled text');
     111    Font.Size := 20;
     112    TextOut(10, 10, 'Scaled text');
     113
     114    Brush.Color := clBlue;
     115    Rectangle(Bounds(20, 30, 60, 30));
     116
     117    Bitmap.Dpi := DpiScreen.Dpi;
     118    DpiBitBltCanvas(PaintBox.Canvas, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas, 0, 0);
    88119  end;
    89120end;
    90121
     122procedure TDpiFormMain.ButtonCloseClick(Sender: TObject);
     123begin
     124  ModalResult := mrOk;
     125end;
     126
    91127procedure TDpiFormMain.DpiButton1Click(Sender: TObject);
     128var
     129  DpiForm: TDpiForm;
    92130begin
    93   ShowMessage('Hello');
     131  //ShowMessage('Hello');
     132  DpiForm := TDpiFormMain.CreateNew(Self);
     133  DpiForm.Name := 'Form10';
     134  DpiForm.Caption := 'Modal form';
     135  DpiForm.SetBounds(200, 150, 400, 200);
     136  DpiForm.ShowModal;
    94137end;
    95138

  • DpiControls/Demo/UFormMain.lfm

    r537 r585  
    88  ClientWidth = 472
    99  DesignTimePPI = 144
     10  OnActivate = FormActivate
    1011  OnDestroy = FormDestroy
    1112  OnShow = FormShow
    12   LCLVersion = '2.0.2.0'
     13  LCLVersion = '3.2.0.0'
    1314  object TrackBar1: TTrackBar
    1415    Left = 13
    … …  
    3132  end
    3233  object ButtonNewDpiForm: TButton
     34    ClientHeight = 38
     35    ClientWidth = 193
     36    Top = 117
    3337    Left = 19
     38    Width = 193
    3439    Height = 38
    35     Top = 117
    36     Width = 193
    3740    Caption = 'New DpiForm'
     41    Enabled = True
     42    ShowHint = False
     43    Font.Color = clDefault
     44    Font.PixelsPerInch = 96
     45    Font.Height = -16
     46    Align = alNone
     47    Color = clDefault
    3848    OnClick = ButtonNewDpiFormClick
    39     TabOrder = 1
     49    TabStop = True
     50    Visible = True
    4051  end
    4152  object Timer1: TTimer
    4253    Interval = 100
    4354    OnTimer = Timer1Timer
    44     left = 256
    45     top = 40
     55    Left = 256
     56    Top = 40
    4657  end
    4758end

  • DpiControls/Demo/UFormMain.pas

    r537 r585  
    77uses
    88  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
    9   ExtCtrls, UDpiControls, UDpiFormMain;
     9  ExtCtrls, Dpi.Controls, Dpi.Forms, UDpiFormMain;
    1010
    1111type
    … …  
    1919    TrackBar1: TTrackBar;
    2020    procedure ButtonNewDpiFormClick(Sender: TObject);
     21    procedure FormActivate(Sender: TObject);
    2122    procedure FormDestroy(Sender: TObject);
    2223    procedure FormShow(Sender: TObject);
    … …  
    2425    procedure TrackBar1Change(Sender: TObject);
    2526  private
     27    Initialized: Boolean;
    2628    DpiForm: TDpiForm;
    2729  public
    … …  
    4244  DpiScreen.Dpi := 96 * 2;
    4345  TrackBar1.Position := DpiScreen.Dpi;
    44   ButtonNewDpiFormClick(nil);
    4546end;
    4647
    … …  
    5354procedure TFormMain.ButtonNewDpiFormClick(Sender: TObject);
    5455begin
    55   DpiForm := TDpiFormMain.Create(nil);
     56  DpiApplication.CreateForm(TDpiFormMain, DpiForm);
     57  //DpiForm := TDpiFormMain.Create(Self);
    5658  DpiForm.Caption := DpiForm.Name;
    5759  DpiForm.SetBounds(100, 100, 400, 200);
    5860  DpiForm.Show;
    59   DpiScreen.Forms.Add(DpiForm);
     61end;
     62
     63procedure TFormMain.FormActivate(Sender: TObject);
     64begin
     65  if not Initialized then begin
     66    Initialized := True;
     67    ButtonNewDpiFormClick(nil);
     68  end;
    6069end;
    6170

  • DpiControls/DpiControls.lpk

    r532 r585  
    11<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    3   <Package Version="4">
     3  <Package Version="5">
    44    <Name Value="DpiControls"/>
    55    <Type Value="RunAndDesignTime"/>
    … …  
    1010        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-${BuildMode}"/>
    1111      </SearchPaths>
     12      <Parsing>
     13        <SyntaxOptions>
     14          <SyntaxMode Value="Delphi"/>
     15          <CStyleOperator Value="False"/>
     16          <AllowLabel Value="False"/>
     17          <CPPInline Value="False"/>
     18        </SyntaxOptions>
     19      </Parsing>
     20      <CodeGeneration>
     21        <Optimizations>
     22          <OptimizationLevel Value="0"/>
     23        </Optimizations>
     24      </CodeGeneration>
     25      <Linking>
     26        <Debugging>
     27          <GenerateDebugInfo Value="False"/>
     28        </Debugging>
     29      </Linking>
     30      <Other>
     31        <CompilerMessages>
     32          <IgnoredMessages idx6058="True" idx3123="True"/>
     33        </CompilerMessages>
     34      </Other>
    1235    </CompilerOptions>
    1336    <Description Value="Controls with dimensions independent to screen DPI setting. The controls use internally VCL controls. All positions and sizes are scaled from DPI independent values."/>
    1437    <License Value="Copyleft, public domain"/>
    15     <Version Minor="1"/>
    16     <Files Count="1">
     38    <Version Minor="2"/>
     39    <Files Count="14">
    1740      <Item1>
    18         <Filename Value="UDpiControls.pas"/>
     41        <Filename Value="DpiControls.pas"/>
    1942        <HasRegisterProc Value="True"/>
    20         <UnitName Value="UDpiControls"/>
     43        <UnitName Value="DpiControls"/>
    2144      </Item1>
     45      <Item2>
     46        <Filename Value="Dpi.PixelPointer.pas"/>
     47        <UnitName Value="Dpi.PixelPointer"/>
     48      </Item2>
     49      <Item3>
     50        <Filename Value="DpiControlsPackage.pas"/>
     51        <Type Value="Main Unit"/>
     52        <UnitName Value="DpiControlsPackage"/>
     53      </Item3>
     54      <Item4>
     55        <Filename Value="Dpi.Forms.pas"/>
     56        <UnitName Value="Dpi.Forms"/>
     57      </Item4>
     58      <Item5>
     59        <Filename Value="Dpi.Controls.pas"/>
     60        <UnitName Value="Dpi.Controls"/>
     61      </Item5>
     62      <Item6>
     63        <Filename Value="Dpi.Graphics.pas"/>
     64        <UnitName Value="Dpi.Graphics"/>
     65      </Item6>
     66      <Item7>
     67        <Filename Value="Dpi.Common.pas"/>
     68        <UnitName Value="Dpi.Common"/>
     69      </Item7>
     70      <Item8>
     71        <Filename Value="Dpi.Menus.pas"/>
     72        <HasRegisterProc Value="True"/>
     73        <UnitName Value="Dpi.Menus"/>
     74      </Item8>
     75      <Item9>
     76        <Filename Value="Dpi.ComCtrls.pas"/>
     77        <UnitName Value="Dpi.ComCtrls"/>
     78      </Item9>
     79      <Item10>
     80        <Filename Value="Dpi.StdCtrls.pas"/>
     81        <HasRegisterProc Value="True"/>
     82        <UnitName Value="Dpi.StdCtrls"/>
     83      </Item10>
     84      <Item11>
     85        <Filename Value="Dpi.ExtCtrls.pas"/>
     86        <HasRegisterProc Value="True"/>
     87        <UnitName Value="Dpi.ExtCtrls"/>
     88      </Item11>
     89      <Item12>
     90        <Filename Value="Dpi.Grids.pas"/>
     91        <UnitName Value="Dpi.Grids"/>
     92      </Item12>
     93      <Item13>
     94        <Filename Value="Dpi.Spin.pas"/>
     95        <UnitName Value="Dpi.Spin"/>
     96      </Item13>
     97      <Item14>
     98        <Filename Value="NativePixelPointer.pas"/>
     99        <UnitName Value="NativePixelPointer"/>
     100      </Item14>
    22101    </Files>
     102    <CompatibilityMode Value="True"/>
    23103    <RequiredPkgs Count="3">
    24104      <Item1>

  • DpiControls/DpiControls.pas

    r532 r585  
    1 { This file was automatically created by Lazarus. Do not edit!
    2   This source is only used to compile and install the package.
    3  }
    4 
    51unit DpiControls;
    62
    7 {$warn 5023 off : no warning about unused units}
    83interface
    94
    105uses
    11   UDpiControls, LazarusPackageIntf;
     6  {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms,
     7  Generics.Collections, FormEditingIntf, ProjectIntf, Controls, StdCtrls, Graphics,
     8  ComCtrls, ExtCtrls, LCLType, GraphType, Types, CustApp, LMessages, LCLIntf,
     9  Menus, Math, Dpi.PixelPointer, Grids, Spin, Dpi.Forms, Dpi.Controls, Dpi.Graphics;
     10
     11type
     12
     13  { TDpiFormFileDesc }
     14
     15  TDpiFormFileDesc = class(TFileDescPascalUnitWithResource)
     16  public
     17    constructor Create; override;
     18    function GetInterfaceUsesSection: string; override;
     19    function GetLocalizedName: string; override;
     20    function GetLocalizedDescription: string; override;
     21  end;
     22
     23var
     24  DpiFormFileDesc: TDpiFormFileDesc;
     25
     26procedure Register;
     27
    1228
    1329implementation
    1430
     31uses
     32  LCLStrConsts, Dpi.Common;
     33
     34resourcestring
     35  SDpiFormTitle = 'DpiForm form';
     36  SDpiFormDescription = 'DPI aware form';
     37
    1538procedure Register;
    1639begin
    17   RegisterUnit('UDpiControls', @UDpiControls.Register);
     40  FormEditingHook.RegisterDesignerBaseClass(TForm);
     41  DpiFormFileDesc := TDpiFormFileDesc.Create;
     42  RegisterProjectFileDescriptor(DpiFormFileDesc);
     43end;
     44
     45{ TDpiFormFileDesc }
     46
     47constructor TDpiFormFileDesc.Create;
     48begin
     49  inherited Create;
     50  Name := 'DpiForm form';
     51  ResourceClass := TForm;
     52  UseCreateFormStatements := False;
     53end;
     54
     55function TDpiFormFileDesc.GetInterfaceUsesSection: string;
     56begin
     57  Result := inherited GetInterfaceUsesSection;
     58  Result := Result + ', UDpiForm';
     59end;
     60
     61function TDpiFormFileDesc.GetLocalizedName: string;
     62begin
     63  Result := SDpiFormTitle;
     64end;
     65
     66function TDpiFormFileDesc.GetLocalizedDescription: string;
     67begin
     68  Result := SDpiFormDescription;
    1869end;
    1970
    2071initialization
    21   RegisterPackage('DpiControls', @Register);
     72
     73
    2274end.
     75
Note: See TracChangeset for help on using the changeset viewer.