मैं अल्फा मिश्रित पैनल कैसे बना सकता हूं?

Question

मैं डेल्फी XE2 में वास्तव में अल्फा मिश्रित टीपीनल प्रदर्शित करने की कोशिश कर रहा हूं। मुझे ऑनलाइन कुछ प्रयास मिल गए हैं, लेकिन उनमें से कोई भी सही तरीके से काम नहीं करता है।

जो मैं प्राप्त करने की कोशिश कर रहा हूं वह एक 'अर्ध मोडल' रूप है। वेब ब्राउज़र में दिखाई देने वाले तरीके से एक फीका पृष्ठभूमि के साथ अन्य नियंत्रणों के शीर्ष पर प्रदर्शित एक रूप।

मैं इसे एक बुनियादी रूप में काम कर रहा है, लेकिन यह निम्न समस्याओं से ग्रस्त है: जब पैनल आकार बदलने

• झिलमिलाहट की एक बड़ी राशि।
• यदि पैनल के शीर्ष पर नियंत्रण स्थानांतरित हो जाता है तो यह एक निशान छोड़ देता है।

यहां मेरे प्रयास अब तक हैं (कुछ कोड के आधार पर मुझे here मिला)।

unit SemiModalFormU; 

interface 

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

type 
    ISemiModalResultHandler = interface 
    ['{0CC5A5D0-1545-4257-A936-AD777E0DAFCF}'] 
    procedure SemiModalFormClosed(Form: TForm); 
    end; 

    TTransparentPanel = class(TCustomPanel) 
    private 
    FBackground: TBitmap; 
    FBlendColor: TColor; 
    FBlendAlpha: Byte; 

    procedure ColorBlend(const ACanvas: TCanvas; const ARect: TRect; const ABlendColor: TColor; const ABlendValue: Byte); 
    procedure SetBlendAlpha(const Value: Byte); 
    procedure SetBlendColor(const Value: TColor); 
    protected 
    procedure CaptureBackground; 
    procedure Paint; override; 

    procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND; 
    procedure WMMove(var Message: TMessage); message WM_MOVE; 
    procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY; 
    public 
    constructor Create(aOwner: TComponent); override; 
    destructor Destroy; override; 

    procedure ClearBackground; 

    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; 
    published 
    property BlendColor: TColor read FBlendColor write SetBlendColor; 
    property BlendAlpha: Byte read FBlendAlpha write SetBlendAlpha; 

    property Align; 
    property Alignment; 
    property Anchors; 
    end; 

    TSemiModalForm = class(TComponent) 
    strict private 
    FFormParent: TWinControl; 
    FBlendColor: TColor; 
    FBlendAlpha: Byte; 
    FSemiModalResultHandler: ISemiModalResultHandler; 
    FForm: TForm; 
    FTransparentPanel: TTransparentPanel; 
    FOldFormOnClose: TCloseEvent; 
    private 
    procedure OnTransparentPanelResize(Sender: TObject); 
    procedure RepositionForm; 
    procedure SetFormParent(const Value: TWinControl); 
    procedure OnFormClose(Sender: TObject; var Action: TCloseAction); 
    protected 
    procedure Notification(AComponent: TComponent; Operation: TOperation); override; 
    public 
    procedure ShowSemiModalForm(AForm: TForm; SemiModalResultHandler: ISemiModalResultHandler); virtual; 

    property ModalPanel: TTransparentPanel read FTransparentPanel; 
    published 
    constructor Create(AOwner: TComponent); override; 

    property BlendColor: TColor read FBlendColor write FBlendColor; 
    property BlendAlpha: Byte read FBlendAlpha write FBlendAlpha; 
    property FormParent: TWinControl read FFormParent write SetFormParent; 
    end; 

implementation 

procedure TTransparentPanel.CaptureBackground; 
var 
    canvas: TCanvas; 
    dc: HDC; 
    sourcerect: TRect; 
begin 
    FBackground := TBitmap.Create; 

    with Fbackground do 
    begin 
    width := clientwidth; 
    height := clientheight; 
    end; 

    sourcerect.TopLeft := ClientToScreen(clientrect.TopLeft); 
    sourcerect.BottomRight := ClientToScreen(clientrect.BottomRight); 

    dc := CreateDC('DISPLAY', nil, nil, nil); 
    try 
    canvas := TCanvas.Create; 
    try 
     canvas.handle := dc; 
     Fbackground.Canvas.CopyRect(clientrect, canvas, sourcerect); 
    finally 
     canvas.handle := 0; 
     canvas.free; 
    end; 
    finally 
    DeleteDC(dc); 
    end; 
end; 

constructor TTransparentPanel.Create(aOwner: TComponent); 
begin 
    inherited; 

    ControlStyle := controlStyle - [csSetCaption]; 

    FBlendColor := clWhite; 
    FBlendAlpha := 200; 
end; 

destructor TTransparentPanel.Destroy; 
begin 
    FreeAndNil(FBackground); 

    inherited; 
end; 

procedure TTransparentPanel.Paint; 
begin 
    if csDesigning in ComponentState then 
    inherited 
end; 

procedure TTransparentPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 
begin 
    if (Visible) and 
    (HandleAllocated) and 
    (not (csDesigning in ComponentState)) then 
    begin 
    FreeAndNil(Fbackground); 

    Hide; 

    inherited; 

    Parent.Update; 

    Show; 
    end 
    else 
    inherited; 
end; 

procedure TTransparentPanel.WMEraseBkGnd(var msg: TWMEraseBkGnd); 
var 
    ACanvas: TCanvas; 
begin 
    if csDesigning in ComponentState then 
    inherited 
    else 
    begin 
    if not Assigned(FBackground) then 
     Capturebackground; 

    ACanvas := TCanvas.create; 
    try 
     ACanvas.handle := msg.DC; 
     ACanvas.draw(0, 0, FBackground); 
     ColorBlend(ACanvas, Rect(0, 0, Width, Height), FBlendColor, FBlendAlpha); 
    finally 
     FreeAndNil(ACanvas); 
    end; 

    msg.result := 1; 
    end; 
end; 

procedure TTransparentPanel.WMMove(var Message: TMessage); 
begin 
CaptureBackground; 
end; 

procedure TTransparentPanel.WMParentNotify(var Message: TWMParentNotify); 
begin 
    CaptureBackground; 
end; 

procedure TTransparentPanel.ClearBackground; 
begin 
    FreeAndNil(FBackground); 
end; 

procedure TTransparentPanel.ColorBlend(const ACanvas: TCanvas; const ARect: TRect; 
    const ABlendColor: TColor; const ABlendValue: Byte); 
var 
    BMP: TBitmap; 
begin 
    BMP := TBitmap.Create; 
    try 
    BMP.Canvas.Brush.Color := ABlendColor; 
    BMP.Width := ARect.Right - ARect.Left; 
    BMP.Height := ARect.Bottom - ARect.Top; 
    BMP.Canvas.FillRect(Rect(0,0,BMP.Width, BMP.Height)); 

    ACanvas.Draw(ARect.Left, ARect.Top, BMP, ABlendValue); 
    finally 
    FreeAndNil(BMP); 
    end; 
end; 

procedure TTransparentPanel.SetBlendAlpha(const Value: Byte); 
begin 
    FBlendAlpha := Value; 

    Paint; 
end; 

procedure TTransparentPanel.SetBlendColor(const Value: TColor); 
begin 
    FBlendColor := Value; 

    Paint; 
end; 

{ TSemiModalForm } 

constructor TSemiModalForm.Create(AOwner: TComponent); 
begin 
    inherited; 

    FBlendColor := clWhite; 
    FBlendAlpha := 150; 

    FTransparentPanel := TTransparentPanel.Create(Self); 
end; 

procedure TSemiModalForm.SetFormParent(const Value: TWinControl); 
begin 
    FFormParent := Value; 
end; 

procedure TSemiModalForm.ShowSemiModalForm(AForm: TForm; 
    SemiModalResultHandler: ISemiModalResultHandler); 
begin 
    if FForm = nil then 
    begin 
    FForm := AForm; 
    FSemiModalResultHandler := SemiModalResultHandler; 

    FTransparentPanel.Align := alClient; 
    FTransparentPanel.BringToFront; 
    FTransparentPanel.Parent := FFormParent; 
    FTransparentPanel.BlendColor := FBlendColor; 
    FTransparentPanel.BlendAlpha := FBlendAlpha; 

    FTransparentPanel.OnResize := OnTransparentPanelResize; 

    AForm.Parent := FTransparentPanel; 
    FOldFormOnClose := AForm.OnClose; 
    AForm.OnClose := OnFormClose; 

    RepositionForm; 

    AForm.Show; 

    FTransparentPanel.ClearBackground; 
    FTransparentPanel.Visible := TRUE; 
    end; 
end; 

procedure TSemiModalForm.OnFormClose(Sender: TObject; var Action: TCloseAction); 
begin 
    FForm.OnClose := FOldFormOnClose; 

    try 
    FForm.Visible := FALSE; 

    FSemiModalResultHandler.SemiModalFormClosed(FForm); 
    finally 
    FForm.Parent := nil; 
    FForm := nil; 

    FTransparentPanel.Visible := FALSE; 
    end; 
end; 

procedure TSemiModalForm.Notification(AComponent: TComponent; 
    Operation: TOperation); 
begin 
    inherited Notification(AComponent, Operation); 

    if (Operation = opRemove) then 
    begin 
    if AComponent = FFormParent then 
     SetFormParent(nil); 
    end; 
end; 

procedure TSemiModalForm.OnTransparentPanelResize(Sender: TObject); 
begin 
    RepositionForm; 
end; 

procedure TSemiModalForm.RepositionForm; 
begin 
    FForm.Left := (FTransparentPanel.Width div 2) - (FForm.Width div 2); 
    FForm.Top := (FTransparentPanel.Height div 2) - (FForm.Height div 2); 
end; 

end. 

क्या कोई मुझे समस्याओं के साथ मदद कर सकता है या मुझे अल्फा मिश्रण पैनल में इंगित कर सकता है जो पहले से मौजूद है?

Answer 1

धन्यवाद आपके सभी सुझाव। मैंने इनपुट लिया है और एक नया घटक बनाया है जो मुझे वही करता है जो मुझे चाहिए। यहाँ यह कैसा दिखाई देता है:

टिप्पणी है कि मुझे सही दिशा में इशारा द्वारा NGLN एक है कि मैं upvoted था। यदि आप इसे उत्तर के रूप में पोस्ट करते हैं तो मैं इसे स्वीकार करूंगा।

मैंने इस उत्तर में घटक कोड जोड़ने की कोशिश की, लेकिन StackOverflow इसे सही ढंग से प्रारूपित नहीं करेगा। हालांकि, आप स्रोत और एक पूर्ण डेमो एप्लिकेशन here डाउनलोड कर सकते हैं।

घटक निम्नलिखित कार्यक्षमता प्रदान करता है:

• अर्द्ध मोडल प्रपत्र मुख्य रूप का एक बच्चा है। इसका मतलब यह है कि को अन्य नियंत्रणों की तरह टैब किया जा सकता है।
• ओवरले क्षेत्र को कोई कलाकृतियों के साथ सही ढंग से खींचा गया है।
• ओवरले क्षेत्र के अंतर्गत नियंत्रण स्वचालित रूप से अक्षम हो जाते हैं।
• यदि आवश्यक हो तो सेमी मोडल फॉर्म/ओवरले दिखाया/छिपाया जा सकता है उदा। स्विचिंग टैब।
• एक सेमीमोडाल रिजल्ट एक घटना में वापस पारित किया जाता है।

अभी भी कई छोटे मुद्दे हैं जिन्हें मैं लोहे से बाहर करना चाहता हूं। अगर कोई जानता है कि उन्हें कैसे ठीक किया जाए, तो कृपया मुझे बताएं।

• जब मूल रूप को स्थानांतरित या आकार बदल दिया जाता है तो उसे अभिभावकफॉर्म संशोधित प्रक्रिया को कॉल करने की आवश्यकता होती है। यह घटक को ओवरले फॉर्म का आकार बदलने/पुनर्स्थापित करने की अनुमति देता है। क्या में मूल रूप से हुक करने का कोई तरीका है और इसे स्थानांतरित होने पर पता लगाया गया है?
• यदि आप मुख्य रूप को नकल करते हैं, तो इसे पुनर्स्थापित करें, ओवरले फॉर्म तत्काल प्रकट होता है, तो मुख्य रूप इसे वापस की पिछली स्थिति में एनिमेटेड किया जाता है। क्या मुख्य फ़ॉर्म एनिमेटिंग समाप्त होने का पता लगाने का कोई तरीका है?
• सेमी मोडल विंडो के गोलाकार कोनों बहुत सुंदर नहीं हैं। मैं नहीं जानता हूं कि इसके बारे में बहुत कुछ किया जा सकता है क्योंकि यह आयताकार क्षेत्र में है।

Answer 2

आपका कोड सामान्य रूप से फ़ॉर्म नहीं दिखाता है, और मुझे आश्चर्य है कि आप क्यों नहीं करेंगे। लेकिन फिर, शायद मैं अर्ध मोडल शब्द को समझ नहीं पा रहा हूं।

किसी भी मामले में, मुझे लगता है कि the idea जिस पर वास्तविक संवाद को दिखाने के लिए ठीक हो जाएगा एक आधा पारदर्शी बनाने के लिए करें:

function ShowObviousModal(AForm: TForm; AParent: TWinControl = nil): Integer; 
var 
    Layer: TForm; 
begin 
    if AParent = nil then 
    AParent := Application.MainForm; 
    Layer := TForm.Create(nil); 
    try 
    Layer.AlphaBlend := True; 
    Layer.AlphaBlendValue := 128; 
    Layer.BorderStyle := bsNone; 
    Layer.Color := clWhite; 
    with AParent, ClientOrigin do 
     SetWindowPos(Layer.Handle, HWND_TOP, X, Y, ClientWidth, ClientHeight, 
     SWP_SHOWWINDOW); 
    Result := AForm.ShowModal; 
    finally 
    Layer.Free; 
    end; 
end; 

उपयोग: के लिए

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    FDialog := TForm2.Create(Self); 
    try 
    if ShowObviousModal(FDialog) = mrOk then 
     Caption := 'OK'; 
    finally 
    FDialog.Free; 
    end; 
end;