unit ChatSystem_Class;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs, IdContext,
Vcl.ComCtrls,
Vcl.StdCtrls,
IdCustomTCPServer, IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient,
Vcl.Menus,
Vcl.ExtCtrls, mmSystem, ClipBrd, User, Contnrs,
Data.DB, Datasnap.DBClient, Datasnap.Win.MConnect, Datasnap.Win.SConnect,
Vcl.OleCtrls, SHDocVw, JvExStdCtrls, JvRichEdit, ShellApi;
type
TChatSystem =
class
private
current_Height: Integer;
Panel: TPanel;
ScrollBar: TScrollBar;
Objekte: TObjectList;
PopupMenu: TPopupMenu;
public
Constructor Create(Panel_Need: TPanel; Scrollbar_Need: TScrollBar;
PopupMenu_Need: TPopupMenu);
Destructor Free;
procedure onMouseOver(Sender: TObject);
procedure onMouseOut(Sender: TObject);
procedure onMouseClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure renderLabels;
procedure addButton(id: Integer; Text:
String);
procedure addProgessbar(id: Integer);
procedure addImage(Text:
String);
procedure addText(Text:
String);
procedure addUserText(Text:
String);
procedure newMessage;
end;
implementation
Constructor TChatSystem.Create(Panel_Need: TPanel; Scrollbar_Need: TScrollBar;
PopupMenu_Need: TPopupMenu);
begin
Panel := Panel_Need;
ScrollBar := Scrollbar_Need;
PopupMenu := PopupMenu_Need;
Objekte := TObjectList.Create;
end;
Destructor TChatSystem.Free;
begin
Objekte.Clear;
Panel.Free;
ScrollBar.Free;
PopupMenu.Free;
end;
procedure TChatSystem.newMessage;
begin
renderLabels;
ScrollBar.Position := current_Height - ScrollBar.PageSize;
renderLabels;
end;
procedure TChatSystem.renderLabels;
var
zahl: Integer;
begin
current_Height := 0;
for zahl := 0
to Objekte.count - 1
do
begin
// Label
if Objekte[zahl]
is TLabel
then
begin
(Objekte[zahl]
as TLabel).Top := current_Height - ScrollBar.Position;
current_Height := current_Height + (Objekte[zahl]
as TLabel).Height;
end;
// Bild
if Objekte[zahl]
is TImage
then
begin
// Ausrechnen der Größe
(Objekte[zahl]
as TImage).Height := Panel.Height
div 3;
(Objekte[zahl]
as TImage).Width := (Objekte[zahl]
as TImage)
.Picture.Width
div ((Objekte[zahl]
as TImage)
.Picture.Height
div (Objekte[zahl]
as TImage).Height);
// Ausrechen der Position
(Objekte[zahl]
as TImage).Top := current_Height - ScrollBar.Position;
current_Height := current_Height + (Objekte[zahl]
as TImage).Height;
end;
// Progressbar
if Objekte[zahl]
is TProgressBar
then
begin
(Objekte[zahl]
as TProgressBar).Top := current_Height -
ScrollBar.Position;
current_Height := current_Height + (Objekte[zahl]
as TProgressBar).Height;
end;
// Button
if Objekte[zahl]
is TButton
then
begin
(Objekte[zahl]
as TButton).Top := current_Height - ScrollBar.Position;
current_Height := current_Height + (Objekte[zahl]
as TButton).Height;
end;
end;
current_Height := current_Height + 10;
if Panel.Height < current_Height
then
begin
ScrollBar.Max := current_Height;
ScrollBar.PageSize := Panel.Height;
ScrollBar.Enabled := true;
end
else
begin
ScrollBar.Enabled := false;
end;
Application.ProcessMessages;
end;
procedure TChatSystem.addUserText(Text:
String);
var
Label_Create: TLabel;
begin
Label_Create := TLabel.Create(Panel);
Label_Create.Parent := Panel;
Label_Create.Caption := Text;
Label_Create.Top := 0;
Label_Create.Left := 0;
Label_Create.Autosize := false;
Label_Create.Font.size := 13;
Label_Create.Width := Panel.Width;
Label_Create.Height := 20;
Label_Create.Font.Color := clHotLight;
Label_Create.Tag := Objekte.count;
Label_Create.OnMouseDown := onMouseClick;
Label_Create.Cursor := crHandPoint;
Objekte.Add(Label_Create);
// newMessage;
end;
procedure TChatSystem.addText(Text:
String);
var
Label_Create: TLabel;
begin
Label_Create := TLabel.Create(Panel);
Label_Create.Parent := Panel;
Label_Create.Caption := Text;
Label_Create.Top := 0;
Label_Create.Left := 10;
Label_Create.Autosize := true;
Label_Create.Tag := Objekte.count;
Label_Create.OnMouseEnter := onMouseOver;
Label_Create.OnMouseLeave := onMouseOut;
Objekte.Add(Label_Create);
newMessage;
end;
procedure TChatSystem.onMouseOver(Sender: TObject);
begin
case (Sender
as TComponent).Tag
of
0:
(Sender
as TLabel).Font.Style := (Sender
as TLabel).Font.Style + [fsBold];
end;
renderLabels;
end;
procedure TChatSystem.onMouseOut(Sender: TObject);
begin
case (Sender
as TComponent).Tag
of
0:
(Sender
as TLabel).Font.Style := (Sender
as TLabel).Font.Style - [fsBold];
end;
renderLabels;
end;
procedure TChatSystem.onMouseClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssRight
in Shift
then
begin
PopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
end;
procedure TChatSystem.addImage(Text:
String);
var
Image_Create: TImage;
begin
Image_Create := TImage.Create(Panel);
Image_Create.Parent := Panel;
Image_Create.Picture.LoadFromFile(Text);
Image_Create.Height := 150;
Image_Create.Width := Image_Create.Picture.Width
div
(Image_Create.Picture.Height
div Image_Create.Height);
Image_Create.Stretch := true;
Image_Create.Top := 0;
Image_Create.Left := 10;
Image_Create.Tag := Objekte.count;
Image_Create.OnMouseDown := onMouseClick;
Image_Create.DragMode := dmAutomatic;
Objekte.Add(Image_Create);
newMessage;
end;
procedure TChatSystem.addProgessbar(id: Integer);
var
Progressbar_Create: TProgressBar;
begin
Progressbar_Create := TProgressBar.Create(Panel);
Progressbar_Create.Parent := Panel;
Progressbar_Create.Left := 10;
Progressbar_Create.Top := 0;
Progressbar_Create.Max := 100;
Progressbar_Create.Position := 0;
Progressbar_Create.Height := 20;
Progressbar_Create.Width := 100;
Progressbar_Create.Tag := Objekte.count;
Progressbar_Create.MarqueeInterval := id;
Objekte.Add(Progressbar_Create);
newMessage;
end;
procedure TChatSystem.addButton(id: Integer; Text:
String);
var
Button_Create: TButton;
begin
Button_Create := TButton.Create(Panel);
Button_Create.Parent := Panel;
Button_Create.Caption := Text;
Button_Create.Left := 10;
Button_Create.Top := 0;
// Button_Create.Height := Form1.Canvas.TextHeight(Text) + 10;
// Button_Create.Width := Form1.Canvas.TextWidth(Text) + 10;
Button_Create.Tag := Objekte.count;
// Button_Create.TBDockHeight := id;
Objekte.Add(Button_Create);
newMessage;
end;
end.