社区
数据库相关
帖子详情
菜鸟的问题:DELPHI中form的形状可以有方形改成自定义的形状吗?
fengguo1009
2003-08-24 01:13:35
各位大吓:
我想做一个有个性形状的东西,怎么样将DELPHI中form的形状可以有方形改成自定义的形状吗?
急急急!!!!!!!!!!!!!!
...全文
68
5
打赏
收藏
菜鸟的问题:DELPHI中form的形状可以有方形改成自定义的形状吗?
各位大吓: 我想做一个有个性形状的东西,怎么样将DELPHI中form的形状可以有方形改成自定义的形状吗? 急急急!!!!!!!!!!!!!!
复制链接
扫一扫
分享
转发到动态
举报
写回复
配置赞助广告
用AI写文章
5 条
回复
切换为时间正序
请发表友善的回复…
发表回复
打赏红包
karach
2003-08-29
打赏
举报
回复
看来我是没有分拉,
我的专家问题->我的问题->管理->给分就可以拉
注意给点给我哦
fengguo1009
2003-08-29
打赏
举报
回复
hehe,我是CSDN的新手,请问怎么给分??不好意思!
frogshero
2003-08-26
打赏
举报
回复
給分撒
fengguo1009
2003-08-26
打赏
举报
回复
xiexie
frogshero
2003-08-24
打赏
举报
回复
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
菜鸟
电子面单,
自定义
区设置方法
菜鸟
电子面单打印组件,
自定义
打印区展示内容
C语言之——
自定义
数据类型
目录 前言:什么是
自定义
数据类型? 一,
自定义
数据类型之:...所谓
自定义
数据类型,就是用一个新名字重新对一个数据类型命名,后面新名字就有了该数据类型的功能,在调用该新名字时,就相当于调用该数据类型。...
iview-
Form
表单校验
自定义
检验规则
在合适的场景
中
调用 blur 失去焦点时,change 内容改变时 validator 关键字,后面跟开始时
自定义
的规则名 trigger 关键字,触发节点 data return 里⬇ rule
Form
:{ tqjebr:[ { validator:brtqfkCheck, trigger: 'blur...
自定义
形状
的ImageView制作
最近公司让我做个头像的显示功能,这个头像有点但疼痛,
形状
竟然像个盾牌!呵呵哒?!各种曲线,贝塞尔线,Android能不能搞啊?果断去问度娘啊!一搜,卧槽,还不少呢!参考了一个github上的一个项目,结合自己的...
计算机遇到电脑无法开机,PC
菜鸟
必读:电脑无法开机的解决办法!
原标题:PC
菜鸟
必读:电脑无法开机的解决办法!在游戏应用甚至办公领域,台式机仍有着很大的使用比例。而在日常使用
中
,很多用户都遇到PC主机无法开机的现象,诸如开机无反应、主机运行正常却无法显示,以及开机滴滴...
数据库相关
2,498
社区成员
88,445
社区内容
发帖
与我相关
我的任务
数据库相关
Delphi 数据库相关
复制链接
扫一扫
分享
社区描述
Delphi 数据库相关
社区管理员
加入社区
获取链接或二维码
近7日
近30日
至今
加载中
查看更多榜单
社区公告
暂无公告
试试用AI创作助手写篇文章吧
+ 用AI写文章