VPF::Панель (Tpanel) не стандартной формы

XVII

Дата 11.9.2007, 18:04 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 9.9.2007

Репутация: нет
Всего: нет

Можно ли как нибудь сделать форму панели например треугольником, кругом или ромбом, или например по рисунку. Если можно, то как? Долго искал инфу на эту тему, но безуспешно. Помогите плиз. smile

bems

Дата 11.9.2007, 18:31 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 31
Всего: 88

Код


procedure TForm1.Button1Click(Sender: TObject);
var rgn:HRGN;
begin
rgn:=CreateEllipticRgn(0,0,panel1.Width,panel1.Height);
SetWindowRgn(panel1.Handle,rgn,true);
end;

--------------------

Обижено школьников: 8

Alexeis

Дата 11.9.2007, 18:35 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Назначить окну другой регион. А по рисунку аналогично, делается проход по рисунку и создание региона.
См. функцию SetWindowRgn(); у меня есть дома примерчики. Позже скину.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Alexeis

Дата 11.9.2007, 19:40 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Вот и пример (не помню правда чей)

Код


unit UnitMain;

interface

uses
  Windows, Messages, Graphics, Controls, Forms, ExtCtrls, Classes;

type
  TFormMain = class(TForm)
    ImageFormMain: TImage;
    Timer: TTimer;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  R: HRgn;

implementation

{$R *.dfm}

procedure TFormMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If ssLeft In Shift Then
  Begin
    ReleaseCapture;
    SendMessage(Handle,WM_NCLBUTTONDOWN,HTCAPTION,0);
  End;
end;

procedure TFormMain.FormCreate(Sender: TObject);
Var
  X1,X,Y: Integer;
begin
  X1 := -1;
  R := CreateRectRgn(0,0,0,0);

  ImageFormMain.Picture.LoadFromFile('1.bmp');
  FormMain.BorderStyle := bsNone;
  FormMain.Height := ImageFormMain.Picture.Bitmap.Height;
  FormMain.Width := ImageFormMain.Picture.Bitmap.Width;

  With ImageFormMain.Picture.Bitmap Do
    For Y := 0 To Height-1 Do
      For X := 0 To Width-1 Do
        If Canvas.Pixels[X,Y] <> Canvas.Pixels[0,0] Then
          Begin If X1=-1 Then X1 := X; End
        Else
          If X1>-1 Then
          Begin
            CombineRgn(R,R,CreateRectRgn(X1,Y,X-1,Y+1),RGN_OR);
            X1 := -1;
          End;
  SetWindowRgn(Handle, R, True);
  SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_LAYERED);
end;

procedure TFormMain.TimerTimer(Sender: TObject);
begin
 If Timer.Tag = 255 Then Timer.Tag := -255;
 If Timer.Tag > 0 Then
   SetLayeredWindowAttributes(Handle, 0, Timer.Tag, LWA_ALPHA)
 Else
   SetLayeredWindowAttributes(Handle, 0, -Timer.Tag, LWA_ALPHA);
 Timer.Tag := Timer.Tag+1;

end;

end.

Изменения нужно произвести в строчке SetWindowRgn(Handle, R, True); - заменить Handle на дескриптор нужного окна.

--------------------

XVII

Дата 12.9.2007, 09:29 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 9.9.2007

Репутация: нет
Всего: нет

Люди, Вам большой THX! smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »