Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit SpTBXFrameUnit;
- {
- *What is it?
- This is TSpTBX support component.
- When TFrame puts on TSpTBXPanel or TSpTBXDockablePanel,
- It has a problem that frame color is black.
- This library resolved this problem.
- *How to use
- First, install SpTBXFrameDesignUnit.pas.
- File->New menu to new "TSpTBXFrame"
- or
- Uses SpTBXFrameUnit, and replace "TFrame" to "TSpTBXFrame".
- ex.
- TMyFrame = class(TSpTBXFrame)
- :
- end;
- *notice
- If you want to not use owner drawed frame, set SkinedBackground property
- to "False".
- }
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, SpTBXControls, SpTBXDkPanels, TntForms;
- type
- TSpTBXFrame = class(TTntFrame)
- protected
- FSkinedBackground: Boolean;
- procedure SetSkinedBackground(const Value: Boolean);
- procedure CreateParams(var Params: TCreateParams); override;
- procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
- property ClientHeight stored False;
- property ClientWidth stored False;
- public
- constructor Create(AOwner: TComponent); override;
- published
- property SkinedBackground: Boolean read FSkinedBackground
- write SetSkinedBackground default True;
- end;
- implementation
- { TSpTBXFrame }
- constructor TSpTBXFrame.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- SkinedBackground := True;
- end;
- procedure TSpTBXFrame.CreateParams(var Params: TCreateParams);
- begin
- inherited CreateParams(Params);
- with Params.WindowClass do
- style := style or CS_HREDRAW or CS_VREDRAW;
- end;
- procedure TSpTBXFrame.SetSkinedBackground(const Value: Boolean);
- begin
- if Value then begin
- ParentBackGround := False;
- ParentColor := False;
- end
- else begin
- ParentBackGround := True;
- ParentColor := True;
- end;
- FSkinedBackground := Value;
- end;
- procedure TSpTBXFrame.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
- var
- ACanvas: TCanvas;
- DrawingRect: TRect;
- begin
- if not FSkinedBackground then begin
- inherited;
- Exit;
- end;
- Msg.Result := 1;
- if (not DoubleBuffered or (TMessage(Msg).wParam = TMessage(Msg).lParam)) then begin
- ACanvas := TCanvas.Create;
- try
- ACanvas.Handle := Msg.DC;
- DrawingRect := ClientRect;
- InflateRect(DrawingRect, 2, 2);
- SpDrawXPDockablePanelBody(ACanvas, DrawingRect, True, False);
- finally
- ACanvas.Handle := 0;
- ACanvas.Free;
- end;
- end;
- end;
- end.
Add Comment
Please, Sign In to add comment