unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls, ComCtrls;

 

  type

  TForm1 = class(TForm)

    RichEdit1: TRichEdit;

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    Button4: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

  private

 { Déclarations privées }

  function GetZoom: Integer;

  procedure SetZoom(Value: Integer);

  property Zoom: Integer read GetZoom write SetZoom;

 

  public

    { Déclarations publiques }

 

end;

 

const

EM_GETZOOM = (WM_USER + 224);

EM_SETZOOM = (WM_USER + 225);

 

var

  Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

function TForm1.GetZoom: Integer; // Added by J.G. Boerema

var wp,lp: Integer;

begin

  Result := 100;

  SendMessage(Richedit1.Handle, EM_GETZOOM, Integer(@wp), Integer(@lp));

  if (lp > 0) then Result := MulDiv(100,wp,lp);

end;

 

procedure TForm1.SetZoom(Value: Integer);

begin

    if Value = 0 then

      SendMessage(Richedit1.Handle, EM_SETZOOM, 0, 0)

    else

      SendMessage(Richedit1.Handle, EM_SETZOOM, Value, 100);

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

Form1.Zoom := 100;

end;

 

procedure TForm1.Button2Click(Sender: TObject);

begin

Form1.Zoom := 200;

end;

 

procedure TForm1.Button3Click(Sender: TObject);

begin

Form1.Zoom := 300;

end;

 

procedure TForm1.Button4Click(Sender: TObject);

begin

Form1.Zoom := 400;

end;

 

end.