取窗体下背景图，后将各点的颜色的RGB各取一半。
unit JtoCXPAuto;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, FORMs,
Dialogs, ExtCtrls, ShellApi;
type
TAutoFORM = class(TFORM)
BackImg: TImage;
procedure FORMShow(Sender: TObject);
procedure BackImgMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BackImgMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
AutoFORM: TAutoFORM;
EMailRect:TRect;
implementation
uses JtoCXPMain,JtoCXPPubVar;
{$R *.dfm}
procedure TAutoFORM.FORMShow(Sender: TObject);
var
ScreenDc,DestDc:Hdc;
BHandle:THandle;
X,Y:integer;
Color:TColor;
Color1,Color2,Color3:Byte;
FORMRgn:Hrgn;
begin
FORMRgn:=CreateRoundRectRgn(0,0,Width,Height,15,15);
SetWindowRgn(Handle,FORMRgn,True);
EnableWindow(MainFORM.Handle,False);
ScreenDc:=CreateDc('DISPLAY',nil,nil,nil);
DestDc:=CreateCompatibleDc(ScreenDc);
BHandle:=CReateCompatibleBitmap(ScreenDc,Width,Height);
SelectObject(DestDc,Bhandle);
BitBlt(DestDc,0,0,Width,Height,ScreenDc,MainFORM.Left+(MainFORM.Width -Width)div 2,
MainFORM.Top +(MainFORM.Height -Height)div 2,SRCCOPY);
for x:=0 to Width-1 do begin
for y:=0 to Height-1 do begin
Color:=GetPixel(DestDc,x,y);
Color1:=GetRvalue(Color) div 3;
Color2:=GetGvalue(Color) div 3;
Color3:=GetBvalue(Color) div 3;
Color:=RGB(Color1,Color2,Color3);
SetPixel(DestDC,x,y,Color);
end;
end;
BitBlt(BackImg.Canvas.Handle,0,0,Width,Height,DestDC ,0,0,SRCCOPY);
DeleteDc (DestDc);
ReleaseDc (Bhandle,ScreenDc);
with BackImg.Canvas do begin
Moveto(0,0);
Pen.Color :=rgb(192,192,192);
Lineto(BackImg.Width -1,0);
// Pen.Color :=rgb(64,64,64);
Lineto(BackImg.Width -1,backImg.Height -1);
Lineto(0,BackImg.Height-1);
Pen.Color :=rgb(192,192,192);
Lineto(0,0);
Font.Size :=16;
Font.Color :=RGB(255,255,255);
Brush.Style :=bsClear;
TextOut((Width-TextWidth('欢迎你使用---对译'))div 2,5,'欢迎你使用---对译');
Font.Size :=12;
TextOut(20,40,'版本信息：');
TextOut(120,40,'( 2002.03.08 )');
TextOut(20,70,'电子邮件：');
TextOut((Width-TextWidth('这是我个人编写的,请指教!'))div 2,105,'这是我个人编写的,请指教!');
Font.Color :=Rgb(255,0,0);
Font.Style :=[fsUnderline];
TextOut(120,70,'sbjane9@163.com');
end;
end;
procedure TAutoFORM.BackImgMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pt:Tpoint;
begin
GetCursorpos(pt);
if PtinRect(EMailRect,pt) then begin
ShellExecute(handle,nil,pchar('MailTo:'+MyEmail),nil,nil,SW_SHOWNORMAL);
exit;end
else begin
AutoFORM.Close;
EnableWindow(MainFORM.Handle,True);
end;
end;
procedure TAutoFORM.BackImgMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
Pt:Tpoint;
begin
EMailRect:=Bounds(Left+120,Top+70,16*12,14);
GetCursorpos(pt);
if PtinRect(EMailRect,pt) then
Cursor:=crHandPoint
else
Cursor:=crDefault;
end;
end.
|
|
