paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-01 10:47:15 +01:00
Code Issues Packages Projects Releases Wiki Activity

qt intf: implements TBitmap (and all other image classes), Dialogs, font fix, ShowModal and much else for Qt from Felipe

Browse Source 
git-svn-id: trunk@10053 -
This commit is contained in:
mattias 2006-10-10 07:00:47 +00:00
parent 2c2803d0c2
commit d26a428920
15 changed files with 1348 additions and 3068 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/interfaces/qt/qtint.pp
View File

@ -34,7 +34,9 @@ interface
{$endif}
uses
qt4, // Must be the first unit to avoid type redefinition problems on Windows
// Bindings - qt4 must come first to avoid type redefinition problems on Windows
qt4,
// LCL
Types, InterfaceBase, SysUtils, LCLProc, LCLType, LMessages, Classes,
Controls, ExtCtrls, Forms, Dialogs, StdCtrls, Comctrls, LCLIntf,
GraphType, Math;
@ -120,7 +122,7 @@ uses
QtWSControls,
// QtWSDbCtrls,
// QtWSDBGrids,
// QtWSDialogs,
QtWSDialogs,
// QtWSDirSel,
// QtWSEditBtn,
QtWSExtCtrls,
@ -137,7 +139,8 @@ uses
// QtWSToolwin,
////////////////////////////////////////////////////
Graphics, buttons, Menus,
qtprivate, qtobjects;
// Bindings
qtprivate, qtwidgets, qtobjects;
const

18
lcl/interfaces/qt/qtlclintf.inc
View File

@ -36,7 +36,7 @@ begin
Desc.Format := ricfRGBA;
Desc.HasPalette := False;
Desc.Depth := 32;
// Desc.Depth := 32;
// Width and Height not relevant
Desc.PaletteColorCount := 0;
Desc.BitOrder := riboReversedBits;
@ -45,10 +45,20 @@ begin
Desc.ColorCount := Desc.PaletteColorCount;
Desc.BitsPerPixel := 32;
Desc.LineEnd := rileDWordBoundary;
// FillRawImageDescriptionColors(Desc);
Desc.AlphaPrec := 1;
// 0-8-8-8 mode, high byte is not used
Desc.RedPrec := 8;
Desc.GreenPrec := 8;
Desc.BluePrec := 8;
Desc.RedShift := 16;
Desc.GreenShift := 8;
Desc.BlueShift := 0;
Desc.Depth := 24;
Desc.AlphaPrec := 0;
Desc.AlphaSeparate := False;
// CreateBitmap winapi call wants word-aligned data
// Qt wants dword-aligned data
Desc.AlphaLineEnd := rileDWordBoundary;
Desc.AlphaShift := 0;
end;

988
lcl/interfaces/qt/qtobjects.pas
View File

File diff suppressed because it is too large Load Diff

2864
lcl/interfaces/qt/qtprivate.pp
View File

File diff suppressed because it is too large Load Diff

260
lcl/interfaces/qt/qtwinapi.inc
View File

@ -41,7 +41,7 @@
function TQtWidgetSet.BeginPaint(Handle: hWnd; Var PS : TPaintStruct): hdc;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI BeginPaint] Handle=', dbgs(Handle));
WriteLn('Trace:> [WinAPI BeginPaint] Handle=', dbgs(Handle));
{$endif}
{ if IsDoubleBuffered then
@ -53,6 +53,10 @@ begin
if Handle <> 0 then TQtMainWindow(Handle).Canvas := TQtDeviceContext(PS.hdc);
Result := PS.hdc;
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:< [WinAPI BeginPaint] Result=', dbgs(Result));
{$endif}
end;
{------------------------------------------------------------------------------
@ -101,7 +105,9 @@ function TQtWidgetSet.CreateBitmapFromRawImage(const RawImage: TRawImage;
var Bitmap, MaskBitmap: HBitmap; AlwaysCreateMask: boolean): boolean;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI CreateBitmapFromRawImage]');
WriteLn('Trace:> [WinAPI CreateBitmapFromRawImage]',
' Width:', dbgs(RawImage.Description.Width),
' Height:', dbgs(RawImage.Description.Height));
{$endif}
Result := False;
@ -109,9 +115,13 @@ begin
MaskBitmap := 0;
Bitmap := HBitmap(TQtImage.Create(RawImage.Data, RawImage.Description.Width,
RawImage.Description.Height, QImageFormat_ARGB32));
RawImage.Description.Height, QImageFormat_RGB32, RawImage.DataSize));
Result := True;
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:< [WinAPI CreateBitmapFromRawImage] Bitmap:', dbgs(Integer(Bitmap)));
{$endif}
end;
{------------------------------------------------------------------------------
@ -313,6 +323,7 @@ var
begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:> [WinAPI DeleteObject] GDIObject: ', IntToStr(GDIObject));
ObjType := 'Unidentifyed';
{$endif}
Result := False;
@ -339,6 +350,9 @@ begin
aObject := TObject(GDIObject);
{------------------------------------------------------------------------------
Font
------------------------------------------------------------------------------}
if aObject is TQtFont then
begin
{$ifdef VerboseQtWinAPI}
@ -346,12 +360,24 @@ begin
{$endif}
end
{------------------------------------------------------------------------------
Brush
------------------------------------------------------------------------------}
else if aObject is TQtBrush then
begin
{$ifdef VerboseQtWinAPI}
ObjType := 'Brush';
{$endif}
end
{------------------------------------------------------------------------------
Image
------------------------------------------------------------------------------}
else if aObject is TQtImage then
begin
{$ifdef VerboseQtWinAPI}
ObjType := 'Image';
{$endif}
end;
// Find out if we want to release internal GDI object
@ -481,17 +507,32 @@ end;
Params: none
Returns: The handle of the window with focus
The GetFocus function retrieves the handle of the window that has the focus.
Describes the inner format utilized by Qt + the specific information for this image
------------------------------------------------------------------------------}
function TQtWidgetSet.GetBitmapRawImageDescription(Bitmap: HBITMAP;
Desc: PRawImageDescription): Boolean;
var
BitmapInfo: TDIBSECTION;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI GetBitmapRawImageDescription]');
WriteLn('[WinAPI GetBitmapRawImageDescription] Bitmap=', dbgs(Bitmap));
{$endif}
Result := true;
FillStandardDescription(Desc^);
GetObject(Bitmap, SizeOf(BitmapInfo), @BitmapInfo);
Desc^.Width := BitmapInfo.dsBm.bmWidth;
Desc^.Height := BitmapInfo.dsBm.bmHeight;
// Desc^.BitOrder := riboReversedBits;
// Desc^.ByteOrder := riboLSBFirst;
// Desc^.LineOrder := riloTopToBottom;
// Desc^.ColorCount := 0; // entries in color palette. Ignore when no palette.
// Desc^.BitsPerPixel := BitmapInfo.bmBitsPixel; // bits per pixel. can be greater than Depth.
// Desc^.LineEnd := rileDWordBoundary;
end;
{------------------------------------------------------------------------------
@ -578,38 +619,184 @@ end;
function TQtWidgetSet.GetDC(hWnd: HWND): HDC;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI GetDC] hWnd: ', IntToStr(hWnd));
WriteLn('Trace:> [WinAPI GetDC] hWnd: ', IntToStr(hWnd));
{$endif}
Result := HDC(TQtDeviceContext.Create(0));
// if hWnd <> 0 then TQtCustomForm(hWnd).Canvas := TQtDeviceContext(Result);
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:< [WinAPI GetDC] Result: ', dbgs(Result));
{$endif}
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.GetDeviceRawImageDescription
Params: none
Returns: The handle of the window with focus
Returns: True if successful
The GetFocus function retrieves the handle of the window that has the focus.
Describes the standard format utilized by Qt
------------------------------------------------------------------------------}
function TQtWidgetSet.GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI GetDeviceRawImageDescription]');
WriteLn('[WinAPI GetDeviceRawImageDescription] DC: ' + IntToStr(DC));
{$endif}
Result := true;
FillStandardDescription(Desc^);
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.GetObject
Params: none
Returns: The size written to the buffer
Necessary for TBitmap support
------------------------------------------------------------------------------}
function TQtWidgetSet.GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer;
var
aObject: TObject;
Width, Height: Longint;
BitmapSection : TDIBSECTION;
{$ifdef VerboseQtWinAPI}
ObjType: string;
{$endif}
begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:> [WinAPI GetObject] GDIObj: ' + IntToStr(GDIObj));
ObjType := '';
{$endif}
Result := 0;
if not IsValidGDIObject(GDIObj) then
begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:< [WinAPI GetObject] Invalid GDI Object');
{$endif}
Exit;
end;
aObject := TObject(GDIObj);
{------------------------------------------------------------------------------
Font
------------------------------------------------------------------------------}
if aObject is TQtFont then
begin
{$ifdef VerboseQtWinAPI}
ObjType := 'Font';
{$endif}
end
{------------------------------------------------------------------------------
Brush
------------------------------------------------------------------------------}
else if aObject is TQtBrush then
begin
{$ifdef VerboseQtWinAPI}
ObjType := 'Brush';
{$endif}
end
{------------------------------------------------------------------------------
Image
------------------------------------------------------------------------------}
else if aObject is TQtImage then
begin
{$ifdef VerboseQtWinAPI}
ObjType := 'Image';
{$endif}
if Buf = nil then Result := SizeOf(TDIBSECTION)
else
begin
Width := 200;
Height := 200;
FillChar(BitmapSection, SizeOf(TDIBSECTION), 0);
{dsBM - BITMAP}
BitmapSection.dsBm.bmType := $4D42;
BitmapSection.dsBm.bmWidth := Width;
BitmapSection.dsBm.bmHeight := Height;
BitmapSection.dsBm.bmWidthBytes := 0;
BitmapSection.dsBm.bmPlanes := 1;//Does Bitmap Format support more?
BitmapSection.dsBm.bmBitsPixel := 1;
BitmapSection.dsBm.bmBits := nil;
{dsBmih - BITMAPINFOHEADER}
BitmapSection.dsBmih.biSize := 40;
BitmapSection.dsBmih.biWidth := Width;
BitmapSection.dsBmih.biHeight := Height;
BitmapSection.dsBmih.biPlanes := BitmapSection.dsBm.bmPlanes;
BitmapSection.dsBmih.biBitCount := 1;
BitmapSection.dsBmih.biCompression := 0;
BitmapSection.dsBmih.biSizeImage := 0;
BitmapSection.dsBmih.biXPelsPerMeter := 0;
BitmapSection.dsBmih.biYPelsPerMeter := 0;
BitmapSection.dsBmih.biClrUsed := 0;
BitmapSection.dsBmih.biClrImportant := 0;
{ case GDIBitmapType of
gbBitmap:
If GDIBitmapObject <> nil then begin
GDK_WINDOW_GET_SIZE(GDIBitmapObject, @biWidth, @biHeight);
NumColors := 2;
biBitCount := 1;
end;
gbPixmap:
If GDIPixmapObject <> nil then begin
biBitCount := word(gdk_drawable_get_depth(GDIPixmapObject));
gdk_drawable_get_size(GDIPixmapObject,@biWidth, @biHeight);
end;
end;}
BitmapSection.dsBmih.biBitCount := 32;
// biSizeImage := (((biBitCount*biWidth+31) shr 5) shl 2)*biHeight;
// BitmapSection.dsBmih.biXPelsPerMeter := ;
// BitmapSection.dsBmih.biYPelsPerMeter := ;
// BitmapSection.dsBm.bmHeight := bmWidth := biWidth;
// bmHeight := biHeight;
// bmBitsPixel := biBitCount;
{dsBitfields: array[0..2] of DWORD;
dshSection: THandle;
dsOffset: DWORD;}
if BufSize >= SizeOf(BitmapSection) then
begin
PDIBSECTION(Buf)^ := BitmapSection;
Result := SizeOf(TDIBSECTION);
end
else if BufSize > 0 then
begin
Move(BitmapSection, Buf^, BufSize);
Result := BufSize;
end;
end;
end;
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:< [WinAPI GetObject] Result=', dbgs(Result), ' ObjectType=', ObjType);
{$endif}
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.GetRawImageFromDevice
Params: none
Returns: The handle of the window with focus
Returns: True if successful
The GetFocus function retrieves the handle of the window that has the focus.
------------------------------------------------------------------------------}
function TQtWidgetSet.GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect;
var NewRawImage: TRawImage): boolean;
@ -622,41 +809,20 @@ begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI GetRawImageFromDevice]');
{$endif}
Result:=false;
FillChar(NewRawImage, SizeOf(NewRawImage), 0);
// make bitmap compatible to src device
SrcWidth := SrcRect.Right - SrcRect.Left;
SrcHeight := SrcRect.Bottom - SrcRect.Top;
{ hMemBitmap := Windows.CreateCompatibleBitmap(SrcDC, SrcWidth, SrcHeight);
Result := hMemBitmap <> 0;
if not Result then exit;}
// make memory device context compatible to device, to select bitmap in for copying
{ hMemDC := Windows.CreateCompatibleDC(SrcDC);
Result := hMemDC <> 0;
hOldObject := Windows.SelectObject(hMemDC, hMemBitmap);}
// copy srcdc -> membitmap
{ Result := Result and Windows.BitBlt(hMemDC, 0, 0, SrcWidth, SrcHeight,
SrcDC, SrcRect.Left, SrcRect.Top, SRCCOPY);
// done copying, deselect bitmap from dc
Windows.SelectObject(hMemDC, hOldObject);
// copy membitmap -> rawimage
Result := Result and GetRawImageFromBitmap(hMemBitmap, 0,
Rect(0, 0, SrcWidth, SrcHeight), NewRawImage);
// free temporary stuff
Windows.DeleteDC(hMemDC);
Windows.DeleteObject(hMemBitmap);}
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.GetRawImageFromBitmap
Params: none
Returns: The handle of the window with focus
Returns: True if successful
Creates a raw image from a bitmap
------------------------------------------------------------------------------}
@ -1375,7 +1541,7 @@ end;
function TQtWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI ReleaseDC]');
WriteLn('[WinAPI ReleaseDC] hWnd: ', dbgs(hWnd), ' DC: ', dbgs(DC));
{$endif}
Result := 0;
@ -1449,7 +1615,9 @@ begin
ObjType := 'Image';
{$endif}
// Result := HGDIOBJ(TQtDeviceContext(DC).brush);
Result := HGDIOBJ(TQtDeviceContext(DC).vImage);
TQtDeviceContext(DC).vImage := TQtImage(aObject).Handle;
end;
{$ifdef VerboseQtWinAPI}
@ -1592,11 +1760,27 @@ end;
function TQtWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP;
XMask, YMask: Integer; Rop: DWORD): Boolean;
var
SrcRect, DstRect: TRect;
Image: QImageH;
begin
DstRect := Bounds(X, Y, Width, Height);
SrcRect := Bounds(XSrc, YSrc, SrcWidth, SrcHeight);
Image := TQtDeviceContext(SrcDC).vImage;
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI StretchMaskBlt] DestDC:', IntToStr(DestDC), ' SrcDC:', IntToStr(SrcDC));
WriteLn('[WinAPI StretchMaskBlt] DestDC:', dbgs(DestDC), ' SrcDC:', dbgs(SrcDC),
' Image:', dbgs(Integer(Image)),
' X:', dbgs(X), ' Y:', dbgs(Y),
' W:', dbgs(Width), ' H:', dbgs(Height),
' XSrc:', dbgs(XSrc), ' YSrc:', dbgs(YSrc),
' WSrc:', dbgs(SrcWidth), ' HSrc:', dbgs(SrcHeight));
{$endif}
TQtDeviceContext(DestDC).drawImage(@DstRect, Image, @SrcRect);
Result := True;
end;

1
lcl/interfaces/qt/qtwinapih.inc
View File

@ -51,6 +51,7 @@ Function GetClipRGN(DC: hDC; RGN: hRGN): Longint; override;
function GetCursorPos(var lpPoint: TPoint ): Boolean; override;
function GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; override;
function GetDC(hWnd: HWND): HDC; override;
function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; override;
function GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; override;
function GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; Override;
function GetSysColor(nIndex: Integer): DWORD; override;

2
lcl/interfaces/qt/qtwsbuttons.pp
View File

@ -28,7 +28,7 @@ interface
uses
// Libs
qt4, qtprivate,
qt4, qtwidgets,
// LCL
SysUtils, Controls, LCLType, Forms, InterfaceBase, Buttons, LMessages,
// Widgetset

13
lcl/interfaces/qt/qtwscomctrls.pp
View File

@ -27,14 +27,11 @@ unit QtWSComCtrls;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
ComCtrls, Controls, LCLType, qtprivate, qt4,
////////////////////////////////////////////////////
// Bindings
qt4, qtwidgets,
// LCL
ComCtrls, Controls, LCLType,
// Widgetset
WSComCtrls, WSLCLClasses;
type

2
lcl/interfaces/qt/qtwscontrols.pp
View File

@ -28,7 +28,7 @@ interface
uses
// Bindings
qt4, qtprivate,
qt4, qtwidgets,
// LCL
SysUtils, Controls, LCLType, Forms, Graphics,
// Widgetset

167
lcl/interfaces/qt/qtwsdialogs.pp
View File

@ -22,19 +22,16 @@
}
unit QtWSDialogs;
{$mode objfpc}{$H+}
{$mode delphi}{$H+}
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Dialogs,
////////////////////////////////////////////////////
// Libs
qt4, qtobjects,
// LCL
SysUtils, Classes, Dialogs, Controls,
// Widgetset
WSDialogs, WSLCLClasses;
type
@ -45,6 +42,9 @@ type
private
protected
public
class function CreateHandle(const ACommonDialog: TCommonDialog): integer; override;
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
end;
{ TQtWSFileDialog }
@ -106,6 +106,151 @@ type
implementation
{ TQtWSCommonDialog }
class function TQtWSCommonDialog.CreateHandle(const ACommonDialog: TCommonDialog): integer;
begin
Result := 1000;
end;
class procedure TQtWSCommonDialog.ShowModal(const ACommonDialog: TCommonDialog);
var
Caption, Dir, Filter, selectedFilter, ReturnText: WideString;
FileDialog: TFileDialog;
options: QFileDialogOptions;
Parent: QWidgetH;
ReturnList: QStringListH;
ParserState, Position, i: Integer;
Strings: TStringList;
ReturnFont, CurrentFont: QFontH;
ReturnBool: Boolean;
begin
{------------------------------------------------------------------------------
Initialization of the dialog´s options
------------------------------------------------------------------------------}
Parent := QWidgetH(TWinControl(ACommonDialog.Owner).Handle);
ReturnText := '';
Caption := WideString(ACommonDialog.Title);
if ACommonDialog is TFileDialog then
begin
FileDialog := TFileDialog(ACommonDialog);
Dir := WideString(FileDialog.InitialDir);
Filter := WideString(FileDialog.Filter);
{------------------------------------------------------------------------------
This is a parser that converts LCL filter strings to Qt filter strings
A LCL filter string looks like this:
Text files|*.txt *.pas|Binaries|*.exe
And a Qt filter string looks like this:
Text files (*.txt *.pas)
Binaries (*.exe)
------------------------------------------------------------------------------}
ParserState := 0;
Position := 1;
for i := 1 to Length(FileDialog.Filter) do
begin
if Copy(FileDialog.Filter, i, 1) = '|' then
begin
ParserState := ParserState + 1;
if ParserState = 1 then
Filter := Filter + Copy(FileDialog.Filter, Position, i - Position) + ' '
else if ParserState = 2 then
begin
Filter := Filter + '(' + Copy(FileDialog.Filter, Position, i - Position) + ')' + LineEnding;
ParserState := 0;
end;
if i <> Length(FileDialog.Filter) then Position := i + 1;
end;
end;
Filter := Filter + '(' + Copy(FileDialog.Filter, Position, i + 1 - Position) + ')';
{------------------------------------------------------------------------------
Sets the selected filter
------------------------------------------------------------------------------}
Strings := TStringList.Create;
try
Strings.Text := Filter;
if FileDialog.FilterIndex < Strings.Count then
selectedFilter := Strings.Strings[FileDialog.FilterIndex];
finally
Strings.Free;
end;
{------------------------------------------------------------------------------
Qt doesn´t have most of the dialog options available on LCL
------------------------------------------------------------------------------}
options := 0;
end;
{------------------------------------------------------------------------------
Code to call the dialog
------------------------------------------------------------------------------}
if ACommonDialog is TOpenDialog then
begin
if ofAllowMultiSelect in TOpenDialog(ACommonDialog).Options then
QFileDialog_getOpenFileNames(ReturnList, Parent, @Caption, @Dir, @Filter, @selectedFilter, options)
else
QFileDialog_getOpenFileName(@ReturnText, Parent, @Caption, @Dir, @Filter, @selectedFilter, options);
FileDialog.FileName := string(ReturnText);
if ReturnText = '' then ACommonDialog.UserChoice := mrCancel
else ACommonDialog.UserChoice := mrOK;
end
else if ACommonDialog is TSaveDialog then
begin
if ofOverwritePrompt in TSaveDialog(ACommonDialog).Options then
options := options or QFileDialogDontConfirmOverwrite;
QFileDialog_getSaveFileName(@ReturnText, Parent, @Caption, @Dir, @Filter, @selectedFilter, options);
if ReturnText = '' then ACommonDialog.UserChoice := mrCancel
else ACommonDialog.UserChoice := mrOK;
end
else if ACommonDialog is TSelectDirectoryDialog then
begin
QFileDialog_getExistingDirectory(@ReturnText, Parent, @Caption, @Dir);
if ReturnText = '' then ACommonDialog.UserChoice := mrCancel
else ACommonDialog.UserChoice := mrOK;
end
else if ACommonDialog is TColorDialog then
begin
end
else if ACommonDialog is TFontDialog then
begin
CurrentFont := TQtFont(TFontDialog(ACommonDialog).Font.Handle).Widget;
QFontDialog_getFont(ReturnFont, @ReturnBool, CurrentFont, Parent);
if ReturnBool then ACommonDialog.UserChoice := mrOk
else ACommonDialog.UserChoice := mrCancel;
end;
end;
class procedure TQtWSCommonDialog.DestroyHandle(const ACommonDialog: TCommonDialog);
begin
end;
initialization
////////////////////////////////////////////////////
@ -114,7 +259,7 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TCommonDialog, TQtWSCommonDialog);
RegisterWSComponent(TCommonDialog, TQtWSCommonDialog);
// RegisterWSComponent(TFileDialog, TQtWSFileDialog);
// RegisterWSComponent(TOpenDialog, TQtWSOpenDialog);
// RegisterWSComponent(TSaveDialog, TQtWSSaveDialog);
@ -123,4 +268,4 @@ initialization
// RegisterWSComponent(TColorButton, TQtWSColorButton);
// RegisterWSComponent(TFontDialog, TQtWSFontDialog);
////////////////////////////////////////////////////
end.
end.

2
lcl/interfaces/qt/qtwsextctrls.pp
View File

@ -28,7 +28,7 @@ interface
uses
// Bindings
qt4, qtprivate,
qt4, qtwidgets,
// LCL
SysUtils, Controls, LCLType, Forms, ExtCtrls,
// Widgetset

61
lcl/interfaces/qt/qtwsforms.pp
View File

@ -28,7 +28,7 @@ interface
uses
// Bindings
qt4, qtprivate,
qt4, qtwidgets,
// LCL
SysUtils, Controls, LCLType, Forms,
// Widgetset
@ -81,13 +81,14 @@ type
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
{ class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); override;
class procedure CloseModal(const ACustomForm: TCustomForm); override;
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
class procedure ShowModal(const ACustomForm: TCustomForm); override;
class procedure SetBorderIcons(const AForm: TCustomForm;
const ABorderIcons: TBorderIcons); override;}
const ABorderIcons: TBorderIcons); override;
end;
{ TQtWSForm }
@ -221,6 +222,56 @@ begin
TQtWidget(AWinControl.Handle).SetWindowTitle(@Str);
end;
class procedure TQtWSCustomForm.CloseModal(const ACustomForm: TCustomForm);
begin
inherited CloseModal(ACustomForm);
end;
class procedure TQtWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle);
begin
inherited SetFormBorderStyle(AForm, AFormBorderStyle);
end;
class procedure TQtWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
begin
inherited SetIcon(AForm, AIcon);
end;
class procedure TQtWSCustomForm.SetShowInTaskbar(const AForm: TCustomForm;
const AValue: TShowInTaskbar);
begin
inherited SetShowInTaskbar(AForm, AValue);
end;
{------------------------------------------------------------------------------
Method: TQtWSCustomForm.ShowModal
Params:
Returns: Nothing
------------------------------------------------------------------------------}
class procedure TQtWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
var
QtDialog: TQtDialog;
begin
QtDialog := TQtDialog.Create;
try
TQtWidget(ACustomForm.Handle).setParent(QtDialog.Widget);
if QtDialog.exec = Integer(QDialogRejected) then ACustomForm.ModalResult := mrCancel
else ACustomForm.ModalResult := mrOk;
TQtWidget(ACustomForm.Handle).setParent(nil);
finally
QtDialog.Free;
end;
end;
class procedure TQtWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
const ABorderIcons: TBorderIcons);
begin
inherited SetBorderIcons(AForm, ABorderIcons);
end;
initialization
////////////////////////////////////////////////////
@ -239,4 +290,4 @@ initialization
// RegisterWSComponent(TScreen, TQtWSScreen);
// RegisterWSComponent(TApplicationProperties, TQtWSApplicationProperties);
////////////////////////////////////////////////////
end.
end.

13
lcl/interfaces/qt/qtwsmenus.pp
View File

@ -27,14 +27,11 @@ unit QtWSMenus;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
SysUtils, Classes, Menus, Forms, LCLType, qt4, qtprivate,
////////////////////////////////////////////////////
// Bindings
qt4, qtwidgets, qtobjects,
// LCL
SysUtils, Classes, Menus, Forms, LCLType,
// Widgetset
WSMenus, WSLCLClasses;
type

2
lcl/interfaces/qt/qtwsspin.pp
View File

@ -28,7 +28,7 @@ interface
uses
// Bindings
qt4, qtprivate,
qt4, qtwidgets,
// LCL
Spin, SysUtils, Controls, LCLType, Forms,
// Widgetset

14
lcl/interfaces/qt/qtwsstdctrls.pp
View File

@ -27,15 +27,11 @@ unit QtWSStdCtrls;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
Classes, StdCtrls, Controls, Graphics, Forms, SysUtils,
InterfaceBase, qt4, qtprivate, qtobjects,
////////////////////////////////////////////////////
// Bindings
qt4, qtprivate, qtwidgets,
// LCL
Classes, StdCtrls, Controls, Graphics, Forms, SysUtils, InterfaceBase,
// Widgetset
WSStdCtrls, WSLCLClasses, LCLType;
type