Всех с наступающим новым годом !
Есть вопрос по созданию компоненты в Лазаре. Я попробовал перенести компоненту написанную на Delphi.
Скомпилировалось нормально, без ошибок, но при попытке установить в палитру вылетает сообщение:
Can't find unit ComponentTreeView used by ObjectInspector. Хотя вроде нигде не нашел ссылки на этот модуль.
Может подскажет кто в чем проблема ?
Код своей компоненты прилагаю
- Код: Выделить всё
unit ComboBox1;
{$mode objfpc}{$H+}
interface
uses
Windows, Messages, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
const
symbTrunc : char = '~';
symbColor : char = '`';
type
{ TComboBox1 }
TComboBox1 = class(TComboBox)
private
FColouring: boolean;
{ Private declarations }
FTruncate : boolean;
procedure SetTrunc(Value: boolean);
procedure FCustomDraw(Control: TWinControl; Index: integer; Rect: TRect; State: TOwnerDrawState);
protected
{ Protected declarations }
public
{ Public declarations }
function GetID(ItemNum: Integer): String;
function GetValue(ItemNum: Integer): String;
function GetColor(ItemNum: Integer): String;
procedure SetID(ItemNum: Integer; AID: String);
procedure SetValue(ItemNum: Integer; AValue: String);
procedure SetColor(ItemNum: Integer; AColor: String);
function SelectItem(ItemNum: Integer): boolean;
function SelectByID(ID: string): boolean;
published
{ Published declarations }
property Truncate: boolean read FTruncate write SetTrunc default false;
property Colouring: boolean read FColouring write FColouring default false;
end;
procedure Register;
implementation
function TComboBox1.SelectByID(ID: string): boolean;
var i: integer;
begin
Result:=false;
for i:=0 to Items.Count-1 do
if GetID(i) = ID then
begin
Result:=true;
ItemIndex:=i;
end;
end;
function TComboBox1.SelectItem(ItemNum: Integer): boolean;
begin
Result:=(SendMessage(Self.Handle,CB_SETCURSEL,ItemNum,0)>-1)
end;
procedure TComboBox1.SetTrunc(Value: boolean);
begin
if Value then begin
OnDrawItem:=@FCustomDraw;
Style:=csOwnerDrawFixed;
end else begin
OnDrawItem:=nil;
Style:=csDropDownList;
end;
FTruncate:=Value;
end;
procedure TComboBox1.FCustomDraw(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
s: string;
i: integer;
begin
if (FColouring) then begin
s:=GetColor(Index);
try
i:=StrToInt(s);
except
on E: EConvertError do
i:=clWindowText;
end;
if (Index<>ItemIndex) then
Canvas.Font.Color:=i
else Canvas.Font.Color:=clHighLightText;
end;
Canvas.TextRect(Rect, Rect.Left, Rect.Top, GetValue(Index));
end;
function TComboBox1.GetID(ItemNum: Integer): String;
var
p:integer;
begin
Result:='NULL';
if (ItemNum<0) or (ItemNum>=Items.Count) then Exit;
p:=Pos(symbTrunc,Items[ItemNum]);
if p>1 then
Result:=Copy(Items[ItemNum],1,p-1);
end;
function TComboBox1.GetValue(ItemNum: Integer): String;
var
p, l : integer;
s : string;
begin
if (ItemNum<0) or (ItemNum>=Items.Count) then begin
Result:='';
Exit;
end;
p:=Pos(symbTrunc,Items[ItemNum]);
s:=Items[ItemNum];
if p>0 then begin
l:=Length(s);
s:=Copy(s,p+1,l);
end;
p:=Pos(symbColor,s);
if p>0 then
s:=Copy(s,1,p-1);
Result:=s;
end;
function TComboBox1.GetColor(ItemNum: Integer): String;
var
p, l : integer;
s: string;
begin
Result:='';
if (ItemNum<0) or (ItemNum>=Items.Count) then Exit;
s:=Items[ItemNum];
p:=Pos(symbColor,s);
l:=Length(s);
if (p>0) and (p<>l) then
Result:=Copy(Items[ItemNum],p+1,l-p);
end;
procedure TComboBox1.SetID(ItemNum: Integer; AID: String);
var
p,l :integer;
s :string;
begin
if (ItemNum<0) or (ItemNum>=Items.Count) then exit;
s:=Items[ItemNum];
p:=Pos(symbTrunc,s);
l:=Length(s);
if p>0 then s:=Copy(s,p+1,l-p);
if AID='' then Items[ItemNum]:=s
else Items[ItemNum]:=AID+symbTrunc+s;
end;
procedure TComboBox1.SetValue(ItemNum: Integer; AValue: String);
var
p, l : integer;
s,s1,s2: string;
begin
if (ItemNum<0) or (ItemNum>=Items.Count) then exit;
s:=Items[ItemNum];
l:=Length(s);
p:=Pos(symbTrunc,s);
s1:='';
if p>1 then
s1:=Copy(s,1,p-1)+'~';
p:=Pos(symbColor,s); s2:='';
if (p>0) and (p<l) then
s2:='`'+Copy(s,p+1,l-p);
Items[ItemNum]:=s1+AValue+s2;
end;
procedure TComboBox1.SetColor(ItemNum: Integer; AColor: String);
var
p: integer;
s: string;
begin
if (ItemNum<0) or (ItemNum>=Items.Count) then exit;
s:=Items[ItemNum];
p:=Pos(symbColor,s);
if p>0 then s:=Copy(s,1,p-1);
if AColor<>'' then s:=s+symbColor+AColor;
Items[ItemNum]:=s;
end;
procedure Register;
begin
RegisterComponents('Onix',[TComboBox1]);
end;
end.
, хотя шаблон лушче доверить сгенерировать Lazarus-у
