paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 08:19:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

added fontdialog options to win32 intf from Wojciech Malinowski

Browse Source 
git-svn-id: trunk@4362 -
This commit is contained in:
mattias 2003-07-03 18:10:55 +00:00
parent 5cc3f25a75
commit e18663becb
6 changed files with 173 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
examples/dlgform.pp
View File

@ -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;

2
lcl/avglvltree.pas
View File

@ -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

9
lcl/graphtype.pp
View File

@ -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

9
lcl/interfaces/gtk/gtkobject.inc
View File

@ -1904,8 +1904,8 @@ begin
Desc^.GreenShift:=Visual^.green_shift;
Desc^.BluePrec:=Visual^.blue_prec;
Desc^.BlueShift:=Visual^.blue_shift;
Desc^.AlphaMask:=true;
Desc^.AlphaPrec:=0;
Desc^.AlphaSeparate:=true;
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

170
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -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
GDIImg:=PGDIObject(SrcBitmap);
GdkPixmap:=nil;
case GDIImg^.GDIBitmapType of
gbBitmap: GdkPixmap:=PGdkPixmap(GDIImg^.GDIBitmapObject);
gbPixmap: GdkPixmap:=PGdkPixmap(GDIImg^.GDIPixmapObject);
else
writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] GDI_RGBImage not implemented');
exit;
end;
writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] A GdkPixmap=',HexStr(Cardinal(GdkPixmap),8));
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
try
// get rawimage for Bitmap
GDIImg:=PGDIObject(SrcBitmap);
GdkPixmap:=nil;
case GDIImg^.GDIBitmapType of
gbBitmap: GdkPixmap:=PGdkPixmap(GDIImg^.GDIBitmapObject);
gbPixmap: GdkPixmap:=PGdkPixmap(GDIImg^.GDIPixmapObject);
else
writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] GDI_RGBImage not implemented');
exit;
end;
writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] A GdkPixmap=',HexStr(Cardinal(GdkPixmap),8));
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;
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

53
lcl/interfaces/win32/win32object.inc
View File

@ -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;
//RGBColors := (Sender As TFontDialog).Color;
Flags := GetFlagsFromOptions((Sender As TFontDialog).Options);
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