File: ideutils.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (120 lines) | stat: -rw-r--r-- 2,961 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
{
 *****************************************************************************
  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************

 Abstract:
   Useful functions for IDE add ons.
}
unit IDEUtils;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  // LCL
  StdCtrls, ImgList, Graphics,
  // LazUtils
  LazUTF8, LazFileUtils;

type
  TCmpStrType = (
    cstCaseSensitive,
    cstCaseInsensitive,
    cstFilename
    );

function IndexInStringList(List: TStrings; Cmp: TCmpStrType; s: string): integer;
procedure SetComboBoxText(AComboBox: TComboBox; const AText: String;
                          Cmp: TCmpStrType; MaxCount: integer = 1000);
function LoadProjectIconIntoImages(const ProjFile: string;
  const Images: TCustomImageList; const Index: TStringList): Integer;


implementation

function IndexInStringList(List: TStrings; Cmp: TCmpStrType; s: string): integer;
var
  i: Integer;
begin
  for i:=0 to List.Count-1 do begin
    case Cmp of
    cstCaseSensitive:   if List[i]=s then exit(i);
    cstCaseInsensitive: if UTF8CompareText(List[i],s)=0 then exit(i);
    cstFilename:        if CompareFilenames(List[i],s)=0 then exit(i);
    end;
  end;
  Result:=-1;
end;

procedure SetComboBoxText(AComboBox:TComboBox; const AText: String;
  Cmp: TCmpStrType; MaxCount: integer);
var
  a: integer;
begin
  if AText<>'' then begin
    a := IndexInStringList(AComboBox.Items,Cmp,AText);
    if a >= 0 then
      AComboBox.ItemIndex := a
    else
    begin
      AComboBox.Items.Insert(0,AText);
      AComboBox.ItemIndex:=IndexInStringList(AComboBox.Items,Cmp,AText);
      if MaxCount<2 then MaxCount:=2;
      while AComboBox.Items.Count>MaxCount do
        AComboBox.Items.Delete(AComboBox.Items.Count-1);
    end;
  end;
  AComboBox.Text := AText;
end;

type
  TLoadProjectIconIntoImagesObject = class
    ImageIndex: Integer;
  end;

function LoadProjectIconIntoImages(const ProjFile: string;
  const Images: TCustomImageList; const Index: TStringList): Integer;
var
  xIconFile: String;
  xIcon: TIcon;
  I: Integer;
  xObj: TLoadProjectIconIntoImagesObject;
begin
  //ToDo: better index

  I := Index.IndexOf(ProjFile);
  if I >= 0 then
    Exit(TLoadProjectIconIntoImagesObject(Index.Objects[I]).ImageIndex);

  if not Index.Sorted or (Index.Count = 0) then
  begin // initialize index
    Index.Sorted := True;
    Index.Duplicates := dupIgnore;
    Index.CaseSensitive := False;
    Index.OwnsObjects := True;
  end;

  Result := -1;
  xIconFile := ChangeFileExt(ProjFile, '.ico');
  if FileExists(xIconFile) then
  begin
    xIcon := TIcon.Create;
    try
      xIcon.LoadFromFile(xIconFile);
      Result := Images.AddIcon(xIcon);
    finally
      xIcon.Free;
    end;
  end;

  xObj := TLoadProjectIconIntoImagesObject.Create;
  xObj.ImageIndex := Result;
  Index.AddObject(ProjFile, xObj);
end;

end.