首页 | 社区 | 博客 | 招聘 | 文章 | 新闻 | 下载 | 读书 | 代码
亲,您未登录哦! 登录 | 注册

在win95,win98下实现半透明的窗口

打印文章

分享到:
取窗体下背景图,后将各点的颜色的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.

本栏文章均来自于互联网,版权归原作者和各发布网站所有,本站收集这些文章仅供学习参考之用。任何人都不能将这些文章用于商业或者其他目的。( Pfan.cn )

编程爱好者论坛

本栏最新文章