add TCustomForm.BorderIcons (delphi compat)

tweak win32 window dialog flags, to create better dialog look

git-svn-id: trunk@6159 -

lcl/forms.pp

@@ -310,6 +310,9 @@ type
 
   TIDesigner = class;
 
+  TBorderIcon = (biSystemMenu, biMinimize, biMaximize, biHelp);
+  TBorderIcons = set of TBorderIcon;
+    
   TCloseEvent = procedure(Sender: TObject; var CloseAction: TCloseAction) of object;
   TCloseQueryEvent = procedure(Sender : TObject;
                                var CanClose : boolean) of object;
@@ -339,6 +342,7 @@ type
   private
     FActive: Boolean;
     FActiveControl: TWinControl;
+    FBorderIcons: TBorderIcons;
     FDefaultControl: TControl;
     FCancelControl: TControl;
     FDesigner: TIDesigner;
@@ -376,6 +380,7 @@ type
     function IsKeyPreviewStored: boolean;
     procedure SetActive(AValue: Boolean);
     procedure SetActiveControl(AWinControl: TWinControl);
+    procedure SetBorderIcons(NewIcons: TBorderIcons);
     procedure SetFormBorderStyle(NewStyle: TFormBorderStyle);
     procedure SetCancelControl(NewControl: TControl);
     procedure SetDefaultControl(NewControl: TControl);
@@ -472,6 +477,8 @@ type
   public
     property Active: Boolean read FActive;
     property ActiveControl: TWinControl read FActiveControl write SetActiveControl;
+    property BorderIcons: TBorderIcons read FBorderIcons write SetBorderIcons 
+      default [biSystemMenu, biMinimize, biMaximize];
     property BorderStyle: TFormBorderStyle
                       read FFormBorderStyle write SetFormBorderStyle default bsSizeable;
     property CancelControl: TControl read FCancelControl write SetCancelControl;
@@ -525,6 +532,7 @@ type
     property ActiveControl;
     property Align;
     property AutoSize;
+    property BorderIcons;
     property BorderStyle;
     property Caption;
     property ClientHeight;

lcl/include/customform.inc

@@ -1044,6 +1044,16 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------}
+{       TCustomForm SetBorderIcons                                             }
+{------------------------------------------------------------------------------}
+procedure TCustomForm.SetBorderIcons(NewIcons: TBorderIcons);
+begin
+  if FBorderIcons = NewIcons then exit;
+  if HandleAllocated then
+    TWSCustomFormClass(WidgetSetClass).SetBorderIcons(Self, NewIcons);
+end;
+
 {------------------------------------------------------------------------------}
 {       TCustomForm SetFormBorderStyle                                         }
 {------------------------------------------------------------------------------}
@@ -1808,6 +1818,10 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.160  2004/10/24 18:54:57  micha
+  add TCustomForm.BorderIcons (delphi compat)
+  tweak win32 window dialog flags, to create better dialog look
+
   Revision 1.159  2004/09/23 09:00:42  vincents
   fix type cast of WidgetSetClass
 

lcl/interfaces/win32/win32proc.pp

@@ -812,17 +812,16 @@ end;
 
 function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD;
 begin
-  Result := WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
+  Result := WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
   case Style of
-  //bsSizeable:; -> Default
-  bsSingle:
-    Result := Result and DWORD(not WS_THICKFRAME);
+  bsSizeable, bsSizeToolWin:
+    Result := Result or (WS_POPUP or WS_THICKFRAME or WS_CAPTION);
+  bsSingle, bsToolWindow:
+    Result := Result or (WS_OVERLAPPED or WS_BORDER or WS_CAPTION);
   bsDialog:
-    Result := Result and DWORD(not (WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX));
+    Result := Result or (WS_POPUP or WS_BORDER or WS_CAPTION);
   bsNone:
-    Result := WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
-  bsToolWindow:
-    Result := Result and DWORD(not WS_THICKFRAME);
+    Result := Result or WS_POPUP;
   end;
 end;
 
@@ -830,6 +829,8 @@ function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD;
 begin
   Result := 0;
   case Style of
+  bsDialog:
+    Result := WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE;
   bsToolWindow, bsSizeToolWin:
     Result := WS_EX_TOOLWINDOW;
   end;

lcl/interfaces/win32/win32wsforms.pp

@@ -80,6 +80,8 @@ type
   private
   protected
   public
+    class procedure SetBorderIcons(const AForm: TCustomForm;
+          const ABorderIcons: TBorderIcons); override;
     class function  CreateHandle(const AWinControl: TWinControl;
           const AParams: TCreateParams): HWND; override;
     class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
@@ -174,21 +176,45 @@ end;
 
 { TWin32WSCustomForm }
 
+function CalcBorderIconsFlags(const AForm: TCustomForm): dword;
+var
+  BorderIcons: TBorderIcons;
+begin
+  Result := 0;
+  if not (AForm.BorderStyle in [bsNone, bsDialog, bsToolWindow]) then
+  begin
+    BorderIcons := AForm.BorderIcons;
+    if biSystemMenu in BorderIcons then
+    begin
+      Result := Result or WS_SYSMENU;
+      if biMinimize in BorderIcons then
+        Result := Result or WS_MINIMIZEBOX;
+      if biMaximize in BorderIcons then
+        Result := Result or WS_MAXIMIZEBOX;
+    end;
+  end;
+end;
+
 function TWin32WSCustomForm.CreateHandle(const AWinControl: TWinControl;
   const AParams: TCreateParams): HWND;
 var
   Params: TCreateWindowExParams;
+  lForm: TCustomForm;
+  BorderStyle: TFormBorderStyle;
 begin
   // general initialization of Params
   PrepareCreateWindow(AWinControl, Params);
   // customization of Params
   with Params do
   begin
-    Flags := BorderStyleToWin32Flags(TCustomForm(AWinControl).BorderStyle);
-    FlagsEx := BorderStyleToWin32FlagsEx(TCustomForm(AWinControl).BorderStyle);
-    if (TCustomForm(AWinControl).FormStyle in fsAllStayOnTop)
-    and (not (csDesigning in TCustomForm(AWinControl).ComponentState)) then
+    lForm := TCustomForm(AWinControl);
+    BorderStyle := lForm.BorderStyle;
+    Flags := BorderStyleToWin32Flags(BorderStyle);
+    FlagsEx := BorderStyleToWin32FlagsEx(BorderStyle);
+    if (lForm.FormStyle in fsAllStayOnTop) and 
+        (not (csDesigning in lForm.ComponentState)) then
       FlagsEx := FlagsEx or WS_EX_TOPMOST;
+    Flags := Flags or CalcBorderIconsFlags(lForm);
     pClassName := @ClsName;
     WindowTitle := StrCaption;
     Left := LongInt(CW_USEDEFAULT);
@@ -202,6 +228,13 @@ begin
   Result := Params.Window;
 end;
 
+procedure TWin32WSCustomForm.SetBorderIcons(const AForm: TCustomForm;
+          const ABorderIcons: TBorderIcons);
+begin
+  UpdateWindowStyle(AForm.Handle, CalcBorderIconsFlags(AForm), 
+    WS_SYSMENU or WS_MINIMIZEBOX or WS_MAXIMIZEBOX);
+end;
+
 procedure TWin32WSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
 begin
   SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, AIcon);

lcl/widgetset/wsforms.pp

@@ -72,6 +72,8 @@ type
   { TWSCustomForm }
 
   TWSCustomForm = class(TWSScrollingWinControl)
+    class procedure SetBorderIcons(const AForm: TCustomForm;
+        const ABorderIcons: TBorderIcons); virtual;
     class procedure SetFormBorderStyle(const AForm: TCustomForm;
                              const AFormBorderStyle: TFormBorderStyle); virtual;
     class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); virtual;
@@ -104,6 +106,11 @@ implementation
 
 { TWSCustomForm }
 
+procedure TWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
+        const ABorderIcons: TBorderIcons);
+begin
+end;
+
 procedure TWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
   const AFormBorderStyle: TFormBorderStyle);
 begin