paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 07:39:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpgui: patch #18542

Browse Source 
git-svn-id: trunk@29075 -
This commit is contained in:
mattias 2011-01-17 20:17:19 +00:00
parent b713da16bb
commit 0d38a13c22
9 changed files with 612 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
lcl/interfaces/fpgui/fpguiint.pp
View File

@ -67,10 +67,28 @@ type
constructor Create; override;
destructor Destroy; override;
//Graphic procedures
function DrawFrameControl(DC: HDC; const Rect: TRect; uType, uState: Cardinal
): Boolean; override;
function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
procedure DCRedraw(CanvasHandle: HDC); override;
procedure SetDesigning(AComponent: TComponent); override;
procedure SetDesigning(AComponent: TComponent); override;
//Raw image support
function RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap,
AMask: HBitmap; ASkipMask: Boolean=False): Boolean; override;
function RawImage_DescriptionFromDevice(ADC: HDC; out ADesc: TRawImageDescription
): Boolean; override;
//Critical sections... Are really needed ?
{*
procedure InitializeCriticalSection(var CritSection: TCriticalSection); override;
procedure DeleteCriticalSection(var CritSection: TCriticalSection); override;
procedure EnterCriticalSection(var CritSection: TCriticalSection); override;
procedure LeaveCriticalSection(var CritSection: TCriticalSection); override;
*}
// create and destroy
function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle; override;

116
lcl/interfaces/fpgui/fpguiobject.inc
View File

@ -84,6 +84,59 @@ begin
inherited Destroy;
end;
function TFpGuiWidgetSet.DrawFrameControl(DC: HDC; const Rect: TRect; uType,
uState: Cardinal): Boolean;
var
ADC: TFPGUIDeviceContext absolute DC;
ControlType: Cardinal;
ControlStyle: Cardinal;
fpgRect: TfpgRect;
Style: TFButtonFlags;
(*
DFC_CAPTION = $01;
DFC_MENU = $02;
DFC_SCROLL = $03;
DFC_BUTTON = $04;
DFCS_BUTTONCHECK = 0;
DFCS_BUTTONRADIOIMAGE = 1;
DFCS_BUTTONRADIOMASK = 2;
DFCS_BUTTONRADIO = 4;
DFCS_BUTTON3STATE = 8;
DFCS_BUTTONPUSH = 16;
*)
const
DFCS_ALLSTATES=DFCS_BUTTONCHECK or DFCS_BUTTONRADIOIMAGE or DFCS_BUTTONRADIOMASK
or DFCS_BUTTONRADIO or DFCS_BUTTON3STATE or DFCS_BUTTONPUSH;
begin
Result:=false;
if Assigned(ADC.fpgCanvas) then begin
ControlType:=uType;
ControlStyle:=uState and DFCS_ALLSTATES;
TRectTofpgRect(Rect,fpgRect);
AdjustRectToOrg(fpgRect,ADC.FOrg);
Case ControlType of
DFC_BUTTON:
begin
if (ControlStyle and DFCS_BUTTONPUSH)=DFCS_BUTTONPUSH then begin
Style:=[];
if (uState and DFCS_INACTIVE) <> 0 then
Style:=Style+[btfIsEmbedded] //Disabled ?
else
if (uState and DFCS_PUSHED) <> 0 then
Style:=Style+[btfIsPressed]
else
if (uState and DFCS_HOT) <> 0 then
Style:=Style+[btfHover];
ADC.fpgCanvas.DrawButtonFace(fpgRect,Style);
Result:=true;
end;
end;
else
Result:=false;
end;
end;
end;
{------------------------------------------------------------------------------
Method: TFpGuiWidgetSet.CreateTimer
Params: None
@ -245,6 +298,69 @@ begin
// Include(AComponent.ComponentState, csDesigning);
end;
function TFpGuiWidgetSet.RawImage_CreateBitmaps(const ARawImage: TRawImage; out
ABitmap, AMask: HBitmap; ASkipMask: Boolean): Boolean;
var
OutBitmap: TFPGUIWinAPIBitmap;
fpgBitmap: TfpgImage;
ImgData: Pointer absolute ARawImage.Data;
ImgMask: Pointer absolute ARawImage.Mask;
ImgWidth: Cardinal absolute ARawImage.Description.Width;
ImgHeight: Cardinal absolute ARawImage.Description.Height;
ImgDepth: Byte absolute ARawImage.Description.Depth;
ImgDataSize: PtrUInt absolute ARawImage.DataSize;
function min(const a,b: SizeInt): SizeInt;
begin
if a>b then Result:=b else Result:=a;
end;
begin
ABitmap:=0;
AMask:=0;
Result:=false;
OutBitmap:=TFPGUIWinAPIBitmap.Create(ARawImage.Description.BitsPerPixel,ARawImage.Description.Width,ARawImage.Description.Height);
fpgBitmap:=OutBitmap.Image;
ABitmap:=HBITMAP(OutBitmap);
move(ARawImage.Data^,pbyte(fpgBitmap.ImageData)^,min(ARawImage.DataSize,fpgBitmap.ImageDataSize));
fpgBitmap.UpdateImage;
Result:=true;
end;
function TFpGuiWidgetSet.RawImage_DescriptionFromDevice(ADC: HDC; out
ADesc: TRawImageDescription): Boolean;
var
DC: TFPGUIDeviceContext;
r: TfpgRect;
begin
DC:=TFPGUIDeviceContext(ADC);
ADesc.Init;
with ADesc do begin
Format:= ricfRGBA;
if Assigned(DC) and Assigned(DC.fpgCanvas) then begin
dc.fpgCanvas.GetWinRect(r);
Width:= r.Width;
Height:= r.Height;
end else begin
Width:= 0;
Height:= 0;
end;
Depth:= 24; // used bits per pixel
BitOrder:= riboBitsInOrder;
ByteOrder:= riboMSBFirst;
LineOrder:= riloTopToBottom;
LineEnd:= rileByteBoundary;
BitsPerPixel:=32; // bits per pixel. can be greater than Depth.
RedPrec:= 8; // red or gray precision. bits for red
RedShift:= 8; // bitshift. Direction: from least to most significant
GreenPrec:= 8;
GreenShift:= 16;
BluePrec:= 8;
BlueShift:= 24;
AlphaPrec:= 0;
AlphaShift:= 0;
end;
Result:=true;
end;
{------------------------------------------------------------------------------
Function: TFpGuiWidgetSet.IsValidDC
Params: DC - handle to a device context (TFpGuiDeviceContext)

301
lcl/interfaces/fpgui/fpguiobjects.pas
View File

@ -72,7 +72,7 @@ type
TFPGUIWinAPIPen = class (TFPGUIWinAPIObject)
private
FPen: TPen;
FPen: tagTFPGUIPen;
function GetColor: TfpgColor;
procedure SetColor(const AValue: TfpgColor);
public
@ -86,26 +86,50 @@ type
TFPGUIWinAPIFont = class (TFPGUIWinAPIObject)
private
FFont: TFont;
fpgFont: TfpgFont;
fpgFont: TfpgFontBase;
FFontHeight: integer;
function GetFontHeight: integer;
function GetFontSize: integer;
procedure SetFontHeight(const AValue: integer);
procedure SetFontSize(const AValue: integer);
public
FontFace: String;
Constructor Create;
Constructor Create(const AFontData: TFontData);
Constructor Create(const AfpgCanvas: TfpgCanvas);
Constructor Create(const AFontData: TLogFont);
Constructor Create(const AFontData: TLogFont; const ALongFontName: string);
Destructor Destroy; override;
property fpguiFont: TfpgFont read fpgFont;
property fpguiFont: TfpgFontBase read fpgFont write fpgFont;
property Size: integer read GetFontSize write SetFontSize;
property Height: integer read GetFontHeight write SetFontHeight;
end;
{ TFPGUIWinAPIBitmap }
TFPGUIWinAPIBitmap = class(TFPGUIWinAPIObject)
private
fpgImage: TfpgImage;
protected
SelectedInDC: HDC;
public
Constructor Create(const ABitsPerPixel,Width,Height: integer);
Destructor Destroy; override;
property Image: TfpgImage read fpgImage;
end;
TFPGUIBasicRegion = class;
{ TFpGuiDeviceContext }
TFPGUIDeviceContext = class(TFPGUIWinAPIElement)
private
FDCStack: array of TFPGUIDeviceContext;
procedure CopyDCToInstance(const ATarget: TFPGUIDeviceContext);
procedure FreeSelfObjects;
procedure SetupFont;
procedure SetupBrush;
procedure SetupPen;
procedure SetupBitmap;
procedure SetupClipping;
public
fpgCanvas: TfpgCanvas;
FPrivateWidget: TFPGUIPrivateWidget;
@ -114,16 +138,20 @@ type
FPen: TFPGUIWinAPIPen;
FFont: TFPGUIWinAPIFont;
FTextColor: TfpgColor;
FBitmap: TFPGUIWinAPIBitmap;
FClipping: TFPGUIBasicRegion;
public
constructor Create(AFPGUIPrivate: TFPGUIPrivateWidget);
destructor Destroy; override;
procedure SetOrigin(const AX,AY: integer);
function SaveDC: Boolean;
function SaveDC: integer;
function RestoreDC(const Index: SizeInt): Boolean;
function SelectObject(const AGDIOBJ: HGDIOBJ): HGDIOBJ;
function SetTextColor(const AColor: TColorRef): TColorRef;
function PrepareRectOffsets(const ARect: TRect): TfpgRect;
procedure ClearRectangle(const AfpgRect: TfpgRect);
procedure ClearDC;
procedure SetupPen;
end;
{ TFPGUIPrivateMenuItem }
@ -142,6 +170,7 @@ type
TFPGUIBasicRegion=class(TFPGUIWinAPIObject)
private
FRegionType: TFPGUIRegionType;
function GetfpgRectRegion: TfpgRect;
function GetRegionType: TFPGUIRegionType;
protected
FRectRegion: TRect;
@ -152,11 +181,45 @@ type
procedure CreateRectRegion(const ARect: TRect);
function CombineWithRegion(const ARegion: TFPGUIBasicRegion; const ACombineMode: TFPGUIRegionCombine): TFPGUIBasicRegion;
property RegionType: TFPGUIRegionType read GetRegionType;
property fpgRectRegion: TfpgRect read GetfpgRectRegion;
end;
function FPGUIGetDesktopDC(): TFPGUIDeviceContext;
implementation
var
FPGUIDesktopDC: TFPGUIDeviceContext=nil;
function FPGUIGetDesktopDC(): TFPGUIDeviceContext;
begin
if not Assigned(FPGUIDesktopDC) then
FPGUIDesktopDC:=TFPGUIDeviceContext.Create(nil);
Result:=FPGUIDesktopDC;
end;
{ TFPGUIWinAPIBitmap }
constructor TFPGUIWinAPIBitmap.Create(const ABitsPerPixel, Width,
Height: integer);
begin
fpgImage:=TfpgImage.Create;
fpgImage.AllocateImage(ABitsPerPixel,Width,Height);
fpgImage.UpdateImage;
end;
destructor TFPGUIWinAPIBitmap.Destroy;
var
Context: TFPGUIDeviceContext;
begin
Context:=TFPGUIDeviceContext(SelectedInDC);
if Assigned(Context) then begin
Context.FBitmap:=nil;
end;
fpgImage.Free;
inherited Destroy;
end;
{ TFpGuiDeviceContext }
procedure TFPGUIDeviceContext.CopyDCToInstance(
@ -165,55 +228,84 @@ begin
ATarget.fpgCanvas:=fpgCanvas;
ATarget.FPrivateWidget:=FPrivateWidget;
ATarget.FBrush:=FBrush;
ATarget.FPen.FPen.Assign(FPen.FPen);
ATarget.FFont.FFont.Assign(FFont.FFont);
ATarget.FPen:=FPen;
ATarget.FFont:=FFont;
ATarget.FOrg:=FOrg;
ATarget.FTextColor:=FTextColor;
end;
procedure TFPGUIDeviceContext.FreeSelfObjects;
begin
FreeAndNIL(FBrush);
FreeAndNIL(FPen);
FreeAndNIL(FFont);
ATarget.FClipping:=FClipping;
end;
procedure TFPGUIDeviceContext.SetupFont;
begin
fpgCanvas.Font:=FFont.fpguiFont;
if Assigned(fpgCanvas) then
if Assigned(FFont) then
fpgCanvas.Font:=FFont.fpguiFont;
end;
procedure TFPGUIDeviceContext.SetupBrush;
begin
if Assigned(fpgCanvas) then
if Assigned(FBrush) then
fpgCanvas.Color:=FBrush.Color;
end;
procedure TFPGUIDeviceContext.SetupPen;
begin
fpgCanvas.Color:=FPen.Color;
if Assigned(fpgCanvas) then
if Assigned(FPen) then
fpgCanvas.Color:=FPen.Color;
end;
procedure TFPGUIDeviceContext.SetupBitmap;
begin
if Assigned(fpgCanvas) then
fpgCanvas.DrawImage(0,0,FBitmap.fpgImage);
end;
procedure TFPGUIDeviceContext.SetupClipping;
var
r: TfpgRect;
begin
if Assigned(fpgCanvas) then
if Assigned(FClipping) then begin
r:=FClipping.fpgRectRegion;
AdjustRectToOrg(r,FOrg);
fpgCanvas.SetClipRect(r);
end else begin
fpgCanvas.ClearClipRect;
end;
end;
constructor TFpGuiDeviceContext.Create(AFPGUIPrivate: TFPGUIPrivateWidget);
begin
if Assigned(AFPGUIPrivate) then begin
fpgCanvas := AFPGUIPrivate.Widget.Canvas;
fpgCanvas.BeginDraw(false);
AFPGUIPrivate.DC:=HDC(Self);
FPrivateWidget := AFPGUIPrivate;
with FOrg do begin
X:=0;
Y:=0;
end;
FBrush:=TFPGUIWinAPIBrush.Create;
FPen:=TFPGUIWinAPIPen.Create;
FFont:=TFPGUIWinAPIFont.Create;
FBrush.Color:=TColorToTfpgColor(clBtnFace);
FPen.FPen.Color:=clWindowText;
end else begin
fpgCanvas := nil;
FPrivateWidget := nil;
end;
with FOrg do begin
X:=0;
Y:=0;
end;
FBrush:=nil;
FPen:=nil;
FFont:=nil;
end;
destructor TFpGuiDeviceContext.Destroy;
var
j: integer;
begin
FreeSelfObjects;
if Assigned(fpgCanvas) then fpgCanvas.EndDraw;
for j := 0 to High(FDCStack) do begin
FDCStack[j].Free;
end;
if Assigned(FPrivateWidget) then
FPrivateWidget.DC:=0;
end;
procedure TFpGuiDeviceContext.SetOrigin(const AX, AY: integer);
@ -224,16 +316,15 @@ begin
end;
end;
function TFPGUIDeviceContext.SaveDC: Boolean;
function TFPGUIDeviceContext.SaveDC: Integer;
var
Tmp: TFPGUIDeviceContext;
begin
Beep;
SetLength(FDCStack,Length(FDCStack)+1);
Tmp:=TFPGUIDeviceContext.Create(FPrivateWidget);
FDCStack[High(FDCStack)]:=Tmp;
Self.CopyDCToInstance(Tmp);
Result:=true;
Result:=High(FDCStack);
end;
function TFPGUIDeviceContext.RestoreDC(const Index: SizeInt): Boolean;
@ -242,7 +333,6 @@ var
TargetIndex: SizeInt;
j: SizeInt;
begin
Beep;
Result:=false;
if Index>=0 then begin
TargetIndex:=Index;
@ -252,15 +342,16 @@ begin
If TargetIndex<0 then Exit;
end;
Tmp:=FDCStack[TargetIndex];
FreeSelfObjects;
Tmp.CopyDCToInstance(Self);
FPrivateWidget.DC:=HDC(Self);
SetupFont;
SetupBrush;
SetupPen;
SetupClipping;
for j := TargetIndex to High(FDCStack) do begin
FDCStack[j].Free;
end;
SetLength(FDCStack,TargetIndex);
SetupFont;
SetupBrush;
SetupPen;
Result:=true;
end;
@ -270,18 +361,57 @@ var
begin
Result:=0;
gObject:=TObject(AGDIOBJ);
if AGDIOBJ<5 then begin
case AGDIOBJ of
1: begin
Result:=HGDIOBJ(FFont);
FFont:=nil;
end;
2: begin
Result:=HGDIOBJ(FBrush);
FBrush:=nil;
end;
3: begin
Result:=HGDIOBJ(FPen);
FPen:=nil;
end;
4: begin
Result:=HGDIOBJ(FBitmap);
FBitmap:=nil;
end;
5: begin
Result:=HGDIOBJ(FClipping);
FClipping:=nil;
end;
end;
Exit;
end;
if gObject is TFPGUIWinAPIFont then begin
Result:=HGDIOBJ(FFont);
FFont:=TFPGUIWinAPIFont(gObject);
SetupFont;
if Result=0 then Result:=1;
end else if gObject is TFPGUIWinAPIBrush then begin
Result:=HGDIOBJ(FBrush);
FBrush:=TFPGUIWinAPIBrush(gObject);
SetupBrush;
if Result=0 then Result:=2;
end else if gObject is TFPGUIWinAPIPen then begin
Result:=HGDIOBJ(FPen);
FPen:=TFPGUIWinAPIPen(gObject);
SetupPen;
if Result=0 then Result:=3;
end else if gObject is TFPGUIWinAPIBitmap then begin
Result:=HGDIOBJ(FBitmap);
FBitmap:=TFPGUIWinAPIBitmap(gObject);
FBitmap.SelectedInDC:=HDC(Self);
SetupBitmap;
if Result=0 then Result:=4;
end else if gObject is TFPGUIBasicRegion then begin
Result:=HGDIOBJ(FClipping);
FClipping:=TFPGUIBasicRegion(gObject);
SetupClipping;
if Result=0 then Result:=5;
end;
end;
@ -304,11 +434,17 @@ var
OldColor: TfpgColor;
begin
OldColor:=fpgCanvas.Color;
fpgCanvas.Color:=FBrush.Color;
fpgCanvas.Color:= FPrivateWidget.Widget.BackgroundColor;
fpgCanvas.FillRectangle(AfpgRect);
if fpgCanvas.Color=0 then writeln(FPrivateWidget.LCLObject.Name);
fpgCanvas.Color:=OldColor;
end;
procedure TFPGUIDeviceContext.ClearDC;
begin
ClearRectangle(fpgCanvas.GetClipRect);
end;
{ TFPGUIPrivateMenuItem }
procedure TFPGUIPrivateMenuItem.HandleOnClick(ASender: TObject);
@ -319,32 +455,70 @@ end;
{ TFPGUIWinAPIFont }
function TFPGUIWinAPIFont.GetFontHeight: integer;
begin
Result:=FFontHeight;
end;
function TFPGUIWinAPIFont.GetFontSize: integer;
begin
Result:=(-FFontHeight * 72) div 96;
end;
procedure TFPGUIWinAPIFont.SetFontHeight(const AValue: integer);
begin
FFontHeight:=AValue;
end;
procedure TFPGUIWinAPIFont.SetFontSize(const AValue: integer);
begin
FFontHeight:=(-96 * AValue) div 72;
end;
constructor TFPGUIWinAPIFont.Create;
begin
FFont:=TFont.Create;
FontFace:='';
Size:=8;
end;
constructor TFPGUIWinAPIFont.Create(const AFontData: TFontData);
begin
FontFace:=AFontData.Name;
Height:=AFontData.Height;
fpgFont:=fpgGetFont(format('%s-%d',[AFontData.Name,Size]));
end;
constructor TFPGUIWinAPIFont.Create(const AfpgCanvas: TfpgCanvas);
begin
fpgFont:=AfpgCanvas.Font;
end;
constructor TFPGUIWinAPIFont.Create(const AFontData: TLogFont);
begin
Create;
FFont.Name:=AFontData.lfFaceName;
FFont.Height:=AFontData.lfHeight;
fpgFont:=fpgGetFont(format('%s-%d',[FFont.Name,FFont.Size]));
FontFace:=AFontData.lfFaceName;
Height:=AFontData.lfHeight;
if FontFace='' then begin
fpgFont:=fpgGetFont(''); //Default
end else begin
fpgFont:=fpgGetFont(format('%s-%d',[FontFace,Size]));
end;
end;
constructor TFPGUIWinAPIFont.Create(const AFontData: TLogFont;
const ALongFontName: string);
begin
Create;
FFont.Name:=ALongFontName;
FFont.Height:=AFontData.lfHeight;
fpgFont:=fpgGetFont(format('%s-%d',[FFont.Name,FFont.Size]));
FontFace:=ALongFontName;
Height:=AFontData.lfHeight;
if FontFace='' then begin
fpgFont:=fpgGetFont(''); //Default
end else begin
fpgFont:=fpgGetFont(format('%s-%d',[FontFace,Size]));
end;
end;
destructor TFPGUIWinAPIFont.Destroy;
begin
fpgFont.Free;
FFont.Free;
FreeAndNIL(fpgFont);
inherited Destroy;
end;
@ -362,7 +536,6 @@ end;
constructor TFPGUIWinAPIPen.Create;
begin
FPen:=TPen.Create;
end;
constructor TFPGUIWinAPIPen.Create(const APenData: TLogPen);
@ -373,7 +546,7 @@ end;
destructor TFPGUIWinAPIPen.Destroy;
begin
FPen.Free;
FreeAndNil(FPen);
inherited Destroy;
end;
@ -381,7 +554,10 @@ end;
function TFPGUIWinAPIBrush.GetColor: TfpgColor;
begin
Result:=FBrush.Color;
if Assigned(Self) then
Result:=FBrush.Color
else
Result:=0;
end;
procedure TFPGUIWinAPIBrush.SetColor(const AValue: TfpgColor);
@ -396,7 +572,6 @@ end;
constructor TFPGUIWinAPIBrush.Create(const ABrushData: TLogBrush);
begin
Create;
FBrush.Color:=TColorToTfpgColor(ABrushData.lbColor);
end;
@ -412,6 +587,11 @@ begin
Result:=FRegionType;
end;
function TFPGUIBasicRegion.GetfpgRectRegion: TfpgRect;
begin
TRectTofpgRect(FRectRegion,Result);
end;
constructor TFPGUIBasicRegion.Create;
var
ARect: TRect;
@ -481,13 +661,20 @@ begin
Case ACombineMode of
eRegionCombineAnd: CombineAnd(Result,ARegion.FRectRegion,Self.FRectRegion);
eRegionCombineCopy,
eRegionCombineDiff,
eRegionCombineDiff:
begin
Result.CreateRectRegion(rect(0,0,0,0));
end;
eRegionCombineOr,
eRegionCombineXor: begin
Raise Exception.CreateFmt('Region mode %d not supported',[integer(ACombineMode)]);
end;
eRegionCombineXor:
begin
Raise Exception.CreateFmt('Region mode %d not supported',[integer(ACombineMode)]);
end;
end;
end;
finalization
FreeAndNil(FPGUIDesktopDC);
end.

2
lcl/interfaces/fpgui/fpguiproc.pas
View File

@ -159,7 +159,7 @@ begin
COLOR_clActiveForeground..COLOR_clActiveHighlightedText
: Result:=GetColor(QPaletteActive, nIndex - COLOR_clActiveForeground);}
else
Result:=0;
Result:=clRed;
end;
end;

164
lcl/interfaces/fpgui/fpguiwinapi.inc
View File

@ -110,12 +110,34 @@ begin
end;
end;
function TFpGuiWidgetSet.CreateBitmap(Width, Height: Integer; Planes,
BitCount: Longint; BitmapBits: Pointer): HBITMAP;
var
img: TFPGUIWinAPIBitmap;
begin
if BitCount>0 then begin
img:=TFPGUIWinAPIBitmap.Create(BitCount,Width,Height);
Result:=HBITMAP(img);
end else begin
Result:=0;
end;
end;
function TFpGuiWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush
): HBRUSH;
begin
Result:=HBRUSH(TFPGUIWinAPIBrush.Create(LogBrush));
end;
function TFpGuiWidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer
): HBITMAP;
var
img: TFPGUIWinAPIBitmap;
begin
img:=TFPGUIWinAPIBitmap.Create(32,Width,Height);
Result:=HBITMAP(img);
end;
function TFpGuiWidgetSet.CreateCompatibleDC(DC: HDC): HDC;
var
ADC: TFpGuiDeviceContext absolute DC;
@ -132,12 +154,11 @@ begin
end;
{$endif}
if DC=0 then begin
//Create DC desktop compatible
Result:=HDC(TFpGuiDeviceContext.Create(nil));
//Create DC desktop compatible, or retrieve the destop one to avoid memory leask.
Result:=HDC(FPGUIGetDesktopDC());
end else begin
//Create DC widget compatible
Result:=HDC(TFpGuiDeviceContext.Create(ADC.FPrivateWidget));
{ TODO : Copy context data from PrivateWidget DC to the newly one }
end;
end;
@ -178,6 +199,7 @@ end;
function TFpGuiWidgetSet.DrawFocusRect(DC: HDC; const Rect: TRect): boolean;
var
ADC: TFpGuiDeviceContext absolute DC;
r: TfpgRect;
begin
ADC.fpgCanvas.DrawFocusRect(ADC.PrepareRectOffsets(Rect));
Result:=true;
@ -246,6 +268,23 @@ begin
Result:=true;
end;
function TFpGuiWidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH
): Boolean;
var
ADC: TFpGuiDeviceContext absolute DC;
NewBrush: TFPGUIWinAPIBrush absolute Brush;
OldColor: TfpgColor;
TheRect: TfpgRect;
begin
OldColor:=ADC.fpgCanvas.Color;
ADC.fpgCanvas.Color:=NewBrush.Color;
TRectTofpgRect(Rect,TheRect);
AdjustRectToOrg(TheRect,ADC.FOrg);
ADC.fpgCanvas.FillRectangle(TheRect);
ADC.fpgCanvas.Color:=OldColor;
Result:=true;
end;
function TFpGuiWidgetSet.GetClientRect(handle: HWND; var ARect: TRect
): Boolean;
var
@ -297,7 +336,13 @@ var
PrivateWidget: TFPGUIPrivateWidget absolute hWnd;
begin
//Create a new DC
Result:=HDC(TFpGuiDeviceContext.Create(PrivateWidget));
if Assigned(PrivateWidget) then begin
if PrivateWidget.DC<>0 then begin
Result:=PrivateWidget.DC;
end else begin
Result:=HDC(TFpGuiDeviceContext.Create(PrivateWidget));
end;
end else Result:=HDC(FPGUIGetDesktopDC());
end;
function TFpGuiWidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
@ -311,16 +356,16 @@ begin
LOGPIXELSX: Result:=96; //Hardcoded by now
BITSPIXEL : Result:=32; //Hardcoded by now
else begin
// {$ifdef VerboseFPGUIWinAPI}
{$ifdef VerboseFPGUIWinAPI}
WriteLn(Self.ClassName,'.GetDeviceCaps Index ',Index,' Desktop');
// {$endif}
{$endif}
end;
end;
end else begin
//other
// {$ifdef VerboseFPGUIWinAPI}
{$ifdef VerboseFPGUIWinAPI}
WriteLn(Self.ClassName,'.GetDeviceCaps Index ',Index,ADC.FPrivateWidget.LCLObject.Name);
// {$endif}
{$endif}
end;
end;
@ -345,7 +390,7 @@ begin
{$ifdef VerboseFPGUIWinAPI}
WriteLn('Trace:Unknown lcl system color: [TFpGuiWidgetSet.GetSysColor]');
{$endif}
Result:=0;
Result:=clRed;
exit;
end;
Result:=GetSysColorRGB(nIndex);
@ -378,11 +423,11 @@ var
ADC: TFpGuiDeviceContext absolute DC;
begin
FillByte(TM,sizeof(TM),0);
TM.tmAscent:=ADC.fpgCanvas.Font.Ascent;
TM.tmDescent:=ADC.fpgCanvas.Font.Descent;
TM.tmAscent:=ADC.FFont.fpguiFont.Ascent;
TM.tmDescent:=ADC.FFont.fpguiFont.Descent;
//Defined usually in MSDN as the average of 'x' char.
TM.tmAveCharWidth:=ADC.fpgCanvas.Font.TextWidth('x');
TM.tmHeight:=ADC.fpgCanvas.Font.Height;
TM.tmAveCharWidth:=ADC.FFont.fpguiFont.TextWidth('x');
TM.tmHeight:=ADC.FFont.Height;
Result:=true;
end;
@ -394,10 +439,33 @@ begin
Result:=1;
end;
function TFpGuiWidgetSet.GetWindowRect(Handle: hwnd; var ARect: TRect
): Integer;
var
PrivateWidget: TFPGUIPrivateBin absolute Handle;
begin
ARect:=fpgRectToRect(PrivateWidget.Widget.GetBoundsRect);
Result:=1;
end;
function TFpGuiWidgetSet.GetWindowSize(Handle: hwnd; var Width, Height: Integer
): boolean;
var
PrivateWidget: TFPGUIPrivateBin absolute Handle;
begin
Width:=PrivateWidget.Widget.Width;
Height:=PrivateWidget.Widget.Height;
Result:=true;
end;
function TFpGuiWidgetSet.InvalidateRect(aHandle: HWND; Rect: pRect;
bErase: Boolean): Boolean;
var
PrivateWidget: TFPGUIPrivateWidget absolute aHandle;
begin
{ TODO -cOS : Add proper InvalidateRect }
PrivateWidget.Widget.Canvas.BeginDraw(false);
PrivateWidget.Paint;
PrivateWidget.Widget.Canvas.EndDraw;
Result:=true;
end;
@ -406,8 +474,8 @@ var
ADC: TFpGuiDeviceContext absolute DC;
r: TfpgRect;
begin
r:=ADC.PrepareRectOffsets(classes.Rect(X1,Y1,X2-X1,Y2-Y1));
ADC.fpgCanvas.BeginDraw(false);
r:=ADC.PrepareRectOffsets(Rect(X1,Y1,X2,Y2));
ADC.fpgCanvas.BeginDraw(true);
ADC.ClearRectangle(r);
ADC.fpgCanvas.DrawRectangle(r);
ADC.fpgCanvas.EndDraw;
@ -418,10 +486,39 @@ function TFpGuiWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer;
var
MyDC: TFpGuiDeviceContext absolute DC;
begin
MyDC.Free;
if MyDC<>FPGUIGetDesktopDC then begin //DesktopDC can not be freed
MyDC.Free;
end;
Result:=1;
end;
function TFpGuiWidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean;
var
ADC: TFPGUIDeviceContext absolute DC;
begin
Result:=ADC.RestoreDC(SavedDC);
end;
function TFpGuiWidgetSet.SaveDC(DC: HDC): Integer;
var
ADC: TFPGUIDeviceContext absolute DC;
begin
Result:=ADC.SaveDC;
end;
function TFpGuiWidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint;
var
ADC: TFPGUIDeviceContext absolute DC;
Reg: TFPGUIBasicRegion absolute RGN;
begin
if Reg.RegionType=eRegionSimple then begin
ADC.SelectObject(HGDIObj(Reg));
Result:=SimpleRegion;
end else begin
Result:=NullRegion;
end;
end;
function TFpGuiWidgetSet.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ;
var
MyDC: TFpGuiDeviceContext absolute DC;
@ -470,6 +567,39 @@ begin
Widget.Visible:=true;{ TODO -oJose Mejuto : Process showwindow mode }
end;
function TFpGuiWidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal
): Boolean;
var
SDC: TFPGUIDeviceContext absolute SrcDC;
TDC: TFPGUIDeviceContext absolute DestDC;
begin
Result:=false;
end;
function TFpGuiWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width,
Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
var
SDC: TFPGUIDeviceContext;
TDC: TFPGUIDeviceContext;
R: TRect;
ClientRect: TfpgRect;
P: TPoint;
begin
SDC:=TFPGUIDeviceContext(SrcDC);
TDC:=TFPGUIDeviceContext(DestDC);
r.Left:=X; r.Right:=Width; R.Top:=Y; r.Bottom:=Height;
AdjustRectToOrg(r,TDC.FOrg);
ClientRect:=TDC.FPrivateWidget.Widget.GetClientRect;
P.x:=-ClientRect.Left;
P.y:=-ClientRect.Top;
AdjustRectToOrg(r,P);
TDC.ClearDC;
TDC.fpgCanvas.DrawImage(r.Left,r.Top,SDC.FBitmap.Image);
Result:=true;
end;
function TFpGuiWidgetSet.WindowFromPoint(Point: TPoint): HWND;
begin
{ TODO : Temporal hack while not real WindowFromPoint implementation }

30
lcl/interfaces/fpgui/fpguiwinapih.inc
View File

@ -49,10 +49,11 @@ function ClipboardGetOwnerShip(ClipboardType: TClipboardType;
function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; override;
}
function CombineRgn(Dest, Src1, Src2: HRGN; fnCombineMode: Longint): Longint; override;
{function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; override;}
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; override;
function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; override;
{function CreateCaret(Handle : HWND; Bitmap : hBitmap; Width, Height : Integer) : Boolean; override;
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; override;}
{function CreateCaret(Handle : HWND; Bitmap : hBitmap; Width, Height : Integer) : Boolean; override;}
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; override;
function CreateCompatibleDC(DC: HDC): HDC; override;
{function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; override;}
function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
@ -60,6 +61,7 @@ function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: strin
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
{function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;}
function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override;
{function DCClipRegionValid(DC: HDC): boolean; override;}
{
procedure DeleteCriticalSection(var CritSection: TCriticalSection); override;
function DeleteDC(hDC: HDC): Boolean; override;}
@ -81,8 +83,8 @@ function ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer;
function ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer; override;}
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
{function FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean; override;
function FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool; override;
function FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean; override;
{function FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool; override;
function Frame(DC: HDC; const ARect: TRect): Integer; override;
function Frame3d(DC: HDC; var ARect: TRect; const FrameWidth : integer; const Style : TBevelCut): Boolean; override;
function FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH): Integer; override;
@ -120,10 +122,10 @@ function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize
function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; override;
{function GetWindowLong(Handle : hwnd; int: Integer): PtrInt; override;}
function GetWindowOrgEx(dc : hdc; P : PPoint): Integer; override;
{function GetWindowRect(Handle: hwnd; var ARect: TRect): Integer; override;
function GetWindowRelativePosition(Handle: hwnd; var Left, Top: Integer): boolean; override;
function GetWindowRect(Handle: hwnd; var ARect: TRect): Integer; override;
{function GetWindowRelativePosition(Handle: hwnd; var Left, Top: Integer): boolean; override;}
function GetWindowSize(Handle: hwnd; var Width, Height: Integer): boolean; override;
function GradientFill(DC: HDC; Vertices: PTriVertex; NumVertices : Longint;
{function GradientFill(DC: HDC; Vertices: PTriVertex; NumVertices : Longint;
Meshes: Pointer; NumMeshes : Longint; Mode : Longint): Boolean; override;
function HideCaret(hWnd: HWND): Boolean; override;
@ -150,12 +152,12 @@ function Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; override;
{function RectVisible(dc : hdc; const ARect: TRect) : Boolean; override;
function ReleaseCapture : Boolean; override;}
function ReleaseDC(hWnd: HWND; DC: HDC): Integer; override;
{function RestoreDC(DC: HDC; SavedDC: Integer): Boolean; override;
function RoundRect(DC : hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer): Boolean; override;
function RestoreDC(DC: HDC; SavedDC: Integer): Boolean; override;
{function RoundRect(DC : hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer): Boolean; override;}
function SaveDC(DC: HDC): Integer; override;
function ScreenToClient(Handle : HWND; var P : TPoint) : Integer; override;
function SelectClipRGN(DC : hDC; RGN : HRGN) : Longint; override;}
{function ScreenToClient(Handle : HWND; var P : TPoint) : Integer; override;}
function SelectClipRGN(DC : hDC; RGN : HRGN) : Longint; override;
function SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; override;
{function SendMessage(HandleWnd: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; override;
function SetActiveWindow(Handle: HWND): HWND; override;
@ -178,12 +180,12 @@ function SetWindowOrgEx(DC : HDC; NewX, NewY : Integer; OldPoint: PPoint) : Bool
function ShowScrollBar(Handle: HWND; wBar: Integer; bShow: Boolean): Boolean; override;
}
function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
{function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;
function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP;
XMask, YMask: Integer; Rop: DWORD): Boolean; override;
function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
{function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
function UpdateWindow(Handle: HWND): Boolean; override;}

11
lcl/interfaces/fpgui/fpguiwscontrols.pp
View File

@ -30,7 +30,7 @@ uses
// FCL
Classes, sysutils,
// Bindings
fpguiwsprivate,
fpguiwsprivate, fpguiobjects,
// LCL
Controls, LCLType, Graphics,
// Widgetset
@ -72,6 +72,7 @@ type
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override;
class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); override;
@ -188,6 +189,14 @@ begin
PreferredWidth:=0;
end;
class procedure TFpGuiWSWinControl.PaintTo(const AWinControl: TWinControl;
ADC: HDC; X, Y: Integer);
//var
// AADC: TFPGUIDeviceContext absolute ADC;
begin
// TFPGUIPrivateWidget(AWinControl.Handle).PaintTo(AADC.fpgCanvas,X,Y);
end;
{------------------------------------------------------------------------------
Method: TFpGuiWSWinControl.SetBounds
Params: AWinControl - the calling object

2
lcl/interfaces/fpgui/fpguiwsfactory.pas
View File

@ -133,7 +133,7 @@ end;
function RegisterGraphicControl: Boolean; alias : 'WSRegisterGraphicControl';
begin
Result := false;
Result := False;
end;
function RegisterCustomControl: Boolean; alias : 'WSRegisterCustomControl';

67
lcl/interfaces/fpgui/fpguiwsprivate.pp
View File

@ -89,6 +89,7 @@ type
procedure ClickHandler(Sender: TObject);
procedure EnterHandler(Sender: TObject);
procedure ExitHandler(Sender: TObject);
procedure ResizeHandler(Sender: TObject);
procedure MsgDeactivate(var fpgmsg: TfpgMessageRec); message FPGM_DEACTIVATE;
procedure MsgPaint(var fpgmsg: TfpgMessageRec); message FPGM_PAINT;
procedure MsgResize(var fpgmsg: TfpgMessageRec); message FPGM_RESIZE;
@ -128,6 +129,8 @@ type
procedure SetSize(AWidth, AHeight: LongInt);
procedure SetPosition(AX, AY: Integer);
procedure SetFocus;
procedure Paint; virtual;
procedure Clear; virtual;
public
{ Properties }
property LCLObject: TWinControl read FLCLObject;
@ -193,6 +196,7 @@ type
MenuBar: TfpgMenuBar;
{ Other methods }
function Form: TfpgForm;
procedure PaintHandler(Sender: TObject);
procedure SetFormBorderStyle(const AFormBorderStyle: TFormBorderStyle);
end;
@ -529,6 +533,11 @@ begin
end;
end;
procedure TFPGUIPrivateWidget.ResizeHandler(Sender: TObject);
begin
LCLSendSizeMsg(FLCLObject,Widget.Width,Widget.Height,SIZENORMAL,true);
end;
procedure TFPGUIPrivateWidget.MsgDeactivate(var fpgmsg: TfpgMessageRec);
begin
//Empty stub. To be implemented.
@ -579,7 +588,7 @@ end;
procedure TFPGUIPrivateWidget.MsgMove(var fpgmsg: TfpgMessageRec);
begin
LCLSendMoveMsg(LCLObject, fpgmsg.Params.rect.Left, fpgmsg.Params.rect.Top,Move_Default,false);
LCLSendMoveMsg(LCLObject, fpgmsg.Params.rect.Left, fpgmsg.Params.rect.Top,Move_Default,true);
end;
procedure TFPGUIPrivateWidget.MsgKeyChar(var fpgmsg: TfpgMessageRec);
@ -725,12 +734,13 @@ end;
procedure TFPGUIPrivateWidget.CreateWidget(const AParams: TCreateParams);
begin
Widget := TfpgWidget.Create(nil);
Widget.Visible:=false; //By default fpGUI creates visible objects ?
end;
procedure TFPGUIPrivateWidget.SetEvents;
begin
WidgetProtected.OnClick := ClickHandler;
// WidgetProtected.OnResize := ResizeHandler;
WidgetProtected.OnResize := ResizeHandler;
WidgetProtected.OnEnter := EnterHandler;
WidgetProtected.OnExit := ExitHandler;
// WidgetProtected.OnKeyPress := KeyHandler;
@ -780,9 +790,12 @@ end;
procedure TFPGUIPrivateWidget.SetWidgetPosition(AWidget: TfpgWidget; AX,
AY: Integer);
var
CLRect: TfpgRect;
begin
if AWidget=nil then exit;
AWidget.SetPosition(AX,AY,AWidget.Width,AWidget.Height);
CLRect:=Widget.GetClientRect;
AWidget.SetPosition(CLRect.Left+AX,CLRect.Top+AY,AWidget.Width,AWidget.Height);
end;
function TFPGUIPrivateWidget.HasStaticText: Boolean;
@ -803,8 +816,8 @@ end;
procedure TFPGUIPrivateWidget.GetPreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean);
begin
PreferredWidth:=FWidget.Width;
PreferredHeight:=FWidget.Height;
PreferredWidth:=0;
PreferredHeight:=0;
end;
procedure TFPGUIPrivateWidget.GetClientRect(var ARect: TRect);
@ -815,13 +828,20 @@ begin
CLRect:=FWidget.GetClientRect;
ARect.Left:=0;
ARect.Top:=0;
ARect.Right:=CLRect.Width-CLRect.Left;
ARect.Bottom:=CLRect.Height-CLRect.Top;
ARect.Right:=CLRect.Width;
ARect.Bottom:=CLRect.Height;
end;
procedure TFPGUIPrivateWidget.GetDefaultClientRect(var ARect: TRect);
var
CLRect: TfpgRect;
begin
TfpgRectToRect(FWidget.GetClientRect,ARect);
//ClientRect must have Left and Top = (0,0)
CLRect:=FWidget.GetClientRect;
ARect.Left:=0;
ARect.Top:=0;
ARect.Right:=CLRect.Width;
ARect.Bottom:=CLRect.Height;
end;
procedure TFPGUIPrivateWidget.AdjustRectXY(var AfpgRect: TfpgRect);
@ -840,6 +860,21 @@ begin
Widget.SetFocus;
end;
procedure TFPGUIPrivateWidget.Paint;
begin
PaintHandler(Self);
end;
procedure TFPGUIPrivateWidget.Clear;
begin
//Do nothing by now, introduces flickering
(*
Widget.Canvas.BeginDraw(false);
Widget.Canvas.FillRectangle(Widget.GetClientRect);
Widget.Canvas.EndDraw;
*)
end;
{ TFPGUIPrivateContainer }
constructor TFPGUIPrivateContainer.Create(ALCLObject: TWinControl;
@ -937,6 +972,7 @@ begin
{$ENDIF}
Widget := TfpgForm.Create(nil);
Widget.Visible:=false; //By default fpGUI creates visible objects ?
MenuBar := TfpgMenuBar.Create(Widget);
MenuBar.Visible := false;
@ -1027,6 +1063,20 @@ begin
end;
end;
procedure TFPGUIPrivateWindow.PaintHandler(Sender: TObject);
var
AStruct: TPaintStruct;
DC: HDC;
begin
DC:=GetDC(THandle(Self));
FillByte(AStruct,sizeof(AStruct),0);
AStruct.fErase:=true;
AStruct.hdc:=DC;
GetClientRect(AStruct.rcPaint);
LCLSendPaintMsg(Self.LCLObject,DC,@AStruct);
ReleaseDC(THandle(Self),DC);
end;
procedure TFPGUIPrivateWindow.SetFormBorderStyle(
const AFormBorderStyle: TFormBorderStyle);
begin
@ -1368,7 +1418,6 @@ constructor TFPGUIPrivateCommonDialog.Create(ALCLDialog: TCommonDialog);
begin
FLCLDialog := ALCLDialog;
CreateDialog;
WriteLn('Created ', ClassNAme, ':', Dialog.ClassName);
end;
destructor TFPGUIPrivateCommonDialog.Destroy;