  Delphi.   
  


     ,    ,             .     ,   .    ,   ,          -      MP3     Word  Excel   Delphi.   ,           .





  

  Delphi.   








    ,    ,  ,     ,  .           Delphi.         .       ,        - .      ,          .       ,    ,        .           ,   ,    .

    ,       ,  ,      .   ,               ,     .   ,          .          .     ,      .

   Delphi   .   ,      ,       .             .  :    ,      ,    .        ,     .   ,    ,             .

     .    ,    ,      :  ,     ,      .




 


 ,         gromakovski@minsk.piter.com (mailto:gromakovski@minsk.piter.com) ( ,  ).

     !

 ,   ,      http://www.piter.com/download (http://www.piter.com/download).

   http://www.piter.com (http://www.piter.com/)       .




 1





   

 

 

    

   

 

     

    



           ?   ,       Windows       (, ,     ).       , , :          Windows.

        ( ,  , ,  ,    ..).   , , Microsoft Word.   ,             (,    ).        ()  ,    ,   ,         .    ,         .

    ,   Borland Delphi,      API (. . 2).   API-          HWND   .   ,       Windows .  Delphi          Handle  .

  ,           ,     .       ,    :   .




   



   ,        .      :             ,         .




  


,     ,              .         ,         .       API- FlashWindow   ,       FlashWindowEx.





 ,         .         .       ,       (. 15).


                ( 1.1).


 1.1.    

procedure TForm1.cmbFlashOnceClick(Sender: TObject);

begin

FlashWindow(Handle, True);

end;



 ,        ( BOOL) .     T rue,        (     ).     False,        ,       (  ).

   FlashWindowEx     (  )   FLASHWINFO,          /  .

 . 1.1     FLASHWINFO.


 1.1.   FLASHWINFO




  dwFlags          :

FLASHW_CAPTION     ;

FLASHW_TRAY       ;

FLASHW_ALL   FLASHW_CAPTION  FLASHW_TRAY;

FLASHW_TIMER       /       ,   FlashWindowEx      FLASHW_STOP;

FLASHW_TIMERNOFG       /       ,     ;

FLASHW_STOP          .

      FlashWindowEx.

                  ( 1.2).


 1.2.    

procedure TForm1.cmbInverse10TimesClick(Sender: TObject);

var

fl: FLASHWINFO;

begin

fl.cbSize:= SizeOf(fl);

fl.hwnd:= Handle;

fl.dwFlags:= FLASHW_CAPTION or FLASHW_TRAY; // FLASHW_ALL

fl.uCount:= 10;

fl.dwTimeout:= 200;

FlashWindowEx(fl);

end;



     FLASHW_TIMER  FLASHW_ STOP          ( 1.3).


 1.3.        

//    

procedure TForm1.cmbFlashFor4SecClick(Sender: TObject);

var

fl: FLASHWINFO;

begin

fl.cbSize:= SizeOf(fl);

fl.hwnd:= Handle;

fl.dwTimeout:= 200;

fl.dwFlags:= FLASHW_ALL or FLASHW_TIMER;

fl.uCount:= 0;

FlashWindowEx(fl);

Timer1.Enabled:= True;

end;

//   

procedure TForm1.Timer1Timer(Sender: TObject);

var

fl: FLASHWINFO;

begin

fl.cbSize:= SizeOf(fl);

fl.hwnd:= Handle;

fl.dwFlags:= FLASHW_STOP;

FlashWindowEx(fl);

Timer1.Enabled:= False;

end;



    ,    .   . ,      ,     ,       (    )      uCount.          FLASHW_TIMER  FLASHW_STOP.




 


  ,         .     API- SetForegroundWindow.         .    ,          ,        .    ,      .

          ( 1.4).


 1.4.  

procedure TForm1.Timer1Timer(Sender: TObject);

begin

SetForegroundWindow(Handle);

end;



    Windows 95  Windows NT 4.0       SetForegroundWindow.                    .

  ,            ,       ,  ..           .  ,   ,      ,    FlashWindow    (        ).         SetForegroundWindow ,   ,   .




 


   ,   ,   ,    ,     (    Application  Project options,    Project ? Options).          .     ,     DPR- (  ).



program 

begin

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.Run;

end;



   TApplication,      Application (     Forms),      .         (,         Title  Application).          Handle  Application.

     (     ),         ,     ,  .

       ,    ( 1.5).


 1.5.   

procedure TForm1.Button1Click(Sender: TObject);

begin

SetWindowPos(Application.Handle, 0, 0, 0, 200, 100,

SWP_NOZORDER or SWP_NOMOVE);

end;



         200,   100,       . ,  ,      (,     )      ,   , .

   ,         FlashWindow  FlashWindowEx    .      , ,   ( 1.6).


 1.6.      

procedure TForm1.Button2Click(Sender: TObject);

var

fl: FLASHWINFO;

begin

fl.cbSize:= SizeOf(fl);

fl.hwnd:= Application.Handle;

fl.dwFlags:= FLASHW_ALL;

fl.uCount:= 10;

fl.dwTimeout:= 200;

FlashWindowEx(fl);

end;



        .    ,     1.5. ,             (,    ),     ( 1.7).


 1.7.       

procedure TForm1.Button3Click(Sender: TObject);

var

fl: FLASHWINFO;

begin

// 

fl.cbSize:= SizeOf(fl);

fl.hwnd:= Application.Handle;

fl.dwFlags:= FLASHW_TRAY;

fl.uCount:= 10;

fl.dwTimeout:= 200;

FlashWindowEx(fl);

// 

fl.cbSize:= SizeOf(fl);

fl.hwnd:= Handle;

fl.dwFlags:= FLASHW_CAPTION;

fl.uCount:= 10;

fl.dwTimeout:= 200;

FlashWindowEx(fl);

end;



      Form1.        ,  , ,    ,     . ,       API- ShowWindow:



ShowWindow(Application.Handle, SW_HIDE);



   ,   ShowWindow    SW_NORMAL  .




 


 Windows 2000       (       Layered windows).   ,     (          ,   . 2).      API-     ,        Delphi.       TForm.

AlphaBlend     .     True,   ,  False  .

AlphaBlendValue  ,    ( 0  255).     0,    ,  255  .

         Object Inspector,       (.1.1).




.1.1.       Object Inspector



 .1.2  ,      ( Delphi).




.1.2.    ,  14 %



    ,    AlphaBlend  AlphaBlendValue         (   tbAlpha,   chkEnableAlpha   lblCurAlpha  ,   .1.2) ( 1.8).


 1.8.    

procedure TForm1.chkEnableAlphaClick(Sender: TObject);

begin

AlphaBlendValue:= tbAlpha.Position;

AlphaBlend:= chkEnableAlpha.Checked;

end;

procedure TForm1.tbAlphaChange(Sender: TObject);

var

pos, perc: Integer;

begin

pos:= tbAlpha.Position;

//  

AlphaBlendValue:= pos;

//   

perc:= pos * 100 div 255;

lblCurAlpha.Caption:= IntToStr(pos) + ' 255 ('+IntToStr(perc) + '%)';

end;



  ,       ,     ( 1.9).


 1.9.    

implementation

var

isInc: Boolean; // True,   AlphaBlend 

//,  False,  

//( )

procedure TForm1.cmbHideAndShowClick(Sender: TObject);

begin

if AlphaBlend then chkEnableAlpha.Checked:= False;

//  (   )

AlphaBlendValue:= 255;

AlphaBlend:= True;

Refresh;

//   

isInc:= False;

Timer1.Enabled:= True;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var val: Integer;

begin

if not isInc then

begin

//" " 

val:= AlphaBlendValue;

Dec(val, 10);

if val <= 0 then

begin

//  

val:= 0;

isInc:= True;

end

end

else begin

// 

val:= AlphaBlendValue;

Inc(val, 10);

if val >= 255 then

begin

//  

val:= 255;

Timer1.Enabled:= False; // 

AlphaBlend:= False;

end

end;

AlphaBlendValue:= val;

end;



  (    )    1.9      (Timerl)     .    ,      ,       ,           .        ,    - Pentium III 600        ,     .

,  ,           (    Winamp 5     ).




    



      Windows,            .        , ,    .




.   


          ()        ,    .    (      )   ,       ,      .

          .              .1.3:      ;    ,   ;    ,          .




.1.3.      



 ,  ,    .


   

         API-:



function CreateRectRgn(p1, p2, p3, p4: Integer): HRGN;

function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN;

function CreateRoundRectRgn(p1, p2, p3, p4, p5, p6: Integer): HRGN;



          GDI- .       ,   .

    (CreateRectRgn)      .       :

p1  p2         ;

p3  p4         .

  (CreateEllipticRgn)       .       (  CreateRectRgn),     .

  (CreateRoundRectRgn)        .           CreateRectRgn.  p5  p6        (.1.4).




.1.4.    CreateRoundRectRgn



       ,       .          ,          .      ,     -     :



function CreatePolygonRgn(const Points; Count, FillMode: Integer): HRGN;



 CreatePolygonRgn   :

Points       TPoint,        (   );

Count     ,     Points;

FillMode     (   ,       ).

 FillMode   WINDING (   )  ALTERNATE (  ,          ).





                 ,     . ,       40  30 ,          (100; 100),   ,       20  15      (0;0)    ,    CreateRectRgn   (0, 0, 19, 14),   (100, 100, 119, 114).


   GDI- (  . 6),    ,     ,    GDI- DeleteObject:



function DeleteObject(p1: HGDIOBJ): BOOL;




      

      ,     ,   ,        ,    .       :



function SetWindowRgn(hWnd: HWND; hRgn: HRGN; bRedraw: BOOL): Integer;



  0,     ,        .   SetWindowRgn :

hWnd   ,      ( Handle    );

hRgn   ,      (    ,      );

bRedraw          (      True,    False).

   ,    ,   API- GetWindowRgn:



function GetWindowRgn(hWnd: HWND; hRgn: HRGN): Integer;



     (Handle)  .       ,       GetWindowRgn ,    ,    .          :

NULLREGION   ;

SIMPLEREGION     ;

COMPLEXREGION   ,  ;

ERROR           .

     GetWindowRgn (,           ).



var rgn: HRGN;

begin

rgn:= CreateRectRgn(0,0,0,0); //    

if GetWindowRgn(Handle, rgn) <> ERROR then

begin

//   ,    

end;

DeleteObject(rgn); //   ,  

// (    ,  )

end;




  

               .       .          CombineRgn:



function CombineRgn(p1, p2, p3: HRGN; p4: Integer): Integer;



   :

p1   ( ),    ;

p2, p3  - ;

p4     .

    CombineRgn     p4   . 1.2.


 1.2.   CombineRgn




   . 1.2 ,    p4  CombineRgn    RGN_COPY.     ,   p2,  ,   p1.

    -,     CombineRgn     ,      .

,           ,       (     ).




   


   :      .              ,     .





             FormCreate.                     ,      .   ,     ,     ,    (       )  ,   ,  .   ,        ()  (. DPR- ).   ,             , ,      .


     FormCreate            ( 1.10).


 1.10.      

procedure TfrmElliptic.FormCreate(Sender: TObject);

var

formRgn, but1Rgn, but2Rgn, but3Rgn: HRGN;

begin

//  

but1Rgn:= CreateEllipticRgn(0, 0, Button1.Width1, Button1.Height1);

SetWindowRgn(Button1.Handle, but1Rgn, False);

but2Rgn:= CreateEllipticRgn(0, 0, Button2.Width1, Button2.Height1);

SetWindowRgn(Button2.Handle, but2Rgn, False);

but3Rgn:= CreateEllipticRgn(0, 0, Button3.Width1, Button3.Height1);

SetWindowRgn(Button3.Handle, but3Rgn, False);

//  

formRgn:= CreateEllipticRgn(0, 0, Width1, Height1);

SetWindowRgn(Handle, formRgn, True);

end;



       , ,     ,    .     , ,  ,         ,     .

    1.10    .1.5.




.1.5.      



     (,     )         ,           .        FormCreate ( 1.11).


 1.11.      

procedure TfrmRoundRect.FormCreate(Sender: TObject);

var

formRgn, but1Rgn, but2Rgn, but3Rgn: HRGN;

begin

//   

but1Rgn:= CreateRoundRectRgn(0, 0, Button1.Width1, Button1.Height1,

Button1.Width div 5, Button1.Height div 5);

SetWindowRgn(Button1.Handle, but1Rgn, False);

but2Rgn:= CreateRoundRectRgn(0, 0, Button2.Width1, Button2.Height1,

Button2.Width div 5, Button2.Height div 5);

SetWindowRgn(Button2.Handle, but2Rgn, False);

but3Rgn:= CreateRoundRectRgn(0, 0, Button3.Width1, Button3.Height1,

Button3.Width div 5, Button3.Height div 5);

SetWindowRgn(Button3.Handle, but3Rgn, False);

//  

formRgn:= CreateRoundRectRgn(0, 0, Width1, Height1,

Width div 5, Height div 5);

SetWindowRgn(Handle, formRgn, False);

end;



  1.11           (20%     20%  ).     .              .

    1.11    .1.6.




.1.6.      



             ,  :    ,    ,    (.1.7).




.1.7.      



           1.12.


 1.12.      

procedure TfrmPoly.FormCreate(Sender: TObject);

var

points: array [0..5] of TPoint;

formRgn, but1Rgn, but2Rgn, but3Rgn: HRGN;

begin

//     

//.. 

Make6Angle(Button1.Width, Button1.Height, points);

but1Rgn:= CreatePolygonRgn(points, 6, WINDING);

SetWindowRgn(Button1.Handle, but1Rgn, False);

//.. 

Make3Angle(Button2.Width, Button2.Height, points);

but2Rgn:= CreatePolygonRgn(points, 3, WINDING);

SetWindowRgn(Button2.Handle, but2Rgn, False);

//.. 

Make5Angle(Button3.Width, Button3.Height, points);

but3Rgn:= CreatePolygonRgn(points, 5, WINDING);

SetWindowRgn(Button3.Handle, but3Rgn, False);

//..   

MakeStar(Width, Height, points);

formRgn:= CreatePolygonRgn(points, 5, WINDING);

SetWindowRgn(Handle, formRgn, False);

end;



             points  -   .    ,      points,    ,      .        1.13.


 1.13.  

procedure Make3Angle(width, height: Integer; var points: array of TPoint);

begin

points[0].X:= 0;

points[0].Y:= height  1;

points[1].X:= width div 2;

points[1].Y:= 0;

points[2].X:= width  1;

points[2].Y:= height  1;

end;



  1.14     .


 1.14.  

procedure Make6Angle(width, height: Integer; var points: array of TPoint);

begin

points[0].X:= 0;

points[0].Y:= height div 2;

points[1].X:= width div 3;

points[1].Y:= 0;

points[2].X:= 2 * (width div 3);

points[2].Y:= 0;

points[3].X:= width  1;

points[3].Y:= height div 2;

points[4].X:= 2 * (width div 3);

points[4].Y:= height  1;

points[5].X:= width div 3;

points[5].Y:= height  1;

end;



 1.15      ().


 1.15.  

procedure Make5Angle(width, height: Integer; var points: array of TPoint);

var a: Integer; // 

begin

a:= width div 2;

points[0].X:= a;

points[0].Y:= 0;

points[1].X:= width  1;

points[1].Y:= a div 2;

points[2].X:= 3 * (a div 2);

points[2].Y:= height  1;

points[3].X:= a div 2;

points[3].Y:= height  1;

points[4].X:= 0;

points[4].Y:= a div 2;

end;



 ,     ,       1.15  Make5Angle.        ,           ,       (, 1-3-5-2-4) ( 1.16).


 1.16.   

procedure MakeStar(width, height: Integer; var points: array of TPoint);

begin

Make5Angle(width, height, points);

//        ,

//  

Swap(points[1], points[2]);

Swap(points[2], points[4]);

Swap(points[3], points[4]);

end;



 MakeStart ( 1.16)    Swap,        .  Swap          .




 


       .        ,             .        ,      .


 

            .          XOR     (.1.8).




.1.8.  



 .1.8  ,           Delphi.  ,     ,      ,     .

 ,       ,    1.17.


 1.17.   

procedure TfrmHole.FormCreate(Sender: TObject);

var

rgn1, rgn2: HRGN; //"-" 

formRgn: HRGN;

begin

//   

formRgn:= CreateRectRgn(0, 0, Width  1, Height  1);

//   ""

rgn1:= CreateEllipticRgn(10, 10, 100, 50);

rgn2:= CreateRoundRectRgn(10, 60, 200, 90, 10, 10);

// ""  

CombineRgn(formRgn, formRgn, rgn1, RGN_XOR);

CombineRgn(formRgn, formRgn, rgn2, RGN_XOR);

SetWindowRgn(Handle, formRgn, True);

//  ""   

DeleteObject(rgn1);

DeleteObject(rgn2);

end;




  

     ,      .          ,   .1.9 (     ).




.1.9.   



 ,    ,    1.18.


 1.18.   

procedure TfrmManyRgn.FormCreate(Sender: TObject);

var

r1, r2, r3, r4, r5, r6, r7: HRGN;

formRgn: HRGN;

butRgn: HRGN;

begin

// 

r1:= CreateRoundRectRgn(100, 0, 700, 400, 40, 40);

r2:= CreateRectRgn(280, 0, 300, 399);

r3:= CreateRectRgn(500, 0, 520, 399);

r4:= CreateEllipticRgn(140, 40, 240, 140);

r5:= CreateEllipticRgn(0, 300, 200, 500);

r6:= CreateEllipticRgn(500, 40, 600, 140);

r7:= CreateEllipticRgn(540, 40, 640, 140);

//

//..   

CombineRgn(r1, r1, r2, RGN_XOR);

CombineRgn(r1, r1, r3, RGN_XOR);

//.. ""  

CombineRgn(r1, r1, r4, RGN_XOR);

//..     

CombineRgn(r1, r1, r5, RGN_OR);

//.. ""  

CombineRgn(r7, r7, r6, RGN_DIFF);

CombineRgn(r1, r1, r7, RGN_XOR);

formRgn:= CreateRectRgn(0, 0, 0, 0);

CombineRgn(formRgn, r1, 0, RGN_COPY);

DeleteObject(r1);

DeleteObject(r2);

DeleteObject(r3);

DeleteObject(r4);

DeleteObject(r5);

DeleteObject(r6);

DeleteObject(r7);

//   

butRgn:= CreateEllipticRgn(50, 50, 150, 150);

SetWindowRgn(Button1.Handle, butRgn, False);

SetWindowRgn(Handle, formRgn, True);

end;



   ,         .     .        .1.10.




.1.10.  ,    ,   .1.9




 

      CombineRgn     .     ,     ,   .            ,       .

   ,       ,         ,   ,     .      ,      .

  :  ,        ,         .        -,   .          ,     .       .1.11.




.1.11.   -



         1.19.


 1.19.    

function RegionFromPicture(pict:TPicture; backcolor: TColor): HRGN;

var

rgn, resRgn: HRGN;

x, y, xFirst: Integer;

begin

resRgn:= CreateRectRgn(0, 0, 0, 0); // 

//  -  ( )

for y:= 0 to pict.Height  1 do

begin

x:= 0;

while x < pict.Width do

begin

if (pict.Bitmap.Canvas.Pixels[x, y] <> backcolor) then

begin

xFirst:= x;

Inc(x);

//  ,    

while (x < pict.Width) and

(pict.Bitmap.Canvas.Pixels[x, y] <> backcolor) do Inc(x);

//    -    

// 

rgn:= CreateRectRgn(xFirst, y, x1, y+1);

CombineRgn(resRgn, resRgn, rgn, RGN_OR);

DeleteObject(rgn);

end;

Inc(x);

end;

end;

RegionFromPicture:= resRgn;

end;



 -     , ,    ( 1.20).


 1.20.      

procedure TfrmTemplate.FormCreate(Sender: TObject);

var

pict: TPicture;

begin

//    

//(,     )

pict:= TPicture.Create;

pict.LoadFromFile('back.bmp');

SetWindowRgn(Handle, RegionFromPicture(pict, RGB(255,255,255)), True);

end;



  1.20 ,    back.bmp,     ,    .    .  ,  ,   .1.11,    back.bmp,     ,   .1.12.




.1.12.     




   



     ,  ,           .  ,     ,   .                 .




   


    (      ) ,         .     :

  (      ,         );

  (     , ,        , ,     );

   (       );

  , , ,   (     );

    ;

  (      );

    (   );

       ,   ,    .

 ,           ,      WM_ NCHITTEST   ,         .   ,   ,           :   ,      ..

 , ,  ,     WM_ NCHITTEST,     .         1.21.


 1.21.     

procedure TfrmMoveClient.WMNCHitTest(var Message: TWMNCHitTest);

var

rc: TRect;

p: TPoint;

begin

//     ,   

//     

rc:= GetClientRect();

p.X:= Message.XPos;

p.Y:= Message.YPos;

p:= ScreenToClient(p);

if PtInRect(rc, p) then

Message.Result:= HTCAPTION

else

//  

Message.Result:= DefWindowProc(Handle, Message.Msg, 0, 65536 * Message.YPos + Message.XPos);

end;



   1.21      ,   HTCAPTION.       ( ,   DefWindowProc):

HTBORDER        (   );

HTBOTTOM, HTTOP, HTLEFT, HTRIGHT      , ,       (   ,   );

HTBOTTOMLEFT, HTBOTTOMRIGHT, HTTOPLEFT, HTTOPRIGHT       ,  ,        (     );

HTSIZE, HTGROWBOX      ,        (     );

HTCAPTION         (    );

HTCLIENT        ;

HTCLOSE        ;

HTHELP         ;

HTREDUCE, HTMINBUTTON        ;

HTZ OOM, HTMAXBUTTON        ;

HTMENU        ;

HTSYSMENU        (    );

HTHSCROLL, HTVSCROLL         , ;

HTTRANSPARENT     ,    ,     (    );

HTNOWHERE      -    (,    );

HTERROR   ,   HTNOWHERE,         (DefWindowProc)   ,   .




  


         ,    ,        .           ,     .

  ,     .  .1.13        .




.1.13.   



       ,   .1.14.




.1.14.     (  )



    ,   ,    ,       (.1.15).




.1.15.       



    ?  .   ,         (     ).          (  . 2),       .   ,          API- SetWindowLong.      ,      ,       (, ,    ) ( 1.22).


 1.22.     

procedure MakeMovable(Handle: HWND);

var

style: LongInt;

flags: UINT;

begin

//   

style:= GetWindowLong(Handle, GWL_STYLE);

style:= style or WS_OVERLAPPED or WS_THICKFRAME or WS_CAPTION;

SetWindowLong(Handle, GWL_STYLE, style);

style:= GetWindowLong(Handle, GWL_EXSTYLE);

style:= style or WS_EX_TOOLWINDOW;

SetWindowLong(Handle, GWL_EXSTYLE, style);

//   

flags:= SWP_NOMOVE or SWP_NOSIZE or SWP_DRAWFRAME or SWP_NOZORDER;

SetWindowPos(Handle, 0, 0, 0, 0, 0, flags);

end;



  ,      .      .        (  )   .    ,        .

,  MakeMovable    :   .       ,         (     ).    ,         2.

   ,  MakeMovable,      ( 1.23).


 1.23.     

procedure MakeUnmovable(Handle: HWND);

var

style: LongInt;

flags: UINT;

begin

//   

style:= GetWindowLong(Handle, GWL_STYLE);

style:= style and not WS_OVERLAPPED and not WS_THICKFRAME

and not WS_CAPTION;

SetWindowLong(Handle, GWL_STYLE, style);

style:= GetWindowLong(Handle, GWL_EXSTYLE);

style:= style and not WS_EX_TOOLWINDOW;

SetWindowLong(Handle, GWL_EXSTYLE, style);

//   

flags:= SWP_NOMOVE or SWP_NOSIZE or SWP_DRAWFRAME or SWP_NOZORDER;

SetWindowPos(Handle, 0, 0, 0, 0, 0, flags);

end;



     MakeMovable  MakeUnmovable    .             ( 1.24).


 1.24.    

procedure TfrmMovingControls.chkSetMovableClick(Sender: TObject);

begin

if chkSetMovable.Checked then

begin

//   

MakeMovable(Memo1.Handle);

MakeMovable(ListBox1.Handle);

MakeMovable(Button1.Handle);

end

else

begin

//   

MakeUnmovable(Memo1.Handle);

MakeUnmovable(ListBox1.Handle);

MakeUnmovable(Button1.Handle);

end;

end;




 


   ()   ,       .           :       ,     .

     Delphi  ,    TWinControl,     ,   .    :

ScaleControls        ;

ChangeScale         ,       .

      :      .          1.25.


 1.25.     

procedure TfrmScaleBy.cmbSmallerClick(Sender: TObject);

begin

ChangeScale(80, 100); //  20 % (   80 %)

end;

procedure TfrmScaleBy.cmbBiggerClick(Sender: TObject);

begin

ChangeScale(120, 100); //  20 % (   120 %)

end;



    ,        TrueType (     Times New Roman).

 .1.16       .




.1.16.    



       1,25  (   80%  )   .1.17.




.1.17.    80 %



,        ,   , , ,  AutoSize   True      (Object Inspector).

  -    AutoSize   ,       .       ,    ,       .       .

1.     (GetClientRect).

2.    .

3.      ,      ;        .

        1,2   :



GetClientRect(Handle, rc);

newWidth:= (rc.Right  rc.Left) * 120 div 100;

newHeight:= (rc.Bottom  rc.Top) * 120 div 100;

Width:= Width + newWidth  (rc.Right  rc.Left);

Height:= Height + newHeight  (rc.Bottom  rc.Top);







             (    ),       ,    . ,     20% ( 0,8 )        25% ( 1/0,8 = 1,25 ).





     


   ,        .       ,     ,   , ,   .        ,        .

   (HMENU)     API- GetSystemMenu,         AppendMenu.  ,     ,    1.26.


 1.26.      

procedure TForm1.FormCreate(Sender: TObject);

var hSysMenu: HMENU;

begin

hSysMenu:= GetSystemMenu(Handle, False);

AppendMenu(hSysMenu, MF_SEPARATOR, 0, '');

AppendMenu(hSysMenu, MF_STRING, 10001, '  20%');

AppendMenu(hSysMenu, MF_STRING, 10002, '  20 %');

end;



        Form1    ,   .1.18.




.1.18.     



           .      WM_SYSCOMMAND ( 1.27).


 1.27.       

procedure TForm1.WMSysCommand(var Message: TWMSysCommand);

begin

if Message.CmdType = 10001 then

// 

ChangeScale(120, 100)

else if Message.CmdType = 10002 then

ChangeScale(80, 100)

else

//  

DefWindowProc(Handle, Message.Msg, Message.CmdType, 65536 *Message.YPos+ Message.XPos);

end;



   ,   ,    Append-Menu,   ,    .     ,        .    ,        ,     ( DefWindowProc).




    


         .      :      Windows.  ,      :     .    ,                 (,          ).




  .


   .

   ,     (https://www.litres.ru/aleksandr-chirtik/programmirovanie-v-delphi-truki-i-effekty/)  .

      Visa, MasterCard, Maestro,    ,   ,     ,  PayPal, WebMoney, ., QIWI ,       .


