Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Форма облегает картинку

Автор: X-Serge 10.10.2002, 21:01

Народ, подскажите.
Вот есть форма, на ней расположена картинка.
Как сделать так, чтобы форма имела форму картинки (это я спрашиваю для Win98, в 2000 и выше это можно сделать с помощью транспорантности).
И вот еще что, желательно, чтобы при таскании шлейфа сильно не оставалось.

Автор: Dexter 10.10.2002, 22:13

Пользуйся регионами

Автор: X-Serge 10.10.2002, 22:24

Хотелось бы чуть-чуть по подробнее :-)
Если не трудно небольшой примерчик.

Автор: Dexter 10.10.2002, 22:54

Уст. региона

SetWindowRgn(Handle, R, True);

Handle - указатель на форму, вид которой хотим поменять
R - указатель на регион
Третий параметр - флаг, при значении TRUE сразу после установки перерисовка

Создание:

CreateRectRgn(0, 0, Width, Height);

Ну и еще там всякие CombineRgn.

Код


constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;
  HorzScrollBar.Visible:= False;  
  VertScrollBar.Visible:= False;  
  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); 
  Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth,
                      ClientY +ClientHeight);
  CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff);
  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;

procedure TForm1.Resize;
begin
  inherited;
  RebuildWindowRgn;            
end;

Должны остаться одни кнопки

Автор: X-Serge 10.10.2002, 23:14

Большое спасибо, сейчас попробую помутить.

Автор: Dapo 11.10.2002, 18:43

Этот пример есть где-то в интернете (не помню где). Немного переделан под свои нужды.
По нажатию на кнопку на форме рисуется обнаженная девушка (супер! :-) ) на белом фоне, после чего белый фон убирается и остается форма в виде этой самой девушки. :-) В общем класно. Картинку могу намылить. D6, W2K.

unit Modifi;
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
function BitmapToRgn(Image: TBitmap): HRGN;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var
MaskBmp: TBitmap;
begin
MaskBmp := TBitmap.Create;
try
MaskBmp.LoadFromFile('C:\67.bmp');
Height := MaskBmp.Height;
Width := MaskBmp.Width;
SetWindowRgn(Handle, BitmapToRgn(MaskBmp), True);
finally
MaskBmp.Free;
end;
end;

function BitmapToRgn(Image: TBitmap): HRGN;
var
TmpRgn: HRGN;
x, y: integer;
ConsecutivePixels: integer;
CurrentPixel: TColor;
CreatedRgns: integer;
CurrentColor: TColor;
begin
CreatedRgns := 0;
Result := CreateRectRgn(0, 0, Form1.Width, Form1.Height);
inc(CreatedRgns);

if (Image.Width = 0 ) or (Image.Height = 0) then exit;

for y := 0 to Image.Height - 1 do
begin
CurrentColor := Image.Canvas.Pixels[0,y];
ConsecutivePixels := 1;
for x := 0 to Image.Width - 1 do
begin
CurrentPixel :=Image.Canvas.Pixels[x,y];
Form1.Canvas.Pixels[x,y]:=Image.Canvas.Pixels[x+4,y+23];
if CurrentColor = CurrentPixel
then inc(ConsecutivePixels)
else begin
//Цвет фона не чисто белый а с градациями поэтому диапазон
if (CurrentColor = 16777215) or (CurrentColor >=15724527 ) then
begin
TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
inc(CreatedRgns);
DeleteObject(TmpRgn);
end;
CurrentColor := CurrentPixel;
ConsecutivePixels := 1;
end;
end;

if ((CurrentColor <= 16777215) or (CurrentColor >=15724527 )) and (ConsecutivePixels > 0) then
begin
TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
inc(CreatedRgns);
DeleteObject(TmpRgn);
end;
end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const SC_DragMove = $F012; { a magic number }
begin
ReleaseCapture;
Form1.perform(WM_SysCommand, SC_DragMove, 0);
end;

end.

Автор: Dexter 11.10.2002, 22:14

Цитата

Этот пример есть где-то в интернете (не помню где). Немного переделан под свои нужды.

Да на http://codenet.ru по-мойму