From 3a28d7a5513f56899529606c8920d175500b654c Mon Sep 17 00:00:00 2001 From: lazarus Date: Tue, 4 Jun 2002 15:17:26 +0000 Subject: [PATCH] MG: improved TFont for XLFD font names git-svn-id: trunk@1724 - --- components/synedit/synedit.pp | 8 + ide/editoroptions.pp | 28 +- ide/main.pp | 39 ++- ide/uniteditor.pp | 34 +- lcl/dialogs.pp | 37 ++- lcl/graphics.pp | 90 ++++-- lcl/graphtype.pp | 7 +- lcl/include/bevel.inc | 4 + lcl/include/canvas.inc | 17 +- lcl/include/custompanel.inc | 17 +- lcl/include/font.inc | 492 +++++++++++++++++++++++++++-- lcl/include/fontdialog.inc | 29 +- lcl/include/statusbar.inc | 14 +- lcl/include/winapi.inc | 10 + lcl/include/winapih.inc | 4 + lcl/interfaces/gtk/gtkcallback.inc | 59 +++- lcl/interfaces/gtk/gtkdef.pp | 5 +- lcl/interfaces/gtk/gtkwinapi.inc | 433 +++++++++++++++---------- lcl/interfaces/gtk/gtkwinapih.inc | 4 + lcl/lcllinux.pp | 4 + lcl/lcltype.pp | 79 ++--- 21 files changed, 1076 insertions(+), 338 deletions(-) diff --git a/components/synedit/synedit.pp b/components/synedit/synedit.pp index ee7eea438c..e229accea0 100644 --- a/components/synedit/synedit.pp +++ b/components/synedit/synedit.pp @@ -3132,8 +3132,11 @@ var Metrics: TTextMetric; AveCW, MaxCW: Integer; begin + writeln('TCustomSynEdit.SetFont--------------------------------------------'); + writeln(' TCustomSynEdit.SetFont A1',Value.Name); DC := GetDC(0); Save := SelectObject(DC, Value.Handle); + writeln(' TCustomSynEdit.SetFont A2',Value.Name); GetTextMetrics(DC, Metrics); SelectObject(DC, Save); ReleaseDC(0, DC); @@ -3141,6 +3144,7 @@ begin AveCW := tmAveCharWidth; MaxCW := tmMaxCharWidth; end; + writeln(' TCustomSynEdit.SetFont B ',AveCW,',',MaxCW,' ',Value.Name); case AveCW = MaxCW of True: inherited Font := Value; False: @@ -3151,9 +3155,13 @@ begin Size := Value.Size; Style := Value.Style; end; + writeln(' TCustomSynEdit.SetFont C ',AveCW,',',MaxCW,' ',Value.Name, + ' Value.Size=',Value.Size,' Value.Height=',Value.Height,' DummyHeight=',fFontDummy.Height); inherited Font := fFontDummy; end; end; + writeln(' TCustomSynEdit.SetFont D ',Font.Name); + writeln('SSS1 "',Font.Name,'" Height=',Font.Height,' AveCW=',AveCW,' MaxCW=',MaxCW); if fGutter.ShowLineNumbers then GutterChanged(Self); end; diff --git a/ide/editoroptions.pp b/ide/editoroptions.pp index 4180182521..3f5e2fa5eb 100644 --- a/ide/editoroptions.pp +++ b/ide/editoroptions.pp @@ -397,7 +397,7 @@ type // form procedure EditorOptionsFormResize(Sender: TObject); - + // general procedure GeneralCheckBoxOnClick(Sender: TObject); procedure ComboBoxOnChange(Sender:TObject); @@ -406,6 +406,7 @@ type procedure ColorButtonColorChanged(Sender:TObject); // display + procedure FontDialogApplyClicked(Sender: TObject); procedure EditorFontButtonClick(Sender:TObject); // key mapping @@ -2264,20 +2265,29 @@ begin end; end; +procedure TEditorOptionsForm.FontDialogApplyClicked(Sender: TObject); +var a: integer; +begin + for a:=Low(PreviewEdits) to High(PreviewEdits) do begin + if PreviewEdits[a]<>nil then + PreviewEdits[a].Font.Assign(TFontDialog(Sender).Font); + end; + EditorFontComboBox.Text:=DisplayPreview.Font.Name; + SetComboBoxText(EditorFontHeightComboBox, + IntToStr(DisplayPreview.Font.Height)); +end; + procedure TEditorOptionsForm.EditorFontButtonClick(Sender:TObject); -var FontDialog:TFontDialog; - a:integer; +var + FontDialog:TFontDialog; begin FontDialog:=TFontDialog.Create(Application); try with FontDialog do begin + Options:=Options+[fdApplyButton]; + OnApplyClicked:=@FontDialogApplyClicked; if Execute then begin - EditorFontComboBox.Text:=FontName; - for a:=Low(PreviewEdits) to High(PreviewEdits) do begin - if PreviewEdits[a]<>nil then - FontDialogNameToFont(FontName,PreviewEdits[a].Font); - end; - EditorFontComboBox.Text:=PreviewEdits[a].Font.Name; + FontDialogApplyClicked(FontDialog); end; end; finally diff --git a/ide/main.pp b/ide/main.pp index f63fc677fb..062131f7fe 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -44,16 +44,17 @@ uses {$ENDIF} Classes, LazarusIDEStrConsts, LCLType, LclLinux, Compiler, StdCtrls, Forms, Buttons, Menus, ComCtrls, Spin, Project, SysUtils, FileCtrl, Controls, - Graphics, ExtCtrls, Dialogs, LazConf, CompReg, CodeToolManager, CodeCache, - DefineTemplates, MsgView, NewProjectDlg, IDEComp, AbstractFormEditor, - Designer, FormEditor, CustomFormEditor, ObjectInspector, PropEdits, - ControlSelection, UnitEditor, CompilerOptions, EditorOptions, EnvironmentOpts, - TransferMacros, SynEditKeyCmds, KeyMapping, ProjectOpts, IDEProcs, Process, - UnitInfoDlg, Debugger, DBGOutputForm, GDBMIDebugger, RunParamsOpts, - ExtToolDialog, MacroPromptDlg, LMessages, ProjectDefs, Watchesdlg, - BreakPointsdlg, ColumnDlg, OutputFilter, BuildLazDialog, MiscOptions, - EditDefineTree, CodeToolsOptions, TypInfo, IDEOptionDefs, CodeToolsDefines, - LocalsDlg, DebuggerDlg, InputHistory, + Graphics, GraphType, ExtCtrls, Dialogs, LazConf, CompReg, CodeToolManager, + CodeCache, DefineTemplates, MsgView, NewProjectDlg, IDEComp, + AbstractFormEditor, Designer, FormEditor, CustomFormEditor, ObjectInspector, + PropEdits, ControlSelection, UnitEditor, CompilerOptions, EditorOptions, + EnvironmentOpts, TransferMacros, SynEditKeyCmds, KeyMapping, ProjectOpts, + IDEProcs, Process, UnitInfoDlg, Debugger, DBGOutputForm, GDBMIDebugger, + RunParamsOpts, ExtToolDialog, MacroPromptDlg, LMessages, ProjectDefs, + Watchesdlg, BreakPointsdlg, ColumnDlg, OutputFilter, BuildLazDialog, + MiscOptions, EditDefineTree, CodeToolsOptions, TypInfo, IDEOptionDefs, + CodeToolsDefines, LocalsDlg, DebuggerDlg, InputHistory, + // main ide BaseDebugManager, DebugManager, MainBar; type @@ -784,13 +785,15 @@ var begin pnlSpeedButtons := TPanel.Create(Self); - pnlSpeedButtons.Parent:= Self; with pnlSpeedButtons do begin - Visible := True; Name := 'pnlSpeedButtons'; + Parent:= Self; Top := 0; Left:= 0; Caption:= ''; + BevelWidth:=1; + BevelOuter:=bvRaised; + Visible := True; end; @@ -822,8 +825,8 @@ begin StepIntoSpeedButton := CreateButton('StepIntoSpeedButton' , 'btn_stepinto' , 1, ButtonLeft, ButtonTop, [mfLeft], @mnuStepIntoProjectClicked, lsiHintStepInto); StepOverSpeedButton := CreateButton('StepOverpeedButton' , 'btn_stepover' , 1, ButtonLeft, ButtonTop, [mfLeft, mfTop], @mnuStepOverProjectClicked, lsiHintStepOver); - pnlSpeedButtons.Width := ButtonLeft+1; - pnlSpeedButtons.Height := ButtonTop+1; + pnlSpeedButtons.Width := ButtonLeft+3; + pnlSpeedButtons.Height := ButtonTop+3; // create the popupmenu for the OpenFileArrowSpeedBtn @@ -845,7 +848,7 @@ begin with ComponentNotebook do begin Parent := Self; Name := 'ComponentNotebook'; - Left := ToggleFormSpeedBtn.Left + ToggleFormSpeedBtn.Width + 4; + Left := ToggleFormSpeedBtn.Left + ToggleFormSpeedBtn.Width + 2; Top := 0; Width := Self.ClientWidth - Left; Height := 60; //Self.ClientHeight - ComponentNotebook.Top; @@ -978,11 +981,12 @@ begin SourceNotebook.OnDeleteLastJumpPoint := @OnSrcNotebookDeleteLastJumPoint; SourceNotebook.OnEditorVisibleChanged := @OnSrcNotebookEditorVisibleChanged; SourceNotebook.OnEditorChanged := @OnSrcNotebookEditorChanged; + SourceNotebook.OnEditorPropertiesClicked := @mnuEnvEditorOptionsClicked; + SourceNotebook.OnFindDeclarationClicked := @OnSrcNotebookFindDeclaration; SourceNotebook.OnJumpToHistoryPoint := @OnSrcNotebookJumpToHistoryPoint; SourceNotebook.OnNewClicked := @OnSrcNotebookFileNew; SourceNotebook.OnOpenClicked := @OnSrcNotebookFileOpen; SourceNotebook.OnOpenFileAtCursorClicked := @OnSrcNotebookFileOpenAtCursor; - SourceNotebook.OnFindDeclarationClicked := @OnSrcNotebookFindDeclaration; SourceNotebook.OnProcessUserCommand := @OnSrcNotebookProcessCommand; SourceNotebook.OnSaveClicked := @OnSrcNotebookFileSave; SourceNotebook.OnSaveAsClicked := @OnSrcNotebookFileSaveAs; @@ -6404,6 +6408,9 @@ end. { ============================================================================= $Log$ + Revision 1.306 2002/06/04 15:17:17 lazarus + MG: improved TFont for XLFD font names + Revision 1.305 2002/06/01 08:41:27 lazarus MG: DrawFramControl now uses gtk style, transparent STrechBlt diff --git a/ide/uniteditor.pp b/ide/uniteditor.pp index 8a61a92221..d2e6eef292 100644 --- a/ide/uniteditor.pp +++ b/ide/uniteditor.pp @@ -282,15 +282,17 @@ type FProcessingCommand: boolean; FOnAddJumpPoint: TOnAddJumpPoint; + FOnAddWatchAtCursor: TNotifyEvent; FOnCloseClicked: TNotifyEvent; FOnDeleteLastJumpPoint: TNotifyEvent; FOnEditorVisibleChanged: TNotifyEvent; FOnEditorChanged: TNotifyEvent; + FOnEditorPropertiesClicked: TNotifyEvent; + FOnFindDeclarationClicked: TNotifyEvent; FOnJumpToHistoryPoint: TOnJumpToHistoryPoint; FOnNewClicked: TNotifyEvent; FOnOpenClicked: TNotifyEvent; FOnOpenFileAtCursorClicked: TNotifyEvent; - FOnFindDeclarationClicked: TNotifyEvent; FOnProcessUserCommand: TOnProcessUserCommand; FOnSaveAsClicked: TNotifyEvent; FOnSaveAllClicked: TNotifyEvent; @@ -299,8 +301,7 @@ type FOnToggleFormUnitClicked : TNotifyEvent; FOnUserCommandProcessed: TOnProcessUserCommand; FOnViewJumpHistory: TNotifyEvent; - FOnAddWatchAtCursor: TNotifyEvent; - + FOnCreateBreakPoint: TOnCreateDeleteBreakPoint; FOnDeleteBreakPoint: TOnCreateDeleteBreakPoint; @@ -320,6 +321,7 @@ type Procedure BookmarkGoTo(Value: Integer); Procedure BookMarkSet(Value : Integer); Procedure BookMarkToggle(Value : Integer); + procedure EditorPropertiesClicked(Sender: TObject); Procedure BreakPointCreated(Sender : TObject; Line : Integer); Procedure BreakPointDeleted(Sender : TObject; Line : Integer); @@ -445,15 +447,17 @@ type read FOnEditorVisibleChanged write FOnEditorVisibleChanged; property OnEditorChanged: TNotifyEvent read FOnEditorChanged write FOnEditorChanged; + property OnEditorPropertiesClicked: TNotifyEvent + read FOnEditorPropertiesClicked write FOnEditorPropertiesClicked; + property OnFindDeclarationClicked : TNotifyEvent + read FOnFindDeclarationClicked write FOnFindDeclarationClicked; property OnJumpToHistoryPoint: TOnJumpToHistoryPoint read FOnJumpToHistoryPoint write FOnJumpToHistoryPoint; property OnNewClicked : TNotifyEvent read FOnNewClicked write FOnNewClicked; property OnOpenClicked : TNotifyEvent read FOnOPenClicked write FOnOpenClicked; property OnOpenFileAtCursorClicked : TNotifyEvent read FOnOpenFileAtCursorClicked write FOnOpenFileAtCursorClicked; - property OnFindDeclarationClicked : TNotifyEvent - read FOnFindDeclarationClicked write FOnFindDeclarationClicked; - property OnSaveAsClicked : TNotifyEvent + property OnSaveAsClicked : TNotifyEvent read FOnSaveAsClicked write FOnSaveAsClicked; property OnSaveAllClicked : TNotifyEvent read FOnSaveAllClicked write FOnSaveAllClicked; @@ -2214,6 +2218,12 @@ begin FUnUsedEditorComponents.Clear; end; +procedure TSourceNotebook.EditorPropertiesClicked(Sender: TObject); +begin + if Assigned(FOnEditorPropertiesClicked) then + FOnEditorPropertiesClicked(Sender); +end; + Procedure TSourceNotebook.BuildPopupMenu; Function Seperator : TMenuItem; @@ -2288,6 +2298,12 @@ Begin MenuItem.OnClick := @ReadOnlyClicked; SrcPopupMenu.Items.Add(MenuItem); + MenuItem := TMenuItem.Create(Self); + MenuItem.Name := 'ShowLineNumbersMenuItem'; + MenuItem.Caption := 'Show Line Numbers'; + menuItem.OnClick := @ToggleLineNumbersClicked; + SrcPopupMenu.Items.Add(MenuItem); + SrcPopupMenu.Items.Add(Seperator); MenuItem := TMenuItem.Create(Self); @@ -2324,9 +2340,9 @@ Begin SrcPopupMenu.Items.Add(Seperator); MenuItem := TMenuItem.Create(Self); - MenuItem.Name := 'ShowLineNumbersMenuItem'; - MenuItem.Caption := 'Show Line Numbers'; - menuItem.OnClick := @ToggleLineNumbersClicked; + MenuItem.Name := 'EditorPropertiesMenuItem'; + MenuItem.Caption := 'Editor properties'; + MenuItem.OnClick :=@EditorPropertiesClicked; SrcPopupMenu.Items.Add(MenuItem); end; diff --git a/lcl/dialogs.pp b/lcl/dialogs.pp index a0d974ff1b..6eec86d424 100644 --- a/lcl/dialogs.pp +++ b/lcl/dialogs.pp @@ -36,7 +36,7 @@ unit Dialogs; interface -uses Classes, Forms, Controls, VCLGlobals, LMessages; +uses Classes, Forms, Controls, VCLGlobals, LMessages, Graphics; //type // TDialogButtons = (mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, @@ -195,13 +195,34 @@ type { TFontDialog } + TFontDialogOption = (fdAnsiOnly, fdTrueTypeOnly, fdEffects, + fdFixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts, + fdNoSimulations, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts, + fdShowHelp, fdWysiwyg, fdLimitSize, fdScalableOnly, fdApplyButton); + TFontDialogOptions = set of TFontDialogOption; + TFontDialog = class(TCommonDialog) private - FFontName : String; + FFont: TFont; + FMaxFontSize: Integer; + FMinFontSize: Integer; + FOnApplyClicked: TNotifyEvent; + FOptions: TFontDialogOptions; + FPreviewText: string; + procedure SetFont(const AValue: TFont); public + procedure ApplyClicked; virtual; constructor Create (AOwner : TComponent); override; + destructor Destroy; override; published - property FontName : String read FFontName write FFontName; + property Font: TFont read FFont write SetFont; + property MinFontSize: Integer read FMinFontSize write FMinFontSize; + property MaxFontSize: Integer read FMaxFontSize write FMaxFontSize; + property Options: TFontDialogOptions + read FOptions write FOptions default [fdEffects]; + property OnApplyClicked: TNotifyEvent + read FOnApplyClicked write FOnApplyClicked; + property PreviewText: string read FPreviewText write FPreviewText; end; @@ -227,7 +248,7 @@ implementation uses - Buttons, StdCtrls, LCLlinux, Graphics, SysUtils, FileCtrl; + Buttons, StdCtrls, LCLlinux, SysUtils, FileCtrl; resourcestring rsMbYes = 'Yes'; @@ -269,6 +290,11 @@ var {$I commondialog.inc} {$I filedialog.inc} {$I colordialog.inc} +procedure TFontDialog.SetFont(const AValue: TFont); +begin + FFont.Assign(AValue); +end; + {$I fontdialog.inc} {$I messagedialogpixmaps.inc} {$I messagedialogs.inc} @@ -305,6 +331,9 @@ end. { ============================================================================= $Log$ + Revision 1.14 2002/06/04 15:17:21 lazarus + MG: improved TFont for XLFD font names + Revision 1.13 2002/05/30 14:11:11 lazarus MG: added filters and history to TOpenDialog diff --git a/lcl/graphics.pp b/lcl/graphics.pp index b5020eec14..7fff79c30a 100644 --- a/lcl/graphics.pp +++ b/lcl/graphics.pp @@ -119,6 +119,8 @@ type TBitmap = class; TPixmap = class; TIcon = class; + + { TGraphicsObject } TGraphicsObject = class(TPersistent) private @@ -133,6 +135,8 @@ type end; + { TFont } + TFont = class(TGraphicsObject) private FColor : TColor; @@ -144,25 +148,39 @@ type //--------- FFontData: TFontData; FPixelsPerInch: Integer; + FFontName: string; + FUpdateCount: integer; + FChanged: boolean; procedure FreeHandle; - Protected - function GetHandle: HFONT; - procedure SetHandle(const Value: HFONT); - Procedure SetName(const value : TFontName); - Function GetName : TFontName; - Procedure SetSize(value : Integer); - Procedure SetHeight(value : Integer); - Function GetSize : Integer; - procedure SetStyle(Value: TFontStyles); - Procedure SetPitch(Value : TFontPitch); - public - procedure Assign(Source : TPersistent); override; + procedure GetData(var FontData: TFontData); + procedure SetData(const FontData: TFontData); + protected + procedure Changed; override; + function GetCharSet: TFontCharSet; + function GetHandle: HFONT; + function GetHeight: Integer; + function GetName : TFontName; + function GetPitch: TFontPitch; + function GetSize : Integer; + function GetStyle: TFontStyles; + procedure SetCharSet(const AValue: TFontCharSet); procedure SetColor(Value : TColor); + procedure SetHandle(const Value: HFONT); + procedure SetHeight(value : Integer); + procedure SetName(const AValue : TFontName); + procedure SetPitch(Value : TFontPitch); + procedure SetSize(value : Integer); + procedure SetStyle(Value: TFontStyles); + public + constructor Create; + destructor Destroy; override; + procedure Assign(Source : TPersistent); override; + procedure Assign(const ALogFont: TLogFont); + procedure BeginUpdate; + procedure EndUpdate; // Extra properties // TODO: implement them though GetTextMetrics, not here //Function GetWidth(Value : String) : Integer; - constructor Create; - destructor Destroy; override; // Extra properties // TODO: implement them though GetTextMetrics, not here //property Width : Integer read FWidth write FWidth; @@ -172,15 +190,18 @@ type property Handle : HFONT read GetHandle write SetHandle; property PixelsPerInch : Integer read FPixelsPerInch; published + property CharSet: TFontCharSet read GetCharSet write SetCharSet; property Color : TColor read FColor write SetColor; - property Height : Integer read FFontData.Height write SetHeight; + property Height : Integer read GetHeight write SetHeight; property Name : TFontName read GetName write SetName; - property Pitch: TFontPitch read FFontData.Pitch write SetPitch; + property Pitch: TFontPitch read GetPitch write SetPitch; property Size: Integer read GetSize write SetSize; - property Style : TFontStyles read FFontData.Style write SetStyle; + property Style : TFontStyles read GetStyle write SetStyle; end; + { TPen } + TPen = class(TGraphicsObject) private FPenData : TPenData; @@ -206,6 +227,8 @@ type end; + { TBrush } + TBrushData = record Handle : HBrush; Color : TColor; @@ -405,6 +428,8 @@ type EInvalidGraphic = class(Exception); + { TCanvas } + TCanvas = class(TPersistent) private FAutoReDraw : Boolean; @@ -474,9 +499,9 @@ type Procedure MoveTo(X1,Y1 : Integer); Procedure LineTo(X1,Y1 : Integer); procedure TextOut(X,Y: Integer; const Text: String); - procedure TextRect(Rect: TRect; X, Y: integer; const Text : string);// overload; + procedure TextRect(Rect: TRect; X, Y: integer; const Text : string); procedure TextRect(Rect: TRect; X, Y: integer; const Text : string; - const Style : TTextStyle); //overload; + const Style : TTextStyle); function TextExtent(const Text: string): TSize; function TextHeight(const Text: string): Integer; function TextWidth(const Text: string): Integer; @@ -498,7 +523,8 @@ type property Color: TColor read GetColor write SetColor; end; - {TBITMAP} + + { TBITMAP } TSharedImage = class private @@ -579,6 +605,7 @@ type property TransparentColor: TColor read FTransparentColor write FTransparentColor; end; + { TPixmap } { @abstract() @@ -620,11 +647,29 @@ function ColorToString(Color: TColor): AnsiString; function StringToColor(const S: shortstring): TColor; procedure GetColorValues(Proc: TGetColorStringProc); - +procedure GetCharsetValues(Proc: TGetStrProc); +function CharsetToIdent(Charset: Longint; var Ident: string): Boolean; +function IdentToCharset(const Ident: string; var Charset: Longint): Boolean; + +function GetDefFontCharSet: TFontCharSet; +function IsFontNameXLogicalFontDesc(const LongFontName: string): boolean; +function XLFDNameToLogFont(const XLFDName: string): TLogFont; +function ExtractFamilyFromXLFDName(const XLFDName: string): string; + var { Stores information about the current screen } ScreenInfo : TLMScreenInit; +const // New TFont instances are initialized with the values in this structure: + DefFontData: TFontData = ( + Handle: 0; + Height: 0; + Pitch: fpDefault; + Style: []; + Charset : DEFAULT_CHARSET; + Name: 'default'); + + (*************************************************************************** ***************************************************************************) implementation @@ -765,6 +810,9 @@ end. { ============================================================================= $Log$ + Revision 1.32 2002/06/04 15:17:21 lazarus + MG: improved TFont for XLFD font names + Revision 1.31 2002/06/01 08:41:28 lazarus MG: DrawFramControl now uses gtk style, transparent STrechBlt diff --git a/lcl/graphtype.pp b/lcl/graphtype.pp index 19215a092d..db1eb1f9df 100644 --- a/lcl/graphtype.pp +++ b/lcl/graphtype.pp @@ -38,10 +38,10 @@ type TColor = longint; //Also defined in LMessages.pp TFontPitch = (fpDefault, fpVariable, fpFixed); - TFontName = shortstring; - TFontStyle = (fsBold, fsItalic, fsStrikeOut, fsUnderline); + TFontName = string; TFontCharSet = 0..255; TFontDataName = string[LF_FACESIZE -1]; + TFontStyle = (fsBold, fsItalic, fsStrikeOut, fsUnderline); TFontStyles = set of TFontStyle; TFontStylesbase = set of TFontStyle; @@ -145,6 +145,9 @@ end. { ============================================================================= $Log$ + Revision 1.4 2002/06/04 15:17:21 lazarus + MG: improved TFont for XLFD font names + Revision 1.3 2002/05/10 06:05:50 lazarus MG: changed license to LGPL diff --git a/lcl/include/bevel.inc b/lcl/include/bevel.inc index 01a7cdaf37..502618a4d5 100644 --- a/lcl/include/bevel.inc +++ b/lcl/include/bevel.inc @@ -78,6 +78,7 @@ Begin End; End; Canvas.Pen.Width:=1; + Case Shape Of bsBox: With Canvas Do @@ -244,6 +245,9 @@ End; { $Log$ + Revision 1.6 2002/06/04 15:17:22 lazarus + MG: improved TFont for XLFD font names + Revision 1.5 2002/05/10 06:05:51 lazarus MG: changed license to LGPL diff --git a/lcl/include/canvas.inc b/lcl/include/canvas.inc index 5d8fbe92bc..4f9b425cbe 100644 --- a/lcl/include/canvas.inc +++ b/lcl/include/canvas.inc @@ -493,19 +493,11 @@ end; ------------------------------------------------------------------------------} procedure TCanvas.TextOut(X,Y: Integer; const Text: String); -var - pStr: PChar; begin RequiredState([csHandleValid, csFontValid, csBrushValid]); - - pStr := StrAlloc(Length(Text)+1); - try - StrPcopy(pStr, Text); - ExtTextOut(FHandle, X, Y, 0 { <-- TODO: FTextFlags}, nil, pStr, Length(Text), nil); - MoveTo(X + TextWidth(Text), Y); - finally - StrDispose(PStr); - end; + ExtTextOut(FHandle, X, Y, 0 { <-- TODO: FTextFlags}, nil, + PChar(Text), Length(Text), nil); + MoveTo(X + TextWidth(Text), Y); end; @@ -842,6 +834,9 @@ end; { ============================================================================= $Log$ + Revision 1.19 2002/06/04 15:17:22 lazarus + MG: improved TFont for XLFD font names + Revision 1.18 2002/05/10 06:05:51 lazarus MG: changed license to LGPL diff --git a/lcl/include/custompanel.inc b/lcl/include/custompanel.inc index a8c97648c0..ed99e41d94 100644 --- a/lcl/include/custompanel.inc +++ b/lcl/include/custompanel.inc @@ -87,22 +87,21 @@ end; procedure TCustomPanel.Paint; var - Rect: TRect; + ARect: TRect; TS : TTextStyle; begin - Rect := GetClientRect; + ARect := GetClientRect; if BorderStyle = bsSingle then begin - Canvas.Rectangle(Rect); - InflateRect(Rect, -1, -1); + Canvas.Rectangle(ARect); + InflateRect(ARect, -1, -1); end; if BevelOuter <> bvNone then - Canvas.Frame3d(Rect, BevelWidth, BevelOuter); - + Canvas.Frame3d(ARect, BevelWidth, BevelOuter); if BevelInner <> bvNone then begin - if BorderWidth > 0 then InflateRect(Rect, -BorderWidth, -BorderWidth); - Canvas.Frame3d(Rect, BevelWidth, BevelInner); + if BorderWidth > 0 then InflateRect(ARect, -BorderWidth, -BorderWidth); + Canvas.Frame3d(ARect, BorderWidth, BevelInner); end; if Caption <> '' then begin @@ -110,7 +109,7 @@ begin TS.Layout:= tlCenter; TS.Opaque:= false; TS.Clipping:= false; - Canvas.TextRect(Rect, 0, 0, Caption, TS); + Canvas.TextRect(ARect, 0, 0, Caption, TS); end; end; diff --git a/lcl/include/font.inc b/lcl/include/font.inc index e8c3f432c7..44fa38f60c 100644 --- a/lcl/include/font.inc +++ b/lcl/include/font.inc @@ -1,3 +1,4 @@ +// included by graphics.pp {****************************************************************************** TFONT ****************************************************************************** @@ -16,6 +17,303 @@ ***************************************************************************** } +const + FontCharsets: array[0..17] of TIdentMapEntry = ( + (Value: ANSI_CHARSET; Name: 'ANSI_CHARSET'), + (Value: DEFAULT_CHARSET; Name: 'DEFAULT_CHARSET'), + (Value: SYMBOL_CHARSET; Name: 'SYMBOL_CHARSET'), + (Value: MAC_CHARSET; Name: 'MAC_CHARSET'), + (Value: SHIFTJIS_CHARSET; Name: 'SHIFTJIS_CHARSET'), + (Value: HANGEUL_CHARSET; Name: 'HANGEUL_CHARSET'), + (Value: JOHAB_CHARSET; Name: 'JOHAB_CHARSET'), + (Value: GB2312_CHARSET; Name: 'GB2312_CHARSET'), + (Value: CHINESEBIG5_CHARSET; Name: 'CHINESEBIG5_CHARSET'), + (Value: GREEK_CHARSET; Name: 'GREEK_CHARSET'), + (Value: TURKISH_CHARSET; Name: 'TURKISH_CHARSET'), + (Value: HEBREW_CHARSET; Name: 'HEBREW_CHARSET'), + (Value: ARABIC_CHARSET; Name: 'ARABIC_CHARSET'), + (Value: BALTIC_CHARSET; Name: 'BALTIC_CHARSET'), + (Value: RUSSIAN_CHARSET; Name: 'RUSSIAN_CHARSET'), + (Value: THAI_CHARSET; Name: 'THAI_CHARSET'), + (Value: EASTEUROPE_CHARSET; Name: 'EASTEUROPE_CHARSET'), + (Value: OEM_CHARSET; Name: 'OEM_CHARSET')); + +procedure GetCharsetValues(Proc: TGetStrProc); +var + I: Integer; +begin + for I:=Low(FontCharsets) to High(FontCharsets) do + Proc(FontCharsets[I].Name); +end; + +function CharsetToIdent(Charset: Longint; var Ident: string): Boolean; +begin + Result:=IntToIdent(Charset, Ident, FontCharsets); +end; + +function IdentToCharset(const Ident: string; var Charset: Longint): Boolean; +begin + Result:=IdentToInt(Ident, CharSet, FontCharsets); +end; + +function GetFontData(Font: HFont): TFontData; +var + ALogFont: TLogFont; +begin + Result := DefFontData; + if Font <> 0 then + begin + if GetObject(Font, SizeOf(ALogFont), @ALogFont) <> 0 then + with Result, ALogFont do + begin + Height := lfHeight; + if lfWeight >= FW_BOLD then + Include(Style, fsBold); + if lfItalic = 1 then + Include(Style, fsItalic); + if lfUnderline = 1 then + Include(Style, fsUnderline); + if lfStrikeOut = 1 then + Include(Style, fsStrikeOut); + Charset := TFontCharset(lfCharSet); + Name := lfFaceName; + case lfPitchAndFamily and $F of + VARIABLE_PITCH: Pitch := fpVariable; + FIXED_PITCH: Pitch := fpFixed; + else + Pitch := fpDefault; + end; + Handle := Font; + end; + end; +end; + +function GetDefFontCharSet: TFontCharSet; +//var +// DisplayDC: HDC; +// TxtMetric: TTEXTMETRIC; +begin + Result := DEFAULT_CHARSET; + {DisplayDC := GetDC(0); + if (DisplayDC <> 0) then begin + if (SelectObject(DisplayDC, StockFont) <> 0) then + if (GetTextMetrics(DisplayDC, TxtMetric)) then + Result := TxtMetric.tmCharSet; + ReleaseDC(0, DisplayDC); + end;} +end; + +{------------------------------------------------------------------------------ + Method: ExtractFamilyFromXLFDName + Params: const XLFDName: string + Returns: string + + Parses a font name in XLFD format and extracts the FamilyName. + (see http://wwwinfo.cern.ch/umtf/working-groups/X11/fonts/hp_xlfd.html) + + An XLFD name is + FontNameRegistry-Foundry-FamilyName-WeightName-Slant-SetwidthName + -AddStyleName-PixelSize-PointSize-ResolutionX-ResolutionY-Spacing + -AverageWidth-CharSetRegistry-CharSetCoding + + ------------------------------------------------------------------------------} +function ExtractFamilyFromXLFDName(const XLFDName: string): string; +var StartPos, EndPos, i: integer; +begin + Result:=''; + StartPos:=1; + i:=0; + while (StartPos<=length(XLFDName)) do begin + if XLFDName[StartPos]='-' then begin + inc(i); + if i=2 then begin + inc(StartPos); + EndPos:=StartPos; + while (EndPos<=length(XLFDName)) and (XLFDName[EndPos]<>'-') do + inc(EndPos); + Result:=copy(XLFDName,StartPos,EndPos-StartPos); + end; + end; + inc(StartPos); + end; +end; + +{------------------------------------------------------------------------------ + Method: XLFDNameToLogFont + Params: const XLFDName: string + Returns: TLogFont + + Parses a font name in XLFD format and creates a TLogFont record from it. + (see http://wwwinfo.cern.ch/umtf/working-groups/X11/fonts/hp_xlfd.html) + + An XLFD name is + FontNameRegistry-Foundry-FamilyName-WeightName-Slant-SetwidthName + -AddStyleName-PixelSize-PointSize-ResolutionX-ResolutionY-Spacing + -AverageWidth-CharSetRegistry-CharSetCoding + + ------------------------------------------------------------------------------} +function XLFDNameToLogFont(const XLFDName: string): TLogFont; +type + TWeightMapEntry = record + Name: string; + Weight: integer; + end; +const + WeightMap: array[1..15] of TWeightMapEntry = ( + (Name: 'DONTCARE'; Weight: FW_DONTCARE), + (Name: 'THIN'; Weight: FW_THIN), + (Name: 'EXTRALIGHT'; Weight: FW_EXTRALIGHT), + (Name: 'LIGHT'; Weight: FW_LIGHT), + (Name: 'NORMAL'; Weight: FW_NORMAL), + (Name: 'MEDIUM'; Weight: FW_MEDIUM), + (Name: 'SEMIBOLD'; Weight: FW_SEMIBOLD), + (Name: 'BOLD'; Weight: FW_BOLD), + (Name: 'EXTRABOLD'; Weight: FW_EXTRABOLD), + (Name: 'HEAVY'; Weight: FW_HEAVY), + (Name: 'ULTRALIGHT'; Weight: FW_ULTRALIGHT), + (Name: 'REGULAR'; Weight: FW_REGULAR), + (Name: 'DEMIBOLD'; Weight: FW_DEMIBOLD), + (Name: 'ULTRABOLD'; Weight: FW_ULTRABOLD), + (Name: 'BLACK'; Weight: FW_BLACK) + ); +var + ItemStart, ItemEnd: integer; + Item: string; + + procedure GetNextItem; + begin + ItemStart:=ItemEnd+1; + ItemEnd:=ItemStart; + while (ItemEnd<=length(XLFDName)) and (XLFDName[ItemEnd]<>'-') do + inc(ItemEnd); + Item:=copy(XLFDName,ItemStart,ItemEnd-ItemStart); + end; + + function WeightNameToWeightID(const WeightName: string): integer; + var i: integer; + begin + for i:=Low(WeightMap) to High(WeightMap) do begin + if AnsiCompareText(WeightMap[i].Name,WeightName)=0 then begin + Result:=WeightMap[i].Weight; + exit; + end; + end; + Result:=FW_DONTCARE; + end; + +var l, FaceNameMax, PixelSize, PointSize, Resolution: integer; +begin + FillChar(Result,SizeOf(TLogFont),0); + ItemEnd:=0; + GetNextItem; // read FontNameRegistry + // ToDo + + GetNextItem; // read Foundry + // ToDo + + GetNextItem; // read FamilyName + l:=length(Item); + FaceNameMax:=High(Result.lfFaceName)-Low(Result.lfFaceName); // max without #0 + if l>FaceNameMax then l:=FaceNameMax; + if l>0 then Move(Item[1],Result.lfFaceName[Low(Result.lfFaceName)],l); + Result.lfFaceName[Low(Result.lfFaceName)+l]:=#0; + + GetNextItem; // read WeightName + Result.lfWeight:=WeightNameToWeightID(Item); + + GetNextItem; // read Slant + if (AnsiCompareText(Item,'I')=0) or (AnsiCompareText(Item,'RI')=0) + or (AnsiCompareText(Item,'O')=0) then + // I = italic, RI = reverse italic, O = oblique + Result.lfItalic:=1 + else + Result.lfItalic:=0; + + GetNextItem; // read SetwidthName + // ToDO: NORMAL, CONDENSED, NARROW, WIDE, EXPANDED + + GetNextItem; // read AddStyleName + // calculate Style name extentions (=rotation) + // API XLFD + // --------------------- -------------- + // Orientation 1/10 deg 1/64 deg + Result.lfOrientation:=(StrToIntDef(Item,0)*10) div 64; + + GetNextItem; // read PixelSize + PixelSize:=StrToIntDef(Item,0); + GetNextItem; // read PointSize + PointSize:=StrToIntDef(Item,0) div 10; + GetNextItem; // read ResolutionX + Resolution:=StrToIntDef(Item,0); + if Resolution<=0 then Resolution:=72; + + if PixelSize=0 then begin + if PointSize<=0 then + Result.lfHeight:=(12*Resolution) div 72 + else + Result.lfHeight:=(PointSize*Resolution) div 72; + end else begin + Result.lfHeight:=PixelSize; + end; + + GetNextItem; // read ResolutionY + Resolution:=StrToIntDef(Item,0); + if Resolution<=0 then Resolution:=72; + + if PixelSize=0 then begin + if PointSize<=0 then + Result.lfWidth:=(12*Resolution) div 72 + else + Result.lfWidth:=(PointSize*Resolution) div 72; + end else begin + Result.lfWidth:=PixelSize; + end; + + GetNextItem; // read Spacing + // ToDo + {M Monospaced (fixed pitch) + P Proportional spaced (variable pitch) + C Character cell. The glyphs of the font can be thought of as + "boxes" of the same width and height that are stacked side by + side or top to bottom.} + + GetNextItem; // read AverageWidth + // ToDo + + GetNextItem; // read CharSetRegistry + // ToDo + + GetNextItem; // read CharSetCoding + // ToDo + +end; + +{------------------------------------------------------------------------------ + Method: IsFontNameXLogicalFontDesc + Params: const LongFontName: string + Returns: boolean + + Checks if font name is in X Logical Font Description format. + (see http://wwwinfo.cern.ch/umtf/working-groups/X11/fonts/hp_xlfd.html) + + An XLFD name is + FontNameRegistry-Foundry-FamilyName-WeightName-Slant-SetwidthName + -AddStyleName-PixelSize-PointSize-ResolutionX-ResolutionY-Spacing + -AverageWidth-CharSetRegistry-CharSetCoding + ------------------------------------------------------------------------------} +function IsFontNameXLogicalFontDesc(const LongFontName: string): boolean; +// Quick test: check if LongFontName contains 14 times the char '-' +var MinusCnt, p: integer; +begin + MinusCnt:=0; + for p:=1 to length(LongFontName) do + if LongFontName[p]='-' then inc(MinusCnt); + Result:=(MinusCnt=14); +end; + + +{ TFont } + {------------------------------------------------------------------------------ Method: TFont.Create @@ -27,12 +325,7 @@ constructor TFont.Create; begin inherited Create; - with FFontData do - begin - Handle := 0; - Charset := ANSI_CHARSET; - Pitch := fpDefault; - end; + FFontData:=DefFontData; FColor := clWindowText; FPixelsPerInch := ScreenInfo.PixelsPerInchX; @@ -52,9 +345,17 @@ begin try //TODO: TFont(Source).Lock; try - Height := TFont(Source).Height; - Color := TFont(Source).Color; - Name := TFont(Source).Name; + BeginUpdate; + try + CharSet:= TFont(Source).CharSet; + Color := TFont(Source).Color; + Height := TFont(Source).Height; + Name := TFont(Source).Name; + Pitch := TFont(Source).Pitch; + Style := TFont(Source).Style; + finally + EndUpdate; + end; finally //TODO: TFont(Source).UnLock; end; @@ -63,7 +364,53 @@ begin end; Exit; end; - inherited Assign(Source); + + inherited Assign(Source); +end; + +{------------------------------------------------------------------------------ + Method: TFont.Assign + Params: ALogFont: TLogFont + Returns: nothing + + Copies the logfont settings to itself + ------------------------------------------------------------------------------} +procedure TFont.Assign(const ALogFont: TLogFont); +var + AStyle: TFontStyles; +begin + BeginUpdate; + try + with ALogFont do + begin + Height := ALogFont.lfHeight; + Charset := TFontCharset(ALogFont.lfCharSet); + AStyle := []; + with ALogFont do + begin + if lfWeight >= FW_SEMIBOLD then Include(AStyle, fsBold); + if lfItalic <> 0 then Include(AStyle, fsItalic); + if lfUnderline <> 0 then Include(AStyle, fsUnderline); + if lfStrikeOut <> 0 then Include(AStyle, fsStrikeOut); + end; + Style := AStyle; + Name := ALogFont.lfFaceName; + end; + finally + EndUpdate; + end; +end; + +procedure TFont.BeginUpdate; +begin + inc(FUpdateCount); +end; + +procedure TFont.EndUpdate; +begin + if FUpdateCount=0 then exit; + dec(FUpdateCount); + if (FUpdateCount=0) and FChanged then Changed; end; {------------------------------------------------------------------------------ @@ -97,7 +444,7 @@ end; Sets the pitch of a font ------------------------------------------------------------------------------} -Procedure TFont.SetPitch(Value : TFOntPitch); +Procedure TFont.SetPitch(Value : TFontPitch); Begin if FFontData.Pitch <> Value then begin @@ -166,7 +513,10 @@ end; ------------------------------------------------------------------------------} function TFont.GetName: TFontName; begin - Result := FFontdata.Name; + if FFontName<>'' then + Result:=FFontName + else + Result := FFontdata.Name; end; {------------------------------------------------------------------------------ @@ -176,12 +526,13 @@ end; Sets the name of a font ------------------------------------------------------------------------------} -procedure TFont.SetName(const Value : TFontName); +procedure TFont.SetName(const AValue : TFontName); begin - if FFontData.Name <> Value + if FFontData.Name <> AValue then begin FreeHandle; - FFontData.Name := Value; + FFontData.Name := AValue; + FFontName:=AValue; Changed; end; end; @@ -208,13 +559,7 @@ end; ------------------------------------------------------------------------------} procedure TFont.SetHandle(const Value: HFONT); begin - if FFontData.Handle <> Value - then begin - FreeHandle; - FFontData.Handle := Value; - //TODO: query new parameters - Changed; - end; + SetData(GetFontData(Value)); end; {------------------------------------------------------------------------------ @@ -229,10 +574,25 @@ const LF_BOOL: array[Boolean] of Byte = (0, 255); LF_WEIGHT: array[Boolean] of Integer = (FW_NORMAL, FW_BOLD); var - LogFont: TLogFont; + ALogFont: TLogFont; + + procedure SetLogFontName(const NewName: string); + var l: integer; + aName: string; + begin + if IsFontNameXLogicalFontDesc(NewName) then + aName:=ExtractFamilyFromXLFDName(NewName) + else + aName:=NewName; + l:=High(ALogFont.lfFaceName)-Low(ALogFont.lfFaceName); + if l>length(aName) then l:=length(aName); + if l>0 then + Move(aName[1],ALogFont.lfFaceName[Low(ALogFont.lfFaceName)],l); + ALogFont.lfFaceName[Low(ALogFont.lfFaceName)+l]:=#0; + end; + begin - if FFontData.Handle = 0 - then with LogFont do + if FFontData.Handle = 0 then with ALogFont do begin lfHeight := Height; lfWidth := 0; @@ -243,14 +603,7 @@ begin lfUnderline := LF_BOOL[fsUnderline in Style]; lfStrikeOut := LF_BOOL[fsStrikeOut in Style]; lfCharSet := Byte(FFontData.Charset); - if AnsiCompareText(Name, 'Default') = 0 - then StrPCopy(lfFaceName, 'helvetica') //TODO: change this to a more flexible default - else begin - if length(Name)+1<=SizeOf(lfFaceName) then - StrPCopy(lfFaceName, Name) - else - StrPCopy(lfFaceName, LeftStr(Name,SizeOf(lfFaceName)-1)); - end; + SetLogFontName(Name); lfQuality := DEFAULT_QUALITY; lfOutPrecision := OUT_DEFAULT_PRECIS; @@ -262,7 +615,8 @@ begin lfPitchAndFamily := DEFAULT_PITCH; end; - FFontData.Handle := CreateFontIndirect(LogFont); + // ask the interface for the nearest font + FFontData.Handle := CreateFontIndirectEx(ALogFont,Name); end; Result := FFontData.Handle; @@ -285,10 +639,80 @@ begin end; end; +function TFont.GetCharSet: TFontCharSet; +begin + Result:=FFontData.CharSet; +end; + +procedure TFont.SetCharSet(const AValue: TFontCharSet); +begin + if FFontData.CharSet <> AValue + then begin + FreeHandle; + FFontData.CharSet := AValue; + Changed; + end; +end; + +procedure TFont.GetData(var FontData: TFontData); +begin + FontData := FFontData; + FontData.Handle := 0; +end; + +procedure TFont.SetData(const FontData: TFontData); +begin + if FFontData.Handle <> FontData.Handle then begin + FreeHandle; + FFontData.Handle := FontData.Handle; + FFontName:=FontData.Name; + //TODO: query new parameters + Changed; + end; + + {Lock; + try + FontManager.ChangeResource(Self, FontData); + finally + Unlock; + end;} +end; + +function TFont.GetHeight: Integer; +begin + Result:=FFontData.Height; +end; + +function TFont.GetPitch: TFontPitch; +begin + Result:=FFontData.Pitch; +end; + +function TFont.GetStyle: TFontStyles; +begin + Result:=FFontData.Style; +end; + +procedure TFont.Changed; +begin + if FUpdateCount>0 then begin + FChanged:=true; + exit; + end; + FChanged:=false; + inherited Changed; + // ToDo: we need interfaces: + // if FNotify <> nil then FNotify.Changed; +end; + +// included by graphics.pp { ============================================================================= $Log$ + Revision 1.6 2002/06/04 15:17:22 lazarus + MG: improved TFont for XLFD font names + Revision 1.5 2002/05/10 06:05:52 lazarus MG: changed license to LGPL diff --git a/lcl/include/fontdialog.inc b/lcl/include/fontdialog.inc index 354eaea22c..31a343bdb1 100644 --- a/lcl/include/fontdialog.inc +++ b/lcl/include/fontdialog.inc @@ -15,6 +15,18 @@ * * ***************************************************************************** } +{------------------------------------------------------------------------------ + Method: TFontDialog.Apply + Params: Wnd: HWND + Returns: Nothing + + Called whenever the Apply button is clicked. + ------------------------------------------------------------------------------} +procedure TFontDialog.ApplyClicked; +begin + if Assigned(FOnApplyClicked) then FOnApplyClicked(Self); +end; + {------------------------------------------------------------------------------ Method: TFontDialog.Create Params: AOwner: the owner of the class @@ -24,14 +36,25 @@ ------------------------------------------------------------------------------} constructor TFontDialog.Create (AOwner : TComponent); begin - inherited Create(AOwner); - fCompStyle := csFontDialog; - FTitle:= 'Select a font:'; + inherited Create(AOwner); + fCompStyle := csFontDialog; + FTitle:= 'Select a font:'; + FFont := TFont.Create; + FOptions := [fdEffects]; +end; + +destructor TFontDialog.Destroy; +begin + FFont.Free; + inherited Destroy; end; { ============================================================================= $Log$ + Revision 1.3 2002/06/04 15:17:22 lazarus + MG: improved TFont for XLFD font names + Revision 1.2 2002/05/10 06:05:52 lazarus MG: changed license to LGPL diff --git a/lcl/include/statusbar.inc b/lcl/include/statusbar.inc index 682c82add4..86b975bbea 100644 --- a/lcl/include/statusbar.inc +++ b/lcl/include/statusbar.inc @@ -1,3 +1,4 @@ +// included by comctrls.pp { ***************************************************************************** * * @@ -23,7 +24,7 @@ begin ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque]; Color := clBtnFace; Height := 19; - Setbounds(0,TWinControl(AOwner).Height-21,TWInControl(AOwner).Width,20); + Setbounds(0,TWinControl(AOwner).Height-21,TWinControl(AOwner).Width,20); Align := alBottom; FPanels := TStatusPanels.Create(Self); FCanvas := TControlCanvas.Create; @@ -135,16 +136,19 @@ Begin For I := 0 to Panels.Count-1 do Begin if I = Panels.Count-1 then - Panels[I].Width := ClientWidth-X; //this sets the last panel to the width of the statusbar + // this sets the last panel to the width of the statusbar + Panels[I].Width := ClientWidth-X; DrawBevel(X,I); Canvas.TextOut(X+2,Y+X2,Panels[i].Text); //draw divider if I < Panels.Count-1 then DrawDivider(X+Panels[i].Width); - inc(X); + inc(X); X := X + Panels[i].Width+1; end; end - else Canvas.TextOut(Left+2,Top+X2,SimpleText); - + else + Canvas.TextOut(Left+2,Top+X2,SimpleText); End; +// included by comctrls.pp + diff --git a/lcl/include/winapi.inc b/lcl/include/winapi.inc index 9a84436372..60e688bca9 100644 --- a/lcl/include/winapi.inc +++ b/lcl/include/winapi.inc @@ -123,6 +123,12 @@ begin Result := InterfaceObject.CreateFontIndirect(LogFont); end; +function CreateFontIndirectEx(const LogFont: TLogFont; + const LongFontName: string): HFONT; +begin + Result := InterfaceObject.CreateFontIndirectEx(LogFont,LongFontName); +end; + function CreatePenIndirect(const LogPen: TLogPen): HPEN; begin Result := InterfaceObject.CreatePenIndirect(LogPen); @@ -667,6 +673,7 @@ function CreateFont(Height, Width, Escapement, Orientation, Weight: Integer; var LogFont: TLogFont; begin +writeln('CreateFont Name="',FaceName,'"'); with LogFont do begin lfHeight := Height; @@ -1129,6 +1136,9 @@ end; { ============================================================================= $Log$ + Revision 1.32 2002/06/04 15:17:22 lazarus + MG: improved TFont for XLFD font names + Revision 1.31 2002/05/27 17:58:42 lazarus MG: added command line help diff --git a/lcl/include/winapih.inc b/lcl/include/winapih.inc index a8fc5753f4..f3bab5207f 100644 --- a/lcl/include/winapih.inc +++ b/lcl/include/winapih.inc @@ -61,6 +61,7 @@ function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; {$IFD function CreateCompatibleDC(DC: HDC): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} //function CreateFont --> independent function CreateFontIndirect(const LogFont: TLogFont): HFONT; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} +function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} //function CreatePen --> independent function CreatePenIndirect(const LogPen: TLogPen): HPEN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} @@ -268,6 +269,9 @@ function UnionRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): Boolean { ============================================================================= $Log$ + Revision 1.27 2002/06/04 15:17:22 lazarus + MG: improved TFont for XLFD font names + Revision 1.26 2002/05/27 17:58:42 lazarus MG: added command line help diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index 62fd2f27fb..48f869f58b 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/lcl/interfaces/gtk/gtkcallback.inc @@ -711,12 +711,16 @@ function gtkDialogOKclickedCB( widget: PGtkWidget; var theDialog : TCommonDialog; Fpointer : Pointer; + // colordialog colorArray : array[0..2] of double; colorsel : GTK_COLOR_SELECTION; newColor : TGdkColor; + // fontdialog FontName : String; + ALogFont : TLogFont; + // filedialog cListRow : PGList; - rowNum : gint; + rowNum : gint; fileInfo : PGChar; fileList : PGTKCList; DirName : string; @@ -784,10 +788,18 @@ begin end else if theDialog is TFontDialog then begin - Assert(False, 'Trace:Prssed OK in FontDialog'); - FontName := gtk_font_selection_dialog_get_font_name(pgtkfontselectiondialog(FPointer)); - TFontDialog(theDialog).FontName := FontName; - Assert(False, 'Trace:-----'+TFontDialog(theDialog).FontName+'----'); + Assert(False, 'Trace:Pressed OK in FontDialog'); + FontName := gtk_font_selection_dialog_get_font_name( + pgtkfontselectiondialog(FPointer)); + // extract basic font attributes from the font name in XLFD format + ALogFont:=XLFDNameToLogFont(FontName); + TFontDialog(theDialog).Font.Assign(ALogFont); + // set the font name in XLFD format + // a font name in XLFD format overrides in the gtk interface all other font + // settings. + TFontDialog(theDialog).Font.Name := FontName; + + Assert(False, 'Trace:-----'+TFontDialog(theDialog).Font.Name+'----'); end; StoreCommonDialogSetup(theDialog); @@ -839,6 +851,40 @@ begin end; end; +{------------------------------------------------------------------------------- + function gtkDialogApplyclickedCB + Params: widget: PGtkWidget; data: gPointer + Result: GBoolean + + This function is called, whenever the user clicks the Apply button in a + commondialog +-------------------------------------------------------------------------------} +function gtkDialogApplyclickedCB(widget: PGtkWidget; data: gPointer): GBoolean; + cdecl; +var + theDialog : TCommonDialog; + FontName: string; + ALogFont: TLogFont; +begin + Result := True; + theDialog := TCommonDialog(data); +// gtk_grab_remove(PgtkWidget(TCommonDialog(data).Handle)); + if (theDialog is TFontDialog) + and (fdApplyButton in TFontDialog(theDialog).Options) + and (Assigned(TFontDialog(theDialog).OnApplyClicked)) then begin + // extract basic font attributes from the font name in XLFD format + FontName := gtk_font_selection_dialog_get_font_name( + pgtkfontselectiondialog(theDialog.Handle)); + ALogFont:=XLFDNameToLogFont(FontName); + TFontDialog(theDialog).Font.Assign(ALogFont); + // set the font name in XLFD format + // a font name in XLFD format overrides in the gtk interface all other font + // settings. + TFontDialog(theDialog).Font.Name := FontName; + TFontDialog(theDialog).OnApplyClicked(theDialog); + end; +end; + {------------------------------------------------------------------------------- function gtkDialogCloseQueryCB Params: widget: PGtkWidget; data: gPointer @@ -1981,6 +2027,9 @@ end; { ============================================================================= $Log$ + Revision 1.78 2002/06/04 15:17:22 lazarus + MG: improved TFont for XLFD font names + Revision 1.77 2002/05/30 14:11:12 lazarus MG: added filters and history to TOpenDialog diff --git a/lcl/interfaces/gtk/gtkdef.pp b/lcl/interfaces/gtk/gtkdef.pp index 90b304ac88..e8806990c7 100644 --- a/lcl/interfaces/gtk/gtkdef.pp +++ b/lcl/interfaces/gtk/gtkdef.pp @@ -72,7 +72,7 @@ type ); gdiFont: ( GDIFontObject: PGdkFont; - LogFont: TLogFont; // for now font info is stored as well, later query font params + LogFont: TLogFont;// for now font info is stored as well, later query font params ); gdiPen: ( GDIPenColor: TGdkColor; @@ -141,6 +141,9 @@ end. { ============================================================================= $Log$ + Revision 1.8 2002/06/04 15:17:23 lazarus + MG: improved TFont for XLFD font names + Revision 1.7 2002/06/01 08:41:28 lazarus MG: DrawFramControl now uses gtk style, transparent STrechBlt diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 7c1c8231a2..d7d7801415 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -1042,12 +1042,25 @@ end; {------------------------------------------------------------------------------ Function: CreateFontIndirect - Params: none - Returns: Nothing - + Params: const LogFont: TLogFont + Returns: HFONT + Creates a font GDIObject. ------------------------------------------------------------------------------} function TgtkObject.CreateFontIndirect(const LogFont: TLogFont): HFONT; +begin + Result:=CreateFontIndirectEx(LogFont,''); +end; + +{------------------------------------------------------------------------------ + Function: CreateFontIndirectEx + Params: const LogFont: TLogFont; const LongFontName: string + Returns: HFONT + + Creates a font GDIObject. + ------------------------------------------------------------------------------} +function TgtkObject.CreateFontIndirectEx(const LogFont: TLogFont; + const LongFontName: string): HFONT; var GdiObject: PGdiObject; S: String; @@ -1058,8 +1071,6 @@ var n: Integer; procedure LoadFont; - var - pStr: PChar; begin S := Format('%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s', [FontNameRegistry, Foundry, FamilyName, WeightName, @@ -1068,172 +1079,224 @@ var CharSetRegistry, CharSetCoding ]); - pStr := StrAlloc(Length(S) + 1); - try - StrPCopy(pStr, S); - GdiObject^.GDIFontObject := gdk_font_load(pStr); - finally - StrDispose(pStr); - end; + //writeln(' Trying "',S,'"'); + GdiObject^.GDIFontObject := gdk_font_load(PChar(s)); + end; + + procedure LoadDefaultFont; + begin + FGDIObjects.Remove(GdiObject); + Dispose(GdiObject); + GdiObject:=CreateDefaultFont; end; begin - // For info about xlfd see: http://wwwinfo.cern.ch/umtf/working-groups/X11/fonts/hp_xlfd.html + // For info about xlfd see: + // http://wwwinfo.cern.ch/umtf/working-groups/X11/fonts/hp_xlfd.html // Lets fill in all the xlfd parts. Assume we have scalable fonts Result := 0; + GDIObject := NewGDIObject(gdiFont); - with LogFont do - begin + try + GdiObject^.LogFont := LogFont; + //writeln('TgtkObject.CreateFontIndirectEx Name="',LogFont.lfFaceName,'"', + //' Long="',LongFontName,'" ',IsFontNameXLogicalFontDesc(LongFontName) + //,' ',ord(LogFont.lfFaceName[0])); + S:=LongFontName; + if IsFontNameXLogicalFontDesc(LongFontName) then begin + GdiObject^.GDIFontObject := gdk_font_load(PChar(LongFontName)); + if GdiObject^.GDIFontObject<>nil then begin + GdiObject^.LogFont := XLFDNameToLogFont(LongFontName); + exit; + end; + end; + + with LogFont do + begin - FontNameRegistry := ''; - Foundry := '*'; + FontNameRegistry := ''; + Foundry := '*'; - if lfFaceName[0] = #0 - then begin - Assert(false,'ERROR: [TgtkObject.CreateFontIndirect] No fontname'); - Exit; + if lfFaceName[0] = #0 + then begin + Assert(false,'ERROR: [TgtkObject.CreateFontIndirectEx] No fontname'); + Exit; + end; + + FamilyName := StrPas(lfFaceName); //StringReplace(FaceName, ' ', '*'); + if AnsiCompareText(FamilyName,'default')=0 then begin + LoadDefaultFont; + exit; + end; + + Assert(False, Format('trace: [TgtkObject.CreateFontIndirectEx] Name: %s, Height: %d', [FamilyName, lfHeight])); + + // calculate weight offset. + // API XLFD + // --------------------- -------------- + // Weight=400 --> normal normal + // Weight=700 --> bold normal+4000 (or bold in non scalable fonts) + // + // So in API the offset for normal = 400 and an increase of 300 equals to + // an offset of 4000 + case lfWeight of + FW_DONTCARE : WeightName := '*'; + FW_LIGHT : WeightName := 'light'; + FW_NORMAL : WeightName := 'normal'; + FW_MEDIUM : WeightName := 'medium'; + FW_SEMIBOLD : WeightName := 'demi bold'; + FW_BOLD : WeightName := 'bold'; + + else begin + n := ((lfWeight - FW_NORMAL) * 4000) div (FW_BOLD - FW_NORMAL); + if n = 0 + then WeightName := 'normal' + else if n > 0 + then WeightName := Format('normal+%d', [n]) + else WeightName := Format('normal%d', [n]); + end; + end; + + // TODO: find out if escapement has something to do with slant + if lfItalic = 0 then Slant := 'r' else Slant := 'i'; + + SetwidthName := '*'; + + // calculate Style name extentions (=rotation) + // API XLFD + // --------------------- -------------- + // Orientation 1/10 deg 1/64 deg + if lfOrientation = 0 + then AddStyleName := '*' + else begin + n := (lfOrientation * 64) div 10; + if n >= 0 + then AddStyleName := Format('+%d', [n]) + else AddStyleName := Format('+%d', [n]); + end; + + // TODO: make more accurate (implement the meaning of + // positive and negative heigtht values. + PixelSize := IntToStr(Abs(lfHeight)); + + // Since we use pixelsize, it isn't allowed to give a value here + PointSize := '*'; + + // Use the default + ResolutionX := '*'; + ResolutionY := '*'; + + Spacing := '*'; + + // calculate AverageWidth + // API XLFD + // --------------------- -------------- + // Width pixel 1/10 pixel + if lfWidth = 0 + then AverageWidth := '*' + else AverageWidth := InttoStr(lfWidth * 10); + + + CharSetRegistry := '*'; + + // TODO: Match charset. + CharSetCoding := '*'; end; - FamilyName := StrPas(lfFaceName); //StringReplace(FaceName, ' ', '*'); - - Assert(False, Format('trace: [TgtkObject.CreateFontIndirect] Name: %s, Height: %d', [FamilyName, lfHeight])); - - // calculate weight offset. - // API XLFD - // --------------------- -------------- - // Weight=400 --> normal normal - // Weight=700 --> bold normal+4000 (or bold in non scalable fonts) - // - // So in API the offset for normal = 400 and an increase of 300 equals to - // an offset of 4000 - case lfWeight of - 0: WeightName := '*'; - FW_NORMAL: WeightName := 'normal'; - FW_MEDIUM: WeightName := 'medium'; - FW_BOLD: WeightName := 'bold'; - FW_BLACK: WeightName := 'black'; - - else begin - n := ((lfWeight - FW_NORMAL) * 4000) div (FW_BOLD - FW_NORMAL); - if n = 0 - then WeightName := 'normal' - else if n > 0 - then WeightName := Format('normal+%d', [n]) - else WeightName := Format('normal%d', [n]); + //write('CreateFontIndirect->'); + LoadFont; + if GdiObject^.GDIFontObject = nil + then begin + if (WeightName='normal') then begin + WeightName:='medium'; + LoadFont; + end else if (WeightName='bold') then begin + WeightName:='black'; + LoadFont; end; end; - // TODO: find out if escapement has something to do with slant - if lfItalic = 0 then Slant := 'r' else Slant := 'i'; - - SetwidthName := '*'; - - // calculate Style name extentions (=rotation) - // API XLFD - // --------------------- -------------- - // Orientation 1/10 deg 1/64 deg - if lfOrientation = 0 - then AddStyleName := '*' - else begin - n := (lfOrientation * 64) div 10; - if n >= 0 - then AddStyleName := Format('+%d', [n]) - else AddStyleName := Format('+%d', [n]); + if GdiObject^.GDIFontObject = nil + then begin + if (WeightName='medium') then begin + WeightName:='regular'; + LoadFont; + end else if (WeightName='black') then begin + WeightName:='demi bold'; + LoadFont; + end; end; - - // TODO: make more accurate (implement the meaning of - // positive and negative heigtht values. - PixelSize := IntToStr(Abs(lfHeight)); - - // Since we use pixelsize, it isn't allowed to give a value here - PointSize := '*'; - - // Use the default - ResolutionX := '*'; - ResolutionY := '*'; - - Spacing := '*'; - - // calculate AverageWidth - // API XLFD - // --------------------- -------------- - // Widht pixel 1/10 pixel - if lfWidth = 0 - then AverageWidth := '*' - else AverageWidth := InttoStr(lfWidth * 10); - - - CharSetRegistry := '*'; - - // TODO: Match charset. - CharSetCoding := '*'; - end; - -//write('CreateFontIndirect->'); - GDIObject := NewGDIObject(gdiFont); - LoadFont; - if GdiObject^.GDIFontObject = nil - then begin - if (WeightName='normal') then begin - WeightName:='medium'; - LoadFont; - end else if (WeightName='bold') then begin - WeightName:='black'; + + if GdiObject^.GDIFontObject = nil + then begin + // try all weights + WeightName := '*'; LoadFont; end; - end; - if GdiObject^.GDIFontObject = nil - then begin - // try all weights - WeightName := '*'; - LoadFont; - end; - - if GdiObject^.GDIFontObject = nil - then begin - // try all weights - WeightName := '*'; - LoadFont; - end; - - if GdiObject^.GDIFontObject = nil - then begin + // try instead of italic oblique + if GdiObject^.GDIFontObject = nil + then begin + if (Slant='i') then begin + Slant := 'o'; + LoadFont; + end; + end; + // try all slant - Slant := '*'; - LoadFont; - end; + if GdiObject^.GDIFontObject = nil + then begin + Slant := '*'; + LoadFont; + end; + + // try one height lower + if GdiObject^.GDIFontObject = nil + then begin + PixelSize := IntToStr(Abs(LogFont.lfHeight)-1); + LoadFont; + end; + + // try one height higher + if GdiObject^.GDIFontObject = nil + then begin + PixelSize := IntToStr(Abs(LogFont.lfHeight)+1); + LoadFont; + end; - if GdiObject^.GDIFontObject = nil - then begin // try all Familys - FamilyName := '*'; - LoadFont; - end; + if GdiObject^.GDIFontObject = nil + then begin + PixelSize := IntToStr(Abs(LogFont.lfHeight)); + FamilyName := '*'; + LoadFont; + end; - if GdiObject^.GDIFontObject = nil - then begin // try all Foundrys - Foundry := '*'; - LoadFont; - end; + if GdiObject^.GDIFontObject = nil + then begin + Foundry := '*'; + LoadFont; + end; - if GdiObject^.GDIFontObject = nil - then begin -//writeln('[TgtkObject.CreateFontIndirect] ',HexStr(Cardinal(GdiObject),8),' ',FGDIObjects.Count); - FGDIObjects.Remove(GdiObject); - Dispose(GdiObject); - Result := 0; - end - else begin - GdiObject^.LogFont := LogFont; - Result := HFONT(GdiObject); - end; + finally + if GdiObject^.GDIFontObject = nil + then begin + //writeln('[TgtkObject.CreateFontIndirect] ',HexStr(Cardinal(GdiObject),8),' ',FGDIObjects.Count); + FGDIObjects.Remove(GdiObject); + Dispose(GdiObject); + Result := 0; + end + else begin + GdiObject^.LogFont := LogFont; + Result := HFONT(GdiObject); + end; - if Result = 0 - then WriteLn(Format('WARNING: [TgtkObject.CreateFontIndirect] NOT found XLFD: <%s>', [S])) - else Assert(False, Format('Trace: [TgtkObject.CreateFontIndirect] found XLFD: <%s>', [S])); + if Result = 0 + then WriteLn(Format('WARNING: [TgtkObject.CreateFontIndirectEx] NOT found XLFD: <%s>', [S])) + else Assert(False, Format('Trace: [TgtkObject.CreateFontIndirectEx] found XLFD: <%s>', [S])); + end; end; {------------------------------------------------------------------------------ @@ -1512,6 +1575,7 @@ begin end; DFC_MENU: begin + end; DFC_SCROLL: begin @@ -1567,11 +1631,11 @@ end; {------------------------------------------------------------------------------ Function: DrawEdge - Params: - Returns: + Params: DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal + Returns: Boolean - Draws one or more edges of a rectangle, not including the - right and bottom edge. + Draws one or more edges of a rectangle. The rectangle is the area + Left to Right-1 and Top to Bottom-1. ------------------------------------------------------------------------------} function TgtkObject.DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; @@ -1597,6 +1661,7 @@ begin Dec(R.Right); Dec(R.Bottom); + // try to use the gdk functions, so that the current theme is used BInner := False; BOuter := False; @@ -1912,8 +1977,12 @@ end; Draws a 3d border in GTK native style. ------------------------------------------------------------------------------} -function TGtkObject.Frame3d(DC : HDC; var Rect : TRect; const FrameWidth : integer; const Style : TBevelCut) : boolean; -const GTKShadowType: array[TBevelCut] of integer = (GTK_SHADOW_NONE, GTK_SHADOW_IN, GTK_SHADOW_OUT); +function TGtkObject.Frame3d(DC : HDC; var Rect : TRect; + const FrameWidth : integer; const Style : TBevelCut) : boolean; + +const GTKShadowType: array[TBevelCut] of integer = + (GTK_SHADOW_NONE, GTK_SHADOW_IN, GTK_SHADOW_OUT); + var Widget : TGtkWidget; i : integer; begin @@ -1928,13 +1997,14 @@ begin Widget:=PGtkFixed(GetFixedWidget(PGtkWidget( PDeviceContext(DC)^.hWnd)))^.Container.Widget; for i:= 1 to FrameWidth do begin - gtk_paint_shadow(Widget.thestyle, Widget.window, GTK_STATE_NORMAL, - GtkShadowType[Style], nil, @Widget, nil, - Rect.left, Rect.top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top); - InflateRect(Rect, -1, -1); + gtk_draw_shadow(Widget.thestyle, Widget.window, GTK_STATE_NORMAL, + GtkShadowType[Style], + Rect.left, Rect.top, + Rect.Right - Rect.Left-1, Rect.Bottom - Rect.Top-1); + InflateRect(Rect, -1, -1); + end; end; end; - end; end; {------------------------------------------------------------------------------ @@ -2333,12 +2403,16 @@ begin end; gdiFont: begin - if Buf = nil then Result := SizeOf(PGDIObject(GDIObj)^.LogFont) + if Buf = nil then + Result := SizeOf(PGDIObject(GDIObj)^.LogFont) else begin if BufSize >= SizeOf(PGDIObject(GDIObj)^.LogFont) then begin PLogfont(Buf)^ := PGDIObject(GDIObj)^.LogFont; Result:= SizeOf(TLogFont); + end else if BufSize>0 then begin + Move(PGDIObject(GDIObj)^.LogFont,Buf^,BufSize); + Result:=BufSize; end; end; end; @@ -2815,27 +2889,41 @@ end; ------------------------------------------------------------------------------} function TgtkObject.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; +const + TestString = '{m|g_}'; + AvrWidthStr = 'abcxyz012789 '; var lbearing, rbearing, dummy: LongInt; + AvrWidthStrLen: integer; begin Assert(False, Format('Trace:> TODO FINISH[TgtkObject.GetTextMetrics] DC: 0x%x', [DC])); Result := IsValidDC(DC); - if Result then with PDeviceContext(DC)^ do begin - if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) - then begin - WriteLn('WARNING: [TgtkObject.GetTGextMetrics] Missing font'); - Result := False; - end - else with TM do begin - FillChar(TM, SizeOf(TM), 0); + if Result then + with PDeviceContext(DC)^ do begin + if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) + then begin + WriteLn('WARNING: [TgtkObject.GetTGextMetrics] Missing font'); + Result := False; + end + else with TM do begin + FillChar(TM, SizeOf(TM), 0); - gdk_text_extents(CurrentFont^.GDIFontObject, '{g|h_}', 1, @lbearing, @rBearing, @dummy, @tmAscent, @tmDescent); - tmHeight := tmAscent + tmDescent + 2; //todo EXACT MEASUREMENT - tmAveCharWidth := gdk_char_width(CurrentFont^.GDIFontObject, 'x'); // avarage is mostly measured by the x - tmMaxCharWidth := gdk_char_width(CurrentFont^.GDIFontObject, 'W'); // temp hack + gdk_text_extents(CurrentFont^.GDIFontObject, TestString, + length(TestString), @lbearing, @rBearing, @dummy, + @tmAscent, @tmDescent); + tmHeight := tmAscent + tmDescent + 2; //todo EXACT MEASUREMENT + AvrWidthStrLen := length(AvrWidthStr); + tmAveCharWidth := gdk_text_width(CurrentFont^.GDIFontObject, + AvrWidthStr,AvrWidthStrLen) div AvrWidthStrLen; + if tmAveCharWidth<2 then tmAveCharWidth:=2; + tmMaxCharWidth := gdk_char_width(CurrentFont^.GDIFontObject, 'W'); // temp hack + if tmMaxCharWidth<2 then tmMaxCharWidth:=2; + //writeln('TgtkObject.GetTextMetrics lbearing=',lbearing,' rBearing=',rBearing, + //' tmAscent=',tmAscent,' tmDescent=',tmDescent,' tmAveCharWidth=',tmAveCharWidth, + //' tmMaxCharWidth=',tmMaxCharWidth); + end; end; - end; Assert(False, Format('Trace:< TODO FINISH[TgtkObject.GetTextMetrics] DC: 0x%x', [DC])); end; @@ -4632,6 +4720,9 @@ end; { ============================================================================= $Log$ + Revision 1.74 2002/06/04 15:17:24 lazarus + MG: improved TFont for XLFD font names + Revision 1.73 2002/06/01 08:41:28 lazarus MG: DrawFramControl now uses gtk style, transparent STrechBlt diff --git a/lcl/interfaces/gtk/gtkwinapih.inc b/lcl/interfaces/gtk/gtkwinapih.inc index f05b4907c0..4934e2de59 100644 --- a/lcl/interfaces/gtk/gtkwinapih.inc +++ b/lcl/interfaces/gtk/gtkwinapih.inc @@ -47,6 +47,7 @@ function CreateCaret(Handle : HWND; Bitmap : hBitmap; width, Height : Integer) : function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; override; function CreateCompatibleDC(DC: HDC): HDC; override; function CreateFontIndirect(const LogFont: TLogFont): HFONT; override; +function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override; function CreatePenIndirect(const LogPen: TLogPen): HPEN; override; function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; override; function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; override; @@ -153,6 +154,9 @@ Function WindowFromPoint(Point : TPoint) : HWND; override; { ============================================================================= $Log$ + Revision 1.31 2002/06/04 15:17:26 lazarus + MG: improved TFont for XLFD font names + Revision 1.30 2002/05/27 17:58:42 lazarus MG: added command line help diff --git a/lcl/lcllinux.pp b/lcl/lcllinux.pp index 643b9782a2..7db5e0a754 100644 --- a/lcl/lcllinux.pp +++ b/lcl/lcllinux.pp @@ -53,6 +53,7 @@ uses Classes, LCLType, VCLGlobals, GraphType; function MakeLong(A,B : Word) : LongInt; function MakeWord(A,B : Byte) : Word; + implementation uses @@ -75,6 +76,9 @@ end. { $Log$ + Revision 1.19 2002/06/04 15:17:21 lazarus + MG: improved TFont for XLFD font names + Revision 1.18 2002/05/20 14:19:03 lazarus MG: activated the clientrect bugfixes diff --git a/lcl/lcltype.pp b/lcl/lcltype.pp index 2d0cb79532..15155bad6c 100644 --- a/lcl/lcltype.pp +++ b/lcl/lcltype.pp @@ -375,7 +375,7 @@ PM_Remove = 1; const - { 3D border styles } + { 3D border styles } BDR_RAISEDOUTER = 1; BDR_SUNKENOUTER = 2; BDR_RAISEDINNER = 4; @@ -768,37 +768,37 @@ BKMODE_LAST = 2; CLIP_TT_ALWAYS = (2 shl 4); CLIP_EMBEDDED = (8 shl 4); - DEFAULT_QUALITY = 0; - DRAFT_QUALITY = 1; - PROOF_QUALITY = 2; + DEFAULT_QUALITY = 0; + DRAFT_QUALITY = 1; + PROOF_QUALITY = 2; NONANTIALIASED_QUALITY = 3; ANTIALIASED_QUALITY = 4; - DEFAULT_PITCH = 0; - FIXED_PITCH = 1; + DEFAULT_PITCH = 0; + FIXED_PITCH = 1; VARIABLE_PITCH = 2; - MONO_FONT = 8; + MONO_FONT = 8; - ANSI_CHARSET = 0; - DEFAULT_CHARSET = 1; - SYMBOL_CHARSET = 2; - SHIFTJIS_CHARSET = $80; - HANGEUL_CHARSET = 129; - GB2312_CHARSET = 134; + ANSI_CHARSET = 0; + DEFAULT_CHARSET = 1; + SYMBOL_CHARSET = 2; + MAC_CHARSET = 77; + SHIFTJIS_CHARSET = 128; + HANGEUL_CHARSET = 129; + JOHAB_CHARSET = 130; + GB2312_CHARSET = 134; CHINESEBIG5_CHARSET = 136; - OEM_CHARSET = 255; - JOHAB_CHARSET = 130; - HEBREW_CHARSET = 177; - ARABIC_CHARSET = 178; - GREEK_CHARSET = 161; - TURKISH_CHARSET = 162; - VIETNAMESE_CHARSET = 163; - THAI_CHARSET = 222; - EASTEUROPE_CHARSET = 238; - RUSSIAN_CHARSET = 204; + GREEK_CHARSET = 161; + TURKISH_CHARSET = 162; + VIETNAMESE_CHARSET = 163; + HEBREW_CHARSET = 177; + ARABIC_CHARSET = 178; + BALTIC_CHARSET = 186; + RUSSIAN_CHARSET = 204; + THAI_CHARSET = 222; + EASTEUROPE_CHARSET = 238; + OEM_CHARSET = 255; - MAC_CHARSET = 77; - BALTIC_CHARSET = 186; //----------- // Font Sets @@ -833,21 +833,21 @@ BKMODE_LAST = 2; //-------------- // Font Weights //-------------- - FW_DONTCARE = 0; - FW_THIN = 100; + FW_DONTCARE = 0; + FW_THIN = 100; FW_EXTRALIGHT = 200; - FW_LIGHT = 300; - FW_NORMAL = 400; - FW_MEDIUM = 500; - FW_SEMIBOLD = 600; - FW_BOLD = 700; - FW_EXTRABOLD = 800; - FW_HEAVY = 900; + FW_LIGHT = 300; + FW_NORMAL = 400; + FW_MEDIUM = 500; + FW_SEMIBOLD = 600; + FW_BOLD = 700; + FW_EXTRABOLD = 800; + FW_HEAVY = 900; FW_ULTRALIGHT = FW_EXTRALIGHT; - FW_REGULAR = FW_NORMAL; - FW_DEMIBOLD = FW_SEMIBOLD; - FW_ULTRABOLD = FW_EXTRABOLD; - FW_BLACK = FW_HEAVY; + FW_REGULAR = FW_NORMAL; + FW_DEMIBOLD = FW_SEMIBOLD; + FW_ULTRABOLD = FW_EXTRABOLD; + FW_BLACK = FW_HEAVY; //============================================== // Brush constants @@ -1406,6 +1406,9 @@ end. { $Log$ + Revision 1.7 2002/06/04 15:17:22 lazarus + MG: improved TFont for XLFD font names + Revision 1.6 2002/05/28 19:39:45 lazarus MG: added gtk rc file support and started stule dependent syscolors