mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-03 05:58:14 +02:00
* Implemented several fpgui dialogs
* Improved base widget signal handlers to reduce code duplication git-svn-id: trunk@22275 -
This commit is contained in:
andrew
parent
a46e172bd9
commit
5ae9882103
@ -15,6 +15,47 @@
|
||||
}
|
||||
//---------------------------------------------------------------
|
||||
|
||||
type
|
||||
|
||||
{ TFPGUITimer }
|
||||
|
||||
TFPGUITimer = class
|
||||
private
|
||||
FLCLTimer: TTimer;
|
||||
FTimer: TfpgTimer;
|
||||
FCallback: TFNTimerProc;
|
||||
protected
|
||||
procedure FPGTimer(Sender: TObject);
|
||||
public
|
||||
constructor Create(AInterval: Integer; ACallbackFunc: TFNTimerProc);
|
||||
destructor Destroy; override;
|
||||
|
||||
property Timer : TfpgTimer read FTimer;
|
||||
end;
|
||||
|
||||
{ TFPGUITimer }
|
||||
|
||||
procedure TFPGUITimer.FPGTimer(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FCallback) then
|
||||
FCallback;
|
||||
end;
|
||||
|
||||
constructor TFPGUITimer.Create(AInterval: Integer; ACallbackFunc: TFNTimerProc);
|
||||
begin
|
||||
FTimer := TfpgTimer.Create(AInterval);
|
||||
FTimer.OnTimer:=@FPGTimer;
|
||||
FCallback := ACallbackFunc;
|
||||
FTimer.Enabled:= True;
|
||||
end;
|
||||
|
||||
destructor TFPGUITimer.Destroy;
|
||||
begin
|
||||
FTimer.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TFpGuiWidgetSet.Create
|
||||
Params: None
|
||||
@ -51,8 +92,12 @@ end;
|
||||
Creates a new timer and sets the callback event.
|
||||
------------------------------------------------------------------------------}
|
||||
function TFpGuiWidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): THandle;
|
||||
var
|
||||
Timer: TFPGUITimer;
|
||||
begin
|
||||
Result := PtrInt(0);
|
||||
Timer := TFPGUITimer.Create(Interval, TimerFunc);
|
||||
|
||||
Result := PtrInt(Timer);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -63,7 +108,12 @@ end;
|
||||
Destroys a timer.
|
||||
------------------------------------------------------------------------------}
|
||||
function TFpGuiWidgetSet.DestroyTimer(TimerHandle: THandle): boolean;
|
||||
var
|
||||
Timer: TFPGUITimer absolute TimerHandle;
|
||||
begin
|
||||
if Timer <> nil then
|
||||
Timer.Free;
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
@ -114,6 +164,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TFpGuiWidgetSet.AppWaitMessage;
|
||||
begin
|
||||
fpgWaitWindowMessage;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
@ -46,12 +46,17 @@ begin
|
||||
{$ifdef VerboseFPGUIWinAPI}
|
||||
WriteLn('Trace:> [WinAPI BeginPaint] Handle=', dbghex(Handle));
|
||||
{$endif}
|
||||
|
||||
{$WARNING TFpGuiWidgetSet.BeginPaint Temporary Fix to prevent Crashing}
|
||||
try
|
||||
if PrivateWidget <> nil then
|
||||
DC := TFpGuiDeviceContext.Create(PrivateWidget.Widget.Canvas)
|
||||
else
|
||||
DC := TFpGuiDeviceContext.Create(nil);
|
||||
|
||||
if PrivateWidget <> nil then
|
||||
WriteLn(PrivateWidget.ClassName);
|
||||
except
|
||||
DC := TFpGuiDeviceContext.Create(nil);
|
||||
end;
|
||||
PS.hdc := HDC(DC);
|
||||
|
||||
Result := PS.hdc;
|
||||
|
||||
@ -27,6 +27,8 @@ unit FpGuiWSControls;
|
||||
interface
|
||||
|
||||
uses
|
||||
// FCL
|
||||
Classes,
|
||||
// Bindings
|
||||
fpguiwsprivate,
|
||||
// LCL
|
||||
@ -62,6 +64,8 @@ type
|
||||
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 procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
|
||||
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override;
|
||||
@ -156,6 +160,34 @@ begin
|
||||
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;
|
||||
end;
|
||||
|
||||
class function TFpGuiWSWinControl.GetClientRect(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;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TFpGuiWSWinControl.SetBounds
|
||||
Params: AWinControl - the calling object
|
||||
@ -187,8 +219,8 @@ class procedure TFpGuiWSWinControl.SetPos(const AWinControl: TWinControl;
|
||||
var
|
||||
FPWidget: TfpgWidget;
|
||||
begin
|
||||
FPWidget := TFPGUIPrivateWidget(AWinControl.Handle).Widget;
|
||||
FPWIdget.SetPosition(ALeft, ATop, AWinControl.Width, AWinControl.Height);
|
||||
with TFPGUIPrivateWidget(AWinControl.Handle).Widget
|
||||
do SetPosition(ALeft, ATop, AWinControl.Width, AWinControl.Height);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
@ -33,8 +33,10 @@ uses
|
||||
// To get as little as posible circles,
|
||||
// uncomment only when needed for registration
|
||||
////////////////////////////////////////////////////
|
||||
// Dialogs,
|
||||
Dialogs,
|
||||
////////////////////////////////////////////////////
|
||||
// Bindings
|
||||
fpg_base, fpg_main, fpg_dialogs, fpguiwsprivate,
|
||||
LCLType, WSDialogs, WSLCLClasses;
|
||||
|
||||
type
|
||||
@ -45,6 +47,9 @@ type
|
||||
private
|
||||
protected
|
||||
public
|
||||
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
|
||||
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
|
||||
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
|
||||
end;
|
||||
|
||||
{ TFpGuiWSFileDialog }
|
||||
@ -53,6 +58,7 @@ type
|
||||
private
|
||||
protected
|
||||
public
|
||||
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
|
||||
end;
|
||||
|
||||
{ TFpGuiWSOpenDialog }
|
||||
@ -61,6 +67,7 @@ type
|
||||
private
|
||||
protected
|
||||
public
|
||||
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
|
||||
end;
|
||||
|
||||
{ TFpGuiWSSaveDialog }
|
||||
@ -69,6 +76,7 @@ type
|
||||
private
|
||||
protected
|
||||
public
|
||||
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
|
||||
end;
|
||||
|
||||
{ TFpGuiWSSelectDirectoryDialog }
|
||||
@ -101,11 +109,67 @@ type
|
||||
private
|
||||
protected
|
||||
public
|
||||
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TFpGuiWSCommonDialog }
|
||||
|
||||
class function TFpGuiWSCommonDialog.CreateHandle(
|
||||
const ACommonDialog: TCommonDialog): THandle;
|
||||
begin
|
||||
Result := TLCLIntfHandle(TFPGUIPrivateCommonDialog.Create(ACommonDialog));
|
||||
end;
|
||||
|
||||
class procedure TFpGuiWSCommonDialog.ShowModal(
|
||||
const ACommonDialog: TCommonDialog);
|
||||
begin
|
||||
TFPGUIPrivateCommonDialog(ACommonDialog.Handle).ShowDialog;
|
||||
end;
|
||||
|
||||
class procedure TFpGuiWSCommonDialog.DestroyHandle(
|
||||
const ACommonDialog: TCommonDialog);
|
||||
var
|
||||
FPGDialog: TFPGUIPrivateCommonDialog;
|
||||
begin
|
||||
FPGDialog := TFPGUIPrivateCommonDialog(ACommonDialog.Handle);
|
||||
FPGDialog.Free;
|
||||
end;
|
||||
|
||||
{ TFpGuiWSFileDialog }
|
||||
|
||||
class function TFpGuiWSFileDialog.CreateHandle(
|
||||
const ACommonDialog: TCommonDialog): THandle;
|
||||
begin
|
||||
Result := TLCLIntfHandle(TFPGUIPrivateFileDialog.Create(ACommonDialog));
|
||||
end;
|
||||
|
||||
{ TFpGuiWSOpenDialog }
|
||||
|
||||
class function TFpGuiWSOpenDialog.CreateHandle(
|
||||
const ACommonDialog: TCommonDialog): THandle;
|
||||
begin
|
||||
Result := TLCLIntfHandle(TFPGUIPrivateOpenDialog.Create(ACommonDialog));
|
||||
end;
|
||||
|
||||
{ TFpGuiWSSaveDialog }
|
||||
|
||||
class function TFpGuiWSSaveDialog.CreateHandle(
|
||||
const ACommonDialog: TCommonDialog): THandle;
|
||||
begin
|
||||
Result := TLCLIntfHandle(TFPGUIPrivateSaveDialog.Create(ACommonDialog));
|
||||
end;
|
||||
|
||||
{ TFpGuiWSFontDialog }
|
||||
|
||||
class function TFpGuiWSFontDialog.CreateHandle(
|
||||
const ACommonDialog: TCommonDialog): THandle;
|
||||
begin
|
||||
Result := TLCLIntfHandle(TFPGUIPrivateFontDialog.Create(ACommonDialog));
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
////////////////////////////////////////////////////
|
||||
|
||||
@ -5,7 +5,7 @@ unit FpGuiWSFactory;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Controls, StdCtrls, Forms, Menus, ExtCtrls,
|
||||
Classes, Controls, StdCtrls, Forms, Menus, ExtCtrls, Dialogs,
|
||||
WSLCLClasses;
|
||||
|
||||
// imglist
|
||||
@ -104,7 +104,8 @@ uses
|
||||
FpGuiWSExtCtrls,
|
||||
FpGuiWSForms,
|
||||
FpGuiWSMenus,
|
||||
FpGuiWSStdCtrls;
|
||||
FpGuiWSStdCtrls,
|
||||
FpGuiWSDialogs;
|
||||
|
||||
// imglist
|
||||
function RegisterCustomImageList: Boolean; alias : 'WSRegisterCustomImageList';
|
||||
@ -199,22 +200,26 @@ end;
|
||||
// dialogs
|
||||
function RegisterCommonDialog: Boolean; alias : 'WSRegisterCommonDialog';
|
||||
begin
|
||||
Result := False;
|
||||
RegisterWSComponent(TCommonDialog, TFpGuiWSCommonDialog);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function RegisterFileDialog: Boolean; alias : 'WSRegisterFileDialog';
|
||||
begin
|
||||
Result := False;
|
||||
RegisterWSComponent(TFileDialog, TFpGuiWSFileDialog);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function RegisterOpenDialog: Boolean; alias : 'WSRegisterOpenDialog';
|
||||
begin
|
||||
Result := False;
|
||||
RegisterWSComponent(TOpenDialog, TFpGuiWSOpenDialog);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function RegisterSaveDialog: Boolean; alias : 'WSRegisterSaveDialog';
|
||||
begin
|
||||
Result := False;
|
||||
RegisterWSComponent(TSaveDialog, TFpGuiWSSaveDialog);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function RegisterSelectDirectoryDialog: Boolean; alias : 'WSRegisterSelectDirectoryDialog';
|
||||
@ -234,7 +239,8 @@ end;
|
||||
|
||||
function RegisterFontDialog: Boolean; alias : 'WSRegisterFontDialog';
|
||||
begin
|
||||
Result := False;
|
||||
RegisterWSComponent(TFontDialog, TFpGuiWSFontDialog);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
// StdCtrls
|
||||
|
||||
@ -153,9 +153,9 @@ begin
|
||||
WriteLn('TFpGuiWSCustomForm.DestroyHandle');
|
||||
{$endif}
|
||||
|
||||
// TFPGUIPrivateWindow(AWinControl.Handle).Free;
|
||||
TFPGUIPrivateWindow(AWinControl.Handle).Free;
|
||||
|
||||
// AWinControl.Handle := 0;
|
||||
AWinControl.Handle := 0;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
@ -34,13 +34,13 @@ interface
|
||||
uses
|
||||
// LCL
|
||||
LCLType, LMessages, LCLProc, Controls, Classes, SysUtils, Forms,
|
||||
LCLIntf, Menus,
|
||||
LCLIntf, Menus, Dialogs, ExtCtrls,
|
||||
// widgetset
|
||||
WSControls, WSLCLClasses, WSProc,
|
||||
// interface
|
||||
fpg_widget, fpg_form, fpg_button, fpg_combobox, fpg_dialogs,
|
||||
fpg_edit, fpg_checkbox, fpg_radiobutton, fpg_tab, fpg_memo,
|
||||
fpg_menu;
|
||||
fpg_menu, fpg_base;
|
||||
|
||||
|
||||
type
|
||||
@ -57,6 +57,10 @@ type
|
||||
function _Release : longint;stdcall;
|
||||
end;
|
||||
|
||||
{ To access protected properties of TfpgWidget }
|
||||
TFPGWidgetHack = class(TfpgWidget)
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateWidget }
|
||||
{ Private class for widgets }
|
||||
|
||||
@ -65,7 +69,29 @@ type
|
||||
FWidget: TfpgWidget;
|
||||
FLCLObject: TWinControl;
|
||||
function GetVisible: Boolean;
|
||||
function GetWidgetProtected: TFPGWidgetHack;
|
||||
procedure SetVisible(const AValue: Boolean);
|
||||
{ Handlers for default properties common to all TfpgWidget descendants}
|
||||
procedure PaintHandler(Sender: TObject{; const ARect: TfpgRect});
|
||||
procedure ClickHandler(Sender: TObject);
|
||||
procedure ResizeHandler(Sender: TObject);
|
||||
procedure MoveHandler(Sender: TObject);
|
||||
procedure EnterHandler(Sender: TObject);
|
||||
procedure ExitHandler(Sender: TObject);
|
||||
procedure MsgPaint(var fpgmsg: TfpgMessageRec); message FPGM_PAINT;
|
||||
procedure MsgResize(var fpgmsg: TfpgMessageRec); message FPGM_RESIZE;
|
||||
procedure MsgMove(var fpgmsg: TfpgMessageRec); message FPGM_MOVE;
|
||||
procedure MsgKeyChar(var fpgmsg: TfpgMessageRec); message FPGM_KEYCHAR;
|
||||
procedure MsgKeyPress(var fpgmsg: TfpgMessageRec); message FPGM_KEYPRESS;
|
||||
procedure MsgKeyRelease(var fpgmsg: TfpgMessageRec); message FPGM_KEYRELEASE;
|
||||
procedure MsgMouseDown(var fpgmsg: TfpgMessageRec); message FPGM_MOUSEDOWN;
|
||||
procedure MsgMouseUp(var fpgmsg: TfpgMessageRec); message FPGM_MOUSEUP;
|
||||
procedure MsgMouseMove(var fpgmsg: TfpgMessageRec); message FPGM_MOUSEMOVE;
|
||||
procedure MsgDoubleClick(var fpgmsg: TfpgMessageRec); message FPGM_DOUBLECLICK;
|
||||
procedure MsgMouseEnter(var fpgmsg: TfpgMessageRec); message FPGM_MOUSEENTER;
|
||||
procedure MsgMouseExit(var fpgmsg: TfpgMessageRec); message FPGM_MOUSEEXIT;
|
||||
procedure MsgMouseScroll(var fpgmsg: TfpgMessageRec); message FPGM_SCROLL;
|
||||
//procedure MouseDown
|
||||
protected
|
||||
{ Helper methods for descendents }
|
||||
function GetParentContainerWidget: TfpgWidget;
|
||||
@ -74,7 +100,7 @@ type
|
||||
constructor Create(ALCLObject: TWinControl; const AParams: TCreateParams); virtual;
|
||||
destructor Destroy; override;
|
||||
{ Virtual methods }
|
||||
procedure CreateWidget(const AParams: TCreateParams); virtual; abstract;
|
||||
procedure CreateWidget(const AParams: TCreateParams); virtual;
|
||||
procedure SetEvents; virtual;
|
||||
procedure SetSize(AWidth, AHeight: LongInt); virtual;
|
||||
procedure SetPosition(AX, AY: Integer); virtual;
|
||||
@ -86,6 +112,7 @@ type
|
||||
property LCLObject: TWinControl read FLCLObject;
|
||||
property Visible: Boolean read GetVisible write SetVisible;
|
||||
property Widget: TfpgWidget read FWidget write FWidget;
|
||||
property WidgetProtected: TFPGWidgetHack read GetWidgetProtected;
|
||||
end;
|
||||
|
||||
|
||||
@ -120,7 +147,6 @@ type
|
||||
TFPGUIPrivateWindow = class(TFPGUIPrivateBin)
|
||||
private
|
||||
{ Event Handlers }
|
||||
procedure PaintHandler(Sender: TObject{; const ARect: TfpgRect});
|
||||
procedure CloseHandler(Sender: TObject; var CloseAction: TCloseAction);
|
||||
protected
|
||||
public
|
||||
@ -145,9 +171,75 @@ type
|
||||
{ TFPGUIPrivateDialog }
|
||||
{ Private class for dialogs }
|
||||
|
||||
TFPGUIPrivateDialog = class(TfpgBaseDialog)
|
||||
{ TFPGUIPrivateCommonDialog }
|
||||
|
||||
TFPGUIPrivateCommonDialog = class(TFPGUIPrivate)
|
||||
private
|
||||
FDialog: TfpgBaseDialog;
|
||||
FLCLDialog: TCommonDialog;
|
||||
protected
|
||||
procedure CreateDialog; virtual;
|
||||
function InternalShowDialog: Boolean; virtual;
|
||||
procedure UpdatePropsBefore; virtual;
|
||||
procedure UpdatePropsAfter; virtual;
|
||||
public
|
||||
constructor Create(ALCLDialog: TCommonDialog); virtual;
|
||||
destructor Destroy; override;
|
||||
|
||||
function ShowDialog: Boolean;
|
||||
|
||||
property Dialog: TfpgBaseDialog read FDialog write FDialog;
|
||||
property LCLDialog: TCommonDialog read FLCLDialog;
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateFileDialog }
|
||||
|
||||
{ TFPGUIPrivateFontDialog }
|
||||
|
||||
TFPGUIPrivateFontDialog = class(TFPGUIPrivateCommonDialog)
|
||||
protected
|
||||
procedure CreateDialog; override;
|
||||
function InternalShowDialog: Boolean; override;
|
||||
procedure UpdatePropsBefore; override;
|
||||
procedure UpdatePropsAfter; override;
|
||||
public
|
||||
function FontDialog: TfpgFontSelectDialog;
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateFileDialog }
|
||||
|
||||
TFPGUIPrivateFileDialog = class(TFPGUIPrivateCommonDialog)
|
||||
private
|
||||
protected
|
||||
procedure UpdatePropsBefore; override;
|
||||
procedure UpdatePropsAfter; override;
|
||||
procedure CreateDialog; override;
|
||||
public
|
||||
function FileDialog: TfpgFileDialog;
|
||||
function LCLFileDialog: TFileDialog;
|
||||
end;
|
||||
|
||||
{ TFPGUIOpenDialog }
|
||||
{ Private class for dialogs }
|
||||
|
||||
{ TFPGUIPrivateOpenDialog }
|
||||
|
||||
TFPGUIPrivateOpenDialog = class(TFPGUIPrivateFileDialog)
|
||||
private
|
||||
protected
|
||||
function InternalShowDialog: Boolean; override;
|
||||
public
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateDialog }
|
||||
{ Private class for dialogs }
|
||||
|
||||
{ TFPGUIPrivateSaveDialog }
|
||||
|
||||
TFPGUIPrivateSaveDialog = class(TFPGUIPrivateFileDialog)
|
||||
private
|
||||
protected
|
||||
function InternalShowDialog: Boolean; override;
|
||||
public
|
||||
end;
|
||||
|
||||
@ -164,7 +256,6 @@ type
|
||||
constructor Create(ALCLObject: TWinControl; const AParams: TCreateParams); override;
|
||||
{ Virtual methods }
|
||||
procedure CreateWidget(const AParams: TCreateParams); override;
|
||||
procedure SetEvents; override;
|
||||
function HasStaticText: Boolean; override;
|
||||
procedure SetText(const AText: String); override;
|
||||
function GetText: String; override;
|
||||
@ -178,9 +269,13 @@ type
|
||||
TFPGUIPrivateComboBox = class(TFPGUIPrivateWidget)
|
||||
private
|
||||
protected
|
||||
procedure HandleChange(Sender: TObject);
|
||||
procedure HandleDropDown(Sender: TObject);
|
||||
procedure HandleCloseUp(Sender: TObject);
|
||||
public
|
||||
{ Virtual methods }
|
||||
procedure CreateWidget(const AParams: TCreateParams); override;
|
||||
procedure SetEvents; override;
|
||||
public
|
||||
{ Other methods }
|
||||
function ComboBox: TfpgComboBox;
|
||||
@ -208,12 +303,14 @@ type
|
||||
TFPGUIPrivateCheckBox = class(TFPGUIPrivateWidget)
|
||||
private
|
||||
protected
|
||||
procedure HandleChange(Sender: TObject);
|
||||
public
|
||||
{ Virtual methods }
|
||||
procedure CreateWidget(const AParams: TCreateParams); override;
|
||||
function HasStaticText: Boolean; override;
|
||||
procedure SetText(const AText: String); override;
|
||||
function GetText: String; override;
|
||||
procedure SetEvents; override;
|
||||
public
|
||||
{ Other methods }
|
||||
function CheckBox: TfpgCheckBox;
|
||||
@ -281,7 +378,7 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLMessageGlue, fpg_base;
|
||||
LCLMessageGlue, fpg_main;
|
||||
|
||||
{ TFPGUIPrivate }
|
||||
|
||||
@ -302,6 +399,180 @@ begin
|
||||
Widget.Visible := AValue;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.PaintHandler(Sender: TObject{; const ARect: TfpgRect});
|
||||
var
|
||||
Msg: TLMPaint;
|
||||
AStruct: PPaintStruct;
|
||||
begin
|
||||
{$ifdef VerboseFPGUIPrivate}
|
||||
WriteLn('TFPGUIPrivateWindow.PaintHandler');
|
||||
{$endif}
|
||||
|
||||
if (LCLObject is TWinControl) then
|
||||
begin
|
||||
FillChar(Msg, SizeOf(Msg), #0);
|
||||
|
||||
Msg.Msg := LM_PAINT;
|
||||
New(AStruct);
|
||||
FillChar(AStruct^, SizeOf(TPaintStruct), 0);
|
||||
Msg.PaintStruct := AStruct;
|
||||
Msg.DC := BeginPaint(THandle(Self), AStruct^);
|
||||
|
||||
// Msg.PaintStruct^.rcPaint := PaintData.ClipRect^;
|
||||
Msg.PaintStruct^.hdc := Msg.DC;
|
||||
|
||||
|
||||
// send paint message
|
||||
try
|
||||
// Saving clip rect and clip region
|
||||
try
|
||||
LCLObject.WindowProc(TLMessage(Msg));
|
||||
finally
|
||||
EndPaint(THandle(Self), AStruct^);
|
||||
Dispose(AStruct);
|
||||
end;
|
||||
except
|
||||
Application.HandleException(nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.ClickHandler(Sender: TObject);
|
||||
begin
|
||||
LCLSendClickedMsg(LCLObject);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.ResizeHandler(Sender: TObject);
|
||||
begin
|
||||
LCLSendSizeMsg(LCLObject, Widget.Width, Widget.Height, SIZENORMAL);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MoveHandler(Sender: TObject);
|
||||
begin
|
||||
LCLSendMoveMsg(LCLObject, Widget.Left, Widget.Top);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.EnterHandler(Sender: TObject);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.ExitHandler(Sender: TObject);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgPaint(var fpgmsg: TfpgMessageRec);
|
||||
var
|
||||
Msg: TLMPaint;
|
||||
AStruct: PPaintStruct;
|
||||
begin
|
||||
{$ifdef VerboseFPGUIPrivate}
|
||||
WriteLn('TFPGUIPrivateWindow.PaintHandler');
|
||||
{$endif}
|
||||
|
||||
if (LCLObject is TWinControl) then
|
||||
begin
|
||||
FillChar(Msg, SizeOf(Msg), #0);
|
||||
|
||||
Msg.Msg := LM_PAINT;
|
||||
New(AStruct);
|
||||
FillChar(AStruct^, SizeOf(TPaintStruct), 0);
|
||||
Msg.PaintStruct := AStruct;
|
||||
Msg.DC := BeginPaint(THandle(Self), AStruct^);
|
||||
|
||||
// Msg.PaintStruct^.rcPaint := PaintData.ClipRect^;
|
||||
Msg.PaintStruct^.hdc := Msg.DC;
|
||||
|
||||
|
||||
// send paint message
|
||||
try
|
||||
// Saving clip rect and clip region
|
||||
try
|
||||
LCLObject.WindowProc(TLMessage(Msg));
|
||||
finally
|
||||
EndPaint(THandle(Self), AStruct^);
|
||||
Dispose(AStruct);
|
||||
end;
|
||||
except
|
||||
Application.HandleException(nil);
|
||||
end;
|
||||
end;end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgResize(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendSizeMsg(LCLObject, fpgmsg.Params.rect.Width, fpgmsg.Params.rect.Height, SIZENORMAL);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgMove(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendMoveMsg(LCLObject, fpgmsg.Params.rect.Left, fpgmsg.Params.rect.Top);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgKeyChar(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgKeyPress(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendKeyDownEvent(LCLObject, fpgmsg.Params.keyboard.keycode, fpgmsg.Params.keyboard.keycode, True, True);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgKeyRelease(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendKeyUpEvent(LCLObject, fpgmsg.Params.keyboard.keycode, fpgmsg.Params.keyboard.keycode, True, True);
|
||||
end;
|
||||
|
||||
function fpgMouseButtonToTButton(AButton: Word): Controls.TMouseButton;
|
||||
begin
|
||||
case AButton of
|
||||
MOUSE_LEFT: Result := Controls.mbLeft;
|
||||
MOUSE_MIDDLE: Result := Controls.mbMiddle;
|
||||
MOUSE_RIGHT: Result := Controls.mbRight;
|
||||
else
|
||||
Result := Controls.mbExtra1;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgMouseDown(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendMouseDownMsg(LCLObject, fpgmsg.Params.mouse.x, fpgmsg.Params.mouse.y,fpgMouseButtonToTButton(fpgmsg.Params.mouse.Buttons), fpgmsg.Params.mouse.shiftstate);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgMouseUp(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendMouseUpMsg(LCLObject, fpgmsg.Params.mouse.x, fpgmsg.Params.mouse.y,fpgMouseButtonToTButton(fpgmsg.Params.mouse.Buttons), fpgmsg.Params.mouse.shiftstate);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgMouseMove(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendMouseMoveMsg(LCLObject, fpgmsg.Params.mouse.x, fpgmsg.Params.mouse.y, fpgmsg.Params.mouse.shiftstate);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgDoubleClick(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendMouseMultiClickMsg(LCLObject, fpgmsg.Params.mouse.x, fpgmsg.Params.mouse.y, fpgMouseButtonToTButton(fpgmsg.Params.mouse.Buttons), 2, fpgmsg.Params.mouse.shiftstate);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgMouseEnter(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendMouseEnterMsg(LCLObject);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgMouseExit(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendMouseLeaveMsg(LCLObject);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.MsgMouseScroll(var fpgmsg: TfpgMessageRec);
|
||||
begin
|
||||
LCLSendMouseWheelMsg(LCLObject, fpgmsg.Params.mouse.x, fpgmsg.Params.mouse.y,fpgmsg.Params.mouse.delta, fpgmsg.Params.mouse.shiftstate);
|
||||
end;
|
||||
|
||||
function TFPGUIPrivateWidget.GetParentContainerWidget: TfpgWidget;
|
||||
begin
|
||||
// Note, if the Handle of the parent doesn't exist, it's automatically
|
||||
@ -317,11 +588,18 @@ begin
|
||||
Result := Widget.Visible;
|
||||
end;
|
||||
|
||||
function TFPGUIPrivateWidget.GetWidgetProtected: TFPGWidgetHack;
|
||||
begin
|
||||
REsult := TFPGWidgetHack(FWidget);
|
||||
end;
|
||||
|
||||
constructor TFPGUIPrivateWidget.Create(ALCLObject: TWinControl; const AParams: TCreateParams);
|
||||
begin
|
||||
FLCLObject := ALCLObject;
|
||||
|
||||
CreateWidget(AParams);
|
||||
|
||||
Widget.SetPosition(AParams.X, AParams.Y, AParams.Width, AParams.Height);
|
||||
|
||||
SetEvents;
|
||||
end;
|
||||
@ -333,9 +611,35 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.CreateWidget(const AParams: TCreateParams);
|
||||
begin
|
||||
Widget := TfpgWidget.Create(nil);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.SetEvents;
|
||||
begin
|
||||
|
||||
//WidgetProtected.OnPaint := PaintHandler;
|
||||
WidgetProtected.OnClick := ClickHandler;
|
||||
//WidgetProtected.OnResize:= ResizeHandler;
|
||||
//WidgetProtected.OnMove := MoveHandler;
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_PAINT, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_ACTIVATE, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_DEACTIVATE, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_KEYPRESS, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_KEYRELEASE, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_KEYCHAR, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_MOUSEDOWN, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_MOUSEUP, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_MOUSEMOVE, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_DOUBLECLICK, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_MOUSEENTER, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_MOUSEEXIT, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_CLOSE, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_SCROLL, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_RESIZE, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_MOVE, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_POPUPCLOSE, Self);
|
||||
fpgApplication.SetMessageHook(Widget, FPGM_HINTTIMER, Self);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWidget.SetSize(AWidth, AHeight: LongInt);
|
||||
@ -428,48 +732,13 @@ end;
|
||||
|
||||
Sends a LM_PAINT message to the LCL. This is for windowed controls only
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TFPGUIPrivateWindow.PaintHandler(Sender: TObject);
|
||||
var
|
||||
Msg: TLMPaint;
|
||||
AStruct: PPaintStruct;
|
||||
begin
|
||||
{$ifdef VerboseFPGUIPrivate}
|
||||
WriteLn('TFPGUIPrivateWindow.PaintHandler');
|
||||
{$endif}
|
||||
|
||||
if (LCLObject is TWinControl) then
|
||||
begin
|
||||
FillChar(Msg, SizeOf(Msg), #0);
|
||||
|
||||
Msg.Msg := LM_PAINT;
|
||||
New(AStruct);
|
||||
FillChar(AStruct^, SizeOf(TPaintStruct), 0);
|
||||
Msg.PaintStruct := AStruct;
|
||||
Msg.DC := BeginPaint(THandle(Self), AStruct^);
|
||||
|
||||
// Msg.PaintStruct^.rcPaint := PaintData.ClipRect^;
|
||||
Msg.PaintStruct^.hdc := Msg.DC;
|
||||
|
||||
|
||||
// send paint message
|
||||
try
|
||||
// Saving clip rect and clip region
|
||||
try
|
||||
LCLObject.WindowProc(TLMessage(Msg));
|
||||
finally
|
||||
EndPaint(THandle(Self), AStruct^);
|
||||
Dispose(AStruct);
|
||||
end;
|
||||
except
|
||||
Application.HandleException(nil);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateWindow.CloseHandler(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
CloseAction := caFree;
|
||||
if LCLSendCloseQueryMsg(LCLObject) = 0 then
|
||||
CloseAction := caNone;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -510,8 +779,6 @@ end;
|
||||
procedure TFPGUIPrivateWindow.SetEvents;
|
||||
begin
|
||||
inherited SetEvents;
|
||||
|
||||
Form.OnPaint := PaintHandler;
|
||||
Form.OnClose := CloseHandler;
|
||||
end;
|
||||
|
||||
@ -594,16 +861,6 @@ begin
|
||||
Widget.SetPosition(LCLObject.Left, LCLObject.Top, LCLObject.Width, LCLObject.Height);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TFPGUIPrivateButton.SetEvents
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TFPGUIPrivateButton.SetEvents;
|
||||
begin
|
||||
Button.OnClick := Clicked;
|
||||
end;
|
||||
|
||||
function TFPGUIPrivateButton.HasStaticText: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
@ -651,6 +908,21 @@ begin
|
||||
Result := TfpgComboBox(Widget);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateComboBox.HandleChange(Sender: TObject);
|
||||
begin
|
||||
LCLSendSelectionChangedMsg(LCLObject);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateComboBox.HandleDropDown(Sender: TObject);
|
||||
begin
|
||||
LCLSendDropDownMsg(LCLObject);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateComboBox.HandleCloseUp(Sender: TObject);
|
||||
begin
|
||||
LCLSendCloseUpMsg(LCLObject);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TFPGUIPrivateComboBox.CreateWidget
|
||||
Params: None
|
||||
@ -662,6 +934,14 @@ begin
|
||||
Widget.SetPosition(LCLObject.Left, LCLObject.Top, LCLObject.Width, LCLObject.Height);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateComboBox.SetEvents;
|
||||
begin
|
||||
inherited SetEvents;
|
||||
ComboBox.OnChange := HandleChange;
|
||||
ComboBox.OnDropDown := HandleDropDown;
|
||||
ComboBox.OnCloseUp := HandleCloseUp;
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateEdit }
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -717,6 +997,11 @@ begin
|
||||
Result := TfpgCheckBox(Widget);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateCheckBox.HandleChange(Sender: TObject);
|
||||
begin
|
||||
LCLSendChangedMsg(LCLObject);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateCheckBox.CreateWidget(const AParams: TCreateParams);
|
||||
begin
|
||||
Widget := TfpgCheckBox.Create(GetParentContainerWidget());
|
||||
@ -738,6 +1023,12 @@ begin
|
||||
Result := CheckBox.Text;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateCheckBox.SetEvents;
|
||||
begin
|
||||
inherited SetEvents;
|
||||
CheckBox.OnChange := HandleChange;
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateRadioButton }
|
||||
|
||||
function TFPGUIPrivateRadioButton.RadioButton: TfpgRadioButton;
|
||||
@ -826,5 +1117,125 @@ begin
|
||||
PopUpMenu.ShowAt(PopUpMenu, X, Y);
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateCommonDialog }
|
||||
|
||||
constructor TFPGUIPrivateCommonDialog.Create(ALCLDialog: TCommonDialog);
|
||||
begin
|
||||
FLCLDialog := ALCLDialog;
|
||||
CreateDialog;
|
||||
WriteLn('Created ', ClassNAme, ':', Dialog.ClassName);
|
||||
end;
|
||||
|
||||
destructor TFPGUIPrivateCommonDialog.Destroy;
|
||||
begin
|
||||
Dialog.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateCommonDialog.CreateDialog;
|
||||
begin
|
||||
Dialog := TfpgBaseDialog.Create(nil);
|
||||
end;
|
||||
|
||||
function TFPGUIPrivateCommonDialog.InternalShowDialog: Boolean;
|
||||
begin
|
||||
Result := Dialog.ShowModal = 1;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateCommonDialog.UpdatePropsBefore;
|
||||
begin
|
||||
Dialog.WindowTitle := LCLDialog.Title;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateCommonDialog.UpdatePropsAfter;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function TFPGUIPrivateCommonDialog.ShowDialog: Boolean;
|
||||
begin
|
||||
UpdatePropsBefore;
|
||||
Result := InternalShowDialog;
|
||||
LCLDialog.UserChoice := Dialog.ModalResult;
|
||||
UpdatePropsAfter;
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateFileDialog }
|
||||
|
||||
procedure TFPGUIPrivateFileDialog.UpdatePropsBefore;
|
||||
|
||||
|
||||
begin
|
||||
inherited UpdatePropsBefore;
|
||||
FileDialog.Filter := LCLFileDialog.Filter;
|
||||
if Length(LCLFileDialog.FileName) <> 0 then
|
||||
FileDialog.FileName := LCLFileDialog.FileName
|
||||
else
|
||||
FileDialog.FileName := LCLFileDialog.InitialDir;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateFileDialog.UpdatePropsAfter;
|
||||
begin
|
||||
inherited UpdatePropsAfter;
|
||||
LCLFileDialog.FileName := FileDialog.FileName;
|
||||
//LCLFileDialog.Files.Assign(FileDialog.);
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateFileDialog.CreateDialog;
|
||||
begin
|
||||
Dialog := TfpgFileDialog.Create(nil);
|
||||
end;
|
||||
|
||||
function TFPGUIPrivateFileDialog.FileDialog: TfpgFileDialog;
|
||||
begin
|
||||
Result :=TfpgFileDialog(Dialog);
|
||||
end;
|
||||
|
||||
function TFPGUIPrivateFileDialog.LCLFileDialog: TFileDialog;
|
||||
begin
|
||||
Result := TFileDialog(LCLDialog) ;
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateOpenDialog }
|
||||
|
||||
function TFPGUIPrivateOpenDialog.InternalShowDialog: Boolean;
|
||||
begin
|
||||
Result:=FileDialog.RunOpenFile;
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateSaveDialog }
|
||||
|
||||
function TFPGUIPrivateSaveDialog.InternalShowDialog: Boolean;
|
||||
begin
|
||||
Result:=FileDialog.RunSaveFile;
|
||||
end;
|
||||
|
||||
{ TFPGUIPrivateFontDialog }
|
||||
|
||||
procedure TFPGUIPrivateFontDialog.CreateDialog;
|
||||
begin
|
||||
Dialog := TfpgFontSelectDialog.Create(nil);
|
||||
end;
|
||||
|
||||
function TFPGUIPrivateFontDialog.InternalShowDialog: Boolean;
|
||||
begin
|
||||
FontDialog.ShowModal;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateFontDialog.UpdatePropsBefore;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TFPGUIPrivateFontDialog.UpdatePropsAfter;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TFPGUIPrivateFontDialog.FontDialog: TfpgFontSelectDialog;
|
||||
begin
|
||||
Result := TfpgFontSelectDialog(Dialog);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -319,7 +319,7 @@ var
|
||||
begin
|
||||
vComboBox := TFPGUIPrivateComboBox(ACustomComboBox.Handle).ComboBox;
|
||||
|
||||
Result := vComboBox.FocusItem-1; // TfpgComboBox is 1-based
|
||||
Result := vComboBox.FocusItem;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -334,7 +334,7 @@ var
|
||||
begin
|
||||
vComboBox := TFPGUIPrivateComboBox(ACustomComboBox.Handle).ComboBox;
|
||||
|
||||
vComboBox.FocusItem := NewIndex+1; // TfpgComboBox is 1-based
|
||||
vComboBox.FocusItem := NewIndex;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
Loading…
Reference in New Issue
Block a user