type
TPopupDlgUKAT3TagCloud =
class(TFMDropDown)
TntListBox1: TListBox;
HTMLViewer1: THTMLViewer;
procedure FormCreate(Sender: TObject);
procedure TntListBox1DblClick(Sender: TObject);
procedure HTMLViewer1HotSpotClick(Sender: TObject;
const SRC:
String;
var Handled: Boolean);
private
SelectedTag :
String;
function GenerateContent(_Cloud : TIntegerStringObjectList) :
String;
public
class function ShowDialog(_ParentForm : TForm;_Owner : TWinControl;
_Cloud : TIntegerStringObjectList;_Position : TRect) :
String;
end;
implementation
{$R *.dfm}
procedure TPopupDlgUKAT3TagCloud.FormCreate(Sender: TObject);
begin
TranslateComponent (self);
Scaled := false;
KeyPreview := true;
Align := alNone;
BorderWidth := 20;
TLclFontHelper.SetWindowsFont(self.Font);
DropDownPosition := ddpAbove;
Sizable := false;
AnimateDropDown := false;
SelectedTag := '
';
HTMLViewer1.DefBackground := clWhite;
end;
class function TPopupDlgUKAT3TagCloud.ShowDialog(_ParentForm : TForm;_Owner : TWinControl;
_Cloud : TIntegerStringObjectList;_Position : TRect) :
String;
var
f : TPopupDlgUKAT3TagCloud;
i : Integer;
begin
Result := '
';
f := TPopupDlgUKAT3TagCloud.Create(_Owner);
for i := 0
to _Cloud.Count-1
do
f.TntListBox1.Items.Add(_Cloud[i].Value);
try
f.HTMLViewer1.LoadFromString(f.GenerateContent(_Cloud));
except
on E:
Exception do TLOg.Log(true,P_FATAL,_('
Fehler beim Laden der Seite.'),e);
end;
try
f.RollDownForm(_ParentForm, _Position.Left, _Position.Top, 0,_Position.Right,_Position.Bottom);
// Use last width
Result := f.SelectedTag;
except
end;
f.Free;
end;
function TPopupDlgUKAT3TagCloud.GenerateContent(
_Cloud: TIntegerStringObjectList):
String;
var
i,min,max : Integer;
s : double;
begin
min := _Cloud.GetMinKey;
max := _Cloud.GetMaxKey-min;
Result := '
<html><body>';
for i := 0
to _Cloud.Count-1
do
begin
//hstr := hstr + '<a href="'+cloud[i].Value+'" style="font-size: '+inttostr(s)+'em; font-weight: '+inttostr(w)+'">'+cloud[i].Value+'</a>';
s := _Cloud[i].Key - min;
s := (s * 100) / max;
s := 20 + (30 /100*s );
Result := Result + '
<a href="'+_Cloud[i].Value+'
" style="text-decoration:none;font-weight:100;font-size: '+FloatToStr(s)+'
px; tahoma,sans-serif;font">'+_cloud[i].Value+'
</a> ';
end;
Result := Result + '
</body></html>';
end;
procedure TPopupDlgUKAT3TagCloud.TntListBox1DblClick(Sender: TObject);
begin
if TntListBox1.ItemIndex < 0
then exit;
SelectedTag := TntListBox1.Items[TntListBox1.ItemIndex];
CloseDropDown;
end;
procedure TPopupDlgUKAT3TagCloud.HTMLViewer1HotSpotClick(Sender: TObject;
const SRC:
String;
var Handled: Boolean);
begin
SelectedTag := src;
Handled := true;
CloseDropDown;
end;