मैं अपने फॉर्म

Question

पर अर्ध पारदर्शी परत कैसे लगा सकता हूं मैंने पिछले सप्ताह या तो स्टैक ओवरफ्लो पर इसके बारे में कुछ प्रश्न पढ़े हैं।

मेरी आवश्यकता उतनी ही कम है।

मैं अपने प्रपत्र शीर्ष पर एक अर्द्ध पारदर्शी परत लगाने की जरूरत है, लेकिन इस फार्म कई अन्य घटक हो सकता है: सूचियाँ, संपादित करता, लेबल, छवियाँ, आदि

मैं इस अर्द्ध पारदर्शी परत की जरूरत पर होना उस सब के ऊपर।

विचार उस फ़ॉर्म के क्षेत्रों को फीका करना है जो उन लोगों का उपयोग नहीं करते हैं, या उस पल में नहीं पहुंच सकते हैं।

मैं उपयोग डेल्फी 2007

धन्यवाद

Answer 1

यहां अल्फा मिश्रित पारदर्शी टीएफओएम का उपयोग फीका छाया के रूप में एक डेमो ऐप है। इस और एंड्रियास के उदाहरण के बीच मुख्य अंतर यह है कि यह कोड नेस्टेड नियंत्रणों को संभालता है और किसी भी विंडो क्षेत्र का उपयोग नहीं करता है।

MainForm.pas:

unit MainForm; 

interface 

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

type 
    TShadowTestForm = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    Panel1: TPanel; 
    Button3: TButton; 
    Button4: TButton; 
    Panel2: TPanel; 
    Button5: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure FormResize(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button4Click(Sender: TObject); 
    procedure Button5Click(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    private 
    { Private declarations } 
    Shadow: TShadowForm; 
    procedure WMMove(var Message: TWMMove); message WM_MOVE; 
    public 
    { Public declarations } 
    end; 

var 
    ShadowTestForm: TShadowTestForm; 

implementation 

{$R *.dfm} 

procedure TShadowTestForm.Button1Click(Sender: TObject); 
begin 
    if not Assigned(Shadow) then 
    begin 
    Shadow := TShadowForm.CreateShadow(Self); 
    Shadow.UpdateShadow; 
    Button1.Caption := 'Hide Shadow'; 
    Button4.Caption := 'Show Modal Form'; 
    end else 
    begin 
    FreeAndNil(Shadow); 
    Button1.Caption := 'Show Shadow'; 
    Button4.Caption := 'Test Click'; 
    end; 
end; 

procedure TShadowTestForm.Button2Click(Sender: TObject); 
begin 
    ShowMessage('clicked ' + TControl(Sender).Name); 
end; 

procedure TShadowTestForm.Button4Click(Sender: TObject); 
var 
    tmpFrm: TForm; 
begin 
    if Assigned(Shadow) then 
    begin 
    tmpFrm := TShadowTestForm.Create(nil); 
    try 
     tmpFrm.ShowModal; 
    finally 
     tmpFrm.Free; 
    end; 
    end else 
    Button2Click(Sender); 
end; 

procedure TShadowTestForm.Button5Click(Sender: TObject); 
begin 
    TShadowTestForm.Create(Self).Show; 
end; 

procedure TShadowTestForm.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
    if not (fsModal in FormState) then 
    Action := caFree; 
end; 

procedure TShadowTestForm.FormResize(Sender: TObject); 
begin 
    if Assigned(Shadow) then Shadow.UpdateShadow; 
end; 

procedure TShadowTestForm.WMMove(var Message: TWMMove); 
begin 
    inherited; 
    if Assigned(Shadow) then Shadow.UpdateShadow; 
end; 

end. 

MainForm.dfm:

object ShadowTestForm: TShadowTestForm 
    Left = 0 
    Top = 0 
    Caption = 'Shadow Test Form' 
    ClientHeight = 243 
    ClientWidth = 527 
    Color = clBtnFace 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [] 
    OldCreateOrder = False 
    PopupMode = pmExplicit 
    Position = poScreenCenter 
    OnClose = FormClose 
    OnResize = FormResize 
    PixelsPerInch = 96 
    TextHeight = 13 
    object Button1: TButton 
    Tag = 1 
    Left = 320 
    Top = 192 
    Width = 97 
    Height = 25 
    Caption = 'Show Shadow' 
    TabOrder = 0 
    OnClick = Button1Click 
    end 
    object Button2: TButton 
    Left = 64 
    Top = 56 
    Width = 75 
    Height = 25 
    Caption = 'Test Click' 
    TabOrder = 1 
    OnClick = Button2Click 
    end 
    object Panel1: TPanel 
    Left = 192 
    Top = 40 
    Width = 289 
    Height = 105 
    Caption = 'Panel1' 
    TabOrder = 2 
    object Button3: TButton 
     Left = 24 
     Top = 16 
     Width = 75 
     Height = 25 
     Caption = 'Test Click' 
     TabOrder = 0 
     OnClick = Button2Click 
    end 
    object Button4: TButton 
     Tag = 1 
     Left = 72 
     Top = 72 
     Width = 129 
     Height = 25 
     Caption = 'Test Click' 
     TabOrder = 1 
     OnClick = Button4Click 
    end 
    end 
    object Panel2: TPanel 
    Tag = 1 
    Left = 24 
    Top = 151 
    Width = 233 
    Height = 84 
    Caption = 'Panel2' 
    TabOrder = 3 
    object Button5: TButton 
     Tag = 1 
     Left = 22 
     Top = 48 
     Width = 155 
     Height = 25 
     Caption = 'Show NonModal Form' 
     TabOrder = 0 
     OnClick = Button5Click 
    end 
    end 
end 

Shadow.pas:

unit Shadow; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, 
    Controls, Forms, Dialogs; 

type 
    TShadowForm = class(TForm) 
    private 
    { Private declarations } 
    FBmp: TBitmap; 
    procedure FillControlRect(Control: TControl); 
    procedure FillControlRects(Control: TWinControl); 
    protected 
    procedure Paint; override; 
    procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; 
    procedure WMDisplayChange(var Message: TMessage); message WM_DISPLAYCHANGE; 
    public 
    { Public declarations } 
    constructor CreateShadow(AForm: TForm); 
    destructor Destroy; override; 
    procedure UpdateShadow; 
    end; 

implementation 

{$R *.dfm} 

constructor TShadowForm.CreateShadow(AForm: TForm); 
begin 
    inherited Create(AForm); 
    PopupParent := AForm; 
    FBmp := TBitmap.Create; 
    FBmp.PixelFormat := pf24bit; 
end; 

destructor TShadowForm.Destroy; 
begin 
    FBmp.Free; 
    inherited; 
end; 

procedure TShadowForm.Paint; 
begin 
    Canvas.Draw(0, 0, FBmp); 
end; 

procedure TShadowForm.FillControlRect(Control: TControl); 
var 
    I: Integer; 
    R: TRect; 
begin 
    if Control.Tag = 1 then 
    begin 
    R := Control.BoundsRect; 
    MapWindowPoints(Control.Parent.Handle, PopupParent.Handle, R, 2); 
    FBmp.Canvas.FillRect(R); 
    end; 
    if Control is TWinControl then 
    FillControlRects(TWinControl(Control)); 
end; 

procedure TShadowForm.FillControlRects(Control: TWinControl); 
var 
    I: Integer; 
begin 
    for I := 0 to Control.ControlCount-1 do 
    FillControlRect(Control.Controls[I]); 
end; 

procedure TShadowForm.UpdateShadow; 
var 
    Pt: TPoint; 
    R: TRect; 
begin 
    Pt := PopupParent.ClientOrigin; 
    R := PopupParent.ClientRect; 

    FBmp.Width := R.Right - R.Left; 
    FBmp.Height := R.Bottom - R.Top; 

    FBmp.Canvas.Brush.Color := clSkyBlue; 
    FBmp.Canvas.FillRect(Rect(0, 0, FBmp.Width, FBmp.Height)); 

    FBmp.Canvas.Brush.Color := TransparentColorValue; 
    FillControlRects(PopupParent); 

    SetBounds(Pt.X, Pt.Y, FBmp.Width, FBmp.Height); 
    if Showing then 
    Invalidate 
    else 
    ShowWindow(Handle, SW_SHOWNOACTIVATE); 
end; 

procedure TShadowForm.WMDisplayChange(var Message: TMessage); 
begin 
    inherited; 
    UpdateShadow; 
end; 

procedure TShadowForm.WMMouseActivate(var Message: TWMMouseActivate); 
begin 
    Message.Result := MA_NOACTIVATE; 
end; 

end. 

Shadow.dfm:

object ShadowForm: TShadowForm 
    Left = 0 
    Top = 0 
    Cursor = crNo 
    AlphaBlend = True 
    AlphaBlendValue = 128 
    BorderStyle = bsNone 
    Caption = 'Shadow' 
    ClientHeight = 281 
    ClientWidth = 543 
    Color = clBtnFace 
    TransparentColor = True 
    TransparentColorValue = clFuchsia 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [] 
    OldCreateOrder = False 
    PopupMode = pmExplicit 
    Position = poDesigned 
    PixelsPerInch = 96 
    TextHeight = 13 
end 

ShadowDemo।डीआरपी:

program ShadowDemo; 

uses 
    Forms, 
    ShadowTestForm in 'MainForm.pas' {ShadowTestForm}, 
    Shadow in 'Shadow.pas' {ShadowForm}; 

{$R *.res} 

begin 
    Application.Initialize; 
    Application.MainFormOnTaskbar := True; 
    Application.CreateForm(TShadowTestForm, ShadowTestForm); 
    Application.Run; 
end. 

Answer 2

एक नया VCL परियोजना बनाएँ। मुख्य रूप में कुछ नमूना बटन और अन्य नियंत्रण जोड़ें। नया फ़ॉर्म बनाएं, AlphaBlendtrue और AlphaBlendValue से 128 पर सेट करें। शायद Color = clSkyBlue पर्याप्त होगा?

procedure TForm1.FormResize(Sender: TObject); 
begin 
    UpdateShadow; 
end; 

और फार्म कदम

procedure TForm1.UpdateShadow; 
var 
    pnt: TPoint; 
    rgn, rgnCtrl: HRGN; 
    i: Integer; 
begin 
    if not Assigned(Form2) then Exit; 
    Form2.Show; 
    pnt := ClientToScreen(Point(0, 0)); 
    Form2.SetBounds(pnt.X, pnt.Y, ClientWidth, ClientHeight); 
    rgn := CreateRectRgn(0, 0, Form2.Width, Form2.Height); 
    for i := 0 to ControlCount - 1 do 
    if Controls[i].Tag = 1 then 
    begin 
     if not (Controls[i] is TWinControl) then Continue; 
     with Controls[i] do 
     rgnCtrl := CreateRectRgn(Left, Top, Left+Width, Top+Height); 
     CombineRgn(rgn, rgn, rgnCtrl, RGN_DIFF); 
     DeleteObject(rgnCtrl); 
    end; 
    SetWindowRgn(Form2.Handle, rgn, true); 
    DeleteObject(rgn); 
end; 

और आकार बदलने पर यह कहते हैं,:: फिर अपने मुख्य फार्म के लिए निम्नलिखित प्रक्रिया को जोड़ने

procedure TForm1.WMMove(var Message: TWMMove); 
begin 
    inherited; 
    UpdateShadow; 
end; 

अंत में, पर 1 को Tag सेट नियंत्रण (आपके मुख्य रूप पर) जो पहुंच योग्य हैं।

Sample screenshot http://privat.rejbrand.se/shadowWithHoles.png

सुझाव: तुम भी crNo करने के लिए 'छाया प्रपत्र' की Cursor स्थापित करने के लिए इच्छा हो सकती है।