Отправляет email-рассылки с помощью сервиса Sendsay

Мастера DELPHI. Новости мира компонент, FAQ, статьи...

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Август 2003   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Сергей

Статистика

13.577 подписчиков
-18 за неделю
←   Все выпуски   →

Мастера DELPHI. Новости мира компонент, FAQ, статьи...


Информационный Канал Subscribe.Ru
Ежедневная рассылка сайта Мастера DELPHI

DELPHIMASTER.ru

Выпуск от 08.08.03 09:04

Кое-что из нашей кладовки   |x|
Лучшее из нашего FAQ   |x|
Прозрачная форма 


Эта форма имет прозрачный фон !!!

unit unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
type
  TForm1 = class(TForm)
  Button1: TButton;
  Button2: TButton;
    // это просто кнопка на форме - для демонстрации
  protected
    procedure RebuildWindowRgn;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;
var
  Form1 : TForm1;
implementation
// ресурс этой формы
{$R *.DFM}

{ Прозрачная форма }
constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;
  // убираем сколлбары, чтобы не мешались
  // при изменении размеров формы
  HorzScrollBar.Visible:= False;
  VertScrollBar.Visible:= False;
 
// строим новый регион
  RebuildWindowRgn;
end;

procedure TFo!
rm1.Resize;
begin
  inherited;
  // строим новый регион
  RebuildWindowRgn;
end;

procedure TForm1.RebuildWindowRgn;
var
  FullRgn, Rgn: THandle;
  ClientX, ClientY, I: Integer;
begin
  // определяем относительные координаты клиенской части
  ClientX:= (Width - ClientWidth) div 2;
  ClientY:= Height - ClientHeight - ClientX;
  // создаем регион для всей формы
  FullRgn:= CreateRectRgn(0, 0, Width, Height);
  // создаем регион для клиентской части формы
  // и вычитаем его из FullRgn
  Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY +
ClientHeight);
  CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff);
  // теперь добавляем к FullRgn регионы каждого контрольного элемента
  for I:= 0 to ControlCount -1 do
    with Controls[I] do begin
     
Rgn:= CreateRectRgn(ClientX + Left, ClientY + Top, ClientX + Left +
Width, ClientY + !
Top + Height);
      CombineRgn(FullRgn, FullRgn, Rgn, rgn_Or);
    end;
  // устанавливаем новый регион окна
  SetWindowRgn(Handle, FullRgn, True);
end;
end.


А как Вам понравится эта форма ?

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;
  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 := 'OOOH! Doughnuts!';
  BorderStyle := bsNone; {required}
  IF Width > Height THEN Width := Height
  ELSE Height := Width;  {harder to calc if
width <> height}
  Center  := Point(Width DIV 2, Height DIV 2);
  Ca!
pY := 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 DO
    BEGIN
      Parent     := 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 DO
    WITH ScreenToClient(Point(XPos,YPos)) DO
      IF PtInRegion(rTitleBar, X, Y) AND
       (NOT PtInRect(SB1.BoundsRect, Point(X,Y))) THEN
        Result := 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 DO
    begin
      Brush.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) DO
        BEGIN
          X := 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);
          T!
extOut(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 DO
    BEGIN
      Pen.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.


»»» Прислать свои комментарии

Обсуждается в конференциях   |x|
  • Создание уникального имени папки
    Подскажите как сгенирировать уникальное имя папки? Я сделал на основе текущего времени и даты и разложил в hex(так как ...
  • Шпион за печатью
    Доброе время суток всем. Поставлена задача подсчитать сколько листов бумаги было намечатано за день с данной машины и ...
  • Отловить нажатие клавиши
    Возможно как-то определить была ли нажата какая-то кнопка на клавиатуре (не важно какая) без использования хуков? ...
  • Извлечение иконок из строкового потока
    Здравствуйте уважаемые господа! Помогите решить задачу: нужно извлечь иконки из строкового потока (где формат хранения ...
  • АDO  и ACCESS
    Добрый день, уважаемые знатоки ! Есть такая проблема: Стоит задача импорта данных из одного mdb файла в другой. При ...
  • Оптимизация вычислений с плавающей точкой
    Помогите пожалуйста информацией по приведению вещественных чисел к целочисленным и обратно, или иным способам ...
  • Com-port в NT
    Не подскажите как работать с СОМ портом под NT,2000... Дело в том что работать под 98 могу, но под 2000 целая проблемма....
У нас большой выбор статей   |x|
Что такое "Змейка" и как с ней бороться?
В статья подробно, шаг за шагом описывается реализация алгоритма движка игры "Змейка".
Новинки книжного рынка   |x|
Профессиональная работа в Delphi 6 (+ дискета)
В предлагаемой вашему вниманию книге описываются нетривиальные возможности системы программирования Delphi 6. Книга является логическим продолжением двух других книг этого же автора: `Delphi 6. Учебный курс` и `Программирование баз данных в Delphi 6. Учебный курс`, вышедших ранее в издательстве `Питер`. Все три пособия дают практически полное описание интегрированной среды разработки приложений Delphi. Достаточно сложный материал изложен на примерах, что позволяет наглядно оценить возможности той или иной технологии. Все примеры снабжены подробным комментарием, а их исходные тексты вы найдете на прилагаемой к книге дискете. Книга предназначена для опытных пользователей.
Автор: Валерий Фаронов
Другие сайты о DELPHI   |x|
Delphi X-Files
Сайт целиком посвящен программированию а Borland Delphi. Все аспекты программирования, статьи, исходные коды, FAQ, компоненты и многое другое. Весь материал будет полезен как новичкам, так и ...
» Оценка сайта: 3
Опрос населения :)
Какой сайт по Delphi лучший?
»»» Королевство Дельфи
»»» Этот сайт
»»» Дельфи. Вокруг да около
»»» Другой
»»» Чем больше, тем лучше!
Для души

Хокку дня
Ты хочешь мне помочь
Сойти с ума? Не стоит,
Я и сам прекрасно управляюсь...

Афоризмы
Умник – осёл, додумавшийся до лошадиной мысли.

Фраза дня
Надоели критические дни - смени пол!

Дурацкие законы (информация предоставлена сайтом kurilka.com)
В городе Пенсакола во Флориде жителям предписывается всегда иметь при себе не меньше10-ти долларов.
В городе Лафайет в Калифронии считается преступлением плеваться в пределах метра от других людей.

И на закуску коротенький анекдот
Секс в машине - это такая дурь! Тесно, неудобно - а шофёр сидит, хихикает...

Фотоприколы.
Начните день с хорошего настроения!
http://www.delphimaster.ru/cgi-bin/prikol.pl?id=1

На этом позвольте откланяться и пожелать вам удачного дня.
Искренне ваш, Алексей (delphi@mastak.ru)

Добро пожаловать на сайт -= Мастера DELPHI =- 
http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное