added fontdialog options to win32 intf from Wojciech Malinowski

git-svn-id: trunk@4362 -

examples/dlgform.pp

@@ -136,11 +136,13 @@ begin
         end;
     4 : with TFontDialog.Create(Self) do
         begin
-          Execute;
+          Font.Assign(Self.Font);
+          if Execute then Self.Font.Assign(Font);
           Free;
         end;
     5 : with TColorDialog.Create(Self) do
         begin
+          Color := Self.Color;
           if Execute then Self.Color := Color;
           Free;
         end;

lcl/avglvltree.pas

@@ -39,6 +39,7 @@ type
     constructor Create;
     destructor Destroy; override;
   end;
+  PAvgLvlTreeNode = ^TAvgLvlTreeNode;
 
   TAvgLvlTree = class
   private
@@ -86,6 +87,7 @@ type
     constructor Create;
     destructor Destroy; override;
   end;
+  PAvgLvlTree = ^TAvgLvlTree;
 
   TAvgLvlTreeNodeMemManager = class
   private

lcl/graphtype.pp

@@ -219,18 +219,20 @@ type
     RedPrec: cardinal; // red precision. bits for red
     RedShift: cardinal;
     GreenPrec: cardinal;
-    GreenShift: cardinal;
+    GreenShift: cardinal; // bitshift. Direction: from least to most signifikant
     BluePrec: cardinal;
     BlueShift: cardinal;
-    AlphaMask: boolean; // the alpha is stored as separate Mask
     AlphaPrec: cardinal;
     AlphaShift: cardinal;
+    AlphaSeparate: boolean; // the alpha is stored as separate Mask
     // The next values are only valid, if there is a separate alpha mask
     AlphaBitsPerPixel: cardinal; // bits per alpha mask pixel.
     AlphaLineEnd: TRawImageLineEnd;
   end;
   PRawImageDescription = ^TRawImageDescription;
   
+  // Note: not all devices/images have all parts at any time. But if a part can
+  // be applied to the device/image, the 'Description' describes its structure.
   TRawImage = record
     Description: TRawImageDescription;
     Data: PByte;
@@ -249,6 +251,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.16  2003/07/03 18:10:55  mattias
+  added fontdialog options to win32 intf from Wojciech Malinowski
+
   Revision 1.15  2003/07/02 10:02:51  mattias
   fixed TPaintStruct
 

lcl/interfaces/gtk/gtkobject.inc

@@ -1904,8 +1904,8 @@ begin
   Desc^.GreenShift:=Visual^.green_shift;
   Desc^.BluePrec:=Visual^.blue_prec;
   Desc^.BlueShift:=Visual^.blue_shift;
-  Desc^.AlphaMask:=true;
+  Desc^.AlphaSeparate:=true;
-  Desc^.AlphaPrec:=0;
+  Desc^.AlphaPrec:=1;
   Desc^.AlphaShift:=0;
   // AlphaBitsPerPixel and AlphaLineEnd
   Desc^.AlphaBitsPerPixel:=Desc^.AlphaPrec;
@@ -1930,7 +1930,7 @@ begin
       ' GreenShift=',GreenShift,
       ' BluePrec=',BluePrec,
       ' BlueShift=',BlueShift,
-      ' AlphaMask=',AlphaMask,
+      ' AlphaSeparate=',AlphaSeparate,
       ' AlphaPrec=',AlphaPrec,
       ' AlphaShift=',AlphaShift,
       ' AlphaBitsPerPixel=',AlphaBitsPerPixel,
@@ -7882,6 +7882,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.389  2003/07/03 18:10:55  mattias
+  added fontdialog options to win32 intf from Wojciech Malinowski
+
   Revision 1.388  2003/07/02 15:56:15  mattias
   fixed win32 painting and started creating bitmaps from rawimages
 

lcl/interfaces/gtk/gtkwinapi.inc

@@ -837,12 +837,23 @@ function TgtkObject.CreateBitmapFromRawImage(const RawImage: TRawImage;
 var
   GdiObject: PGDIObject;
   DefGDkWindow: PGdkWindow;
-  fg, bg: TGdkColor;
+  GDkWindow: PGdkWindow;
+  GC: PGdkGC;
+  ImgData: PDWord;
+  ImgWidth: Cardinal;
+  ImgHeight: Cardinal;
+  ImgDepth: Cardinal;
+  Visual: PGdkVisual;
+  GdkImage: PGdkImage;
+  ImgDataSize: Cardinal;
 begin
   Result:=false;
   Bitmap:=0;
   MaskBitmap:=0;
   
+  if (RawImage.Description.Width=0) or (RawImage.Description.Height=0) then
+    exit;
+  
   writeln('TgtkObject.CreateBitmapFromRawImage A ',
     ' Depth=',RawImage.Description.Depth,
     ' Width=',RawImage.Description.Width,
@@ -858,23 +869,45 @@ begin
   // ToDo: check description
   
   DefGdkWindow := nil;
-  gdk_color_white(gdk_colormap_get_system, @fg);
-  gdk_color_black(gdk_colormap_get_system, @bg);
-
   GdiObject := NewGDIObject(gdiBitmap);
   GdiObject^.GDIBitmapType := gbPixmap;
 
   if RawImage.Data<>nil then begin
-    GdiObject^.GDIPixmapObject :=
+    { The gdk_pixmap_create_from_data seems to be buggy.
+      It only creates pixmaps of Depth 1
         gdk_pixmap_create_from_data(DefGdkWindow,PGChar(RawImage.Data),
                       RawImage.Description.Width, RawImage.Description.Height,
-                      RawImage.Description.Depth, @fg,@bg);
+                      RawImage.Description.Depth, @fg,@bg);}
+    ImgData:=PDWord(RawImage.Data);
+    ImgDataSize:=RawImage.DataSize;
+    ImgWidth:=RawImage.Description.Width;
+    ImgHeight:=RawImage.Description.Height;
+    ImgDepth:=RawImage.Description.Depth;
+    GdiObject^.GDIPixmapObject :=
+        gdk_pixmap_new(DefGdkWindow,ImgWidth,imgHeight,ImgDepth);
+    GDkWindow:=PGdkWindow(GdiObject^.GDIPixmapObject);
+
+    Visual:=gdk_visual_get_best_with_depth(ImgDepth);
+    GdkImage:=gdk_image_new(GDK_IMAGE_FASTEST,Visual,ImgWidth,ImgHeight);
+    if ImgDataSize<>GdkImage^.bpl*ImgHeight then
+      RaiseGDBException('TgtkObject.CreateBitmapFromRawImage Incompatible DataSize');
+    System.Move(ImgData^,GdkImage^.mem^,ImgDataSize);
+    {for y:=0 to ImgHeight-1 do begin
+      for x:=0 to ImgWidth-1 do begin
+        gdk_image_put_pixel(GdkImage,X,Y,ImgData[X+Y*ImgWidth]);
+      end;
+    end;}
+    GC:=gdk_gc_new(GDkWindow);
+    gdk_draw_image(PGDKDrawable(GdiObject^.GDIPixmapObject),GC,
+                   GdkImage,0,0,0,0,ImgWidth,ImgHeight);
+    gdk_gc_unref(GC);
+    gdk_image_destroy(GdkImage);
   end else
-    GdiObject^.GDIBitmapObject :=
+    GdiObject^.GDIPixmapObject :=
         gdk_pixmap_new(DefGdkWindow,
                        RawImage.Description.Width, RawImage.Description.Height,
                        RawImage.Description.Depth);
-  GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIBitmapObject);
+  GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIPixmapObject);
   Bitmap:=HBITMAP(GdiObject);
 
   If (RawImage.Mask<>nil) then begin
@@ -4190,63 +4223,71 @@ begin
     exit;
   end;
 
-  // get rawimage for Bitmap
+  try
-  GDIImg:=PGDIObject(SrcBitmap);
+    // get rawimage for Bitmap
-  GdkPixmap:=nil;
+    GDIImg:=PGDIObject(SrcBitmap);
-  case GDIImg^.GDIBitmapType of
+    GdkPixmap:=nil;
-  gbBitmap: GdkPixmap:=PGdkPixmap(GDIImg^.GDIBitmapObject);
+    case GDIImg^.GDIBitmapType of
-  gbPixmap: GdkPixmap:=PGdkPixmap(GDIImg^.GDIPixmapObject);
+    gbBitmap: GdkPixmap:=PGdkPixmap(GDIImg^.GDIBitmapObject);
-  else
+    gbPixmap: GdkPixmap:=PGdkPixmap(GDIImg^.GDIPixmapObject);
-    writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] GDI_RGBImage not implemented');
+    else
-    exit;
+      writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] GDI_RGBImage not implemented');
-  end;
+      exit;
-  writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] A GdkPixmap=',HexStr(Cardinal(GdkPixmap),8));
+    end;
-  if not GetRawImageFromGdkWindow(PGdkWindow(GdkPixmap),SrcRect,NewRawImage)
+    writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] A GdkPixmap=',HexStr(Cardinal(GdkPixmap),8));
-  then exit;
+    if not GetRawImageFromGdkWindow(PGdkWindow(GdkPixmap),SrcRect,NewRawImage)
+    then exit;
+
+    // the bitmap is ready. If there is no mask the rawimage is complete
+    if SrcMaskBitmap=0 then begin
+      Result:=true;
+      exit;
+    end;
+
+    // get rawimage for MaskBitmap
+    GDIMaskImg:=PGDIObject(SrcMaskBitmap);
+    GdkMaskBitmap:=nil;
+    case GDIMaskImg^.GDIBitmapType of
+    gbBitmap: GdkMaskBitmap:=PGdkPixmap(GDIMaskImg^.GDIBitmapObject);
+    else
+      writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] invalid MaskBitmap');
+      exit;
+    end;
+    if not GetRawImageFromGdkWindow(PGdkWindow(GdkMaskBitmap),SrcRect,
+                                    MaskRawImage)
+    then exit;
+
+    // check if mask is compatible
+    if (MaskRawImage.Description.Width<>NewRawImage.Description.Width)
+    or (MaskRawImage.Description.Height<>NewRawImage.Description.Height) then begin
+      writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] MaskBitmap has different Size than Bitmap');
+      exit;
+    end;
+    if (MaskRawImage.Description.Depth<>1) then begin
+      writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] MaskBitmap Depth<>1');
+      exit;
+    end;
+    if (MaskRawImage.Description.HasPalette) then begin
+      writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] MaskBitmap HasPalette');
+      exit;
+    end;
+
+    // merge mask
+    if NewRawImage.Mask<>nil then FreeMem(NewRawImage.Mask);
+    NewRawImage.Mask:=MaskRawImage.Data;
+    NewRawImage.MaskSize:=MaskRawImage.DataSize;
+    NewRawImage.Description.AlphaSeparate:=true;
+    NewRawImage.Description.AlphaPrec:=MaskRawImage.Description.Depth;
+    NewRawImage.Description.AlphaShift:=0;
 
-  // the bitmap is ready. If there is no mask the rawimage is complete
-  if SrcMaskBitmap=0 then begin
     Result:=true;
-    exit;
+  finally
+    if not Result then begin
+      ReAllocMem(NewRawImage.Data,0);
+      ReAllocMem(NewRawImage.Mask,0);
+      ReAllocMem(NewRawImage.Palette,0);
+    end;
   end;
-
-  // get rawimage for MaskBitmap
-  GDIMaskImg:=PGDIObject(SrcMaskBitmap);
-  GdkMaskBitmap:=nil;
-  case GDIMaskImg^.GDIBitmapType of
-  gbBitmap: GdkMaskBitmap:=PGdkPixmap(GDIMaskImg^.GDIBitmapObject);
-  else
-    writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] invalid MaskBitmap');
-    exit;
-  end;
-  if not GetRawImageFromGdkWindow(PGdkWindow(GdkMaskBitmap),SrcRect,
-                                  MaskRawImage)
-  then exit;
-  
-  // check if mask is compatible
-  if (MaskRawImage.Description.Width<>NewRawImage.Description.Width)
-  or (MaskRawImage.Description.Height<>NewRawImage.Description.Height) then begin
-    writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] MaskBitmap has different Size than Bitmap');
-    exit;
-  end;
-  if (MaskRawImage.Description.Depth<>1) then begin
-    writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] MaskBitmap Depth<>1');
-    exit;
-  end;
-  if (MaskRawImage.Description.HasPalette) then begin
-    writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] MaskBitmap HasPalette');
-    exit;
-  end;
-
-  // merge mask
-  if NewRawImage.Mask<>nil then FreeMem(NewRawImage.Mask);
-  NewRawImage.Mask:=MaskRawImage.Data;
-  NewRawImage.MaskSize:=MaskRawImage.DataSize;
-  NewRawImage.Description.AlphaMask:=true;
-  NewRawImage.Description.AlphaPrec:=MaskRawImage.Description.Depth;
-  NewRawImage.Description.AlphaShift:=0;
-
-  Result:=true;
 end;
 
 {------------------------------------------------------------------------------
@@ -8509,6 +8550,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.257  2003/07/03 18:10:55  mattias
+  added fontdialog options to win32 intf from Wojciech Malinowski
+
   Revision 1.256  2003/07/02 15:56:15  mattias
   fixed win32 painting and started creating bitmaps from rawimages
 

lcl/interfaces/win32/win32object.inc

@@ -1395,6 +1395,27 @@ Var
       Result := Result Or OFN_SHOWHELP;
   End;
 
+  Function GetFlagsFromOptions(Options : TFontDialogOptions): DWord;
+  Begin
+    Result := 0;
+    If fdAnsiOnly In Options Then Result := Result Or CF_ANSIONLY;
+    If fdTrueTypeOnly In Options Then Result := Result Or CF_TTONLY;
+    If fdEffects In Options Then Result := Result Or CF_EFFECTS;
+    If fdFixedPitchOnly In Options then Result := Result Or CF_FIXEDPITCHONLY;
+    If fdForceFontExist In Options then Result := Result Or CF_FORCEFONTEXIST;
+    If fdNoFaceSel In Options then Result := Result Or CF_NOFACESEL;
+    If fdNoOEMFonts In Options then Result := Result Or CF_NOOEMFONTS;
+    If fdNoSimulations In Options then Result := Result Or CF_NOSIMULATIONS;
+    If fdNoSizeSel In Options then Result := Result Or CF_NOSIZESEL;
+    If fdNoStyleSel In Options then Result := Result Or CF_NOSTYLESEL;
+    If fdNoVectorFonts In Options then Result := Result Or CF_NOVECTORFONTS;
+    If fdShowHelp In Options then Result := Result Or CF_SHOWHELP;
+    If fdWysiwyg In Options then Result := Result Or CF_WYSIWYG;
+    If fdLimitSize In Options then Result := Result Or CF_LIMITSIZE;
+    If fdScalableOnly In Options then Result := Result Or CF_SCALABLEONLY;
+    If fdApplyButton In Options then Result := Result Or CF_APPLY;
+  End;
+
   function GetOwnerHandle: HWND;
   begin
     if (Sender As TComponent).Owner Is TWinControl then
@@ -1462,22 +1483,41 @@ Begin
   End
   Else If Sender Is TFontDialog Then
   Begin
-    //CF := LPChooseFont(@Sender)^;
     ZeroMemory(@CF, SizeOf(TChooseFont));
-    LF.LFFaceName := (Sender As TFontDialog).Font.Name;
+    ZeroMemory(@LF, SizeOf(LogFont));
+    With LF Do
+    Begin
+      LFHeight := (Sender As TFontDialog).Font.Height;
+      LFFaceName := TFontDataName((Sender As TFontDialog).Font.Name);
+      If (fsBold In (Sender As TFontDialog).Font.Style) then LFWeight:= FW_BOLD;
+      LFItalic := Byte(fsItalic In (Sender As TFontDialog).Font.Style);
+      LFStrikeOut := Byte(fsStrikeOut In (Sender As TFontDialog).Font.Style);
+      LFUnderline := Byte(fsUnderline In (Sender As TFontDialog).Font.Style);
+      LFCharSet := (Sender As TFontDialog).Font.CharSet;
+    End;
     With CF Do
     Begin
       LStructSize := SizeOf(TChooseFont);
       HWndOwner := GetOwnerHandle;
       LPLogFont := @LF;
-      Flags := CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_SCREENFONTS;
+      Flags := GetFlagsFromOptions((Sender As TFontDialog).Options);
-      //RGBColors := (Sender As TFontDialog).Color;
+      Flags := Flags Or CF_INITTOLOGFONTSTRUCT Or CF_BOTH;
+      RGBColors := (Sender As TFontDialog).Font.Color;
     End;
     Ret := ChooseFont(@CF);
   End;
 
   If Ret Then
-    (Sender As TCommonDialog).UserChoice := mrOK
+  Begin
+    If Sender Is TFontDialog then
+    Begin
+      (Sender As TFontDialog).Font.Assign(LF);
+      (Sender As TFontDialog).Font.Color := CF.RGBColors;
+    End;
+    If Sender Is TColorDialog then
+      (Sender As TColorDialog).Color := CC.RGBResult;
+    (Sender As TCommonDialog).UserChoice := mrOK;
+  End
   Else
     (Sender As TCommonDialog).UserChoice := mrCancel;
 
@@ -2701,6 +2741,9 @@ End;
 
 {
   $Log$
+  Revision 1.71  2003/07/03 18:10:55  mattias
+  added fontdialog options to win32 intf from Wojciech Malinowski
+
   Revision 1.70  2003/07/03 17:19:19  mattias
   added RectVisible from Micha