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

added default values for compiler skip options and improved many parts of synedit for UTF8

Browse Source 
git-svn-id: trunk@5919 -
This commit is contained in:
mattias 2004-09-04 22:24:16 +00:00
parent 90b8b206c0
commit 9cbff0982c
27 changed files with 2196 additions and 723 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
components/synedit/syncompletion.pas
View File

@ -217,8 +217,11 @@ type
procedure backspace(Sender: TObject);
procedure Cancel(Sender: TObject);
procedure Validate(Sender: TObject; Shift: TShiftState);
procedure KeyPress(Sender: TObject; var Key: char);
{$IFDEF SYN_LAZARUS}
procedure UTF8KeyPress(Sender: TObject; var Key: TUTF8Char);
{$ELSE}
procedure KeyPress(Sender: TObject; var Key: char);
{$ENDIF}
procedure EditorKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure EditorKeyPress(Sender: TObject; var Key: char);
function GetPreviousToken(FEditor: TCustomSynEdit): string;
@ -964,28 +967,30 @@ var
Value, CurLine: string;
{$IFDEF SYN_LAZARUS}
NewCaretXY, NewBlockBegin: TPoint;
LogCaret: TPoint;
{$Else}
Pos: TPoint;
{$ENDIF}
begin
F := Sender as TSynBaseCompletionForm;
if F.CurrentEditor <> nil then
with F.CurrentEditor as TCustomSynEdit do begin
if F.CurrentEditor is TCustomSynEdit then
with TCustomSynEdit(F.CurrentEditor) do begin
BeginUndoBlock;
{$IFDEF SYN_LAZARUS}
NewBlockBegin:=CaretXY;
CurLine:=TSynEditStringList(Lines).ExpandedStrings[NewBlockBegin.Y - 1];
LogCaret:=PhysicalToLogicalPos(CaretXY);
NewBlockBegin:=LogCaret;
CurLine:=Lines[NewBlockBegin.Y - 1];
while (NewBlockBegin.X>1) and (NewBlockBegin.X-1<=length(CurLine))
and (CurLine[NewBlockBegin.X-1] in ['a'..'z','A'..'Z','0'..'9','_']) do
dec(NewBlockBegin.X);
BlockBegin:=NewBlockBegin;
if ssShift in Shift then begin
// replace only prefix
BlockEnd := Point(CaretX, CaretY);
BlockEnd := LogCaret;
end else begin
// replace the whole word
NewCaretXY:=CaretXY;
CurLine:=TSynEditStringList(Lines).ExpandedStrings[NewCaretXY.Y - 1];
NewCaretXY:=LogCaret;
CurLine:=Lines[NewCaretXY.Y - 1];
while (NewCaretXY.X<=length(CurLine))
and (CurLine[NewCaretXY.X] in ['a'..'z','A'..'Z','0'..'9','_']) do
inc(NewCaretXY.X);
@ -1016,19 +1021,11 @@ begin
end;
end;
procedure TSynCompletion.KeyPress(Sender: TObject; var Key: char);
var
F: TSynBaseCompletionForm;
begin
F := Sender as TSynBaseCompletionForm;
if F.CurrentEditor <> nil then begin
with F.CurrentEditor as TCustomSynEdit do begin
CommandProcessor(ecChar, Key, nil);
end;
end;
end;
{$IFDEF SYN_LAZARUS}
procedure TSynCompletion.UTF8KeyPress(Sender: TObject; var Key: TUTF8Char);
{$ELSE}
procedure TSynCompletion.KeyPress(Sender: TObject; var Key: char);
{$ENDIF}
var
F: TSynBaseCompletionForm;
begin
@ -1057,8 +1054,11 @@ end;
constructor TSynCompletion.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Form.OnKeyPress := {$IFDEF FPC}@{$ENDIF}KeyPress;
{$IFDEF SYN_LAZARUS}
Form.OnUTF8KeyPress := {$IFDEF FPC}@{$ENDIF}UTF8KeyPress;
{$ELSE}
Form.OnKeyPress := {$IFDEF FPC}@{$ENDIF}KeyPress;
{$ENDIF}
Form.OnKeyDelete := {$IFDEF FPC}@{$ENDIF}Backspace;
Form.OnValidate := {$IFDEF FPC}@{$ENDIF}Validate;
Form.OnCancel := {$IFDEF FPC}@{$ENDIF}Cancel;

2552
components/synedit/synedit.pp
View File

File diff suppressed because it is too large Load Diff

4
components/synedit/synedittextbuffer.pp
View File

@ -176,8 +176,8 @@ type
public
fChangeReason: TSynChangeReason;
fChangeSelMode: TSynSelectionMode;
fChangeStartPos: TPoint;
fChangeEndPos: TPoint;
fChangeStartPos: TPoint; // logical position (byte)
fChangeEndPos: TPoint; // logical position (byte)
fChangeStr: string;
fChangeNumber: integer; //sbs 2000-11-19
end;

15
components/synedit/syntextdrawer.pp
View File

@ -218,6 +218,9 @@ type
procedure ReleaseETODist; virtual;
procedure AfterStyleSet; virtual;
procedure DoSetCharExtra(Value: Integer); virtual;
{$IFDEF SYN_LAZARUS}
function GetUseUTF8: boolean;
{$ENDIF}
property StockDC: HDC read FDC;
property DrawingCount: Integer read FDrawingCount;
property FontStock: TheFontStock read FFontStock;
@ -248,6 +251,9 @@ type
property BackColor: TColor write SetBackColor;
property Style: TFontStyles write SetStyle;
property CharExtra: Integer read FCharExtra write SetCharExtra;
{$IFDEF SYN_LAZARUS}
property UseUTF8: boolean read GetUseUTF8;
{$ENDIF}
end;
{ TheTextDrawer2 }
@ -894,6 +900,15 @@ begin
inherited;
end;
{$IFDEF SYN_LAZARUS}
function TheTextDrawer.GetUseUTF8: boolean;
begin
FFontStock.BaseFont.Handle;
Result:=FFontStock.BaseFont.CanUTF8;
//debugln('TheTextDrawer.GetUseUTF8 ',FFontStock.BaseFont.Name,' ',dbgs(FFontStock.BaseFont.CanUTF8),' ',dbgs(FFontStock.BaseFont.HandleAllocated));
end;
{$ENDIF}
procedure TheTextDrawer.ReleaseETODist;
begin
if Assigned(FETODist) then

33
ide/compileroptions.pp
View File

@ -152,7 +152,6 @@ const
crAll = [crCompile, crBuild, crRun];
type
TCompilationToolClass = class of TCompilationTool;
TCompilationTool = class
public
Command: string;
@ -166,7 +165,8 @@ type
DoSwitchPathDelims: boolean); virtual;
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string); virtual;
end;
TCompilationToolClass = class of TCompilationTool;
TCompilationGenerateCode = (
cgcNormalCode,
cgcFasterCode,
@ -536,8 +536,10 @@ function ConvertOptionsToCmdLine(const Delim, Switch, OptionStr: string): string
function CompilationGenerateCodeNameToType(
const Name: string): TCompilationGenerateCode;
function LoadXMLCompileReasons(const AConfig: TXMLConfig; const APath: String): TCompileReasons;
procedure SaveXMLCompileReasons(const AConfig: TXMLConfig; const APath: String; const AFlags: TCompileReasons);
function LoadXMLCompileReasons(const AConfig: TXMLConfig;
const APath: String; const DefaultReasons: TCompileReasons): TCompileReasons;
procedure SaveXMLCompileReasons(const AConfig: TXMLConfig; const APath: String;
const AFlags, DefaultFlags: TCompileReasons);
implementation
@ -756,22 +758,24 @@ begin
Result:=cgcNormalCode;
end;
function LoadXMLCompileReasons(const AConfig: TXMLConfig; const APath: String): TCompileReasons;
function LoadXMLCompileReasons(const AConfig: TXMLConfig; const APath: String;
const DefaultReasons: TCompileReasons): TCompileReasons;
begin
Result := [];
if AConfig.GetValue(APath+'Compile',false)
if AConfig.GetValue(APath+'Compile',crCompile in DefaultReasons)
then Include(Result, crCompile);
if AConfig.GetValue(APath+'Build',false)
if AConfig.GetValue(APath+'Build',crBuild in DefaultReasons)
then Include(Result, crBuild);
if AConfig.GetValue(APath+'Run',false)
if AConfig.GetValue(APath+'Run',crRun in DefaultReasons)
then Include(Result, crRun);
end;
procedure SaveXMLCompileReasons(const AConfig: TXMLConfig; const APath: String; const AFlags: TCompileReasons);
procedure SaveXMLCompileReasons(const AConfig: TXMLConfig; const APath: String;
const AFlags, DefaultFlags: TCompileReasons);
begin
AConfig.SetDeleteValue(APath+'Compile', crCompile in AFlags, False);
AConfig.SetDeleteValue(APath+'Build', crBuild in AFlags, False);
AConfig.SetDeleteValue(APath+'Run', crRun in AFlags, False);
AConfig.SetDeleteValue(APath+'Compile', crCompile in AFlags, crCompile in DefaultFlags);
AConfig.SetDeleteValue(APath+'Build', crBuild in AFlags, crBuild in DefaultFlags);
AConfig.SetDeleteValue(APath+'Run', crRun in AFlags, crRun in DefaultFlags);
end;
@ -780,7 +784,8 @@ end;
{------------------------------------------------------------------------------
TBaseCompilerOptions Constructor
------------------------------------------------------------------------------}
constructor TBaseCompilerOptions.Create(const AOwner: TObject; const AToolClass: TCompilationToolClass);
constructor TBaseCompilerOptions.Create(const AOwner: TObject;
const AToolClass: TCompilationToolClass);
begin
inherited Create;
FOwner := AOwner;
@ -1014,8 +1019,6 @@ var
end;
end;
var
SkipCompiler: Boolean; // old compatebility
begin
{ Load the compiler options from the XML file }
p:=Path;

11
ide/compileroptionsdlg.pp
View File

@ -993,11 +993,12 @@ begin
Options.ExecuteBefore.ShowAllMessages:=ExecuteBeforeShowAllCheckBox.Checked;
if Options.ExecuteBefore is TProjectCompilationTool
then begin
TProjectCompilationTool(Options.ExecuteBefore).CompileReasons := MakeCompileReasons(
chkExecBeforeCompile,
chkExecBeforeBuild,
chkExecBeforeRun
);
TProjectCompilationTool(Options.ExecuteBefore).CompileReasons :=
MakeCompileReasons(
chkExecBeforeCompile,
chkExecBeforeBuild,
chkExecBeforeRun
);
end;
Options.CompilerPath := edtCompiler.Text;

2
ide/editoroptions.pp
View File

@ -1576,7 +1576,7 @@ begin
DefFGCol:=clWhite;
end;
end
else if lowercase(SynColorScheme)='ocean' then begin
else if lowercase(SynColorScheme)='ocean' then begin
// default for ocean color scheme
DefBGCol:=clNavy;
DefFGCol:=clYellow;

33
ide/project.pp
View File

@ -231,6 +231,7 @@ type
TProjectCompilationTool = class(TCompilationTool)
public
CompileReasons: TCompileReasons;
DefaultCompileReasons: TCompileReasons;
procedure Clear; override;
function IsEqual(Params: TCompilationTool): boolean; override;
procedure Assign(Src: TCompilationTool); override;
@ -2698,16 +2699,20 @@ begin
end;
end;
procedure TProjectCompilationTool.LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; DoSwitchPathDelims: boolean);
procedure TProjectCompilationTool.LoadFromXMLConfig(XMLConfig: TXMLConfig;
const Path: string; DoSwitchPathDelims: boolean);
begin
inherited LoadFromXMLConfig(XMLConfig, Path, DoSwitchPathDelims);
CompileReasons := LoadXMLCompileReasons(XMLConfig, Path+'CompileReasons/');
CompileReasons := LoadXMLCompileReasons(XMLConfig, Path+'CompileReasons/',
DefaultCompileReasons);
end;
procedure TProjectCompilationTool.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure TProjectCompilationTool.SaveToXMLConfig(XMLConfig: TXMLConfig;
const Path: string);
begin
inherited SaveToXMLConfig(XMLConfig, Path);
SaveXMLCompileReasons(XMLConfig, Path+'CompileReasons/', CompileReasons);
SaveXMLCompileReasons(XMLConfig, Path+'CompileReasons/', CompileReasons,
DefaultCompileReasons);
end;
{ TProjectCompilerOptions }
@ -2717,16 +2722,19 @@ begin
inherited LoadTheCompilerOptions(APath);
// old compatebility
if XMLConfigFile.GetValue(APAth+'SkipCompiler/Value',false)
if XMLConfigFile.GetValue(APath+'SkipCompiler/Value',false)
then FCompileReasons := []
else FCompileReasons := LoadXMLCompileReasons(XMLConfigFile,APath+'CompileReasons/');
else FCompileReasons :=
LoadXMLCompileReasons(XMLConfigFile,APath+'CompileReasons/',
crAll);
end;
procedure TProjectCompilerOptions.SaveTheCompilerOptions(const APath: string);
begin
inherited SaveTheCompilerOptions(APath);
SaveXMLCompileReasons(XMLConfigFile, APath+'CompileReasons/', FCompileReasons);
SaveXMLCompileReasons(XMLConfigFile, APath+'CompileReasons/', FCompileReasons,
crAll);
end;
procedure TProjectCompilerOptions.SetTargetCPU(const AValue: string);
@ -2769,6 +2777,14 @@ begin
FGlobals := TGlobalCompilerOptions.Create;
FCompileReasons := [crCompile, crBuild, crRun];
inherited Create(AOwner, TProjectCompilationTool);
with TProjectCompilationTool(ExecuteBefore) do begin
DefaultCompileReasons:=crAll;
CompileReasons:=DefaultCompileReasons;
end;
with TProjectCompilationTool(ExecuteAfter) do begin
DefaultCompileReasons:=crAll;
CompileReasons:=DefaultCompileReasons;
end;
UpdateGlobals;
if AOwner <> nil
then FOwnerProject := AOwner as TProject;
@ -2904,6 +2920,9 @@ end.
{
$Log$
Revision 1.162 2004/09/04 22:24:15 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.161 2004/09/04 21:54:08 marc
+ Added option to skip compiler step on compile, build or run
* Fixed adding of runtime watches

20
ide/uniteditor.pp
View File

@ -968,6 +968,7 @@ var
P: TPoint;
Texts, Texts2: String;
Handled: boolean;
LogCaret: TPoint;
Begin
Handled:=true;
@ -981,18 +982,19 @@ Begin
ecIdentCompletion :
if not TCustomSynEdit(Sender).ReadOnly then begin
CurrentCompletionType:=ctIdentCompletion;
TextS := FEditor.LineTextExtended;
i := FEditor.CaretX - 1;
TextS := FEditor.LineText;
LogCaret:=FEditor.PhysicalToLogicalPos(FEditor.CaretXY);
i := LogCaret.X - 1;
if i > length(TextS) then
TextS2 := ''
else begin
while (i > 0) and (TextS[i] in ['a'..'z','A'..'Z','0'..'9','_']) do
dec(i);
TextS2 := Trim(copy(TextS, i + 1, FEditor.CaretX - i - 1));
TextS2 := Trim(copy(TextS, i + 1, LogCaret.X - i - 1));
end;
with TCustomSynEdit(Sender) do
P := ClientToScreen(Point(CaretXPix - length(TextS2)*CharWidth
, CaretYPix + LineHeight));
,CaretYPix + LineHeight));
aCompletion.Editor:=TCustomSynEdit(Sender);
aCompletion.Execute(TextS2,P.X,P.Y);
end;
@ -1000,8 +1002,9 @@ Begin
ecWordCompletion :
if not TCustomSynEdit(Sender).ReadOnly then begin
CurrentCompletionType:=ctWordCompletion;
TextS := FEditor.LineTextExtended;
i := FEditor.CaretX - 1;
TextS := FEditor.LineText;
LogCaret:=FEditor.PhysicalToLogicalPos(FEditor.CaretXY);
i := LogCaret.X - 1;
if i > length(TextS) then
TextS2 := ''
else begin
@ -1011,7 +1014,7 @@ Begin
end;
with TCustomSynEdit(Sender) do
P := ClientToScreen(Point(CaretXPix - length(TextS2)*CharWidth
, CaretYPix + LineHeight));
,CaretYPix + LineHeight));
aCompletion.Editor:=TCustomSynEdit(Sender);
aCompletion.Execute(TextS2,P.X,P.Y);
end;
@ -2593,7 +2596,8 @@ Begin
SrcEdit.EditorComponent.SelText:=NewValue;
if CursorToLeft>0 then
begin
CaretXY:=SrcEdit.EditorComponent.BlockEnd;
CaretXY:=SrcEdit.EditorComponent.LogicalToPhysicalPos(
SrcEdit.EditorComponent.BlockEnd);
dec(CaretXY.X,CursorToLeft);
SrcEdit.EditorComponent.CaretXY:=CaretXY;
end;

5
lcl/comctrls.pp
View File

@ -2033,7 +2033,7 @@ type
procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL;
procedure WMLButtonDown(var AMessage: TLMLButtonDown); message LM_LBUTTONDOWN;
procedure WMNotify(var AMessage: TLMNotify); message LM_NOTIFY;
procedure WMSize(var Msg: TLMSize); message LM_SIZE;
procedure Resize; override;
protected
property AutoExpand: Boolean read GetAutoExpand write SetAutoExpand default False;
property BorderStyle default bsSingle;
@ -2306,6 +2306,9 @@ end.
{ =============================================================================
$Log$
Revision 1.144 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.143 2004/08/18 09:31:21 mattias
removed obsolete unit vclglobals

6
lcl/extctrls.pp
View File

@ -608,7 +608,7 @@ type
procedure SetColumns(Value: integer);
procedure SetItemIndex(Value: integer);
function GetItemIndex: integer;
procedure WMSize(var Message: TLMSize); message LM_SIZE;
procedure Resize; override;
protected
property ItemIndex: integer read GetItemIndex write SetItemIndex default -1;
property Items: TStrings read FItems write SetItem;
@ -687,7 +687,6 @@ type
protected
procedure SetItems(Value: TStrings);
procedure SetColumns(Value: integer);
procedure WMSize(var Message: TLMSize); message LM_SIZE;
procedure DefineProperties(Filer: TFiler); override;
procedure ReadData(Stream: TStream);
procedure WriteData(Stream: TStream);
@ -967,6 +966,9 @@ end.
{
$Log$
Revision 1.116 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.115 2004/08/18 09:31:21 mattias
removed obsolete unit vclglobals

2
lcl/forms.pp
View File

@ -153,7 +153,7 @@ type
procedure CreateWnd; override;
Procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
procedure WMPaint(var message: TLMPaint); message LM_PAINT;
procedure WMSize(var Message: TLMSize); message LM_Size;
procedure DoOnResize; override;
Procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
Procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
procedure ScrollBy(DeltaX, DeltaY: Integer);

5
lcl/graphics.pp
View File

@ -415,6 +415,7 @@ type
TFont = class(TGraphicsObject)
private
FCanUTF8: boolean;
FColor: TColor;
FFontData: TFontData;
FPixelsPerInch: Integer;
@ -462,6 +463,7 @@ type
//-----------------
property Handle: HFONT read GetHandle write SetHandle;
property PixelsPerInch: Integer read FPixelsPerInch;
property CanUTF8: boolean read FCanUTF8;
published
property CharSet: TFontCharSet read GetCharSet write SetCharSet default DEFAULT_CHARSET;
property Color: TColor read FColor write SetColor default clWindowText;
@ -1744,6 +1746,9 @@ end.
{ =============================================================================
$Log$
Revision 1.145 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.144 2004/08/18 13:12:05 mattias
synedit UTF8 support started by Mazen

5
lcl/include/control.inc
View File

@ -2259,7 +2259,7 @@ end;
-------------------------------------------------------------------------------}
procedure TControl.Resize;
begin
if (csLoading in ComponentState) then exit;
if ([csLoading,csDestroying]*ComponentState<>[]) then exit;
if (FLastResizeWidth<>Width) or (FLastResizeHeight<>Height)
or (FLastResizeClientWidth<>ClientWidth)
or (FLastResizeClientHeight<>ClientHeight) then begin
@ -3275,6 +3275,9 @@ end;
{ =============================================================================
$Log$
Revision 1.213 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.212 2004/08/26 19:09:34 mattias
moved navigation key handling to TApplication and added options for custom navigation

9
lcl/include/customcheckgroup.inc
View File

@ -202,12 +202,6 @@ begin
end;
end;
procedure TCustomCheckGroup.WMSize(var Message: TLMSize);
begin
DoPositionButtons;
inherited WMSize(Message);
end;
procedure TCustomCheckGroup.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
@ -278,6 +272,9 @@ end;
{
$Log$
Revision 1.10 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.9 2004/08/15 17:00:58 mattias
improved DefineProperties to read/write endian independent

11
lcl/include/customradiogroup.inc
View File

@ -271,16 +271,14 @@ begin
end;
{------------------------------------------------------------------------------
Method: TCustomRadioGroup.WMSize
Params: Message: TLMSize
Returns: none
Method: TCustomRadioGroup.Resize
Reposition buttons on resize
------------------------------------------------------------------------------}
procedure TCustomRadioGroup.WMSize(var Message: TLMSize);
procedure TCustomRadioGroup.Resize;
begin
if HandleAllocated then DoPositionButtons;
inherited WMSize(Message);
inherited Resize;
end;
{------------------------------------------------------------------------------
@ -398,6 +396,9 @@ end;
{
$Log$
Revision 1.33 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.32 2004/07/16 21:49:00 mattias
added RTTI controls

4
lcl/include/font.inc
View File

@ -848,6 +848,7 @@ begin
FontResourceCache.Add(FFontData.Handle,ALogFont,Name);
end;
FFontHandleCached:=true;
FCanUTF8:=FontCanUTF8(FFontData.Handle);
end;
Result := FFontData.Handle;
@ -949,6 +950,9 @@ end;
{ =============================================================================
$Log$
Revision 1.16 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.15 2004/08/11 22:05:07 mattias
fixed brush handle cache size

8
lcl/include/intfbaselcl.inc
View File

@ -120,6 +120,11 @@ begin
Result:=ExtTextOut(DC,X,Y,Options,Rect,Str,Count,Dx);
end;
function TWidgetSet.FontCanUTF8(Font: HFont): boolean;
begin
Result:=false;
end;
function TWidgetSet.Frame(DC: HDC; const ARect: TRect) : integer;
begin
Result:= 0;
@ -641,6 +646,9 @@ end;
{ =============================================================================
$Log$
Revision 1.30 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.29 2004/09/02 09:16:59 mattias
improved double byte char fonts for gtk1, started synedit UTF8 support

8
lcl/include/lclintf.inc
View File

@ -118,6 +118,11 @@ begin
Result := InterfaceObject.ExtUTF8Out(DC,X,Y,Options,Rect,Str,Count,Dx);
end;
function FontCanUTF8(Font: HFont): boolean;
begin
Result := InterfaceObject.FontCanUTF8(Font);
end;
function Frame(DC: HDC; const ARect: TRect): Integer;
begin
Result := InterfaceObject.Frame(DC, ARect);
@ -542,6 +547,9 @@ end;
{ =============================================================================
$Log$
Revision 1.27 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.26 2004/09/02 09:16:59 mattias
improved double byte char fonts for gtk1, started synedit UTF8 support

4
lcl/include/lclintfh.inc
View File

@ -60,6 +60,7 @@ procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); {$IFDEF IF_BASE_MEM
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function FontCanUTF8(Font: HFont): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function Frame(DC: HDC; const ARect: TRect): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function Frame3d(DC: HDC; var ARect: TRect; const FrameWidth : integer; const Style : TGraphicsBevelCut): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -153,6 +154,9 @@ procedure RaiseLastOSError;
{ =============================================================================
$Log$
Revision 1.26 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.25 2004/09/02 09:16:59 mattias
improved double byte char fonts for gtk1, started synedit UTF8 support

4
lcl/include/scrollingwincontrol.inc
View File

@ -92,9 +92,9 @@ begin
end;
end;
procedure TScrollingWinControl.WMSize(var Message: TLMSize);
procedure TScrollingWinControl.DoOnResize;
begin
inherited WMSize(Message);
inherited DoOnResize;
if AutoScroll or HorzScrollBar.Visible or VertScrollBar.Visible
then
UpdateScrollBars;

4
lcl/include/treeview.inc
View File

@ -4632,11 +4632,11 @@ begin
inherited WMNotify(AMessage);
end;
procedure TCustomTreeView.WMSize(var Msg: TLMSize);
procedure TCustomTreeView.Resize;
begin
FStates:=FStates+[tvsScrollbarChanged,
tvsBottomItemNeedsUpdate];
inherited WMSize(Msg);
inherited Resize;
end;
procedure TCustomTreeView.InternalSelectionChanged;

22
lcl/include/wincontrol.inc
View File

@ -496,7 +496,6 @@ begin
if AlignWork then
begin
AdjustClientRect(ARect);
FAdjustClientRectRealized:=ARect;
//DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' ClientRect=',ARect.Left,',',ARect.Top,',',ARect.Right,',',ARect.Bottom);
AlignList := TList.Create;
try
@ -662,21 +661,17 @@ End;
procedure TWinControl.DoAdjustClientRectChange;
var r: TRect;
begin
if (csLoading in ComponentState) then exit;
r:=GetClientRect;
AdjustClientRect(r);
//DebugLn(' TWinControl.DoAdjustClientRectChange ',Name,':',ClassName,' ',r.Right,',',r.Bottom);
if (r.Left<>FAdjustClientRectRealized.Left)
or (r.Top<>FAdjustClientRectRealized.Top)
or (r.Right<>FAdjustClientRectRealized.Right)
or (r.Bottom<>FAdjustClientRectRealized.Bottom)
then begin
//DebugLn(' TWinControl.DoAdjustClientRectChange ',Name,':',ClassName,' ',dbgs(r.Right),',',dbgs(r.Bottom));
if not CompareRect(@r,@FAdjustClientRectRealized) then begin
// client rect changed since last AlignControl
{$IFDEF VerboseClientRectBugFix}
DebugLn('UUU TWinControl.DoAdjustClientRectChange ClientRect changed ',Name,':',ClassName,
' Old=',FAdjustClientRectRealized.Right,'x',FAdjustClientRectRealized.Bottom,
' New=',r.RIght,'x',r.Bottom);
{$ENDIF}
FAdjustClientRectRealized:=r;
ReAlign;
Resize;
end;
@ -2376,8 +2371,8 @@ end;
{------------------------------------------------------------------------------}
Procedure TWinControl.Invalidate;
Begin
if HandleAllocated and (not (csDestroying in ComponentState))
then CNSendMessage(LM_Invalidate,Self,Nil);
if HandleAllocated and ([csDestroying,csLoading]*ComponentState=[]) then
CNSendMessage(LM_Invalidate,Self,Nil);
end;
{------------------------------------------------------------------------------}
@ -2480,7 +2475,8 @@ end;
------------------------------------------------------------------------------}
procedure TWinControl.ReAlign;
begin
if (csLoading in ComponentState) or (not HandleAllocated) then begin
if ([csLoading,csDestroying]*ComponentState<>[]) or (not HandleAllocated) then
begin
Include(FFlags,wcfReAlignNeeded);
exit;
end;
@ -2507,7 +2503,6 @@ begin
end;
End;
{------------------------------------------------------------------------------}
{ TWinControl RemoveFocus }
{------------------------------------------------------------------------------}
@ -3917,6 +3912,9 @@ end;
{ =============================================================================
$Log$
Revision 1.272 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.271 2004/09/02 17:59:59 mattias
removed double KeyPress method in synedit

14
lcl/interfaces/gtk/gtklclintf.inc
View File

@ -103,6 +103,17 @@ begin
end;
end;
{------------------------------------------------------------------------------
function TGTKWidgetSet.FontCanUTF8(Font: HFont): boolean;
True if font recognizes Unicode.
------------------------------------------------------------------------------}
function TGTKWidgetSet.FontCanUTF8(Font: HFont): boolean;
begin
Result:=IsValidGDIObject(Font)
and FontIsDoubleByteCharsFont(PGdiObject(Font)^.GDIFontObject);
end;
{------------------------------------------------------------------------------
Function: GetAcceleratorString
Params: AVKey:
@ -501,6 +512,9 @@ end;
{ =============================================================================
$Log$
Revision 1.31 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.30 2004/09/02 09:17:00 mattias
improved double byte char fonts for gtk1, started synedit UTF8 support

5
lcl/interfaces/gtk/gtklclintfh.inc
View File

@ -35,6 +35,8 @@ function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
function FontCanUTF8(Font: HFont): boolean; override;
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; override;
function GetControlConstraints(Constraints: TObject): boolean; override;
function GetLCLOwnerObject(Handle: HWnd): TObject; override;
@ -57,6 +59,9 @@ procedure StatusBarUpdate(StatusBar: TObject); override;
{ =============================================================================
$Log$
Revision 1.19 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.18 2004/09/02 09:17:00 mattias
improved double byte char fonts for gtk1, started synedit UTF8 support

5
lcl/interfaces/gtk/gtkproc.inc
View File

@ -7044,7 +7044,7 @@ var
SingleCharLen, DoubleCharLen: integer;
begin
SingleCharLen:=gdk_text_width(TheFont, 'A', 1);
DoubleCharLen:=gdk_text_width(TheFont, 'AA', 2);
DoubleCharLen:=gdk_text_width(TheFont, #0'A', 2);
Result:=(SingleCharLen=0) and (DoubleCharLen>0);
end;
{$EndIf}
@ -7238,6 +7238,9 @@ end;
{ =============================================================================
$Log$
Revision 1.303 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8
Revision 1.302 2004/09/02 17:59:59 mattias
removed double KeyPress method in synedit

86
lcl/lclproc.pas
View File

@ -152,12 +152,19 @@ function DbgStr(const StringWithSpecialChars: string): string;
function DbgS(const i1,i2,i3,i4: integer): string;
// UTF utility functions
// MG: Should be moved to the RTL
function UTF8CharacterLength(p: PChar): integer;
function UTF8Length(const s: string): integer;
function UTF8Length(p: PChar; Count: integer): integer;
function UTF8CharacterToUnicode(p: PChar; var CharLen: integer): Cardinal;
function UnicodeToUTF8(u: cardinal): string;
function UTF8ToDoubleByteString(const s: string): string;
function UTF8ToDoubleByte(UTF8Str: PChar; Len: integer; DBStr: PByte): integer;
function UTF8FindNearestCharStart(UTF8Str: PChar; Len: integer;
BytePos: integer): integer;
// find the n-th UTF8 character, ignoring BIDI
function UTF8CharStart(UTF8Str: PChar; Len, Index: integer): PChar;
implementation
@ -924,7 +931,7 @@ begin
i:=1;
while (i<=length(Result)) do begin
case Result[i] of
' '..'z': inc(i);
' '..#126: inc(i);
else
s:='#'+IntToStr(ord(Result[i]));
Result:=copy(Result,1,i-1)+s+copy(Result,i+1,length(Result)-i);
@ -997,7 +1004,7 @@ function UTF8CharacterToUnicode(p: PChar; var CharLen: integer): Cardinal;
begin
if p<>nil then begin
if ord(p^)<%11000000 then begin
// regular single byte character (#0 is single byte, this is pascal ;)
// regular single byte character (#0 is a normal char, this is pascal ;)
Result:=ord(p^);
CharLen:=1;
end
@ -1050,6 +1057,46 @@ begin
end;
end;
function UnicodeToUTF8(u: cardinal): string;
procedure RaiseInvalidUnicode;
begin
raise Exception.Create('UnicodeToUTF8: invalid unicode: '+IntToStr(u));
end;
begin
case u of
0..$7f:
begin
SetLength(Result,1);
Result[1]:=char(byte(u));
end;
$80..$7ff:
begin
SetLength(Result,2);
Result[1]:=char(byte($c0 or (u shr 6)));
Result[2]:=char(byte($80 or (u and $3f)));
end;
$800..$ffff:
begin
SetLength(Result,3);
Result[1]:=char(byte($e0 or (u shr 12)));
Result[2]:=char(byte((u shr 6) and $3f) or $80);
Result[3]:=char(byte(u and $3f) or $80);
end;
$10000..$1fffff:
begin
SetLength(Result,4);
Result[1]:=char(byte($f0 or (u shr 18)));
Result[2]:=char(byte((u shr 12) and $3f) or $80);
Result[3]:=char(byte((u shr 6) and $3f) or $80);
Result[4]:=char(byte(u and $3f) or $80);
end;
else
RaiseInvalidUnicode;
end;
end;
function UTF8ToDoubleByteString(const s: string): string;
var
Len: Integer;
@ -1083,6 +1130,41 @@ begin
end;
end;
function UTF8FindNearestCharStart(UTF8Str: PChar; Len: integer;
BytePos: integer): integer;
var
CharLen: LongInt;
begin
Result:=0;
if UTF8Str<>nil then begin
if BytePos>Len then BytePos:=Len;
while (BytePos>0) do begin
CharLen:=UTF8CharacterLength(UTF8Str);
dec(BytePos,CharLen);
if (BytePos<0) then exit;
inc(Result,CharLen);
if (BytePos=0) then exit;
end;
end;
end;
function UTF8CharStart(UTF8Str: PChar; Len, Index: integer): PChar;
var
CharLen: LongInt;
begin
Result:=UTF8Str;
if Result<>nil then begin
while (Index>0) and (Len>0) do begin
CharLen:=UTF8CharacterLength(Result);
dec(Len,CharLen);
dec(Index);
inc(Result,CharLen);
end;
if (Index>0) or (Len<0) then
Result:=nil;
end;
end;
initialization
SendApplicationMessageFunction:=nil;
OwnerFormDesignerModifiedProc:=nil;