convert LM_SHOWMODAL to interface methods

git-svn-id: trunk@5990 -
This commit is contained in:
micha 2004-09-13 13:13:47 +00:00
parent 06702cefa4
commit 977ee858b4
15 changed files with 186 additions and 139 deletions

View File

@ -334,7 +334,8 @@ procedure Register;
implementation
uses Math;
uses
Math, WSDialogs;
const
//
@ -419,6 +420,9 @@ end.
{ =============================================================================
$Log$
Revision 1.52 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods
Revision 1.51 2004/08/18 09:31:21 mattias
removed obsolete unit vclglobals

View File

@ -80,7 +80,7 @@ function TCommonDialog.DoExecute : boolean;
var CanClose: boolean;
begin
if Assigned(FOnShow) then FOnShow(Self);
CNSendMessage(LM_SHOWMODAL, Self, nil);
TWSCommonDialogClass(WidgetSetClass).ShowModal(Self);
repeat
Application.HandleMessage;
if (FUserChoice <> mrNone) and (Handle<>0)
@ -97,6 +97,9 @@ end;
{ =============================================================================
$Log$
Revision 1.16 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods
Revision 1.15 2004/05/11 12:16:47 mattias
replaced writeln by debugln

View File

@ -1682,7 +1682,7 @@ begin
try
Show;
try
CNSendMessage(LM_SHOWMODAL, Self, nil);
TWSCustomFormClass(WidgetSetClass).ShowModal(Self);
repeat
{ Delphi calls Application.HandleMessage
But HandleMessage processes all pending events and then calls idle,
@ -1808,6 +1808,9 @@ end;
{ =============================================================================
$Log$
Revision 1.156 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods
Revision 1.155 2004/08/30 10:49:20 mattias
fixed focus catch for combobox csDropDownList

View File

@ -237,8 +237,6 @@ type
procedure BringFormToFront(Sender: TObject);
procedure SetWindowSizeAndPosition(Window: PGtkWindow;
AWinControl: TWinControl);virtual;
procedure ShowModal(Sender: TObject); virtual;
procedure UpdateTransientWindows; virtual;
procedure UntransientWindow(GtkWindow: PGtkWindow);
procedure InitializeFileDialog(FileDialog: TFileDialog;
var SelWidget: PGtkWidget; Title: PChar);
@ -257,8 +255,6 @@ type
function GetValue(Sender : TObject; Data : pointer) : integer;virtual;
function SetValue(Sender : TObject; Data : pointer) : integer;virtual;
function SetProperties (Sender: TObject) : integer;virtual;
procedure SetColorDialogColor(ColorSelection: PGtkColorSelection;
Color: TColor);virtual;
procedure WordWrap(DC: HDC; AText: PChar; MaxWidthInPixel: integer;
var Lines: PPChar; var LineCount: integer);
procedure UpdateStatusBarPanels(StatusBar: TObject;
@ -267,7 +263,6 @@ type
StatusPanelWidget: PGtkWidget); virtual;
procedure ResizeChild(Sender : TObject; Left,Top,Width,Height : Integer);virtual;
procedure UnsetResizeRequest(Widget: PGtkWidget);virtual;
procedure RemoveCallbacks(Widget: PGtkWidget); virtual;
public
// for gtk specific components:
@ -303,7 +298,10 @@ type
procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
// helper routines needed by interface methods
procedure UnsetResizeRequest(Widget: PGtkWidget);virtual;
procedure SetResizeRequest(Widget: PGtkWidget);virtual;
// |-forms
procedure UpdateTransientWindows; virtual;
function ForceLineBreaks(DC : hDC; Src: PChar; MaxWidthInPixels : Longint;
ProcessAmpersands : Boolean) : PChar;
@ -343,13 +341,13 @@ uses
GtkWSControls,
// GtkWSDbCtrls,
// GtkWSDBGrids,
// GtkWSDialogs,
GtkWSDialogs,
// GtkWSDirSel,
// GtkWSEditBtn,
GtkWSExtCtrls,
// GtkWSExtDlgs,
// GtkWSFileCtrl,
// GtkWSForms,
GtkWSForms,
// GtkWSGrids,
// GtkWSImgList,
// GtkWSMaskEdit,
@ -458,6 +456,9 @@ end.
{ =============================================================================
$Log$
Revision 1.203 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods
Revision 1.202 2004/09/12 19:50:35 micha
convert LM_SETSIZE message to new interface method

View File

@ -443,53 +443,6 @@ begin
gtk_widget_set_uposition(PGtkWidget(Window),AWinControl.Left,AWinControl.Top);
end;
{------------------------------------------------------------------------------
procedure TGtkWidgetSet.ShowModal(Sender: TObject);
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.ShowModal(Sender: TObject);
var
GtkWindow: PGtkWindow;
ACustomForm: TCustomForm;
begin
ReleaseMouseCapture;
if Sender is TCommonDialog then
begin
GtkWindow:=PGtkWindow(TCommonDialog(Sender).Handle);
gtk_window_set_title(GtkWindow,PChar(TCommonDialog(Sender).Title));
if Sender is TColorDialog then
SetColorDialogColor(PGtkColorSelection(GtkWindow),
TColorDialog(Sender).Color);
gtk_window_set_position(GtkWindow, GTK_WIN_POS_CENTER);
end else if (Sender is TCustomForm) then begin
ACustomForm:=TCustomForm(Sender);
if ACustomForm.Parent=nil then begin
GtkWindow:=PGtkWindow(ACustomForm.Handle);
gtk_window_set_default_size(GtkWindow,
Max(1,ACustomForm.Width),Max(1,ACustomForm.Height));
gtk_widget_set_uposition(PGtkWidget(GtkWindow),
ACustomForm.Left, ACustomForm.Top);
end;
end else begin
GtkWindow:=nil;
DebugLn('WARNING: TGtkWidgetSet.ShowModal ',Sender.ClassName);
exit;
end;
if (GtkWindow=nil) then exit;
UnsetResizeRequest(PgtkWidget(GtkWindow));
if ModalWindows=nil then ModalWindows:=TList.Create;
ModalWindows.Add(GtkWindow);
gtk_window_set_modal(GtkWindow, true);
gtk_widget_show(PGtkWidget(GtkWindow));
{$IFDEF VerboseTransient}
DebugLn('TGtkWidgetSet.ShowModal ',Sender.ClassName);
{$ENDIF}
UpdateTransientWindows;
end;
{------------------------------------------------------------------------------
procedure TGtkWidgetSet.UpdateTransientWindows;
------------------------------------------------------------------------------}
@ -3162,8 +3115,6 @@ begin
LM_DESTROY :
DestroyLCLComponent(Sender);
LM_ShowModal: ShowModal(Sender);
LM_TB_BUTTONCOUNT:
begin
{$IFNDEF OldToolBar}
@ -6809,35 +6760,6 @@ begin
Result := TGDKColorToTColor(GDKColor);
end;
{------------------------------------------------------------------------------
Method: TGtkWidgetSet.SetColorDialogColor
Params: ColorSelection : a gtk color selection dialog;
Color : the color to select
Returns: nothing
Set the color of the color selection dialog
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.SetColorDialogColor(ColorSelection: PGtkColorSelection;
Color: TColor);
var
SelectionColor: TGDKColor;
colorSel : PGTKCOLORSELECTION;
begin
{$IFDEF VerboseColorDialog}
DebugLn('TGtkWidgetSet.SetColorDialogColor Start Color=',HexStr(Cardinal(Color),8));
{$ENDIF}
Color:=ColorToRGB(Color);
{$IFDEF VerboseColorDialog}
DebugLn('TGtkWidgetSet.SetColorDialogColor Converted Color=',HexStr(Cardinal(Color),8));
{$ENDIF}
SelectionColor.Pixel := 0;
SelectionColor.Red := Red(Color) shl 8;
SelectionColor.Green:= Green(Color) shl 8;
SelectionColor.Blue:= Blue(Color) shl 8;
colorSel := PGTKCOLORSELECTION((PGTKCOLORSELECTIONDIALOG(ColorSelection))^.colorsel);
gtk_color_selection_set_current_color(colorSel,@SelectionColor);
end;
{------------------------------------------------------------------------------
Method: TGtkWidgetSet.GetValue
Params: Sender : the lcl object which called this func via SenMessage
@ -8502,6 +8424,9 @@ end;
{ =============================================================================
$Log$
Revision 1.560 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods
Revision 1.559 2004/09/12 19:50:35 micha
convert LM_SETSIZE message to new interface method

View File

@ -98,6 +98,8 @@ type
end;
procedure GtkWindowShowModal(GtkWindow: PGtkWindow);
implementation
uses
@ -428,6 +430,25 @@ begin
TGtkWidgetSet(InterfaceObject).ShowHide(AWinControl);
end;
{ helper/common routines }
procedure GtkWindowShowModal(GtkWindow: PGtkWindow);
begin
if (GtkWindow=nil) then exit;
TGtkWidgetSet(InterfaceObject).UnsetResizeRequest(PgtkWidget(GtkWindow));
if ModalWindows=nil then ModalWindows:=TList.Create;
ModalWindows.Add(GtkWindow);
gtk_window_set_modal(GtkWindow, true);
gtk_widget_show(PGtkWidget(GtkWindow));
{$IFDEF VerboseTransient}
DebugLn('TGtkWidgetSet.ShowModal ',Sender.ClassName);
{$ENDIF}
TGtkWidgetSet(InterfaceObject).UpdateTransientWindows;
end;
initialization
////////////////////////////////////////////////////

View File

@ -27,7 +27,9 @@ unit GtkWSDialogs;
interface
uses
Dialogs, WSDialogs, WSLCLClasses;
{$IFDEF GTK2} Gtk2, Glib2, gdk2, {$ELSE} Gtk, gdk, Glib, {$ENDIF}
SysUtils, Classes, Controls, LMessages, InterfaceBase, graphics,
Dialogs, WSDialogs, WSLCLClasses, gtkint, gtkproc, gtkwscontrols;
type
@ -37,6 +39,7 @@ type
private
protected
public
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
end;
{ TGtkWSFileDialog }
@ -97,6 +100,49 @@ type
implementation
{------------------------------------------------------------------------------
Method: SetColorDialogColor
Params: ColorSelection : a gtk color selection dialog;
Color : the color to select
Returns: nothing
Set the color of the color selection dialog
------------------------------------------------------------------------------}
procedure SetColorDialogColor(ColorSelection: PGtkColorSelection;
Color: TColor);
var
SelectionColor: TGDKColor;
colorSel : PGTKCOLORSELECTION;
begin
{$IFDEF VerboseColorDialog}
DebugLn('TGtkWidgetSet.SetColorDialogColor Start Color=',HexStr(Cardinal(Color),8));
{$ENDIF}
Color:=ColorToRGB(Color);
{$IFDEF VerboseColorDialog}
DebugLn('TGtkWidgetSet.SetColorDialogColor Converted Color=',HexStr(Cardinal(Color),8));
{$ENDIF}
SelectionColor.Pixel := 0;
SelectionColor.Red := Red(Color) shl 8;
SelectionColor.Green:= Green(Color) shl 8;
SelectionColor.Blue:= Blue(Color) shl 8;
colorSel := PGTKCOLORSELECTION((PGTKCOLORSELECTIONDIALOG(ColorSelection))^.colorsel);
gtk_color_selection_set_current_color(colorSel,@SelectionColor);
end;
procedure TGtkWSCommonDialog.ShowModal(const ACommonDialog: TCommonDialog);
var
GtkWindow: PGtkWindow;
begin
ReleaseMouseCapture;
GtkWindow:=PGtkWindow(ACommonDialog.Handle);
gtk_window_set_title(GtkWindow,PChar(ACommonDialog.Title));
if ACommonDialog is TColorDialog then
SetColorDialogColor(PGtkColorSelection(GtkWindow),
TColorDialog(ACommonDialog).Color);
gtk_window_set_position(GtkWindow, GTK_WIN_POS_CENTER);
GtkWindowShowModal(GtkWindow);
end;
initialization
@ -106,7 +152,7 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TCommonDialog, TGtkWSCommonDialog);
RegisterWSComponent(TCommonDialog, TGtkWSCommonDialog);
// RegisterWSComponent(TFileDialog, TGtkWSFileDialog);
// RegisterWSComponent(TOpenDialog, TGtkWSOpenDialog);
// RegisterWSComponent(TSaveDialog, TGtkWSSaveDialog);

View File

@ -27,7 +27,10 @@ unit GtkWSForms;
interface
uses
Forms, WSForms, WSLCLClasses;
{$IFDEF GTK2} Gtk2, Glib2, gdk2, {$ELSE} Gtk, gdk, Glib, {$ENDIF}
SysUtils, Classes, Controls, LMessages, InterfaceBase, graphics,
Dialogs, WSDialogs, WSLCLClasses, gtkint, gtkproc, gtkwscontrols,
Forms, WSForms, Math;
type
@ -69,8 +72,9 @@ type
private
protected
public
class procedure SetFormBorderStyle(const AWinControl: TWinControl;
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); override;
class procedure ShowModal(const ACustomForm: TCustomForm); override;
end;
{ TGtkWSForm }
@ -110,14 +114,29 @@ implementation
{ TGtkWSCustomForm }
procedure TGtkWSCustomForm.SetFormBorderStyle(const AWinControl: TWinControl;
procedure TGtkWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle);
begin
inherited SetFormBorderStyle(AWinControl, AFormBorderStyle);
inherited SetFormBorderStyle(AForm, AFormBorderStyle);
// the form border style can only be set at creation time.
// This is Delphi compatible, so no Recreatewnd needed.
end;
procedure TGtkWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
var
GtkWindow: PGtkWindow;
begin
ReleaseMouseCapture;
if ACustomForm.Parent=nil then begin
GtkWindow:=PGtkWindow(ACustomForm.Handle);
gtk_window_set_default_size(GtkWindow,
Max(1,ACustomForm.Width),Max(1,ACustomForm.Height));
gtk_widget_set_uposition(PGtkWidget(GtkWindow),
ACustomForm.Left, ACustomForm.Top);
end;
GtkWindowShowModal(GtkWindow);
end;
initialization
////////////////////////////////////////////////////
@ -130,7 +149,7 @@ initialization
// RegisterWSComponent(TScrollBox, TGtkWSScrollBox);
// RegisterWSComponent(TCustomFrame, TGtkWSCustomFrame);
// RegisterWSComponent(TFrame, TGtkWSFrame);
// RegisterWSComponent(TCustomForm, TGtkWSCustomForm);
RegisterWSComponent(TCustomForm, TGtkWSCustomForm);
// RegisterWSComponent(TForm, TGtkWSForm);
// RegisterWSComponent(THintWindow, TGtkWSHintWindow);
// RegisterWSComponent(TScreen, TGtkWSScreen);

View File

@ -29,30 +29,6 @@
const
WM_THEMECHANGED = $31A;
{-----------------------------------------------------------------------------
Function: DisableWindowsProc
Params: Window - handle of toplevel windows to be disabled
Data - handle of current window form
Returns: Whether the enumeration should continue
Used in LM_SHOWMODAL to disable the windows of application thread
except the current form.
-----------------------------------------------------------------------------}
Function DisableWindowsProc(Window: Hwnd; Data: LParam): LongBool; StdCall;
var
Buffer: array[0..15] of Char;
Begin
Result:=true;
// Don't disable the current window form
if Window=HWND(Data) then exit;
// Don't disable any ComboBox listboxes
if (GetClassName(Window, @Buffer, sizeof(Buffer))<sizeof(Buffer))
and (stricomp(Buffer, 'ComboLBox')=0) then exit;
EnableWindow(Window,False);
End;
{-----------------------------------------------------------------------------
Function: EnableWindowsProc
Params: Window - handle of toplevel windows to be enabled
@ -1319,6 +1295,9 @@ end;
{
$Log$
Revision 1.139 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods
Revision 1.138 2004/09/07 14:13:16 micha
fix key handling of maskedit (inhibit backspace handling)

View File

@ -227,13 +227,13 @@ Uses
Win32WSControls,
// Win32WSDbCtrls,
// Win32WSDBGrids,
// Win32WSDialogs,
Win32WSDialogs,
// Win32WSDirSel,
// Win32WSEditBtn,
// Win32WSExtCtrls,
// Win32WSExtDlgs,
// Win32WSFileCtrl,
// Win32WSForms,
Win32WSForms,
// Win32WSGrids,
// Win32WSImgList,
// Win32WSMaskEdit,
@ -282,6 +282,9 @@ End.
{ =============================================================================
$Log$
Revision 1.108 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods
Revision 1.107 2004/09/12 19:50:36 micha
convert LM_SETSIZE message to new interface method

View File

@ -335,15 +335,6 @@ Begin
Else
Assert(False, Format('Trace:I don''t know how to destroy component %S', [Sender.ClassName]));
End;
LM_SHOWMODAL:
Begin
If Sender Is TCommonDialog Then
Exit
Else begin
EnumThreadWindows(GetWindowThreadProcessId(Handle,nil),@DisableWindowsProc, Handle);
ShowWindow(Handle, SW_Show);
end;
End;
LM_TB_BUTTONCOUNT:
Begin
If Sender Is TToolbar Then
@ -2472,6 +2463,9 @@ End;
{
$Log$
Revision 1.252 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods
Revision 1.251 2004/09/12 19:50:36 micha
convert LM_SETSIZE message to new interface method

View File

@ -33,9 +33,9 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Forms,
Forms,
////////////////////////////////////////////////////
WSForms, WSLCLClasses;
WSForms, WSLCLClasses, Windows, SysUtils;
type
@ -77,6 +77,7 @@ type
private
protected
public
class procedure ShowModal(const ACustomForm: TCustomForm); override;
end;
{ TWin32WSForm }
@ -114,6 +115,41 @@ type
implementation
{-----------------------------------------------------------------------------
Function: DisableWindowsProc
Params: Window - handle of toplevel windows to be disabled
Data - handle of current window form
Returns: Whether the enumeration should continue
Used in LM_SHOWMODAL to disable the windows of application thread
except the current form.
-----------------------------------------------------------------------------}
function DisableWindowsProc(Window: HWND; Data: LParam): LongBool; stdcall;
var
Buffer: array[0..15] of Char;
begin
Result:=true;
// Don't disable the current window form
if Window=HWND(Data) then exit;
// Don't disable any ComboBox listboxes
if (GetClassName(Window, @Buffer, sizeof(Buffer))<sizeof(Buffer))
and (StrIComp(Buffer, 'ComboLBox')=0) then exit;
EnableWindow(Window,False);
end;
{ TWin32WSCustomForm }
procedure TWin32WSCustomForm.ShowModal(const ACustomForm: TCustomForm);
var
FormHandle: HWND;
begin
FormHandle := ACustomForm.Handle;
EnumThreadWindows(GetWindowThreadProcessId(FormHandle, nil), @DisableWindowsProc, FormHandle);
ShowWindow(FormHandle, SW_SHOW);
end;
initialization
////////////////////////////////////////////////////
@ -126,7 +162,7 @@ initialization
// RegisterWSComponent(TScrollBox, TWin32WSScrollBox);
// RegisterWSComponent(TCustomFrame, TWin32WSCustomFrame);
// RegisterWSComponent(TFrame, TWin32WSFrame);
// RegisterWSComponent(TCustomForm, TWin32WSCustomForm);
RegisterWSComponent(TCustomForm, TWin32WSCustomForm);
// RegisterWSComponent(TForm, TWin32WSForm);
// RegisterWSComponent(THintWindow, TWin32WSHintWindow);
// RegisterWSComponent(TScreen, TWin32WSScreen);

View File

@ -153,7 +153,6 @@ const
LM_CONFIGUREEVENT = LM_User+31;
//LM_DRAW = LM_User+32; //LM_DRAW and LM_PAINT are the same.
LM_PAINT = LM_User+32;
LM_SHOWMODAL = LM_USER+33;
LM_OK_CLICKED = LM_USER+36;
LM_CANCEL_CLICKED = LM_USER+37;
//LM_KEYDOWN = LM_User+38; // Windows Compatability
@ -933,7 +932,6 @@ begin
LM_CONFIGUREEVENT :Result:='LM_CONFIGUREEVENT';
//LM_DRAW :Result:='LM_DRAW';
LM_PAINT :Result:='LM_PAINT';
LM_SHOWMODAL :Result:='LM_SHOWMODAL';
LM_OK_CLICKED :Result:='LM_OK_CLICKED';
LM_CANCEL_CLICKED :Result:='LM_CANCEL_CLICKED';
//LM_KEYDOWN :Result:='LM_KEYDOWN';
@ -984,6 +982,9 @@ end.
{
$Log$
Revision 1.92 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods
Revision 1.91 2004/09/12 19:50:35 micha
convert LM_SETSIZE message to new interface method

View File

@ -44,14 +44,17 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Dialogs,
Dialogs,
////////////////////////////////////////////////////
WSLCLClasses, WSControls;
type
{ TWSCommonDialog }
TWSCommonDialogClass = class of TWSCommonDialog;
TWSCommonDialog = class(TWSLCLComponent)
public
class procedure ShowModal(const ACommonDialog: TCommonDialog); virtual;
end;
{ TWSFileDialog }
@ -92,6 +95,10 @@ type
implementation
procedure TWSCommonDialog.ShowModal(const ACommonDialog: TCommonDialog);
begin
end;
initialization
////////////////////////////////////////////////////

View File

@ -44,9 +44,9 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Forms,
Forms,
////////////////////////////////////////////////////
WSLCLClasses, WSControls, Forms, Controls;
WSLCLClasses, WSControls, Controls;
type
{ TWSScrollingWinControl }
@ -74,6 +74,7 @@ type
TWSCustomForm = class(TWSScrollingWinControl)
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); virtual;
class procedure ShowModal(const ACustomForm: TCustomForm); virtual;
end;
TWSCustomFormClass = class of TWSCustomForm;
@ -108,6 +109,10 @@ begin
// will be done in interface override
end;
procedure TWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
begin
end;
initialization
////////////////////////////////////////////////////
@ -118,7 +123,7 @@ initialization
// RegisterWSComponent(TScrollBox, TWSScrollBox);
// RegisterWSComponent(TCustomFrame, TWSCustomFrame);
// RegisterWSComponent(TFrame, TWSFrame);
RegisterWSComponent(TCustomForm, TWSCustomForm);
// RegisterWSComponent(TCustomForm, TWSCustomForm);
// RegisterWSComponent(TForm, TWSForm);
// RegisterWSComponent(THintWindow, TWSHintWindow);
// RegisterWSComponent(TScreen, TWSScreen);