lcl:

- create, destroy TIcon.Handle when needed
- repair TCustomForm.SetIcon, TApplication.SetIcon

git-svn-id: trunk@15503 -

lcl/forms.pp

@@ -442,6 +442,7 @@ type
     procedure WMShowWindow(var message: TLMShowWindow); message LM_SHOWWINDOW;
     procedure WMSize(var message: TLMSize); message LM_Size;
     procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
+    procedure CMIconChanged(var Message: TLMessage); message CM_ICONCHANGED;
     procedure AddHandler(HandlerType: TFormHandlerType;
                          const Handler: TMethod; AsLast: Boolean);
     procedure RemoveHandler(HandlerType: TFormHandlerType;

lcl/graphics.pp

@@ -1383,6 +1383,7 @@ type
   private
     FImages: TFPList;
   protected
+    procedure FreeHandle; override;
     class function GetImagesClass: TIconImageClass; virtual;
   public
     constructor Create; override;
@@ -1434,6 +1435,8 @@ type
   }
   
 
+  { TCustomIcon }
+
   TCustomIcon = class(TRasterImage)
   private
     FCurrent: Integer;
@@ -1465,6 +1468,7 @@ type
     constructor Create; override;
 
     procedure Add(AFormat: TPixelFormat; AHeight, AWidth: Word);
+    procedure Assign(Source: TPersistent); override;
     procedure Delete(Aindex: Integer);
     procedure Remove(AFormat: TPixelFormat; AHeight, AWidth: Word);
     procedure GetDescription(Aindex: Integer; out AFormat: TPixelFormat; out AHeight, AWidth: Word);
@@ -1485,6 +1489,7 @@ type
     function  GetIconHandle: HICON;
     procedure SetIconHandle(const AValue: HICON);
   protected
+    procedure HandleNeeded; override;
   public
     function ReleaseHandle: HICON;
     property Handle: HICON read GetIconHandle write SetIconHandle;

lcl/include/application.inc

@@ -104,7 +104,8 @@ begin
   FShowMainForm := true;
   FFormList := nil;
   FOnIdle := nil;
-  FIcon := nil;
+  FIcon := TIcon.Create;
+  FIcon.OnChange := @IconChanged;
   FNavigation := [anoTabToSelectNext,anoReturnForDefaultControl,
                   anoEscapeForCancelControl,anoF1ForHelp];
   ApplicationActionComponent:=Self;
@@ -347,13 +348,8 @@ begin
   ScreenInfo.Initialized:=true;
   Screen.UpdateScreen;
   // application icon
-  if LazarusResources.Find('MAINICON')<>nil then begin
-    if FIcon=nil then begin
-      FIcon:=TIcon.Create;
-      FIcon.OnChange := @IconChanged;
-    end;
-    FIcon.LoadFromLazarusResource('MAINICON');
-  end;
+  if LazarusResources.Find('MAINICON') <> nil then
+    Icon.LoadFromLazarusResource('MAINICON');
 end;
 
 {------------------------------------------------------------------------------
@@ -503,10 +499,6 @@ end;
  ------------------------------------------------------------------------------}
 procedure TApplication.SetIcon(AValue: TIcon);
 begin
-  if FIcon=nil then begin
-    FIcon:=TIcon.Create;
-    FIcon.OnChange := @IconChanged;
-  end;
   FIcon.Assign(AValue);
 end;
 
@@ -874,10 +866,13 @@ end;
   Method: TApplication.IconChanged
  ------------------------------------------------------------------------------}
 procedure TApplication.IconChanged(Sender: TObject);
+var
+  i: integer;
 begin
-  DebugLn('TApplication.IconChanged - TODO: convert this message...no implementation in gtk or win32');
-  // CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
-  // NotifyForms(CM_ICONCHANGED);
+  Widgetset.AppSetIcon(GetIconHandle);
+  if FFormList<>nil then
+    for i :=0 to FFormList.Count - 1 do
+      TForm(FFormList[i]).Perform(CM_ICONCHANGED, 0, 0);
 end;
 
 {------------------------------------------------------------------------------
@@ -886,8 +881,8 @@ end;
  ------------------------------------------------------------------------------}
 function TApplication.GetIconHandle: HICON;
 begin
-  if FIcon <> nil then
-    Result := FIcon.Handle
+  if not Icon.Empty then
+    Result := Icon.Handle
   else
     Result := 0;
 end;

lcl/include/customform.inc

@@ -221,10 +221,6 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCustomForm.SetIcon(AValue: TIcon);
 begin
-  if FIcon=nil then begin
-    FIcon:=TIcon.Create;
-    FIcon.OnChange := @IconChanged;
-  end;
   FIcon.Assign(AValue);
 end;
 
@@ -252,7 +248,7 @@ end;
  ------------------------------------------------------------------------------}
 function TCustomForm.GetIconHandle: HICON;
 begin
-  if (FIcon <> nil) and (not FIcon.Empty) then
+  if not FIcon.Empty then
     Result := FIcon.Handle
   else
     Result := Application.GetIconHandle;
@@ -554,6 +550,11 @@ begin
   end;
 end;
 
+procedure TCustomForm.CMIconChanged(var Message: TLMessage);
+begin
+  IconChanged(Self);
+end;
+
 procedure TCustomForm.AddHandler(HandlerType: TFormHandlerType;
   const Handler: TMethod; AsLast: Boolean);
 begin
@@ -1432,6 +1433,7 @@ begin
   Ctl3D := True;
   FWindowState := wsNormal;
   FIcon := TIcon.Create;
+  FIcon.OnChange := @IconChanged;
   FKeyPreview :=  False;
   Color := clBtnFace;
   FloatingDockSiteClass := TWinControlClass(ClassType);
@@ -1827,6 +1829,8 @@ begin
   
   // set allow drop files
   TWSCustomFormClass(WidgetSetClass).SetAllowDropFiles(Self, FAllowDropFiles);
+  // update icon
+  Perform(CM_ICONCHANGED, 0, 0);
   //DebugLn('TCustomForm.CreateWnd END ',ClassName);
 end;
 

lcl/include/icon.inc

@@ -82,6 +82,14 @@ end;
 
 { TSharedIcon }
 
+procedure TSharedIcon.FreeHandle;
+begin
+  if FHandle = 0 then Exit;
+
+  DestroyIcon(FHandle);
+  FHandle := 0;
+end;
+
 class function TSharedIcon.GetImagesClass: TIconImageClass;
 begin
   Result := TIconImage;
@@ -240,6 +248,13 @@ begin
   end;
 end;
 
+procedure TCustomIcon.Assign(Source: TPersistent);
+begin
+  if Source is TCustomIcon then
+    FCurrent := TCustomIcon(Source).Current;
+  inherited Assign(Source);
+end;
+
 function TCustomIcon.BitmapHandleAllocated: boolean;
 begin
   Result := (FCurrent <> -1) and (TIconImage(TSharedIcon(FSharedImage).FImages[FCurrent]).FHandle <> 0);
@@ -709,4 +724,16 @@ begin
   SetHandle(AValue);
 end;
 
+procedure TIcon.HandleNeeded;
+var
+  IconInfo: TIconInfo;
+begin
+  if FSharedImage.FHandle <> 0 then Exit;
+
+  IconInfo.fIcon := True;
+  IconInfo.hbmMask := MaskHandle;
+  IconInfo.hbmColor := BitmapHandle;
+  FSharedImage.FHandle := WidgetSet.CreateIconIndirect(@IconInfo);
+end;
+