如何做出不规则窗体

Question

如何做出不规则窗体
请问如何实现像有些播放软件如金山影霸2003那样实现形状截然不同的界面切换，他的skins目录下有好多的
图片，其原理怎样？可否有原代码给例子？或有什么可以改变窗体形状不规则的控件？
谢谢！！！   [email protected]

Answer 1

http://www.torry.net有类似功能的VCL,可以参考

Answer 2

unit fmMain;这里有一个做不规则窗体的例子。
   1、在窗体上放一个Image控件，left:0  Top:0 Width及Height与窗体一致，用作背景。
   2、背景图中的边缘白色将会透明，这样就可能做出不规则窗体。
   3、在XP中Delphi 7可直接设定某种颜色透明。
interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, ComCtrls, ImgList;type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    FullRgn : THandle ;
    procedure SetFormTransparent ;  public
    WorkPath : String ;
    { Public declarations }
  end;var
  Form1: TForm1;implementation
{$R *.dfm}procedure TForm1.SetFormTransparent;
begin
  SetWindowRgn(Handle, FullRgn, True);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  ClientRgn,  ControlRgn: THandle;
  Margin,  MarginX,  MarginY,  X,  Y: Integer;
  blX, bhX, bY :Integer;
  C    : TColor;
begin
  WorkPath := ExtractFilePath(Application.ExeName);
  Margin := (Width - ClientWidth) div 2;
  FullRgn := CreateRectRgn(0, 0, Width, Height);
  MarginX := Margin;
  MarginY := Height - ClientHeight - Margin;
  ClientRgn := CreateRectRgn(MarginX, MarginY, MarginX + ClientWidth, MarginY + ClientHeight);
  CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
  DeleteObject(ClientRgn);
  X := MarginX + Image1.Left;
  Y := MarginY + Image1.Top;
  with Image1 do begin
     for bY:=0 to Picture.Bitmap.Height-1 do begin
       blX:=0;    C :=  Picture.Bitmap.Canvas.Pixels[blX,bY];
       While (C and $FF>192)and((C shr 8 and $FF)>192)and
         ((C shr 16 and $FF)>192) do  begin
            Inc(blX); C :=  Picture.Bitmap.Canvas.Pixels[blX,bY];
       end;
       bhx:=Picture.Bitmap.Width -1; C :=  Picture.Bitmap.Canvas.Pixels[bhX,bY];
       While (C and $FF>192)and((C shr 8 and $FF)>192)and
         ((C shr 16 and $FF)>192) do  begin
            Dec(bhX); C :=  Picture.Bitmap.Canvas.Pixels[bhX,bY];
       end;
       ControlRgn := CreateRectRgn(X+blX, Y+bY, X + bhX, Y + bY+1);
       CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
       DeleteObject(ControlRgn);
     end;
  end;
  SetFormTransparent ;
end;end.

Answer 3

使窗体象你能想象到的任何形状  
CoDelphi.com
摘　要：如何生成一个非矩形窗体?
关键字：SetWindowRgn Region PathToRegion
类　别：用户界面
 
 
    你想要你的窗体想一颗大树或者其它什么东西吗? 窗体的''CreateRoundRectRegion()''函数仅能剪切标准窗体的边缘。如果你想要特别一点,你需要亲手在画布(TCanvas)上画你想要的形状，然后你通过''SetWindowRgn()'' 函数把这个新的区域放置上你的窗体上。
 
    具体怎么做呢?这儿有一个简单的例子，它仅仅是接收一些字符，然后设置一个区域看上去象这些字符。自己动脑筋扩充它! unit uMainForm; interface uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls, Menus; type 
  TfrmMainForm = class(TForm) 
    btnDoAction: TButton; 
    pmnPopup: TPopupMenu; 
    miDrawText: TMenuItem; 
    miExit: TMenuItem; 
    procedure btnDoActionClick(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure miExitClick(Sender: TObject); 
  private 
    { Private declarations } 
    HRgn: THandle; 
  public 
    { Public declarations } 
  end; var 
  frmMainForm: TfrmMainForm; implementation {$R *.DFM} procedure TfrmMainForm.btnDoActionClick(Sender: TObject); 
var 
  s: String; 
begin 
  DeleteObject(HRgn); 
  s := InputBox(''Region Text'', ''Please enter some text to set to the region'', ''CoolRgn'');   BeginPath(Canvas.Handle); 
  with Canvas do 
  begin 
    Font.Name := ''Comic Sans MS''; Font.Size := 64; Font.Style := [fsBold]; 
    TextOut(0, 0, s); 
  end;   EndPath(Canvas.Handle); 
  HRgn := PathToRegion(Canvas.Handle); 
  SetWindowRgn(Handle, HRgn, True);   btnDoAction.Visible := False; 
  Color := clRed; 
end; procedure TfrmMainForm.FormClose(Sender: TObject; 
  var Action: TCloseAction); 
begin 
  DeleteObject(HRgn); 
end; procedure TfrmMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if Button = mbLeft then 
  begin 
    ReleaseCapture; 
    SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0); 
  end; 
end; procedure TfrmMainForm.miExitClick(Sender: TObject); 
begin 
  Application.MainForm.Close; 
end; end. 
 

Answer 4

在TForm的Tcanvas类中，将skin下的图片根据你想要确定的位置分别加载到窗体上。