mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-02 19:18:14 +02:00
489 lines
16 KiB
PHP
489 lines
16 KiB
PHP
{%MainUnit qtint.pp}
|
|
{ $Id$ }
|
|
|
|
{******************************************************************************
|
|
All QT interface support routines
|
|
Initial Revision : Sat Jan 17 19:00:00 2004
|
|
|
|
|
|
!! Keep alphabetical !!
|
|
|
|
Support routines go to qtproc.pp
|
|
|
|
******************************************************************************
|
|
Implementation
|
|
******************************************************************************
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
|
|
//##apiwiz##sps## // Do not remove
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: CreateStandardCursor
|
|
Params:
|
|
Returns:
|
|
------------------------------------------------------------------------------}
|
|
function TQtWidgetSet.CreateStandardCursor(ACursor: SmallInt): hCursor;
|
|
var
|
|
CursorShape: QtCursorShape;
|
|
begin
|
|
Result := 0;
|
|
if ACursor < crLow then Exit;
|
|
if ACursor > crHigh then Exit;
|
|
|
|
// TODO: map is better
|
|
case TCursor(ACursor) of
|
|
crNone : CursorShape := QtBlankCursor;
|
|
crArrow : CursorShape := QtArrowCursor;
|
|
crCross : CursorShape := QtCrossCursor;
|
|
crIBeam : CursorShape := QtIBeamCursor;
|
|
crSizeAll : CursorShape := QtSizeAllCursor;
|
|
crSizeNESW : CursorShape := QtSizeBDiagCursor;
|
|
crSizeNS : CursorShape := QtSizeVerCursor;
|
|
crSizeNWSE : CursorShape := QtSizeFDiagCursor;
|
|
crSizeWE : CursorShape := QtSizeHorCursor;
|
|
crSizeNW : CursorShape := QtSizeFDiagCursor;
|
|
crSizeN : CursorShape := QtSizeVerCursor;
|
|
crSizeNE : CursorShape := QtSizeBDiagCursor;
|
|
crSizeW : CursorShape := QtSizeHorCursor;
|
|
crSizeE : CursorShape := QtSizeHorCursor;
|
|
crSizeSW : CursorShape := QtSizeBDiagCursor;
|
|
crSizeS : CursorShape := QtSizeVerCursor;
|
|
crSizeSE : CursorShape := QtSizeFDiagCursor;
|
|
crUpArrow : CursorShape := QtUpArrowCursor;
|
|
crHourGlass : CursorShape := QtWaitCursor;
|
|
crHSplit : CursorShape := QtSplitHCursor;
|
|
crVSplit : CursorShape := QtSplitVCursor;
|
|
crNo : CursorShape := QtForbiddenCursor;
|
|
crAppStart : CursorShape := QtBusyCursor;
|
|
crHelp : CursorShape := QtWhatsThisCursor;
|
|
crHandPoint : CursorShape := QtPointingHandCursor;
|
|
else
|
|
CursorShape := QtCursorShape(-1);
|
|
end;
|
|
if CursorShape <> QtCursorShape(-1) then
|
|
Result := hCursor(QCursor_create(CursorShape));
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: DrawArrow
|
|
Params:
|
|
Returns:
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtWidgetSet.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
|
|
const
|
|
QtArrowTypeMap: array[TArrowType] of QStylePrimitiveElement =
|
|
(
|
|
{atUp } QStylePE_IndicatorArrowUp,
|
|
{atDown } QStylePE_IndicatorArrowDown,
|
|
{atLeft } QStylePE_IndicatorArrowLeft,
|
|
{atRight} QStylePE_IndicatorArrowRight
|
|
);
|
|
var
|
|
DC: TQtDeviceContext;
|
|
ARect: TRect;
|
|
StyleOption: QStyleOptionH;
|
|
begin
|
|
DC := TQtDeviceContext(TCanvas(Canvas).Handle);
|
|
ARect := TControl(Arrow).ClientRect;
|
|
|
|
StyleOption := QStyleOption_create(1, integer(QStyleOptionSO_Default));
|
|
try
|
|
// I dont know the reason, but under windows down arrow size is very small
|
|
// and is not dependent on passed ARect.
|
|
// There is nothing in qt source that can cause such bad painting.
|
|
// Other styles draw down arrow very well.
|
|
QStyleOption_initFrom(StyleOption, DC.Parent);
|
|
QStyleOption_setRect(StyleOption, @ARect);
|
|
QStyle_drawPrimitive(QApplication_style, QtArrowTypeMap[TArrow(Arrow).ArrowType],
|
|
StyleOption, DC.Widget, DC.Parent);
|
|
finally
|
|
QStyleOption_destroy(StyleOption);
|
|
end;
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: FontCanUTF8
|
|
Params:
|
|
Returns:
|
|
------------------------------------------------------------------------------}
|
|
function TQtWidgetSet.FontCanUTF8(Font: HFont): Boolean;
|
|
begin
|
|
{$ifdef windows}
|
|
{$ifdef WindowsUnicodeSupport}
|
|
Result := True;
|
|
{$else}
|
|
Result := False;
|
|
{$endif}
|
|
{$else}
|
|
Result := IsValidGDIObject(Font);
|
|
{$endif}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: FontIsMonoSpace
|
|
Params:
|
|
Returns:
|
|
------------------------------------------------------------------------------}
|
|
function TQtWidgetSet.FontIsMonoSpace(Font: HFont): Boolean;
|
|
var
|
|
QtFontInfo: QFontInfoH;
|
|
begin
|
|
Result := IsValidGDIObject(Font);
|
|
if Result then
|
|
begin
|
|
QtFontInfo := QFontInfo_create(TQtFont(Font).Widget);
|
|
try
|
|
Result := QFontInfo_fixedPitch(QtFontInfo);
|
|
finally
|
|
QFontInfo_destroy(QtFontInfo);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: IntfSendsUTF8KeyPress
|
|
Params:
|
|
Returns:
|
|
------------------------------------------------------------------------------}
|
|
|
|
function TQtWidgetSet.IntfSendsUTF8KeyPress: boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: PromptUser
|
|
Params:
|
|
Returns:
|
|
|
|
Note: Qt appears to map Esc key to Cancel button, so no need for EscapeResult.
|
|
------------------------------------------------------------------------------}
|
|
function TQtWidgetSet.PromptUser(const DialogCaption : string;
|
|
const DialogMessage : string;
|
|
DialogType : LongInt;
|
|
Buttons : PLongInt;
|
|
ButtonCount : LongInt;
|
|
DefaultIndex : LongInt;
|
|
EscapeResult : LongInt) : LongInt;
|
|
var
|
|
QBtns : QMessageBoxStandardButtons;
|
|
DefQBtn : QMessageBoxStandardButton;
|
|
CurQBtn : QMessageBoxStandardButton;
|
|
BtnIdx : LongInt;
|
|
CaptionStr : WideString;
|
|
MessageStr : WideString;
|
|
QResult : QMessageBoxStandardButton;
|
|
begin
|
|
QBtns := 0;
|
|
DefQBtn := QMessageBoxNoButton;
|
|
{Convert LCL "id" button values to Qt values}
|
|
for BtnIdx := 0 to ButtonCount-1 do
|
|
begin
|
|
case Buttons[BtnIdx] of
|
|
idButtonYes : CurQBtn := QMessageBoxYes;
|
|
idButtonNo : CurQBtn := QMessageBoxNo;
|
|
idButtonOK : CurQBtn := QMessageBoxOk;
|
|
idButtonCancel : CurQBtn := QMessageBoxCancel;
|
|
idButtonAbort : CurQBtn := QMessageBoxAbort;
|
|
idButtonRetry : CurQBtn := QMessageBoxRetry;
|
|
idButtonIgnore : CurQBtn := QMessageBoxIgnore;
|
|
// idButtonAll : no equivalent
|
|
idButtonNoToAll : CurQBtn := QMessageBoxNoToAll;
|
|
idButtonYesToAll : CurQBtn := QMessageBoxYesToAll;
|
|
idButtonHelp : CurQBtn := QMessageBoxHelp;
|
|
idButtonClose : CurQBtn := QMessageBoxClose;
|
|
else
|
|
CurQBtn := QMessageBoxNoButton;
|
|
end;
|
|
QBtns := QBtns or CurQBtn;
|
|
if BtnIdx = DefaultIndex then {Default button?}
|
|
DefQBtn := CurQBtn;
|
|
end;
|
|
|
|
CaptionStr := GetUtf8String(DialogCaption);
|
|
MessageStr := GetUtf8String(DialogMessage);
|
|
|
|
case DialogType of
|
|
idDialogWarning :
|
|
QResult := QMessageBox_warning(nil, @CaptionStr, @MessageStr, QBtns, DefQBtn);
|
|
idDialogError :
|
|
QResult := QMessageBox_critical(nil, @CaptionStr, @MessageStr, QBtns, DefQBtn);
|
|
idDialogInfo :
|
|
QResult := QMessageBox_information(nil, @CaptionStr, @MessageStr, QBtns, DefQBtn);
|
|
idDialogConfirm :
|
|
QResult := QMessageBox_question(nil, @CaptionStr, @MessageStr, QBtns, DefQBtn);
|
|
else
|
|
// simple show message
|
|
QResult := QMessageBox_information(nil, @CaptionStr, @MessageStr, QBtns, DefQBtn);
|
|
end;
|
|
|
|
{Convert Qt result to LCL "id" dialog result}
|
|
case QResult of
|
|
QMessageBoxOk : Result := idButtonOK;
|
|
QMessageBoxCancel : Result := idButtonCancel;
|
|
QMessageBoxAbort : Result := idButtonAbort;
|
|
QMessageBoxRetry : Result := idButtonRetry;
|
|
QMessageBoxIgnore : Result := idButtonIgnore;
|
|
QMessageBoxYes : Result := idButtonYes;
|
|
QMessageBoxNo : Result := idButtonNo;
|
|
// QMessageBoxAll : no equivalent
|
|
QMessageBoxNoToAll : Result := idButtonNoToAll;
|
|
QMessageBoxYesToAll : Result := idButtonYesToAll;
|
|
else
|
|
Result := -1;
|
|
end;
|
|
end; {TQtWidgetSet.PromptUser}
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: RawImage_CreateBitmaps
|
|
Params: ARawImage:
|
|
ABitmap:
|
|
AMask:
|
|
ASkipMask: When set, no mask is created
|
|
Returns:
|
|
|
|
This functions is for TBitmap support
|
|
|
|
The memory allocation code was added because it is necessary for
|
|
TBitmap.LoadFromDevice support. For other operations it isnt needed
|
|
------------------------------------------------------------------------------}
|
|
function TQtWidgetSet.RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean): Boolean;
|
|
var
|
|
Desc: TRawImageDescription absolute ARawImage.Description;
|
|
NewData: PByte;
|
|
ImageFormat: QImageFormat;
|
|
begin
|
|
Result := False;
|
|
ABitmap := 0;
|
|
AMask := 0;
|
|
|
|
//MWE: shouldn't the memory get copied at the place where it is needed,
|
|
// its not really oo if the bitmap (or thisr party) needs this to do it here.
|
|
NewData := GetMem(ARawImage.DataSize);
|
|
Move(ARawImage.Data^, NewData^, ARawImage.DataSize);
|
|
|
|
{$note TODO: use format given in rawimage}
|
|
// this is only a rough implementation, there is no check against bitsperpixel
|
|
case Desc.Depth of
|
|
1: ImageFormat := QImageFormat_Mono;
|
|
//2..14: ;
|
|
15, 16: ImageFormat := QImageFormat_RGB16;
|
|
24: ImageFormat := QImageFormat_RGB32;
|
|
32: ImageFormat := QImageFormat_ARGB32;
|
|
else
|
|
ImageFormat := QImageFormat_ARGB32;
|
|
end;
|
|
ABitmap := HBitmap(TQtImage.Create(NewData, Desc.Width, Desc.Height, ImageFormat, True));
|
|
Result := ABitmap <> 0;
|
|
|
|
if ASkipMask then Exit;
|
|
if ARawImage.Mask = nil then Exit;
|
|
if ARawImage.MaskSize = 0 then Exit;
|
|
|
|
NewData := GetMem(ARawImage.MaskSize);
|
|
Move(ARawImage.Mask^, NewData^, ARawImage.MaskSize);
|
|
|
|
AMask := HBitmap(TQtImage.Create(NewData, Desc.Width, Desc.Height, QImageFormat_Mono, True));
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: RawImage_DescriptionFromBitmap
|
|
Params: ABitmap:
|
|
ADesc:
|
|
Returns:
|
|
|
|
Describes the inner format utilized by Qt + the specific information for this image
|
|
------------------------------------------------------------------------------}
|
|
function TQtWidgetSet.RawImage_DescriptionFromBitmap(ABitmap: HBITMAP; out ADesc: TRawImageDescription): Boolean;
|
|
var
|
|
Image: TQtImage absolute ABitmap;
|
|
begin
|
|
Result := CheckBitmap(ABitmap, 'RawImage_DescriptionFromBitmap');
|
|
if not Result then Exit;
|
|
|
|
FillStandardDescription(ADesc);
|
|
|
|
ADesc.Width := Image.Width;
|
|
ADesc.Height := Image.Height;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: RawImage_DescriptionFromDevice
|
|
Params: ADC:
|
|
ADesc:
|
|
Returns:
|
|
|
|
Describes the standard format utilized by Qt
|
|
------------------------------------------------------------------------------}
|
|
function TQtWidgetSet.RawImage_DescriptionFromDevice(ADC: HDC; out ADesc: TRawImageDescription): Boolean;
|
|
begin
|
|
Result := true;
|
|
|
|
FillStandardDescription(ADesc);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: RawImage_FromBitmap
|
|
Params: ABitmap:
|
|
AMask:
|
|
ARect:
|
|
ARawImage:
|
|
Returns:
|
|
|
|
Creates a raw image from a bitmap
|
|
------------------------------------------------------------------------------}
|
|
function TQtWidgetSet.RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMask: HBITMAP; const ARect: TRect): Boolean;
|
|
var
|
|
Desc: TRawImageDescription absolute ARawImage.Description;
|
|
Image: TQtImage absolute ABitmap;
|
|
Mask: TQtImage absolute AMask;
|
|
|
|
WorkImage, WorkMask: TQtImage;
|
|
Width, Height: Integer;
|
|
begin
|
|
Result := False;
|
|
|
|
if not CheckBitmap(ABitmap, 'RawImage_FromBitmap') then Exit;
|
|
if (AMask <> 0) and not CheckBitmap(AMask, 'RawImage_FromBitmap (mask)') then Exit;
|
|
|
|
|
|
ARawImage.Init;
|
|
FillStandardDescription(ARawImage.Description);
|
|
|
|
Width := ARect.Right - ARect.Left;
|
|
Height := ARect.Bottom - ARect.Top;
|
|
|
|
if (Width = Image.Width) and (Height = Image.Height)
|
|
then begin
|
|
WorkImage := Image;
|
|
WorkMask := Mask;
|
|
end
|
|
else begin
|
|
// Create SubImage
|
|
{$note TODO: Use create subimage when size doesn't match }
|
|
// for now return image
|
|
WorkImage := Image;
|
|
WorkMask := Mask;
|
|
end;
|
|
|
|
Desc.Width := WorkImage.width;
|
|
Desc.Height := WorkImage.height;
|
|
|
|
// copy data
|
|
ARawImage.DataSize := WorkImage.numBytes;
|
|
ReAllocMem(ARawImage.Data, ARawImage.DataSize);
|
|
if ARawImage.DataSize > 0 then
|
|
Move(WorkImage.bits^, ARawImage.Data^, ARawImage.DataSize);
|
|
|
|
if WorkMask <> nil
|
|
then begin
|
|
ARawImage.MaskSize := WorkMask.numBytes;
|
|
ReAllocMem(ARawImage.Mask, ARawImage.MaskSize);
|
|
if ARawImage.MaskSize > 0 then
|
|
Move(WorkMask.bits^, ARawImage.Mask^, ARawImage.MaskSize);
|
|
end;
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: RawImage_FromDevice
|
|
Params: ADC:
|
|
ARect:
|
|
ARawImage:
|
|
Returns:
|
|
|
|
This function is utilized when the function TBitmap.LoadFromDevice is called
|
|
|
|
The main use for this function is to get a screenshot. It may have other uses,
|
|
but this is the only one implemented here.
|
|
|
|
MWE: exept for the desktop, there is always a bitmep selected in the DC.
|
|
So get this internal bitmap and pass it to RawImage_FromBitmap
|
|
------------------------------------------------------------------------------}
|
|
function TQtWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean;
|
|
var
|
|
Desc: TRawImageDescription absolute ARawImage.Description;
|
|
|
|
//SrcWidth, SrcHeight: Integer;
|
|
WinID: Cardinal;
|
|
DCSize: TSize;
|
|
Pixmap: TQtPixmap;
|
|
Image: QImageH;
|
|
Context: TQtDeviceContext;
|
|
|
|
procedure RawImage_FromImage(AImage: QImageH);
|
|
begin
|
|
ARawImage.DataSize := QImage_numBytes(AImage);
|
|
ARawImage.Data := GetMem(ARawImage.DataSize);
|
|
Move(QImage_bits(AImage)^, ARawImage.Data^, ARawImage.DataSize);
|
|
ARawImage.Mask := nil;
|
|
end;
|
|
|
|
begin
|
|
{$ifdef VerboseQtWinAPI}
|
|
WriteLn('Trace:> [WinAPI GetRawImageFromDevice] SrcDC: ', dbghex(ADC),
|
|
' SrcWidth: ', dbgs(ARect.Right - ARect.Left),
|
|
' SrcHeight: ', dbgs(ARect.Bottom - ARect.Top));
|
|
{$endif}
|
|
|
|
// todo: copy only passed rectangle
|
|
|
|
Result := True;
|
|
|
|
FillStandardDescription(ARawImage.Description);
|
|
Context := TQtDeviceContext(ADC);
|
|
|
|
with DCSize, Context.getDeviceSize do
|
|
begin
|
|
cx := x;
|
|
cy := y;
|
|
end;
|
|
|
|
Pixmap := TQtPixmap.Create(@DCSize);
|
|
|
|
if Context.Parent <> nil then
|
|
begin
|
|
WinID := QWidget_winId(Context.Parent);
|
|
try
|
|
Pixmap.grabWindow(WinID);
|
|
Image := QImage_Create;
|
|
Pixmap.toImage(Image);
|
|
RawImage_FromImage(Image);
|
|
QImage_destroy(Image);
|
|
finally
|
|
Pixmap.Free;
|
|
end;
|
|
end else
|
|
begin
|
|
if Context.vImage <> nil then
|
|
RawImage_FromImage(Context.vImage)
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
// In this case we use the size of the context
|
|
Desc.Width := DCSize.cx;
|
|
Desc.Height := DCSize.cy;
|
|
|
|
{$ifdef VerboseQtWinAPI}
|
|
WriteLn('Trace:< [WinAPI GetRawImageFromDevice]');
|
|
{$endif}
|
|
end;
|
|
|
|
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
|