Советы по Delphi
         

Круглый логотип при запуске приложения


Некоторое время назад я находил информацию по этому вопросу. Я даже ее где-то сохранил, а теперь не могу найти.

Без пробем! Код позволяет вывести окно-кольцо с полукруглой областью заголовка и сквозь дырку в форме можно увидеть и щелкнуть мышкой на других приложениях! Создайте новый проект и сохраните главный модуль с именем RGNU.PAS. Используйте следующий код:

unit rgnu;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Buttons, Menus;
type
TForm1 = class(TForm)procedure FormCreate(Sender: TObject);procedure Button1Click(Sender: TObject);procedure FormPaint(Sender: TObject);private{ Private declarations }rTitleBar : THandle;Center : TPoint;CapY : Integer;Circum : Double;SB1 : TSpeedButton;RL, RR : Double;procedure TitleBar(Act : Boolean);procedure WMNCHITTEST(var Msg: TWMNCHitTest);message WM_NCHITTEST;procedure WMNCACTIVATE(var Msg: TWMNCACTIVATE);message WM_NCACTIVATE;procedure WMSetText(var Msg: TWMSetText);message WM_SETTEXT;public{ Public declarations }end;
var
Form1: TForm1;
implementation

{$R *.DFM}

CONST
TitlColors : ARRAY[Boolean] OF TColor =(clInactiveCaption, clActiveCaption);TxtColors : ARRAY[Boolean] OF TColor =(clInactiveCaptionText, clCaptionText);
procedure TForm1.FormCreate(Sender: TObject);
VAR
rTemp, rTemp2 : THandle;Vertices : ARRAY[0..2] OF TPoint;X, Y : INteger;begin
Caption := 'ОООО! Пончики!';BorderStyle := bsNone; {требуется}IF Width > Height THEN Width := HeightELSE Height := Width; {труднее вычислить если width <> height}Center := Point(Width DIV 2, Height DIV 2);CapY := GetSystemMetrics(SM_CYCAPTION)+8;rTemp := CreateEllipticRgn(0, 0, Width, Height);rTemp2 := CreateEllipticRgn((Width DIV 4), (Height DIV 4),3*(Width DIV 4), 3*(Height DIV 4));CombineRgn(rTemp, rTemp, rTemp2, RGN_DIFF);SetWindowRgn(Handle, rTemp, True);DeleteObject(rTemp2);rTitleBar := CreateEllipticRgn(4, 4, Width-4, Height-4);rTemp := CreateEllipticRgn(CapY, CapY, Width-CapY, Height-CapY);CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_DIFF);Vertices[0] := Point(0,0);Vertices[1] := Point(Width, 0);Vertices[2] := Point(Width DIV 2, Height DIV 2);rTemp := CreatePolygonRgn(Vertices, 3, ALTERNATE);CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_AND);DeleteObject(rTemp);RL := ArcTan(Width / Height);RR := -RL + (22 / Center.X);X := Center.X-Round((Center.X-1-(CapY DIV 2))*Sin(RR));Y := Center.Y-Round((Center.Y-1-(CapY DIV 2))*Cos(RR));SB1 := TSpeedButton.Create(Self);WITH SB1 DOBEGINParent := Self;Left := X;Top := Y;Width := 14;Height := 14;OnClick := Button1Click;Caption := 'X';Font.Style := [fsBold];END;end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Close;End;

procedure TForm1.WMNCHITTEST(var Msg: TWMNCHitTest);
begin
Inherited;WITH Msg DOWITH ScreenToClient(Point(XPos,YPos)) DOIF PtInRegion(rTitleBar, X, Y) AND(NOT PtInRect(SB1.BoundsRect, Point(X,Y))) THENResult := htCaption;end;

procedure TForm1.WMNCActivate(var Msg: TWMncActivate);
begin
Inherited;TitleBar(Msg.Active);end;

procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
Inherited;TitleBar(Active);end;

procedure TForm1.TitleBar(Act: Boolean);
VAR
TF : TLogFont;R : Double;N, X, Y : Integer;begin
IF Center.X = 0 THEN Exit;WITH Canvas DObeginBrush.Style := bsSolid;Brush.Color := TitlColors[Act];PaintRgn(Handle, rTitleBar);R := RL;Brush.Color := TitlColors[Act];Font.Name := 'Arial';Font.Size := 12;Font.Color := TxtColors[Act];Font.Style := [fsBold];GetObject(Font.Handle, SizeOf(TLogFont), @TF);FOR N := 1 TO Length(Caption) DOBEGINX := Center.X-Round((Center.X-6)*Sin(R));Y := Center.Y-Round((Center.Y-6)*Cos(R));TF.lfEscapement := Round(R * 1800 / pi);Font.Handle := CreateFontIndirect(TF);TextOut(X, Y, Caption[N]);R := R - (((TextWidth(Caption[N]))+2) / Center.X);IF R < RR THEN Break;END;Font.Name := 'MS Sans Serif';Font.Size := 8;Font.Color := clWindowText;Font.Style := [];end;end;

procedure TForm1.FormPaint(Sender: TObject);
begin
WITH Canvas DOBEGINPen.Color := clBlack;Brush.Style := bsClear;Pen.Width := 1;Pen.Color := clWhite;Arc(1, 1, Width-1, Height-1, Width, 0, 0, Height);Arc((Width DIV 4)-1, (Height DIV 4)-1,3*(Width DIV 4)+1, 3*(Height DIV 4)+1, 0, Height, Width, 0);Pen.Color := clBlack;Arc(1, 1, Width-1, Height-1, 0, Height, Width, 0);Arc((Width DIV 4)-1, (Height DIV 4)-1,3*(Width DIV 4)+1, 3*(Height DIV 4)+1, Width, 0, 0, Height);TitleBar(Active);END;end;

end.

[000317]



Содержание раздела