paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-04 06:20:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

fpgui: update from José Mejuto (issue #0016473)

Browse Source 
git-svn-id: trunk@25390 -
This commit is contained in:
paul 2010-05-14 03:20:46 +00:00
parent 95c213a0ee
commit b81a841753
15 changed files with 1765 additions and 462 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/interfaces/fpgui/README.txt
View File

@ -1,8 +1,15 @@
The Lazarus svn does not contain the fpGUI sources.
You can get the fpGUI sources with
Old versions:
-------------
svn co https://fpgui.svn.sourceforge.net/svnroot/fpgui/trunk fpgui
Recent versions (post may 2010):
--------------------------------
Using GIT: git clone git://fpgui.git.sourceforge.net/gitroot/fpgui/fpgui
Web access: http://sourceforge.net/projects/fpgui/files/
Copy or link directories
<fpGUI dir>/src/gui ⇒ lazarus/lcl/interfaces/fpgui/gui
<fpGUI dir>/src/corelib ⇒ lazarus/lcl/interfaces/fpgui/corelib
@ -10,3 +17,4 @@ Copy or link directories
For more details see:
http://wiki.lazarus.freepascal.org/fpGUI_Interface
Current code tested using fpgui 0.7.rc2

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

@ -41,7 +41,7 @@ uses
Controls, ExtCtrls, Forms, Dialogs, StdCtrls, Comctrls, LCLIntf,
GraphType,
// Bindings
fpg_main, fpg_form,
fpg_main, fpg_form, fpguiproc, fpg_base,
// Widgetset
FPGUIWSPrivate, fpguiobjects;

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

@ -21,7 +21,7 @@ type
TFPGUITimer = class
private
FLCLTimer: TTimer;
//FLCLTimer: TTimer;
FTimer: TfpgTimer;
FCallback: TWSTimerProc;
protected
@ -149,7 +149,8 @@ begin
if Assigned(Application.MainForm) then
begin
vMainForm := TFPGUIPrivateWindow(Application.MainForm.Handle).Form;
vMainForm.Show;
if Application.MainForm.Visible then
vMainForm.Show;
end;
// GFApplication.EventFilter can maybe be used on X11 for aloop but it is X only
fpgApplication.Run;
@ -272,9 +273,14 @@ begin
aObject := TObject(GDIObject);
if aObject is TObject then
begin
// Result := (aObject is TFpGuiFont) or (aObject is TFpGuiBrush) or (aObject is TFpGuiImage);
try
if aObject is TObject then
begin
Result:= (aObject is TFPGUIWinAPIObject);
end;
except
//Eat exceptions. If Exception happends it is not a TObject after all and
//of course it is not a fpgui GDI object.
end;
end;

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

@ -28,21 +28,102 @@ interface
uses
// RTL, FCL, LCL
Classes, SysUtils,
Graphics, Menus,
Graphics, Menus, LCLType,
// Widgetset
fpguiwsprivate,
//Others
fpguiproc,
// interface
fpg_main, fpg_menu;
fpg_main, fpg_base, fpg_menu;
type
TFPGUIRegionType=(eRegionNULL,eRegionSimple,eRegionComplex,eRegionNotCombinableOrError);
TFPGUIRegionCombine=(eRegionCombineAnd,eRegionCombineCopy, eRegionCombineDiff, eRegionCombineOr, eRegionCombineXor);
TFPGUIWinAPIElement = class(TObject);
TFPGUIWinAPIObject = class(TFPGUIWinAPIElement);
type tagTFPGUIBrush= record
Color: TfpgColor;
end;
type tagTFPGUIPen= record
Color: TfpgColor;
Width: Integer;
end;
{ TFPGUIWinAPIBrush }
TFPGUIWinAPIBrush = class (TFPGUIWinAPIObject)
private
FBrush: tagTFPGUIBrush;
function GetColor: TfpgColor;
procedure SetColor(const AValue: TfpgColor);
public
property Color: TfpgColor read GetColor Write SetColor;
Constructor Create;
Constructor Create(const ABrushData: TLogBrush);
Destructor Destroy; override;
end;
{ TFPGUIWinAPIPen }
TFPGUIWinAPIPen = class (TFPGUIWinAPIObject)
private
FPen: TPen;
function GetColor: TfpgColor;
procedure SetColor(const AValue: TfpgColor);
public
property Color: TfpgColor read GetColor Write SetColor;
Constructor Create;
Constructor Create(const APenData: TLogPen);
Destructor Destroy; override;
end;
{ TFPGUIWinAPIFont }
TFPGUIWinAPIFont = class (TFPGUIWinAPIObject)
private
FFont: TFont;
fpgFont: TfpgFont;
public
Constructor Create;
Constructor Create(const AFontData: TLogFont);
Constructor Create(const AFontData: TLogFont; const ALongFontName: string);
Destructor Destroy; override;
property fpguiFont: TfpgFont read fpgFont;
end;
{ TFpGuiDeviceContext }
TFpGuiDeviceContext = class(TObject)
TFPGUIDeviceContext = class(TFPGUIWinAPIElement)
private
FDCStack: array of TFPGUIDeviceContext;
procedure CopyDCToInstance(const ATarget: TFPGUIDeviceContext);
procedure FreeSelfObjects;
procedure SetupFont;
procedure SetupBrush;
procedure SetupPen;
public
fpgCanvas: TfpgCanvas;
FPrivateWidget: TFPGUIPrivateWidget;
FOrg: TPoint;
FBrush: TFPGUIWinAPIBrush;
FPen: TFPGUIWinAPIPen;
FFont: TFPGUIWinAPIFont;
FTextColor: TfpgColor;
public
constructor Create(AfpgCanvas: TfpgCanvas);
constructor Create(AFPGUIPrivate: TFPGUIPrivateWidget);
destructor Destroy; override;
procedure SetOrigin(const AX,AY: integer);
function SaveDC: Boolean;
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);
end;
{ TFPGUIPrivateMenuItem }
@ -56,13 +137,176 @@ type
procedure HandleOnClick(ASender: TObject);
end;
{ TFPGUIBasicRegion }
TFPGUIBasicRegion=class(TFPGUIWinAPIObject)
private
FRegionType: TFPGUIRegionType;
function GetRegionType: TFPGUIRegionType;
protected
FRectRegion: TRect;
public
constructor Create; overload;
constructor Create(const ARect: TRect); overload;
destructor Destroy; override;
procedure CreateRectRegion(const ARect: TRect);
function CombineWithRegion(const ARegion: TFPGUIBasicRegion; const ACombineMode: TFPGUIRegionCombine): TFPGUIBasicRegion;
property RegionType: TFPGUIRegionType read GetRegionType;
end;
implementation
{ TFpGuiDeviceContext }
constructor TFpGuiDeviceContext.Create(AfpgCanvas: TfpgCanvas);
procedure TFPGUIDeviceContext.CopyDCToInstance(
const ATarget: TFPGUIDeviceContext);
begin
fpgCanvas := AfpgCanvas;
ATarget.fpgCanvas:=fpgCanvas;
ATarget.FPrivateWidget:=FPrivateWidget;
ATarget.FBrush:=FBrush;
ATarget.FPen.FPen.Assign(FPen.FPen);
ATarget.FFont.FFont.Assign(FFont.FFont);
ATarget.FOrg:=FOrg;
ATarget.FTextColor:=FTextColor;
end;
procedure TFPGUIDeviceContext.FreeSelfObjects;
begin
FreeAndNIL(FBrush);
FreeAndNIL(FPen);
FreeAndNIL(FFont);
end;
procedure TFPGUIDeviceContext.SetupFont;
begin
fpgCanvas.Font:=FFont.fpguiFont;
end;
procedure TFPGUIDeviceContext.SetupBrush;
begin
end;
procedure TFPGUIDeviceContext.SetupPen;
begin
fpgCanvas.Color:=FPen.Color;
end;
constructor TFpGuiDeviceContext.Create(AFPGUIPrivate: TFPGUIPrivateWidget);
begin
if Assigned(AFPGUIPrivate) then begin
fpgCanvas := AFPGUIPrivate.Widget.Canvas;
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;
end;
destructor TFpGuiDeviceContext.Destroy;
begin
FreeSelfObjects;
end;
procedure TFpGuiDeviceContext.SetOrigin(const AX, AY: integer);
begin
With FOrg do begin
X:=AX;
Y:=AY;
end;
end;
function TFPGUIDeviceContext.SaveDC: Boolean;
var
Tmp: TFPGUIDeviceContext;
begin
Beep;
SetLength(FDCStack,Length(FDCStack)+1);
Tmp:=TFPGUIDeviceContext.Create(FPrivateWidget);
FDCStack[High(FDCStack)]:=Tmp;
Self.CopyDCToInstance(Tmp);
Result:=true;
end;
function TFPGUIDeviceContext.RestoreDC(const Index: SizeInt): Boolean;
var
Tmp: TFPGUIDeviceContext;
TargetIndex: SizeInt;
j: SizeInt;
begin
Beep;
Result:=false;
if Index>=0 then begin
TargetIndex:=Index;
if TargetIndex>High(FDCStack) then Exit;
end else begin
TargetIndex:=High(FDCStack)-Index+1;
If TargetIndex<0 then Exit;
end;
Tmp:=FDCStack[TargetIndex];
FreeSelfObjects;
Tmp.CopyDCToInstance(Self);
for j := TargetIndex to High(FDCStack) do begin
FDCStack[j].Free;
end;
SetLength(FDCStack,TargetIndex);
SetupFont;
SetupBrush;
SetupPen;
Result:=true;
end;
function TFPGUIDeviceContext.SelectObject(const AGDIOBJ: HGDIOBJ): HGDIOBJ;
var
gObject: TObject;
begin
Result:=0;
gObject:=TObject(AGDIOBJ);
if gObject is TFPGUIWinAPIFont then begin
Result:=HGDIOBJ(FFont);
FFont:=TFPGUIWinAPIFont(gObject);
SetupFont;
end else if gObject is TFPGUIWinAPIBrush then begin
Result:=HGDIOBJ(FBrush);
FBrush:=TFPGUIWinAPIBrush(gObject);
SetupBrush;
end else if gObject is TFPGUIWinAPIPen then begin
Result:=HGDIOBJ(FPen);
FPen:=TFPGUIWinAPIPen(gObject);
SetupPen;
end;
end;
function TFPGUIDeviceContext.SetTextColor(const AColor: TColorRef): TColorRef;
begin
Result:=FTextColor;
FTextColor:=AColor;
fpgCanvas.TextColor:=FTextColor;
end;
function TFPGUIDeviceContext.PrepareRectOffsets(const ARect: TRect): TfpgRect;
begin
TRectTofpgRect(ARect,Result);
AdjustRectToOrg(Result,FOrg);
FPrivateWidget.AdjustRectXY(Result);
end;
procedure TFPGUIDeviceContext.ClearRectangle(const AfpgRect: TfpgRect);
var
OldColor: TfpgColor;
begin
OldColor:=fpgCanvas.Color;
fpgCanvas.Color:=FBrush.Color;
fpgCanvas.FillRectangle(AfpgRect);
fpgCanvas.Color:=OldColor;
end;
{ TFPGUIPrivateMenuItem }
@ -73,5 +317,177 @@ begin
LCLMenuItem.OnClick(LCLMenuItem);
end;
{ TFPGUIWinAPIFont }
constructor TFPGUIWinAPIFont.Create;
begin
FFont:=TFont.Create;
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]));
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]));
end;
destructor TFPGUIWinAPIFont.Destroy;
begin
fpgFont.Free;
FFont.Free;
inherited Destroy;
end;
{ TFPGUIWinAPIPen }
function TFPGUIWinAPIPen.GetColor: TfpgColor;
begin
Result:=FPen.Color;
end;
procedure TFPGUIWinAPIPen.SetColor(const AValue: TfpgColor);
begin
FPen.Color:=AValue;
end;
constructor TFPGUIWinAPIPen.Create;
begin
FPen:=TPen.Create;
end;
constructor TFPGUIWinAPIPen.Create(const APenData: TLogPen);
begin
Create;
FPen.Color:=APenData.lopnColor;
end;
destructor TFPGUIWinAPIPen.Destroy;
begin
FPen.Free;
inherited Destroy;
end;
{ TFPGUIWinAPIBrush }
function TFPGUIWinAPIBrush.GetColor: TfpgColor;
begin
Result:=FBrush.Color;
end;
procedure TFPGUIWinAPIBrush.SetColor(const AValue: TfpgColor);
begin
FBrush.Color:=AValue;
end;
constructor TFPGUIWinAPIBrush.Create;
begin
FBrush.Color:=TColorToTfpgColor(clBtnFace);
end;
constructor TFPGUIWinAPIBrush.Create(const ABrushData: TLogBrush);
begin
Create;
FBrush.Color:=TColorToTfpgColor(ABrushData.lbColor);
end;
destructor TFPGUIWinAPIBrush.Destroy;
begin
inherited Destroy;
end;
{ TFPGUIBasicRegion }
function TFPGUIBasicRegion.GetRegionType: TFPGUIRegionType;
begin
Result:=FRegionType;
end;
constructor TFPGUIBasicRegion.Create;
var
ARect: TRect;
begin
FillByte(ARect,sizeof(ARect),0);
CreateRectRegion(ARect);
end;
constructor TFPGUIBasicRegion.Create(const ARect: TRect);
begin
CreateRectRegion(ARect);
end;
destructor TFPGUIBasicRegion.Destroy;
begin
inherited Destroy;
end;
procedure TFPGUIBasicRegion.CreateRectRegion(const ARect: TRect);
begin
FRectRegion:=ARect;
if (FRectRegion.Left=FRectRegion.Top) and (FRectRegion.Right=FRectRegion.Bottom) and
(FRectRegion.Top=FRectRegion.Bottom) then begin
FRegionType:=eRegionNULL;
end else begin
FRegionType:=eRegionSimple;
end;
end;
function TFPGUIBasicRegion.CombineWithRegion(const ARegion: TFPGUIBasicRegion;
const ACombineMode: TFPGUIRegionCombine): TFPGUIBasicRegion;
function Min(const V1,V2: SizeInt): SizeInt;
begin
if V1<V2 then Result:=V1 else Result:=V2;
end;
function Max(const V1,V2: SizeInt): SizeInt;
begin
if V1>V2 then Result:=V1 else Result:=V2;
end;
procedure CombineAnd(const TargetRegion: TFPGUIBasicRegion; const r1,r2: TRect);
var
Intersect: Boolean;
begin
if (r2.Left>r1.Right) or
(r2.Right<r1.Left) or
(r2.Top>r1.Bottom) or
(r2.Bottom<r1.Top) then begin
Intersect:=false;
end else begin
Intersect:=true;
end;
if Intersect then begin
TargetRegion.CreateRectRegion(
classes.Rect(
Max(r1.Left,r2.Left),
Max(r1.Top,r2.Top),
Min(r1.Right,r2.Right),
Min(r1.Bottom,r2.Bottom)
)
);
end else begin
TargetRegion.CreateRectRegion(classes.Rect(0,0,0,0));
end;
end;
begin
Result:=TFPGUIBasicRegion.Create;
Case ACombineMode of
eRegionCombineAnd: CombineAnd(Result,ARegion.FRectRegion,Self.FRectRegion);
eRegionCombineCopy,
eRegionCombineDiff,
eRegionCombineOr,
eRegionCombineXor: begin
Raise Exception.CreateFmt('Region mode %d not supported',[integer(ACombineMode)]);
end;
end;
end;
end.

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

@ -26,9 +26,17 @@ unit fpguiproc;
interface
uses
Classes, SysUtils, fpg_base, Graphics;
Classes, SysUtils, fpg_base, Graphics,LCLType;
function TColorToTfpgColor(AColor: TColor): TfpgColor;
function TTfpgColorToTColor(AColor: TfpgColor): TColor;
procedure TfpgRectToRect(const AfpguiRect: TfpgRect; var ARect: TRect); inline;
procedure TRectTofpgRect(const ARect: TRect; var AfpguiRect: TfpgRect); inline;
function TFontToTfpgFontDesc(const AFont: TFont): string;
procedure AdjustRectToOrg(var ARect: TRect; const AOrgPoint: TPoint); overload;
procedure AdjustRectToOrg(var AfpgRect: TfpgRect; const AOrgPoint: TPoint); overload;
function GetSysColorRGB(const Index: Integer): DWORD;
procedure AdjustToZeroLeftTop(var ARect: TRect);
implementation
@ -40,10 +48,9 @@ implementation
function TColorToTfpgColor(AColor: TColor): TfpgColor;
var
RGBColor: TColor;
RGBTriple: TRGBTriple;
RGBTriple: fpg_base.TRGBTriple;
begin
RGBColor := ColorToRGB(AColor);
RGBTriple.Alpha := 0;
RGBTriple.Red := Graphics.Red(RGBColor);
RGBTriple.Green := Graphics.Green(RGBColor);
@ -52,5 +59,117 @@ begin
Result := RGBTripleTofpgColor(RGBTriple);
end;
function TTfpgColorToTColor(AColor: TfpgColor): TColor;
var
RGBTriple: fpg_base.TRGBTriple;
begin
RGBTriple:=fpgColorToRGBTriple(AColor);
Result:=RGBToColor(RGBTriple.Red,RGBTriple.Green,RGBTriple.Blue);
end;
procedure TfpgRectToRect(const AfpguiRect: TfpgRect; var ARect: TRect);
begin
with AfpguiRect do begin
ARect:=Rect(Left,Top,Width,Height);
end;
end;
procedure TRectTofpgRect(const ARect: TRect; var AfpguiRect: TfpgRect); inline;
begin
with ARect do begin
AfpguiRect.Left:=Left;
AfpguiRect.Top:=Top;
AfpguiRect.Width:=Right-Left;
AfpguiRect.Height:=Bottom-Top;
end;
end;
function TFontToTfpgFontDesc(const AFont: TFont): string;
var
fontdesc: string;
begin
fontdesc:=AFont.Name;
if AFont.Size>0 then
{ TODO -oJose Mejuto : This conversion seems to be performed somewhere in the WinAPI interface, but now keep it here while the right position is not found }
fontdesc:=fontdesc+'-'+inttostr(round((AFont.Size*AFont.PixelsPerInch) / 96));
if fsBold in AFont.Style then
fontdesc:=fontdesc+':bold';
Result:=fontdesc;
end;
procedure AdjustRectToOrg(var ARect: TRect; const AOrgPoint: TPoint);
begin
With ARect,AOrgPoint do begin
Left:=Left-x;
Top:=Top-y;
end;
end;
procedure AdjustRectToOrg(var AfpgRect: TfpgRect; const AOrgPoint: TPoint);
overload;
begin
With AfpgRect,AOrgPoint do begin
Left:=Left-x;
Top:=Top-y;
end;
end;
function GetSysColorRGB(const Index: Integer): DWORD;
begin
case Index of
{ COLOR_SCROLLBAR : Result:=clGray;
COLOR_BACKGROUND : Result:=;
COLOR_ACTIVECAPTION : Result:=;
COLOR_INACTIVECAPTION : Result:=;
COLOR_MENU : Result:=;}
COLOR_WINDOW : Result:=clWhite;
{ COLOR_WINDOWFRAME : Result:=;
COLOR_MENUTEXT : Result:=;
COLOR_WINDOWTEXT : Result:=;
COLOR_CAPTIONTEXT : Result:=GetColor(QPaletteActive, QPaletteText);
COLOR_ACTIVEBORDER : Result:=GetColor(QPaletteActive, QPaletteWindow);
COLOR_INACTIVEBORDER : Result:=GetColor(QPaletteInactive, QPaletteWindow);
COLOR_APPWORKSPACE : Result:=GetColor(QPaletteActive, QPaletteWindow);
COLOR_HIGHLIGHT : Result:=GetColor(QPaletteActive, QPaletteHighlight);
COLOR_HIGHLIGHTTEXT : Result:=GetColor(QPaletteActive, QPaletteHighlightedText);}
COLOR_BTNFACE : Result:=clLtGray;
{ COLOR_BTNSHADOW : Result:=GetColor(QPaletteActive, QPaletteDark);
COLOR_GRAYTEXT : Result:=GetColor(QPaletteActive, QPaletteText);
COLOR_BTNTEXT : Result:=GetColor(QPaletteActive, QPaletteButtonText);
COLOR_INACTIVECAPTIONTEXT : Result:=GetColor(QPaletteInactive, QPaletteText);
COLOR_BTNHIGHLIGHT : Result:=GetColor(QPaletteActive, QPaletteLight);
COLOR_3DDKSHADOW : Result:=GetColor(QPaletteActive, QPaletteShadow);
COLOR_3DLIGHT : Result:=GetColor(QPaletteActive, QPaletteMidlight);
COLOR_INFOTEXT : Result:=GetClInfo(False);
COLOR_INFOBK : Result:=GetClInfo(True);
// PBD: 25 is unassigned in all the docs I can find
// if someone finds what this is supposed to be then fill it in
// note defaults below, and cl[ColorConst] in graphics
COLOR_HOTLIGHT : Result:=GetColor(QPaletteActive, QPaletteLight);
COLOR_GRADIENTACTIVECAPTION : Result:=GetColor(QPaletteActive, QPaletteHighlight);
COLOR_GRADIENTINACTIVECAPTION : Result:=GetColor(QPaletteInactive, QPaletteBase);
COLOR_FORM : Result:=GetColor(QPaletteActive, QPaletteWindow);
COLOR_clForeground..COLOR_clHighlightedText
: Result:=GetColor(QPaletteActive, nIndex - COLOR_clForeground);
COLOR_clNormalForeground..COLOR_clNormalHighlightedText
: Result:=GetColor(QPaletteInactive, nIndex - COLOR_clNormalForeground);
COLOR_clDisabledForeground..COLOR_clDisabledHighlightedText
: Result:=GetColor(QPaletteDisabled, nIndex - COLOR_clDisabledForeground);
COLOR_clActiveForeground..COLOR_clActiveHighlightedText
: Result:=GetColor(QPaletteActive, nIndex - COLOR_clActiveForeground);}
else
Result:=0;
end;
end;
procedure AdjustToZeroLeftTop(var ARect: TRect);
begin
ARect.Right:=ARect.Right-ARect.Left;
ARect.Bottom:=ARect.Bottom-ARect.Top;
ARect.Left:=0;
ARect.Top:=0;
end;
end.

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

@ -49,11 +49,13 @@ begin
{$WARNING TFpGuiWidgetSet.BeginPaint Temporary Fix to prevent Crashing}
try
if PrivateWidget <> nil then
DC := TFpGuiDeviceContext.Create(PrivateWidget.Widget.Canvas)
DC := TFpGuiDeviceContext.Create(PrivateWidget)
else
DC := TFpGuiDeviceContext.Create(nil);
{$ifdef VerboseFPGUIWinAPI}
if PrivateWidget <> nil then
WriteLn(PrivateWidget.ClassName);
{$endif}
except
DC := TFpGuiDeviceContext.Create(nil);
end;
@ -66,13 +68,149 @@ begin
{$endif}
end;
function TFpGuiWidgetSet.ClientToScreen(Handle: HWND; var P: TPoint): Boolean;
var
O: TFPGUIPrivateWidget;
begin
O:=GlobalMouseCursorPosWidget;
while O<>nil do begin
P.X:=P.X+O.Widget.Left;
P.Y:=P.Y+O.Widget.Top;
if O.LCLObject.Parent<>nil then begin
O:=TFPGUIPrivateWidget(O.LCLObject.Parent.Handle);
end else begin
O:=nil;
end;
end;
Result:=true;
end;
function TFpGuiWidgetSet.CombineRgn(Dest, Src1, Src2: HRGN;
fnCombineMode: Longint): Longint;
var
R1: TFPGUIBasicRegion absolute Src1;
R2: TFPGUIBasicRegion absolute Src2;
DR: TFPGUIBasicRegion absolute Dest;
Combine: TFPGUIRegionCombine;
begin
case fnCombineMode of
RGN_AND: Combine:=eRegionCombineAnd;
RGN_COPY: Combine:=eRegionCombineCopy;
RGN_DIFF: Combine:=eRegionCombineDiff;
RGN_OR: Combine:=eRegionCombineOr;
RGN_XOR: Combine:=eRegionCombineXor;
end;
if DR<>nil then DR.Free;
DR:=R1.CombineWithRegion(R2,Combine);
Case dr.RegionType of
eRegionNULL: Result:=NullRegion;
eRegionSimple: Result:=SimpleRegion ;
eRegionComplex: Result:=ComplexRegion;
eRegionNotCombinableOrError: Result:=Region_Error;
end;
end;
function TFpGuiWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush
): HBRUSH;
begin
Result:=HBRUSH(TFPGUIWinAPIBrush.Create(LogBrush));
end;
function TFpGuiWidgetSet.CreateCompatibleDC(DC: HDC): HDC;
var
ADC: TFpGuiDeviceContext absolute DC;
begin
{$ifdef VerboseFPGUIWinAPI}
if DC=0 then begin
WriteLn(Self.ClassName,'.CreateCompatibleDC ','NULL');
end else begin
if ADC.FPrivateWidget<>nil then begin
WriteLn(Self.ClassName,'.CreateCompatibleDC ',ADC.FPrivateWidget.LCLObject.Name);
end else begin
WriteLn(Self.ClassName,'.CreateCompatibleDC ','Desktop');
end;
end;
{$endif}
if DC=0 then begin
//Create DC desktop compatible
Result:=HDC(TFpGuiDeviceContext.Create(nil));
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;
function TFpGuiWidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT;
begin
Result:=HFONT(TFPGUIWinAPIFont.Create(LogFont));
end;
function TFpGuiWidgetSet.CreateFontIndirectEx(const LogFont: TLogFont;
const LongFontName: string): HFONT;
begin
Result:=HFONT(TFPGUIWinAPIFont.Create(LogFont,LongFontName));
end;
function TFpGuiWidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN;
begin
Result:=HPEN(TFPGUIWinAPIPen.Create(LogPen));
end;
function TFpGuiWidgetSet.CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
var
Reg: TFPGUIBasicRegion;
begin
Reg:=TFPGUIBasicRegion.Create(Rect(X1,Y1,X2,Y2));
Result:=HRGN(Reg);
end;
function TFpGuiWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean;
begin
if IsValidGDIObject(GDIObject) then begin
TObject(GDIObject).Free;
Result:=true;
end else begin
Result:=false;
end;
end;
function TFpGuiWidgetSet.DrawFocusRect(DC: HDC; const Rect: TRect): boolean;
var
ADC: TFpGuiDeviceContext absolute DC;
begin
ADC.fpgCanvas.DrawFocusRect(ADC.PrepareRectOffsets(Rect));
Result:=true;
end;
function TFpGuiWidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer;
var ARect: TRect; Flags: Cardinal): Integer;
var
ADC: TFpGuiDeviceContext absolute DC;
begin
Result:=inherited DrawText(DC, Str, Count, ARect, Flags);
if (Flags and DT_CALCRECT)=0 then begin
ADC.fpgCanvas.DrawText(ADC.PrepareRectOffsets(ARect),Str,[],0);
end;
Result:=ARect.Bottom-ARect.Top; //The height of the text.
end;
function TFpGuiWidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
var
Widget: TFPGUIPrivateWidget absolute hWnd;
begin
Result:=true;
Widget.Enabled:=bEnable;
Result:=true;
end;
function TFpGuiWidgetSet.EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer;
var
DC: TFpGuiDeviceContext;
begin
DC := TFpGuiDeviceContext(PS.hdc);
DC.Free;
Result:=1; //Any non zero value.
end;
function TFpGuiWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
@ -80,10 +218,124 @@ function TFpGuiWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
var
ADC: TFpGuiDeviceContext absolute DC;
AStr: string;
r: TfpgRect;
rClip,OldClip: TfpgRect;
RestoreClip: Boolean;
begin
AStr := string(Str);
SetLength(AStr,Count);
move(Str[0],AStr[1],Count);
r:=ADC.PrepareRectOffsets(classes.Rect(X,Y,0,0));
RestoreClip:=false;
if Rect<>nil then begin
rClip:=fpgRect(Rect^.Left,Rect^.Top,Rect^.Right-Rect^.Left,Rect^.Bottom-Rect^.Top);
if (ETO_CLIPPED or ETO_OPAQUE) and Options <> 0 then begin
OldClip:=ADC.fpgCanvas.GetClipRect;
ADC.fpgCanvas.SetClipRect(rClip);
RestoreClip:=true;
end;
if ETO_OPAQUE and Options = ETO_OPAQUE then begin
ADC.ClearRectangle(rClip);
end;
end;
ADC.fpgCanvas.DrawText(X, Y, AStr);
ADC.fpgCanvas.DrawText(r.Left, r.Top, AStr);
if RestoreClip then begin
ADC.fpgCanvas.SetClipRect(OldClip);
end;
Result:=true;
end;
function TFpGuiWidgetSet.GetClientRect(handle: HWND; var ARect: TRect
): Boolean;
var
fpguiPrivate: TFPGUIPrivateWidget absolute handle;
begin
fpguiPrivate.GetClientRect(ARect);
Result:=true;
end;
function TFpGuiWidgetSet.GetClipRGN(DC: hDC; RGN: hRGN): Longint;
var
ADC: TFpGuiDeviceContext absolute DC;
Clip: TfpgRect;
Region: TFPGUIBasicRegion absolute RGN;
begin
ADC.fpgCanvas.GetWinRect(Clip); { TODO : Should be a clip region, but use this by now }
if Region<>nil Then FreeAndNil(Region);
Region:=TFPGUIBasicRegion.Create(Rect(Clip.Left,Clip.Top,Clip.Right,Clip.Bottom));
RGN:=HRGN(Region);
if Region.RegionType=eRegionNULL then begin
Result:=0;
end else if Region.RegionType=eRegionNotCombinableOrError then begin
Result:=-1;
end else begin
Result:=1;
end;
end;
function TFpGuiWidgetSet.GetCursorPos(var lpPoint: TPoint): Boolean;
var
O: TFPGUIPrivateWidget;
begin
O:=GlobalMouseCursorPosWidget;
lpPoint:=GlobalMouseCursorPos;
while O<>nil do begin
lpPoint.X:=lpPoint.X+O.Widget.Left;
lpPoint.Y:=lpPoint.Y+O.Widget.Top;
if O.LCLObject.Parent<>nil then begin
O:=TFPGUIPrivateWidget(O.LCLObject.Parent.Handle);
end else begin
O:=nil;
end;
end;
Result:=true;
end;
function TFpGuiWidgetSet.GetDC(hWnd: HWND): HDC;
var
PrivateWidget: TFPGUIPrivateWidget absolute hWnd;
begin
//Create a new DC
Result:=HDC(TFpGuiDeviceContext.Create(PrivateWidget));
end;
function TFpGuiWidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
var
ADC: TFpGuiDeviceContext absolute DC;
begin
if ADC.FPrivateWidget=nil then begin
//Desktop device caps
{ TODO : Create real data for GetDeviceCaps }
Case Index of
LOGPIXELSX: Result:=96; //Hardcoded by now
BITSPIXEL : Result:=32; //Hardcoded by now
else begin
// {$ifdef VerboseFPGUIWinAPI}
WriteLn(Self.ClassName,'.GetDeviceCaps Index ',Index,' Desktop');
// {$endif}
end;
end;
end else begin
//other
// {$ifdef VerboseFPGUIWinAPI}
WriteLn(Self.ClassName,'.GetDeviceCaps Index ',Index,ADC.FPrivateWidget.LCLObject.Name);
// {$endif}
end;
end;
function TFpGuiWidgetSet.GetProp(Handle: hwnd; Str: PChar): Pointer;
var
PrivateWidget: TFPGUIPrivateWidget absolute Handle;
begin
if Str='WinControl' then begin
Result:=PrivateWidget.LCLObject;
end else begin
{$ifdef VerboseFPGUIWinAPI}
WriteLn('Trace:Unknown Window property: ',Str);
{$endif}
Result:=nil;
end;
end;
function TFpGuiWidgetSet.GetSysColor(nIndex: Integer): DWORD;
@ -93,61 +345,135 @@ begin
{$ifdef VerboseFPGUIWinAPI}
WriteLn('Trace:Unknown lcl system color: [TFpGuiWidgetSet.GetSysColor]');
{$endif}
Result:=0;
exit;
end;
Result:=GetSysColorRGB(nIndex);
end;
function TFpGuiWidgetSet.GetSystemMetrics(nIndex: Integer): Integer;
begin
case nIndex of
{ COLOR_SCROLLBAR : Result:=clGray;
COLOR_BACKGROUND : Result:=;
COLOR_ACTIVECAPTION : Result:=;
COLOR_INACTIVECAPTION : Result:=;
COLOR_MENU : Result:=;}
COLOR_WINDOW : Result:=clWhite;
{ COLOR_WINDOWFRAME : Result:=;
COLOR_MENUTEXT : Result:=;
COLOR_WINDOWTEXT : Result:=;
COLOR_CAPTIONTEXT : Result:=GetColor(QPaletteActive, QPaletteText);
COLOR_ACTIVEBORDER : Result:=GetColor(QPaletteActive, QPaletteWindow);
COLOR_INACTIVEBORDER : Result:=GetColor(QPaletteInactive, QPaletteWindow);
COLOR_APPWORKSPACE : Result:=GetColor(QPaletteActive, QPaletteWindow);
COLOR_HIGHLIGHT : Result:=GetColor(QPaletteActive, QPaletteHighlight);
COLOR_HIGHLIGHTTEXT : Result:=GetColor(QPaletteActive, QPaletteHighlightedText);}
COLOR_BTNFACE : Result:=clLtGray;
{ COLOR_BTNSHADOW : Result:=GetColor(QPaletteActive, QPaletteDark);
COLOR_GRAYTEXT : Result:=GetColor(QPaletteActive, QPaletteText);
COLOR_BTNTEXT : Result:=GetColor(QPaletteActive, QPaletteButtonText);
COLOR_INACTIVECAPTIONTEXT : Result:=GetColor(QPaletteInactive, QPaletteText);
COLOR_BTNHIGHLIGHT : Result:=GetColor(QPaletteActive, QPaletteLight);
COLOR_3DDKSHADOW : Result:=GetColor(QPaletteActive, QPaletteShadow);
COLOR_3DLIGHT : Result:=GetColor(QPaletteActive, QPaletteMidlight);
COLOR_INFOTEXT : Result:=GetClInfo(False);
COLOR_INFOBK : Result:=GetClInfo(True);
// PBD: 25 is unassigned in all the docs I can find
// if someone finds what this is supposed to be then fill it in
// note defaults below, and cl[ColorConst] in graphics
COLOR_HOTLIGHT : Result:=GetColor(QPaletteActive, QPaletteLight);
COLOR_GRADIENTACTIVECAPTION : Result:=GetColor(QPaletteActive, QPaletteHighlight);
COLOR_GRADIENTINACTIVECAPTION : Result:=GetColor(QPaletteInactive, QPaletteBase);
COLOR_FORM : Result:=GetColor(QPaletteActive, QPaletteWindow);
COLOR_clForeground..COLOR_clHighlightedText
: Result:=GetColor(QPaletteActive, nIndex - COLOR_clForeground);
COLOR_clNormalForeground..COLOR_clNormalHighlightedText
: Result:=GetColor(QPaletteInactive, nIndex - COLOR_clNormalForeground);
COLOR_clDisabledForeground..COLOR_clDisabledHighlightedText
: Result:=GetColor(QPaletteDisabled, nIndex - COLOR_clDisabledForeground);
COLOR_clActiveForeground..COLOR_clActiveHighlightedText
: Result:=GetColor(QPaletteActive, nIndex - COLOR_clActiveForeground);}
else
Result:=0;
//Current screen size
SM_CXSCREEN: Result:=1400; //Hardcoded by now
SM_CYSCREEN: Result:=400;
//Desktop size
SM_CXVIRTUALSCREEN: Result:=1400;
SM_CYVIRTUALSCREEN: Result:=400;
end;
end;
function TFpGuiWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar;
Count: Integer; var Size: TSize): Boolean;
var
ADC: TFpGuiDeviceContext absolute DC;
begin
Size.cx:=ADC.fpgCanvas.Font.TextWidth(Str);
Size.cy:=ADC.fpgCanvas.Font.Height;
Result:=true;
end;
function TFpGuiWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
var
ADC: TFpGuiDeviceContext absolute DC;
begin
FillByte(TM,sizeof(TM),0);
TM.tmAscent:=ADC.fpgCanvas.Font.Ascent;
TM.tmDescent:=ADC.fpgCanvas.Font.Descent;
//Defined usually in MSDN as the average of 'x' char.
TM.tmAveCharWidth:=ADC.fpgCanvas.Font.TextWidth('x');
TM.tmHeight:=ADC.fpgCanvas.Font.Height;
Result:=true;
end;
function TFpGuiWidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer;
var
ADC: TFpGuiDeviceContext absolute DC;
begin
P^:=ADC.FOrg;
Result:=1;
end;
function TFpGuiWidgetSet.InvalidateRect(aHandle: HWND; Rect: pRect;
bErase: Boolean): Boolean;
begin
{ TODO -cOS : Add proper InvalidateRect }
Result:=true;
end;
function TFpGuiWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
var
ADC: TFpGuiDeviceContext absolute DC;
r: TfpgRect;
begin
ADC.fpgCanvas.DrawRectangle(X1, Y1, X2 - X1, Y2 - Y1);
r:=ADC.PrepareRectOffsets(classes.Rect(X1,Y1,X2-X1,Y2-Y1));
ADC.fpgCanvas.BeginDraw(false);
ADC.ClearRectangle(r);
ADC.fpgCanvas.DrawRectangle(r);
ADC.fpgCanvas.EndDraw;
Result:=true;
end;
function TFpGuiWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer;
var
MyDC: TFpGuiDeviceContext absolute DC;
begin
MyDC.Free;
Result:=1;
end;
function TFpGuiWidgetSet.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ;
var
MyDC: TFpGuiDeviceContext absolute DC;
begin
Result:=MyDC.SelectObject(GDIObj);
end;
function TFpGuiWidgetSet.SetFocus(hWnd: HWND): HWND;
var
Widget: TFPGUIPrivateWidget absolute hWnd;
begin
Result:=LCLType.HWND(Widget.Widget.ActiveWidget);
Widget.SetFocus;
end;
function TFpGuiWidgetSet.SetParent(hWndChild: HWND; hWndParent: HWND): HWND;
var
PrivateWidgetParent: TFPGUIPrivateWidget absolute hWndParent;
PrivateWidgetChild: TFPGUIPrivateWidget absolute hWndChild;
begin
PrivateWidgetChild.Widget.Parent:=PrivateWidgetParent.Widget;
Result:=0; //???
end;
function TFpGuiWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
var
ADC: TFpGuiDeviceContext absolute DC;
begin
Result:=ADC.SetTextColor(Color);
end;
function TFpGuiWidgetSet.SetWindowOrgEx(DC: HDC; NewX, NewY: Integer;
OldPoint: PPoint): Boolean;
var
ADC: TFpGuiDeviceContext absolute DC;
begin
ADC.SetOrigin(NewX,NewY);
Result:=true;
end;
function TFpGuiWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
var
Widget: TFPGUIPrivateWidget absolute hWnd;
begin
Result:=Widget.Visible;
Widget.Visible:=true;{ TODO -oJose Mejuto : Process showwindow mode }
end;
function TFpGuiWidgetSet.WindowFromPoint(Point: TPoint): HWND;
begin
{ TODO : Temporal hack while not real WindowFromPoint implementation }
Result:=HWND(GlobalMouseCursorPosWidget);
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line

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

@ -34,9 +34,9 @@ function BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc; override;
{function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; override;
function CallNextHookEx(hHk: HHOOK; ncode : Integer; wParam: WParam; lParam : LParam) : Integer; override;
function CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; wParam: WParam; lParam : lParam) : Integer; override;
function CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; wParam: WParam; lParam : lParam) : Integer; override;}
function ClientToScreen(Handle: HWND; var P: TPoint) : Boolean; override;
{
function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; override;
function ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean; override;
@ -47,33 +47,33 @@ function ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean; override;
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 CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; override;}
function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;
{function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;}
function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override;
{
procedure DeleteCriticalSection(var CritSection: TCriticalSection); override;
function DeleteDC(hDC: HDC): Boolean; override;
function DeleteDC(hDC: HDC): Boolean; override;}
function DeleteObject(GDIObject: HGDIOBJ): Boolean; override;
function DestroyCaret(Handle : HWND): Boolean; override;
{function DestroyCaret(Handle : HWND): Boolean; override;
function DestroyCursor(Handle: hCursor): Boolean; override;
function DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; override;
function DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; override;}
function DrawFocusRect(DC: HDC; const Rect: TRect): boolean; override;
function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; override;
{function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; override;}
function DrawText(DC: HDC; Str: PChar; Count: Integer; var ARect: TRect; Flags: Cardinal): Integer; override;
function Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean; override;
function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; override;
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; override;}
{function Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean; override;
function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; override;}
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; override;
function EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer; override;
{procedure EnterCriticalSection(var CritSection: TCriticalSection); override;
function EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint; override;
@ -92,44 +92,44 @@ function GetBitmapBits(Bitmap: HBITMAP; Count: Longint; Bits: Pointer): Longint
function GetCapture: HWND; override;
function GetCaretPos(var lpPoint: TPoint): Boolean; override;
function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; override;
function GetClientBounds(handle : HWND; var ARect : TRect) : Boolean; override;
function GetClientBounds(handle : HWND; var ARect : TRect) : Boolean; override;}
function GetClientRect(handle : HWND; var ARect : TRect) : Boolean; override;
function GetClipBox(DC : hDC; lpRect : PRect) : Longint; override;
{function GetClipBox(DC : hDC; lpRect : PRect) : Longint; override;}
function GetClipRGN(DC: hDC; RGN: hRGN): Longint; override;
function GetCursorPos(var lpPoint: TPoint ): Boolean; override;
function GetDC(hWnd: HWND): HDC; override;
function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; override;
{function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; override;}
function GetDeviceCaps(DC: HDC; Index: Integer): Integer; override;
function GetDeviceSize(DC: HDC; var P: TPoint): Boolean; Override;
{function GetDeviceSize(DC: HDC; var P: TPoint): Boolean; Override;
function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; Override;
function GetFocus: HWND; override;
function GetKeyState(nVirtKey: Integer): Smallint; override;
function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; override;
function GetParent(Handle : HWND): HWND; override;
function GetParent(Handle : HWND): HWND; override;}
function GetProp(Handle : hwnd; Str : PChar): Pointer; override;
function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint; override;
{function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint; override;
function GetROP2(DC: HDC): Integer; override;
function GetScrollBarSize(Handle: HWND; BarKind: Integer): integer; override;
function GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean; override;
function GetScrollInfo(Handle: HWND; BarFlag: Integer; Var ScrollInfo: TScrollInfo): Boolean; override;
function GetStockObject(Value: Integer): THandle; override;}
function GetSysColor(nIndex: Integer): DWORD; override;
{function GetSystemMetrics(nIndex: Integer): Integer; override;
function GetTextColor(DC: HDC) : TColorRef; Override;
function GetSystemMetrics(nIndex: Integer): Integer; override;
{function GetTextColor(DC: HDC) : TColorRef; Override;}
function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; override;
function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; override;
function GetWindowLong(Handle : hwnd; int: Integer): PtrInt; 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 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;
Meshes: Pointer; NumMeshes : Longint; Mode : Longint): Boolean; override;
function HideCaret(hWnd: HWND): Boolean; override;
}
function InvalidateRect(aHandle : HWND; Rect : pRect; bErase : Boolean) : Boolean; override;
procedure InitializeCriticalSection(var CritSection: TCriticalSection); override;
{procedure InitializeCriticalSection(var CritSection: TCriticalSection); override;
function IntersectClipRect(dc: hdc; Left, Top, Right, Bottom: Integer): Integer; override;
function IsWindowEnabled(Handle: HWND): boolean; override;
function IsWindowVisible(Handle: HWND): boolean; override;
@ -148,16 +148,16 @@ function PostMessage(Handle: HWND; Msg: Cardinal; wParam: WParam; lParam: LParam
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 ReleaseCapture : Boolean; override;}
function ReleaseDC(hWnd: HWND; DC: HDC): Integer; override;
function RestoreDC(DC: HDC; SavedDC: 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 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 SendMessage(HandleWnd: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; override;
function SetActiveWindow(Handle: HWND): HWND; override;
function SetBKColor(DC: HDC; Color: TColorRef): TColorRef; override;
function SetBkMode(DC: HDC; bkMode : Integer) : Integer; override;
@ -166,17 +166,19 @@ function SetCaretPos(X, Y: Integer): Boolean; override;
function SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean; override;
function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; override;
function SetCursor(ACursor: HCURSOR): HCURSOR; override;
function SetCursorPos(X, Y: Integer): Boolean; override;
function SetCursorPos(X, Y: Integer): Boolean; override;}
function SetFocus(hWnd: HWND): HWND; override;
function SetForegroundWindow(HWnd: HWND): boolean; override;
function SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean; override;
function SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer; override;
{function SetForegroundWindow(HWnd: HWND): boolean; override;}
function SetParent(hWndChild: HWND; hWndParent: HWND): HWND; override;
{function SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean; override;
function SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer; override;}
function SetTextColor(DC: HDC; Color: TColorRef): TColorRef; override;
function SetWindowOrgEx(DC : HDC; NewX, NewY : Integer; OldPoint: PPoint) : Boolean; override;
function ShowCaret(hWnd: HWND): Boolean; override;
{function ShowCaret(hWnd: HWND): Boolean; override;
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;
@ -184,8 +186,8 @@ function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
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;
function WindowFromPoint(Point: TPoint): HWND; override;}
function UpdateWindow(Handle: HWND): Boolean; override;}
function WindowFromPoint(Point: TPoint): HWND; override;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line

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

@ -28,11 +28,11 @@ interface
uses
// FCL
Classes,
Classes, sysutils,
// Bindings
fpguiwsprivate,
// LCL
Controls, LCLType,
Controls, LCLType, Graphics,
// Widgetset
fpguiproc, WSControls, WSLCLClasses;
@ -59,33 +59,33 @@ type
TFpGuiWSWinControl = class(TWSWinControl)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure Invalidate(const AWinControl: TWinControl); override;
class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
class function GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
public
class function GetClientRect(const AWincontrol: TWinControl;
var ARect: TRect): Boolean; override;
class function GetDefaultClientRect(const AWinControl: TWinControl;
const aLeft, aTop, aWidth, aHeight: integer;
var aClientRect: TRect): Boolean; override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); 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;
class procedure ShowHide(const AWinControl: TWinControl); override; //TODO: rename to SetVisible(control, visible)
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
{ class procedure AddControl(const AControl: TControl); override;
class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;}
class procedure SetChildZPosition(const AWinControl, AChild: TWinControl;
const AOldPos, ANewPos: Integer;
const AChildren: TFPList); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure ConstraintsChange(const AWinControl: TWinControl); override;}
{ class procedure ConstraintsChange(const AWinControl: TWinControl); override;}
end;
{ TFpGuiWSGraphicControl }
@ -116,7 +116,7 @@ type
implementation
uses
fpg_widget;
fpg_widget, fpg_base;
{ TFpGuiWSWinControl }
@ -128,8 +128,8 @@ uses
class function TFpGuiWSWinControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
begin
{$ifdef VerboseFPGUI}
WriteLn('TFpGuiWSWinControl.CreateHandle for ',AWinControl.Name);
{$ifdef VerboseFPGUIIntf}
WriteLn(Self.ClassName,'.CreateHandle ',AWinControl.Name);
{$endif}
Result := TLCLIntfHandle(TFPGUIPrivateWidget.Create(AWinControl, AParams));
@ -157,35 +157,35 @@ var
FPWidget: TfpgWidget;
begin
FPWidget := TFPGUIPrivateWidget(AWinControl.Handle).Widget;
FPWIdget.Invalidate;
end;
class function TFpGuiWSWinControl.GetClientBounds(
const AWincontrol: TWinControl; var ARect: TRect): Boolean;
var
Widget: TFPGWidget;
begin
Widget := TFPGUIPrivateWidget(AWincontrol.Handle).Widget;
if Widget = nil then
Exit;
with Widget do ARect :=Rect(Left, Top, Width, Height);
REsult := True;
FPWidget.Invalidate;
end;
class function TFpGuiWSWinControl.GetClientRect(const AWincontrol: TWinControl;
var ARect: TRect): Boolean;
var
Widget: TFPGWidget;
begin
Widget := TFPGUIPrivateWidget(AWincontrol.Handle).Widget;
TFPGUIPrivateWidget(AWincontrol.Handle).GetClientRect(ARect);
Result:=true;
end;
if Widget = nil then
Exit;
class function TFpGuiWSWinControl.GetDefaultClientRect(
const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer;
var aClientRect: TRect): Boolean;
begin
if AWincontrol.HandleAllocated then begin
TFPGUIPrivateWidget(AWincontrol.Handle).GetDefaultClientRect(aClientRect);
Result:=true;
end else begin
Result:=false;
end;
end;
with Widget do ARect :=Rect(Left, Top, Width, Height);
Result := True;
class procedure TFpGuiWSWinControl.GetPreferredSize(
const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean);
begin
//fpgui widgets does not have a default size (maybe later).
PreferredHeight:=0;
PreferredWidth:=0;
end;
{------------------------------------------------------------------------------
@ -199,11 +199,9 @@ end;
------------------------------------------------------------------------------}
class procedure TFpGuiWSWinControl.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
var
FPWidget: TfpgWidget;
begin
FPWidget := TFPGUIPrivateWidget(AWinControl.Handle).Widget;
FPWIdget.SetPosition(ALeft, ATop, AWidth, AHeight);
TFPGUIPrivateWidget(AWinControl.Handle).SetPosition(ALeft,ATop);
TFPGUIPrivateWidget(AWinControl.Handle).SetSize(AWidth,AHeight);
end;
{------------------------------------------------------------------------------
@ -216,11 +214,8 @@ end;
------------------------------------------------------------------------------}
class procedure TFpGuiWSWinControl.SetPos(const AWinControl: TWinControl;
const ALeft, ATop: Integer);
var
FPWidget: TfpgWidget;
begin
with TFPGUIPrivateWidget(AWinControl.Handle).Widget
do SetPosition(ALeft, ATop, AWinControl.Width, AWinControl.Height);
TFPGUIPrivateWidget(AWinControl.Handle).SetPosition(ALeft,ATop);
end;
{------------------------------------------------------------------------------
@ -233,11 +228,8 @@ end;
------------------------------------------------------------------------------}
class procedure TFpGuiWSWinControl.SetSize(const AWinControl: TWinControl;
const AWidth, AHeight: Integer);
var
FPWidget: TfpgWidget;
begin
FPWidget := TFPGUIPrivateWidget(AWinControl.Handle).Widget;
FPWIdget.SetPosition(AWinControl.Left, AWinControl.Top, AWidth, AHeight);
TFPGUIPrivateWidget(AWinControl.Handle).SetSize(AWidth,AHeight);
end;
{------------------------------------------------------------------------------
@ -252,7 +244,7 @@ var
FPWidget: TfpgWidget;
begin
FPWidget := TFPGUIPrivateWidget(AWinControl.Handle).Widget;
FPWidget.Visible := not FPWidget.Visible;
FPWidget.Visible := AWinControl.Visible;
end;
class procedure TFpGuiWSWinControl.SetColor(const AWinControl: TWinControl);
@ -263,19 +255,6 @@ begin
FPWidget.BackgroundColor := TColorToTfpgColor(AWinControl.Color);
end;
{------------------------------------------------------------------------------
Method: TFpGuiWSWinControl.SetCursor
Params: AWinControl - the calling object
Returns: Nothing
Sets the cursor of the widget.
------------------------------------------------------------------------------}
class procedure TFpGuiWSWinControl.SetCursor(const AWinControl: TWinControl;
const ACursor: HCursor);
begin
end;
class function TFpGuiWSWinControl.GetText(const AWinControl: TWinControl;
var AText: String): Boolean;
var
@ -295,4 +274,13 @@ begin
FPPrivateWidget.SetText(AText);
end;
class procedure TFpGuiWSWinControl.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
var
FPPrivateWidget: TFPGUIPrivateWindow;
begin
FPPrivateWidget := TFPGUIPrivateWindow(AWinControl.Handle);
FPPrivateWidget.Font:=AFont;
end;
end.

10
lcl/interfaces/fpgui/fpguiwsdialogs.pp
View File

@ -46,7 +46,7 @@ type
TFpGuiWSCommonDialog = class(TWSCommonDialog)
private
protected
public
published
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
@ -57,7 +57,7 @@ type
TFpGuiWSFileDialog = class(TWSFileDialog)
private
protected
public
published
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
end;
@ -66,7 +66,7 @@ type
TFpGuiWSOpenDialog = class(TWSOpenDialog)
private
protected
public
published
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
end;
@ -75,7 +75,7 @@ type
TFpGuiWSSaveDialog = class(TWSSaveDialog)
private
protected
public
published
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
end;
@ -108,7 +108,7 @@ type
TFpGuiWSFontDialog = class(TWSFontDialog)
private
protected
public
published
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
end;

24
lcl/interfaces/fpgui/fpguiwsextctrls.pp
View File

@ -50,7 +50,7 @@ type
TFpGuiWSCustomNotebook = class(TWSCustomNotebook)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
@ -181,7 +181,10 @@ type
TFpGuiWSCustomPanel = class(TWSCustomPanel)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
end;
{ TFpGuiWSPanel }
@ -195,7 +198,7 @@ type
{ TFpGuiWSCustomTrayIcon }
TFpGuiWSCustomTrayIcon = class(TWSCustomTrayIcon)
public
published
class function Hide(const ATrayIcon: TCustomTrayIcon): Boolean; override;
class function Show(const ATrayIcon: TCustomTrayIcon): Boolean; override;
class procedure InternalUpdate(const ATrayIcon: TCustomTrayIcon); override;
@ -251,4 +254,19 @@ begin
Result:=inherited GetPosition(ATrayIcon);
end;
{ TFpGuiWSCustomPanel }
class function TFpGuiWSCustomPanel.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
begin
Result := TLCLIntfHandle(TFPGUIPrivateCustomPanel.Create(AWinControl, AParams));
end;
class procedure TFpGuiWSCustomPanel.DestroyHandle(const AWinControl: TWinControl
);
begin
TFPGUIPrivateCustomPanel(AWinControl.Handle).Free;
AWinControl.Handle := 0;
end;
end.

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

@ -121,7 +121,8 @@ end;
function RegisterControl: Boolean; alias : 'WSRegisterControl';
begin
Result := False;
RegisterWSComponent(TControl, TFpGuiWSControl);
Result := True;
end;
function RegisterWinControl: Boolean; alias : 'WSRegisterWinControl';
@ -132,7 +133,7 @@ end;
function RegisterGraphicControl: Boolean; alias : 'WSRegisterGraphicControl';
begin
Result := False;
Result := false;
end;
function RegisterCustomControl: Boolean; alias : 'WSRegisterCustomControl';
@ -251,7 +252,8 @@ end;
function RegisterCustomGroupBox: Boolean; alias : 'WSRegisterCustomGroupBox';
begin
Result := False;
RegisterWSComponent(TCustomGroupBox, TFpGuiWSCustomGroupBox);
Result := True;
end;
function RegisterCustomComboBox: Boolean; alias : 'WSRegisterCustomComboBox';
@ -262,7 +264,8 @@ end;
function RegisterCustomListBox: Boolean; alias : 'WSRegisterCustomListBox';
begin
Result := False;
RegisterWSComponent(TCustomListBox, TFpGuiWSCustomListBox);
Result := True;
end;
function RegisterCustomEdit: Boolean; alias : 'WSRegisterCustomEdit';
@ -273,7 +276,8 @@ end;
function RegisterCustomMemo: Boolean; alias : 'WSRegisterCustomMemo';
begin
Result := False;
RegisterWSComponent(TCustomMemo, TFpGuiWSCustomMemo);
Result := True;
end;
function RegisterButtonControl: Boolean; alias : 'WSRegisterButtonControl';
@ -311,7 +315,7 @@ end;
function RegisterCustomLabel: Boolean; alias : 'WSRegisterCustomLabel';
begin
Result := False;
Result := false;
end;
// extctrls
@ -368,6 +372,7 @@ end;
function RegisterCustomPanel: Boolean; alias : 'WSRegisterCustomPanel';
begin
RegisterWSComponent(TCustomPanel, TFpGuiWSCustomPanel);
Result := False;
end;

32
lcl/interfaces/fpgui/fpguiwsforms.pp
View File

@ -28,9 +28,9 @@ interface
uses
// Bindings
fpg_base, fpg_main, fpguiwsprivate,
fpg_base, fpg_main, fpg_form, fpguiwsprivate,
// LCL
Classes, Forms, LCLType, Controls,
Classes, Forms, LCLType, Controls, Graphics,
// Widgetset
WSForms, WSLCLClasses;
@ -73,7 +73,7 @@ type
TFpGuiWSCustomForm = class(TWSCustomForm)
private
protected
public
published
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
@ -83,6 +83,8 @@ type
class procedure SetFormBorderStyle(const AForm: Forms.TCustomForm;
const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetFont(const AWinControl: TWinControl;
const AFont: TFont); override;
end;
{ TFpGuiWSForm }
@ -135,10 +137,14 @@ var
FPForm: TFPGUIPrivateWindow;
begin
{$ifdef VerboseFPGUIIntf}
WriteLn('TFpGuiWSCustomForm.CreateHandle');
WriteLn(Self.ClassName,'.CreateHandle ',AWinControl.Name);
{$endif}
FPForm := TFPGUIPrivateWindow.Create(AWinControl, AParams);
FPForm.SetFormBorderStyle(TForm(AWinControl).BorderStyle);
if AWinControl.Visible then begin
TfpgForm(FPForm.Widget).Show;
end;
Result := TLCLIntfHandle(FPForm);
end;
@ -150,11 +156,10 @@ end;
class procedure TFpGuiWSCustomForm.DestroyHandle(const AWinControl: TWinControl);
begin
{$ifdef VerboseFPGUIIntf}
WriteLn('TFpGuiWSCustomForm.DestroyHandle');
WriteLn(Self.ClassName,'.DestroyHandle ',AWinControl.Name);
{$endif}
TFPGUIPrivateWindow(AWinControl.Handle).Free;
AWinControl.Handle := 0;
end;
@ -180,11 +185,20 @@ end;
------------------------------------------------------------------------------}
class procedure TFpGuiWSCustomForm.SetFormBorderStyle(const AForm: Forms.TCustomForm;
const AFormBorderStyle: TFormBorderStyle);
//var
// FPForm: TFPGUIPrivateWindow;
var
FPForm: TFPGUIPrivateWindow;
begin
// FPForm := TFPGUIPrivateWindow(AForm.Handle);
FPForm := TFPGUIPrivateWindow(AForm.Handle);
FPForm.SetFormBorderStyle(AFormBorderStyle);
end;
class procedure TFpGuiWSCustomForm.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
var
FPForm: TFPGUIPrivateWindow;
begin
FPForm := TFPGUIPrivateWindow(AWinControl.Handle);
FPForm.Font:=AFont;
end;
{------------------------------------------------------------------------------

58
lcl/interfaces/fpgui/fpguiwsmenus.pp
View File

@ -32,7 +32,7 @@ uses
// widgetset
WSMenus, WSLCLClasses, LCLType, fpguiobjects, fpguiwsprivate,
// interface
fpg_main, fpg_menu;
fpg_base, fpg_main, fpg_menu;
type
@ -41,7 +41,7 @@ type
TFpGuiWSMenuItem = class(TWSMenuItem)
private
protected
public
published
class procedure AttachMenu(const AMenuItem: TMenuItem); override;
class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override;
class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
@ -60,7 +60,7 @@ type
TFpGuiWSMenu = class(TWSMenu)
private
protected
public
published
class function CreateHandle(const AMenu: TMenu): HMENU; override;
// class procedure SetBiDiMode(const AMenu: TMenu; UseRightToLeftAlign, UseRightToLeftReading : Boolean); override;
end;
@ -78,13 +78,16 @@ type
TFpGuiWSPopupMenu = class(TWSPopupMenu)
private
protected
public
published
class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override;
end;
implementation
uses
LCLMessageGlue;
{ TFpGuiWSMenuItem }
class procedure TFpGuiWSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
@ -102,7 +105,8 @@ end;
class function TFpGuiWSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU;
var
Menu: TFPGUIPrivateMenuItem;
AMenuName, hotkeydef: string;
AMenuName: string;
// hotkeydef: string;
{ Possible parents }
ParentPrivateItem: TFPGUIPrivateMenuItem;
ParentMenuBar: TfpgMenuBar;
@ -141,25 +145,26 @@ begin
because TMainMenu uses the special Handle TfpgMenuBar
------------------------------------------------------------------------------}
else
if ((not AMenuItem.Parent.HasParent) and (AMenuItem.GetParentMenu is TMainMenu)) then
begin
if AMenuItem.Parent.HasParent then begin
{------------------------------------------------------------------------------
If the parent has a parent, then that item's Handle is necessarely a TFPGUIPrivateMenuItem
------------------------------------------------------------------------------}
Menu := TFPGUIPrivateMenuItem.Create;
Menu.LCLMenuItem := AMenuItem;
ParentPrivateItem := TFPGUIPrivateMenuItem(AMenuItem.Parent.Handle);
Menu.MenuItem := ParentPrivateItem.MenuItem.SubMenu.AddMenuItem(AMenuName, '', Menu.HandleOnClick);
Result := HMENU(Menu);
end else if (AMenuItem.GetParentMenu is TMainMenu) then begin
Menu := TFPGUIPrivateMenuItem.Create;
Menu.LCLMenuItem := AMenuItem;
ParentMenuBar := TfpgMenuBar(AMenuItem.GetParentMenu.Handle);
Menu.MenuItem := ParentMenuBar.AddMenuItem(AMenuName, Menu.HandleOnClick);
Result := HMENU(Menu);
end
{ ParentPrivatePopUp := TFPGUIPrivatePopUpMenu(LCLMenuItem.Parent.Handle);
MenuItem := ParentPrivatePopUp.PopUpMenu.AddMenuItem(AMenuName, hotkeydef, nil);}
{------------------------------------------------------------------------------
If the parent has a parent, then that item's Handle is necessarely a TFPGUIPrivateMenuItem
------------------------------------------------------------------------------}
else
begin
end else begin
Menu := TFPGUIPrivateMenuItem.Create;
Menu.LCLMenuItem := AMenuItem;
ParentPrivateItem := TFPGUIPrivateMenuItem(AMenuItem.Parent.Handle);
Menu.MenuItem := ParentPrivateItem.MenuItem.SubMenu.AddMenuItem(AMenuName, '', Menu.HandleOnClick);
ParentPrivatePopUp := TFPGUIPrivatePopUpMenu(AMenuItem.GetParentMenu.Handle);
Menu.MenuItem := ParentPrivatePopUp.PopUpMenu.AddMenuItem(AMenuName,'',Menu.HandleOnClick);
Result := HMENU(Menu);
end;
@ -179,30 +184,37 @@ end;
class procedure TFpGuiWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
begin
TFPGUIPrivateMenuItem(AMenuItem.Handle).Free;
AMenuItem.Handle:=0;
end;
class procedure TFpGuiWSMenuItem.SetCaption(const AMenuItem: TMenuItem;
const ACaption: string);
var
APrivate: TfpgMenuItem;
begin
APrivate:=TfpgMenuItem(AMenuItem.Handle);
APrivate.Text:=ACaption;
end;
class procedure TFpGuiWSMenuItem.SetVisible(const AMenuItem: TMenuItem;
const Visible: boolean);
var
APrivate: TfpgMenuItem;
begin
APrivate:=TfpgMenuItem(AMenuItem.Handle);
APrivate.Visible:=Visible;
end;
class function TFpGuiWSMenuItem.SetCheck(const AMenuItem: TMenuItem;
const Checked: boolean): boolean;
begin
Result:=false; //Default by now
end;
class function TFpGuiWSMenuItem.SetEnable(const AMenuItem: TMenuItem;
const Enabled: boolean): boolean;
begin
Result:=false; //Default by now
end;
{ TFpGuiWSMenu }
@ -211,6 +223,7 @@ class function TFpGuiWSMenu.CreateHandle(const AMenu: TMenu): HMENU;
var
MenuBar: TfpgMenuBar;
Menu: TFPGUIPrivatePopUpMenu;
msg: TfpgMessageParams;
begin
{------------------------------------------------------------------------------
If the menu is a main menu, there is no need to create a handle for it.
@ -223,6 +236,9 @@ begin
MenuBar.Align := alTop;
Result := HMENU(MenuBar);
//Notify LCL to repaint because MainMenu changes NCBorders
msg.rect:=MenuBar.Parent.GetBoundsRect;
fpgSendMessage(MenuBar,MenuBar.Parent,FPGM_RESIZE,msg);
end
{------------------------------------------------------------------------------
The menu is a popup menu

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

File diff suppressed because it is too large Load Diff

194
lcl/interfaces/fpgui/fpguiwsstdctrls.pp
View File

@ -30,7 +30,7 @@ uses
// Bindings
fpguiwsprivate,
// LCL
Classes, StdCtrls, Controls, LCLType,
Classes, StdCtrls, Controls, LCLType, sysutils,
// Widgetset
WSStdCtrls, WSLCLClasses;
@ -49,12 +49,15 @@ type
TFpGuiWSCustomGroupBox = class(TWSCustomGroupBox)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
end;
{ TFpGuiWSGroupBox }
TFpGuiWSGroupBox = class(TWSGroupBox)
TFpGuiWSGroupBox = class(TWSCustomGroupBox)
private
protected
public
@ -65,11 +68,11 @@ type
TFpGuiWSCustomComboBox = class(TWSCustomComboBox)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
public
{ class function GetSelStart(const ACustomComboBox: TCustomComboBox): integer; override;
class function GetSelLength(const ACustomComboBox: TCustomComboBox): integer; override;}
class function GetItemIndex(const ACustomComboBox: TCustomComboBox): integer; override;
@ -77,6 +80,8 @@ type
class procedure SetArrowKeysTraverseList(const ACustomComboBox: TCustomComboBox;
NewTraverseList: boolean); virtual;
class procedure SetDroppedDown(const ACustomComboBox: TCustomComboBox;
ADroppedDown: Boolean); override;
class procedure SetSelStart(const ACustomComboBox: TCustomComboBox; NewStart: integer); override;
class procedure SetSelLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;}
class procedure SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer); override;
@ -84,10 +89,8 @@ type
class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); override;
class procedure SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); override;}
class function GetItems(const ACustomComboBox: TCustomComboBox): TStrings; override;
class function GetItems(const ACustomComboBox: TCustomComboBox): TStrings; override;
class procedure FreeItems(var AItems: TStrings); override;
// class procedure Sort(const ACustomComboBox: TCustomComboBox; AList: TStrings; IsSorted: boolean); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
end;
{ TFpGuiWSComboBox }
@ -103,7 +106,13 @@ type
TFpGuiWSCustomListBox = class(TWSCustomListBox)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class function GetStrings(const ACustomListBox: TCustomListBox
): TStrings; override;
class procedure FreeStrings(var AStrings: TStrings); override;
class procedure SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer); override;
end;
{ TFpGuiWSListBox }
@ -119,25 +128,10 @@ type
TFpGuiWSCustomEdit = class(TWSCustomEdit)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
public
{ class function GetSelStart(const ACustomEdit: TCustomEdit): integer; override;
class function GetSelLength(const ACustomEdit: TCustomEdit): integer; override;
class procedure SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); override;
class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
class procedure SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char); override;
class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); override;
class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); override;
class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer); override;}
// class procedure SetColor(const AWinControl: TWinControl); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
end;
{ TFpGuiWSCustomMemo }
@ -145,19 +139,14 @@ type
TFpGuiWSCustomMemo = class(TWSCustomMemo)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
public
{ class procedure AppendText(const ACustomMemo: TCustomMemo; const AText: string); override;
class procedure SetAlignment(const ACustomMemo: TCustomMemo; const AAlignment: TAlignment); override;}
class function GetStrings(const ACustomMemo: TCustomMemo): TStrings; override;
class procedure FreeStrings(var AStrings: TStrings); override;
{ class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override;
class procedure SetWantReturns(const ACustomMemo: TCustomMemo; const NewWantReturns: boolean); override;
class procedure SetWantTabs(const ACustomMemo: TCustomMemo; const NewWantTabs: boolean); override;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;}
class procedure ShowHide(const AWinControl: TWinControl); override;
end;
{ TFpGuiWSEdit }
@ -189,13 +178,12 @@ type
TFpGuiWSButton = class(TWSButton)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure Invalidate(const AWinControl: TWinControl); override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
end;
{ TFpGuiWSCustomCheckBox }
@ -203,18 +191,18 @@ type
TFpGuiWSCustomCheckBox = class(TWSCustomCheckBox)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class function RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; override;
class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox;
const OldShortCut, NewShortCut: TShortCut); override;
class procedure SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
end;
{ TFpGuiWSCheckBox }
@ -238,19 +226,19 @@ type
TFpGuiWSRadioButton = class(TWSRadioButton)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class function RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; override;
class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox;
const OldShortCut, NewShortCut: TShortCut); override;
class procedure SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
end;
{ TFpGuiWSCustomStaticText }
@ -276,7 +264,9 @@ uses
fpg_combobox,
fpg_edit,
fpg_checkbox,
fpg_radiobutton;
fpg_radiobutton,
fpg_listbox,
fpg_panel;
{ TFpGuiWSCustomComboBox }
@ -323,9 +313,9 @@ begin
end;
{------------------------------------------------------------------------------
Method: TQtWSCustomComboBox.SetItemIndex
Params: None
Returns: The state of the control
Method: TFpGuiWSCustomComboBox.SetItemIndex
Params: Item index in combo
Returns: Nothing
------------------------------------------------------------------------------}
class procedure TFpGuiWSCustomComboBox.SetItemIndex(
const ACustomComboBox: TCustomComboBox; NewIndex: integer);
@ -338,9 +328,9 @@ begin
end;
{------------------------------------------------------------------------------
Method: TQtWSCustomComboBox.GetItems
Method: TFpGuiWSCustomComboBox.GetItems
Params: None
Returns: The state of the control
Returns: Returns a TStrings controlling the combo items
------------------------------------------------------------------------------}
class function TFpGuiWSCustomComboBox.GetItems(
const ACustomComboBox: TCustomComboBox): TStrings;
@ -354,14 +344,8 @@ end;
class procedure TFpGuiWSCustomComboBox.FreeItems(var AItems: TStrings);
begin
end;
class procedure TFpGuiWSCustomComboBox.ShowHide(const AWinControl: TWinControl
);
begin
inherited ShowHide(AWinControl);
TFPGUIPrivateComboBox(AWinControl.Handle).Widget.Visible := AWinControl.Visible;
//Widgetset atomatically frees the items, so override
//and do not call inherited.
end;
{ TFpGuiWSCustomEdit }
@ -377,12 +361,6 @@ begin
Result := TLCLIntfHandle(TFPGUIPrivateEdit.Create(AWinControl, AParams));
end;
class procedure TFpGuiWSCustomEdit.ShowHide(const AWinControl: TWinControl);
begin
inherited ShowHide(AWinControl);
TFPGUIPrivateEdit(AWinControl.Handle).Widget.Visible := AWinControl.Visible;
end;
{ TFpGuiWSButton }
{------------------------------------------------------------------------------
@ -408,12 +386,6 @@ begin
TFPGUIPrivateButton(AWinControl.Handle).SetText(AText);
end;
class procedure TFpGuiWSButton.ShowHide(const AWinControl: TWinControl);
begin
inherited ShowHide(AWinControl);
TFPGUIPrivateButton(AWinControl.Handle).Widget.Visible := AWinControl.Visible;
end;
{------------------------------------------------------------------------------
Method: TFpGuiWSButton.CreateHandle
Params: None
@ -430,7 +402,6 @@ end;
class procedure TFpGuiWSButton.DestroyHandle(const AWinControl: TWinControl);
begin
TFPGUIPrivateButton(AWinControl.Handle).Free;
AWinControl.Handle := 0;
end;
@ -455,13 +426,6 @@ begin
Result := cbUnchecked;
end;
class procedure TFpGuiWSCustomCheckBox.SetShortCut(
const ACustomCheckBox: TCustomCheckBox; const OldShortCut,
NewShortCut: TShortCut);
begin
end;
class procedure TFpGuiWSCustomCheckBox.SetState(
const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState);
var
@ -495,11 +459,11 @@ begin
vCheckBox.Text := AText;
end;
class procedure TFpGuiWSCustomCheckBox.ShowHide(const AWinControl: TWinControl
);
class procedure TFpGuiWSCustomCheckBox.GetPreferredSize(
const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean);
begin
inherited ShowHide(AWinControl);
TFPGUIPrivateCheckBox(AWinControl.Handle).Widget.Visible := AWinControl.Visible;
TFPGUIPrivateCheckBox(AWinControl.Handle).GetPreferredSize(PreferredWidth,PreferredHeight,WithThemeSpace);
end;
class function TFpGuiWSCustomCheckBox.CreateHandle(
@ -532,13 +496,6 @@ begin
Result := cbUnchecked;
end;
class procedure TFpGuiWSRadioButton.SetShortCut(
const ACustomCheckBox: TCustomCheckBox; const OldShortCut,
NewShortCut: TShortCut);
begin
end;
class procedure TFpGuiWSRadioButton.SetState(
const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState);
var
@ -572,10 +529,11 @@ begin
vRadioButton.Text := AText;
end;
class procedure TFpGuiWSRadioButton.ShowHide(const AWinControl: TWinControl);
class procedure TFpGuiWSRadioButton.GetPreferredSize(
const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean);
begin
inherited ShowHide(AWinControl);
TFPGUIPrivateRadioButton(AWinControl.Handle).Widget.Visible := AWinControl.Visible;
TFPGUIPrivateRadioButton(AWinControl.Handle).GetPreferredSize(PreferredWidth,PreferredHeight,WithThemeSpace);
end;
class function TFpGuiWSRadioButton.CreateHandle(const AWinControl: TWinControl;
@ -596,23 +554,67 @@ end;
class function TFpGuiWSCustomMemo.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
begin
Result:=inherited CreateHandle(AWinControl, AParams);
Result := TLCLIntfHandle(TFPGUIPrivateMemo.Create(AWinControl, AParams));
end;
class function TFpGuiWSCustomMemo.GetStrings(const ACustomMemo: TCustomMemo): TStrings;
var
PrivateMemo: TFPGUIPrivateMemo;
begin
Result:=inherited GetStrings(ACustomMemo);
PrivateMemo := TFPGUIPrivateMemo(ACustomMemo.Handle);
Result:=PrivateMemo.GetStrings;
end;
class procedure TFpGuiWSCustomMemo.FreeStrings(var AStrings: TStrings);
begin
//Do nothing, autofree by fpguimemo
end;
class procedure TFpGuiWSCustomMemo.ShowHide(const AWinControl: TWinControl);
{ TFpGuiWSListBox }
class function TFpGuiWSCustomListBox.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
begin
inherited ShowHide(AWinControl);
TFPGUIPrivateMemo(AWinControl.Handle).Widget.Visible := AWinControl.Visible;
Result := TLCLIntfHandle(TFPGUIPrivateListBox.Create(AWinControl, AParams));
end;
class function TFpGuiWSCustomListBox.GetStrings(
const ACustomListBox: TCustomListBox): TStrings;
var
FListBox: TfpgListBox;
begin
FListBox := TFPGUIPrivateListBox(ACustomListBox.Handle).ListBox;
Result := FListBox.Items;
end;
class procedure TFpGuiWSCustomListBox.FreeStrings(var AStrings: TStrings);
begin
//Do nothing, autofree by fpguilistbox
end;
class procedure TFpGuiWSCustomListBox.SetItemIndex(
const ACustomListBox: TCustomListBox; const AIndex: integer);
var
PrivateListBox: TFPGUIPrivateListBox;
begin
PrivateListBox:=TFPGUIPrivateListBox(ACustomListBox.Handle);
PrivateListBox.ItemIndex:=AIndex;
end;
{ TFpGuiWSCustomGroupBox }
class function TFpGuiWSCustomGroupBox.CreateHandle(
const AWinControl: TWinControl; const AParams: TCreateParams
): TLCLIntfHandle;
begin
Result := TLCLIntfHandle(TFPGUIPrivateGroupBox.Create(AWinControl, AParams));
end;
class procedure TFpGuiWSCustomGroupBox.DestroyHandle(
const AWinControl: TWinControl);
begin
TFPGUIPrivateGroupBox(AWinControl.Handle).Free;
AWinControl.Handle := 0;
end;
end.