--- Merging r42812 into '.':

A    packages/winunits-base/tests/inproccomtest
A    packages/winunits-base/tests/inproccomtest/com_clnt.dpr
A    packages/winunits-base/tests/inproccomtest/com_impl.pas
A    packages/winunits-base/tests/inproccomtest/com_serv.dpr
A    packages/winunits-base/tests/inproccomtest/com_serv.tlb
A    packages/winunits-base/tests/inproccomtest/com_serv_TLB.pas
--- Recording mergeinfo for merge of r42812 into '.':
 U   .
--- Merging r42813 into '.':
U    rtl/objpas/classes/classesh.inc
--- Recording mergeinfo for merge of r42813 into '.':
 G   .
--- Merging r42586 into '.':
U    packages/fcl-image/src/fptiffcmn.pas
U    packages/fcl-image/src/fpwritetiff.pas
--- Recording mergeinfo for merge of r42586 into '.':
 G   .
--- Merging r42876 into '.':
U    packages/fcl-image/src/fpreadpng.pp
--- Recording mergeinfo for merge of r42876 into '.':
 G   .

# revisions: 42812,42813,42586,42876

git-svn-id: branches/fixes_3_2@42912 -

.gitattributes

@@ -8351,6 +8351,11 @@ packages/winunits-base/tests/OOHelper.pp svneol=native#text/plain
 packages/winunits-base/tests/OOTest.pp svneol=native#text/plain
 packages/winunits-base/tests/hhex.pp svneol=native#text/pascal
 packages/winunits-base/tests/hhex2.pp svneol=native#text/pascal
+packages/winunits-base/tests/inproccomtest/com_clnt.dpr svneol=native#text/plain
+packages/winunits-base/tests/inproccomtest/com_impl.pas svneol=native#text/plain
+packages/winunits-base/tests/inproccomtest/com_serv.dpr svneol=native#text/plain
+packages/winunits-base/tests/inproccomtest/com_serv.tlb -text
+packages/winunits-base/tests/inproccomtest/com_serv_TLB.pas svneol=native#text/plain
 packages/winunits-base/tests/testcom1.pp svneol=native#text/plain
 packages/winunits-base/tests/testcom2.pp svneol=native#text/plain
 packages/winunits-base/tests/testver.pp svneol=native#text/plain

packages/fcl-image/src/fpreadpng.pp

@@ -26,6 +26,8 @@ Type
   TSetPixelProc = procedure (x,y:integer; CD : TColordata) of object;
   TConvertColorProc = function (CD:TColorData) : TFPColor of object;
 
+  { TFPReaderPNG }
+
   TFPReaderPNG = class (TFPCustomImageReader)
     private
 
@@ -46,6 +48,11 @@ Type
       FPalette : TFPPalette;
       FSetPixel : TSetPixelProc;
       FConvertColor : TConvertColorProc;
+      function GetGrayScale: Boolean;
+      function GetHeaderByte(AIndex: Integer): Byte;
+      function GetIndexed: Boolean;
+      function GetUseAlpha: Boolean;
+      function GetWordSized: Boolean;
       procedure ReadChunk;
       procedure HandleData;
       procedure HandleUnknown;
@@ -99,6 +106,17 @@ Type
     public
       constructor create; override;
       destructor destroy; override;
+      // These 2 match writer properties. Calculated from header values
+      Property GrayScale : Boolean Read GetGrayScale;
+      Property WordSized : Boolean Read GetWordSized;
+      Property Indexed : Boolean Read GetIndexed;
+      Property UseAlpha : Boolean Read GetUseAlpha;
+      // Raw reader values
+      Property BitDepth : Byte Index 0 Read GetHeaderByte;
+      Property ColorType : Byte Index 1 Read GetHeaderByte;
+      Property Compression : Byte Index 2 Read GetHeaderByte;
+      Property Filter : Byte Index 3 Read GetHeaderByte;
+      Property Interlace : Byte Index 4 Read GetHeaderByte;
   end;
 
 implementation
@@ -176,6 +194,40 @@ begin
     end;
 end;
 
+function TFPReaderPNG.GetHeaderByte(AIndex: Integer): Byte;
+begin
+  With FHeader do
+  Case aIndex of
+     0 : Result:=BitDepth;
+     1 : Result:=ColorType;
+     2 : Result:=Compression;
+     3 : Result:=Filter;
+     4 : Result:=Interlace;
+  else
+    Result:=0;
+  end;
+end;
+
+function TFPReaderPNG.GetIndexed: Boolean;
+begin
+  Result:=ColorType=3;
+end;
+
+function TFPReaderPNG.GetUseAlpha: Boolean;
+begin
+  Result:=ColorType in [4,6]; // Can also be in 3, but that would require scanning the palette
+end;
+
+function TFPReaderPNG.GetWordSized: Boolean;
+begin
+  Result:=BitDepth=16;
+end;
+
+function TFPReaderPNG.GetGrayScale: Boolean;
+begin
+  Result:=ColorType in [0,4];
+end;
+
 procedure TFPReaderPNG.HandleData;
 var OldSize : longword;
 begin

packages/fcl-image/src/fptiffcmn.pas

@@ -88,7 +88,9 @@ const
   TiffCompressionIT8BL = 32898; { IT8BL }
   TiffCompressionPixarFilm = 32908; { PIXARFILM }
   TiffCompressionPixarLog = 32909; { PIXARLOG }
-  TiffCompressionDeflateZLib = 32946; { DeflatePKZip }
+  TiffCompressionDeflateZLib = 32946; { DeflatePKZip - obsolete,
+       same as TiffCompressionDeflateAdobe,
+       Macos Finder does not like this, use Adobe instead }
   TiffCompressionDCS = 32947; { DCS }
   TiffCompressionJBIG = 34661; { JBIG }
   TiffCompressionSGILog = 34676; { SGILOG }

packages/fcl-image/src/fpwritetiff.pas

@@ -464,12 +464,12 @@ begin
     Compression:=IFD.Compression;
     case Compression of
     TiffCompressionNone,
-    TiffCompressionDeflateZLib: ;
+    TiffCompressionDeflateAdobe: ;
     else
       {$ifdef FPC_DEBUG_IMAGE}
       writeln('TFPWriterTiff.AddImage unsupported compression '+TiffCompressionName(Compression)+', using deflate instead.');
       {$endif}
-      Compression:=TiffCompressionDeflateZLib;
+      Compression:=TiffCompressionDeflateAdobe;
     end;
 
     if IFD.Orientation in [1..4] then begin
@@ -698,7 +698,7 @@ t=',ChunkCount);
 
         // compress
         case Compression of
-        TiffCompressionDeflateZLib: EncodeDeflate(Chunk,ChunkBytes);
+        TiffCompressionDeflateZLib, TiffCompressionDeflateAdobe: EncodeDeflate(Chunk,ChunkBytes);
         end;
 
         ChunkOffsets.Chunks[ChunkIndex].Data:=Chunk;

packages/winunits-base/tests/inproccomtest/com_clnt.dpr

@@ -0,0 +1,28 @@
+program com_clnt;
+// Comtest demo from Anton K. mantis #35013
+
+{$ifdef fpc}{$mode delphi}{$endif}
+uses variants,sysutils,classes,activex,comobj;
+
+var co,resp:variant;
+begin
+  co := CreateOleObject('com_serv.TestApp');
+
+  if (VarIsEmpty(co)) then halt(1);
+
+  try 
+    co.test('Hello1');
+    resp:=widestring('yyyyy');
+    co.test_ret(resp);
+    writeln(resp);
+    if (resp<>'zzzz') then halt(2);
+  except
+    on E:Exception do
+    begin
+      writeln(E.Message);
+      halt(3);
+    end;
+  end;
+  writeln('Success!');
+
+end.

packages/winunits-base/tests/inproccomtest/com_impl.pas

@@ -0,0 +1,49 @@
+unit com_impl;
+// Comtest from Anton K. mantis #35013
+{$WARN SYMBOL_PLATFORM OFF}
+
+interface
+{$ifdef fpc}{$mode delphi}{$endif}
+
+uses
+  ComObj, com_serv_TLB;
+
+type
+  TTestApp = class(TAutoObject, ITestApp)
+  private
+    stor:widestring;
+  protected
+    procedure test(const text: WideString); safecall;
+    procedure test_ret(var res: OleVariant); safecall;
+  public
+    procedure Initialize;override;
+  end;
+
+implementation
+
+uses comserv,sysutils;
+
+procedure TTestApp.Initialize;
+begin
+  inherited;
+
+end;
+
+procedure TTestApp.test(const text: WideString);
+begin
+   stor:=formatdatetime('yyyy-mm-dd hh:nn:ss',now)+': '+text;
+   writeln(stor);
+end;
+
+procedure TTestApp.test_ret(var res: OleVariant);
+begin
+   writeln('Got: '+widestring(res));
+   res:=widestring('zzzz');
+  // res:=formatdatetime('yyyy-mm-dd hh:nn:ss',now)+': '+widestring(res);
+   writeln(res);
+end;
+
+initialization
+  TAutoObjectFactory.Create(ComServer, TTestApp, Class_TestApp,
+    ciMultiInstance, tmApartment);
+end.

packages/winunits-base/tests/inproccomtest/com_serv.dpr

@@ -0,0 +1,42 @@
+program com_serv;
+// Comtest from Anton K. mantis #35013
+uses
+  windows,
+  messages,
+  sysutils,
+  com_serv_TLB in 'com_serv_TLB.pas',
+  com_impl in 'com_impl.pas' {TestApp: CoClass};
+
+{$R *.TLB}
+
+var msg:TMsg;
+   res:integer;
+   fTerminate:boolean;
+begin
+  AllocConsole;
+
+  fTerminate:=false;
+
+  repeat
+  if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
+  begin
+    if Msg.Message <> WM_QUIT then
+    begin
+        TranslateMessage(Msg);
+
+        writeln(format('msg.message=%.08x msg.wparam=%.08x msg.lparam=%.08x',[msg.message,msg.wparam,msg.lparam]));
+        res:=DispatchMessage(Msg);
+        writeln(format('result=%.08x',[res]));
+    end
+    else
+      FTerminate := True;
+  end;
+  until fterminate;
+
+
+  (*Application.Run;
+  repeat
+    Application.ProcessMessages;
+  until Application.Terminated;*)
+
+end.

packages/winunits-base/tests/inproccomtest/com_serv_TLB.pas

@@ -0,0 +1,116 @@
+unit com_serv_TLB;
+// part of Comtest demo from Anton K. mantis #35013
+
+// ************************************************************************ //
+// WARNING                                                                    
+// -------                                                                    
+// The types declared in this file were generated from data read from a       
+// Type Library. If this type library is explicitly or indirectly (via        
+// another type library referring to this type library) re-imported, or the   
+// 'Refresh' command of the Type Library Editor activated while editing the   
+// Type Library, the contents of this file will be regenerated and all        
+// manual modifications will be lost.                                         
+// ************************************************************************ //
+
+// PASTLWTR : 1.2
+// File generated on 16.08.2019 18:46:07 from Type Library described below.
+
+// ************************************************************************  //
+// Type Lib: com_serv.tlb (1)
+// LIBID: {4657B1E3-77D1-4504-A96C-3E79EF05721C}
+// LCID: 0
+// Helpfile: 
+// HelpString: Project1 Library
+// DepndLst: 
+//   (1) v2.0 stdole, (C:\WINDOWS\system32\stdole2.tlb)
+// ************************************************************************ //
+{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
+{$WARN SYMBOL_PLATFORM OFF}
+{$WRITEABLECONST ON}
+{$VARPROPSETTER ON}
+interface
+{$ifdef fpc}{$mode delphi}{$endif}
+
+uses Windows, ActiveX, Classes, Variants;
+  
+
+// *********************************************************************//
+// GUIDS declared in the TypeLibrary. Following prefixes are used:        
+//   Type Libraries     : LIBID_xxxx                                      
+//   CoClasses          : CLASS_xxxx                                      
+//   DISPInterfaces     : DIID_xxxx                                       
+//   Non-DISP interfaces: IID_xxxx                                        
+// *********************************************************************//
+const
+  // TypeLibrary Major and minor versions
+  com_servMajorVersion = 1;
+  com_servMinorVersion = 0;
+
+  LIBID_com_serv: TGUID = '{4657B1E3-77D1-4504-A96C-3E79EF05721C}';
+
+  IID_ITestApp: TGUID = '{1DD0AE6B-30C7-474E-8972-01981454B649}';
+  CLASS_TestApp: TGUID = '{FD2054C2-4C67-47AE-A518-3FA6A7D691AA}';
+type
+
+// *********************************************************************//
+// Forward declaration of types defined in TypeLibrary                    
+// *********************************************************************//
+  ITestApp = interface;
+  ITestAppDisp = dispinterface;
+
+// *********************************************************************//
+// Declaration of CoClasses defined in Type Library                       
+// (NOTE: Here we map each CoClass to its Default Interface)              
+// *********************************************************************//
+  TestApp = ITestApp;
+
+
+// *********************************************************************//
+// Interface: ITestApp
+// Flags:     (4416) Dual OleAutomation Dispatchable
+// GUID:      {1DD0AE6B-30C7-474E-8972-01981454B649}
+// *********************************************************************//
+  ITestApp = interface(IDispatch)
+    ['{1DD0AE6B-30C7-474E-8972-01981454B649}']
+    procedure test(const text: WideString); safecall;
+    procedure test_ret(var res: OleVariant); safecall;
+  end;
+
+// *********************************************************************//
+// DispIntf:  ITestAppDisp
+// Flags:     (4416) Dual OleAutomation Dispatchable
+// GUID:      {1DD0AE6B-30C7-474E-8972-01981454B649}
+// *********************************************************************//
+  ITestAppDisp = dispinterface
+    ['{1DD0AE6B-30C7-474E-8972-01981454B649}']
+    procedure test(const text: WideString); dispid 201;
+    procedure test_ret(var res: OleVariant); dispid 202;
+  end;
+
+// *********************************************************************//
+// The Class CoTestApp provides a Create and CreateRemote method to          
+// create instances of the default interface ITestApp exposed by              
+// the CoClass TestApp. The functions are intended to be used by             
+// clients wishing to automate the CoClass objects exposed by the         
+// server of this typelibrary.                                            
+// *********************************************************************//
+  CoTestApp = class
+    class function Create: ITestApp;
+    class function CreateRemote(const MachineName: string): ITestApp;
+  end;
+
+implementation
+
+uses ComObj;
+
+class function CoTestApp.Create: ITestApp;
+begin
+  Result := CreateComObject(CLASS_TestApp) as ITestApp;
+end;
+
+class function CoTestApp.CreateRemote(const MachineName: string): ITestApp;
+begin
+  Result := CreateRemoteComObject(MachineName, CLASS_TestApp) as ITestApp;
+end;
+
+end.

rtl/objpas/classes/classesh.inc

@@ -91,6 +91,8 @@ type
   TAlignment = (taLeftJustify, taRightJustify, taCenter);
 
   TLeftRight = taLeftJustify..taRightJustify;
+  TVerticalAlignment = (taAlignTop, taAlignBottom, taVerticalCenter);
+  TTopBottom = taAlignTop..taAlignBottom;
 
   TBiDiMode = (bdLeftToRight,bdRightToLeft,bdRightToLeftNoAlign,bdRightToLeftReadingOnly);