paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 14:29:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: added TPicture.FindGraphicClassWithFileExt

Browse Source 
git-svn-id: trunk@13526 -
This commit is contained in:
mattias 2007-12-29 19:17:18 +00:00
parent 72c50fe0be
commit 02774924f6
4 changed files with 26 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/synedit/synedit.pp
View File

@ -8773,19 +8773,21 @@ var
{$ENDIF} {$ENDIF}
begin begin
{$IFDEF SYN_LAZARUS} {$IFDEF SYN_LAZARUS}
LogCaret:=PhysicalToLogicalPos(CaretXY); LogCaret:=LogicalCaretXY;
CX := LogCaret.X; CX := LogCaret.X;
CY := LogCaret.Y; CY := LogCaret.Y;
{$ELSE} {$ELSE}
CX := CaretX; CX := CaretX;
CY := CaretY; CY := CaretY;
{$ENDIF} {$ENDIF}
//DebugLn(['TCustomSynEdit.PrevWordPos ',dbgs(LogCaret)]);
// valid line? // valid line?
if (CY >= 1) and (CY <= Lines.Count) then begin if (CY >= 1) and (CY <= Lines.Count) then begin
Line := Lines[CY - 1]; Line := Lines[CY - 1];
CX := Min(CX, Length(Line) + 1); CX := Min(CX, Length(Line) + 1);
CurIdentChars:=IdentChars; CurIdentChars:=IdentChars;
WhiteChars := [#1..#255] - CurIdentChars; WhiteChars := [#1..#255] - CurIdentChars;
//DebugLn(['TCustomSynEdit.PrevWordPos Line="',dbgstr(Line),'" CX=',CX]);
if CX <= 1 then begin if CX <= 1 then begin
// find last IdentChar in the previous line // find last IdentChar in the previous line
if CY > 1 then begin if CY > 1 then begin
@ -8797,6 +8799,7 @@ begin
// if previous char is a "whitespace" search for the last IdentChar // if previous char is a "whitespace" search for the last IdentChar
if Line[CX - 1] in WhiteChars then if Line[CX - 1] in WhiteChars then
CX := StrRScanForCharInSet(Line, CX - 1, CurIdentChars); CX := StrRScanForCharInSet(Line, CX - 1, CurIdentChars);
//DebugLn(['TCustomSynEdit.PrevWordPos AAA1 CX=',CX]);
if CX > 0 then if CX > 0 then
// search for the first IdentChar of this "word" // search for the first IdentChar of this "word"
CX := StrRScanForCharInSet(Line, CX - 1, WhiteChars) + 1 CX := StrRScanForCharInSet(Line, CX - 1, WhiteChars) + 1
@ -8807,13 +8810,16 @@ begin
Line := Lines[CY - 1]; Line := Lines[CY - 1];
CX := Length(Line) + 1; CX := Length(Line) + 1;
end; end;
//DebugLn(['TCustomSynEdit.PrevWordPos AAA2 CX=',CX]);
end; end;
end; end;
//DebugLn(['TCustomSynEdit.PrevWordPos AAA3 ',CX,',',CY]);
{$IFDEF SYN_LAZARUS} {$IFDEF SYN_LAZARUS}
Result := LogicalToPhysicalPos(Point(CX, CY)); Result := LogicalToPhysicalPos(Point(CX, CY));
{$ELSE} {$ELSE}
Result := Point(CX, CY); Result := Point(CX, CY);
{$ENDIF} {$ENDIF}
//DebugLn(['TCustomSynEdit.PrevWordPos END ',dbgs(Result)]);
end; end;
procedure TCustomSynEdit.SetSelectionMode(const Value: TSynSelectionMode); procedure TCustomSynEdit.SetSelectionMode(const Value: TSynSelectionMode);

3
lcl/graphics.pp
View File

@ -817,6 +817,7 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure LoadFromFile(const Filename: string); procedure LoadFromFile(const Filename: string);
procedure SaveToFile(const Filename: string); procedure SaveToFile(const Filename: string);
procedure LoadFromStream(const Filename: string);
procedure LoadFromClipboardFormat(FormatID: TClipboardFormat); procedure LoadFromClipboardFormat(FormatID: TClipboardFormat);
procedure LoadFromClipboardFormatID(ClipboardType: TClipboardType; procedure LoadFromClipboardFormatID(ClipboardType: TClipboardType;
FormatID: TClipboardFormat); FormatID: TClipboardFormat);
@ -829,6 +830,8 @@ type
AGraphicClass: TGraphicClass); AGraphicClass: TGraphicClass);
class procedure UnregisterGraphicClass(AClass: TGraphicClass); class procedure UnregisterGraphicClass(AClass: TGraphicClass);
procedure Clear; virtual; procedure Clear; virtual;
function FindGraphicClassWithFileExt(const Ext: string;
ExceptionOnNotFound: boolean = true): TGraphicClass;
public public
property Bitmap: TBitmap read GetBitmap write SetBitmap; property Bitmap: TBitmap read GetBitmap write SetBitmap;
property Icon: TIcon read GetIcon write SetIcon; property Icon: TIcon read GetIcon write SetIcon;

17
lcl/include/picture.inc
View File

@ -488,9 +488,7 @@ var
begin begin
Ext := ExtractFileExt(Filename); Ext := ExtractFileExt(Filename);
System.Delete(Ext, 1, 1); // delete '.' System.Delete(Ext, 1, 1); // delete '.'
GraphicClass := GetPicFileFormats.FindExt(Ext); GraphicClass := FindGraphicClassWithFileExt(Ext);
if GraphicClass = nil then
raise EInvalidGraphic.CreateFmt(rsUnknownPictureExtension, [Ext]);
NewGraphic := GraphicClass.Create; NewGraphic := GraphicClass.Create;
ok:=false; ok:=false;
@ -594,6 +592,19 @@ begin
SetGraphic(nil); SetGraphic(nil);
end; end;
function TPicture.FindGraphicClassWithFileExt(const Ext: string;
ExceptionOnNotFound: boolean): TGraphicClass;
var
FileExt: String;
begin
FileExt:=Ext;
if (FileExt<>'') and (FileExt[1]='.') then
FileExt:=copy(FileExt,2,length(FileExt));
Result := GetPicFileFormats.FindExt(FileExt);
if (Result = nil) and ExceptionOnNotFound then
raise EInvalidGraphic.CreateFmt(rsUnknownPictureExtension, [Ext]);
end;
procedure TPicture.Changed(Sender: TObject); procedure TPicture.Changed(Sender: TObject);
begin begin
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);

4
lcl/lazhelpintf.pas
View File

@ -548,7 +548,7 @@ procedure FreeUnusedLCLHelpSystem;
function FilenameToURL(const Filename: string): string; function FilenameToURL(const Filename: string): string;
function FilenameToURLPath(const Filename: string): string; function FilenameToURLPath(const Filename: string): string;
function URLPathToFilename(const URLPath: string): string; function URLPathToFilename(const URLPath: string): string;
procedure SplitURL(const URL: string; var URLType, URLPath, URLParams: string); procedure SplitURL(const URL: string; out URLType, URLPath, URLParams: string);
function CombineURL(const URLType, URLPath, URLParams: string): string; function CombineURL(const URLType, URLPath, URLParams: string): string;
function URLFilenameIsAbsolute(const URLPath: string): boolean; function URLFilenameIsAbsolute(const URLPath: string): boolean;
function FindURLPathStart(const URL: string): integer; function FindURLPathStart(const URL: string): integer;
@ -626,7 +626,7 @@ begin
{$warnings on} {$warnings on}
end; end;
procedure SplitURL(const URL: string; var URLType, URLPath, URLParams: string); procedure SplitURL(const URL: string; out URLType, URLPath, URLParams: string);
var var
Len: Integer; Len: Integer;
ColonPos: Integer; ColonPos: Integer;