菜鸟的问题：DELPHI中form的形状可以有方形改成自定义的形状吗？

[fengguo1009]

各位大吓：
我想做一个有个性形状的东西，怎么样将DELPHI中form的形状可以有方形改成自定义的形状吗？
急急急！！！！！！！！！！！！！！

[frogshero]

zswang老大的

(*//
标题:不规则窗体的弹出效果
说明:加上图片效果就好点
日期:2002-10-07
设计:Zswang
//*)

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons;

type
TForm1 = class(TForm)
ImageRight: TImage;
ImageDown: TImage;
PanelCenter: TPanel;
ImageCenter: TImage;
MemoRight: TMemo;
MemoDown: TMemo;
SpeedButtonRight: TSpeedButton;
SpeedButtonDown: TSpeedButton;
SpeedButtonClose: TSpeedButton;
procedure SpeedButtonRightClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpeedButtonDownClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ImageCenterMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpeedButtonCloseClick(Sender: TObject);
private
{ Private declarations }
FRGNRight: HRGN;
FRGNDown: HRGN;
FRGNCenter: HRGN;
FRGNForm: HRGN;
FShowRight: Boolean;
FShowDown: Boolean;
procedure SetShowRight(const Value: Boolean);
procedure SetShowDown(const Value: Boolean);
procedure ShowFormRgn;
public
{ Public declarations }
property ShowRight: Boolean read FShowRight write SetShowRight;
property ShowDown: Boolean read FShowDown write SetShowDown;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SpeedButtonRightClick(Sender: TObject);
begin
ShowRight := not ShowRight;
end;

procedure TForm1.SpeedButtonDownClick(Sender: TObject);
begin
ShowDown := not ShowDown;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
with ImageCenter do begin
Picture.Bitmap.Width := Width;
Picture.Bitmap.Height := Height;
Picture.Bitmap.Canvas.Brush.Color := clBlue;
Picture.Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
end;

///////Begin 创建不规则的区域
{ TODO : 修改区域 }
FRGNRight := CreateRectRgn(
ImageRight.BoundsRect.Left,
ImageRight.BoundsRect.Top,
ImageRight.BoundsRect.Right,
ImageRight.BoundsRect.Bottom);

FRGNDown := CreateRectRgn(
ImageDown.BoundsRect.Left,
ImageDown.BoundsRect.Top,
ImageDown.BoundsRect.Right,
ImageDown.BoundsRect.Bottom);

FRGNCenter := CreateRectRgn(
ImageCenter.BoundsRect.Left,
ImageCenter.BoundsRect.Top,
ImageCenter.BoundsRect.Right,
ImageCenter.BoundsRect.Bottom);
///////End 创建不规则的区域

ShowFormRgn;

DoubleBuffered := True;
FShowRight := False;
FShowDown := False;
end;

procedure TForm1.SetShowRight(const Value: Boolean);
const
{$J+}vChanging: Boolean = False;
const
cOffset = 3;
var
I: Integer;
vStart, vEnd: Integer;
vOffset: Integer; //偏移量
begin
if FShowRight = Value then Exit;
if vChanging then Exit;
FShowRight := Value;
vChanging := True;
if FShowRight then begin
vOffset := -cOffset;
vStart := ImageRight.Left;
vEnd := ImageRight.Left - ImageRight.Width + 20;
end else begin
vOffset := +cOffset;
vStart := ImageRight.Left;
vEnd := ImageRight.Left + ImageRight.Width - 20;
end;
I := vStart;
while Abs(I - vEnd) > Abs(vOffset) do begin
ImageRight.Left := I;
MemoRight.Left := I + 1;
SpeedButtonRight.Left := I + 170;
Application.ProcessMessages;
OffsetRgn(FRGNRight, vOffset, 0); //偏移区域
ShowFormRgn;
ClientWidth := I + ImageRight.Width + 2; //宽度改变
Update;
I := I + vOffset;
end;
vChanging := False;
end;

procedure TForm1.SetShowDown(const Value: Boolean);
const
{$J+}vChanging: Boolean = False;
const
cOffset = 3;
var
I: Integer;
vStart, vEnd: Integer;
vOffset: Integer; //偏移量
begin
if FShowDown = Value then Exit;
if vChanging then Exit;
FShowDown := Value;
vChanging := True;
if FShowDown then begin
vOffset := -cOffset;
vStart := ImageDown.Top;
vEnd := ImageDown.Top - ImageDown.Height + 20;
end else begin
vOffset := +cOffset;
vStart := ImageDown.Top;
vEnd := ImageDown.Top + ImageDown.Height - 20;
end;
I := vStart;
while Abs(I - vEnd) > Abs(vOffset) do begin
ImageDown.Top := I;
MemoDown.Top := I + 1;
SpeedButtonDown.Top := I + 95;
Application.ProcessMessages;
OffsetRgn(FRGNDown, 0, vOffset); //偏移区域
ShowFormRgn;
ClientHeight := I + ImageDown.Height + 2; //宽度改变
Update;
I := I + vOffset;
end;
vChanging := False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(FRGNRight);
DeleteObject(FRGNDown);
DeleteObject(FRGNCenter);
DeleteObject(FRGNForm);
end;

procedure TForm1.ShowFormRgn;
begin
///////Begin 清除区域
DeleteObject(FRGNForm);
FRGNForm := CreateRectRgn(0, 0, 0, 0);
///////End 清除区域
CombineRgn(FRGNForm, FRGNCenter, FRGNRight, RGN_OR);
CombineRgn(FRGNForm, FRGNForm, FRGNDown, RGN_OR);
SetWindowRgn(Handle, FRGNForm, True);
end;

procedure TForm1.ImageCenterMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, SC_MOVE + 1, 0);
end;

procedure TForm1.SpeedButtonCloseClick(Sender: TObject);
begin
Close;
end;

end.

//------------------------------------------------------------------------

object Form1: TForm1
Left = 97
Top = 22
BorderStyle = bsNone
Caption = 'Form1'
ClientHeight = 486
ClientWidth = 602
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object ImageRight: TImage
Left = 408
Top = 36
Width = 190
Height = 263
end
object ImageDown: TImage
Left = 64
Top = 368
Width = 294
Height = 115
end
object SpeedButtonRight: TSpeedButton
Left = 576
Top = 140
Width = 17
Height = 33
OnClick = SpeedButtonRightClick
end
object SpeedButtonDown: TSpeedButton
Left = 192
Top = 464
Width = 41
Height = 17
OnClick = SpeedButtonDownClick
end
object MemoDown: TMemo
Left = 83
Top = 369
Width = 256
Height = 80
BevelKind = bkFlat
Lines.Strings = (
'MemoDown')
TabOrder = 2
end
object MemoRight: TMemo
Left = 410
Top = 52
Width = 156
Height = 225
BevelKind = bkFlat
Lines.Strings = (
'MemoRight')
TabOrder = 1
end
object PanelCenter: TPanel
Left = 0
Top = 0
Width = 409
Height = 369
BevelOuter = bvNone
TabOrder = 0
object ImageCenter: TImage
Left = -2
Top = 0
Width = 411
Height = 369
ParentShowHint = False
ShowHint = False
OnMouseDown = ImageCenterMouseDown
end
object SpeedButtonClose: TSpeedButton
Left = 380
Top = 5
Width = 23
Height = 22
OnClick = SpeedButtonCloseClick
end
end
end

[fengguo1009]

xiexie

[frogshero]

給分撒

[fengguo1009]

hehe,我是CSDN的新手，请问怎么给分？？不好意思！

[karach]

看来我是没有分拉，
我的专家问题->我的问题->管理->给分就可以拉
注意给点给我哦