Solved

My saga continue with form template

Posted on 2007-11-26
10
461 Views
Last Modified: 2010-04-05
Hi again to all Delphi Masters ,
My saga with Form Template continue but I hope now to be ended.
I give one time 500 point but it's seems that code that I get didn't help me .
What I'm trying to do when i receive a message i must create a form from template.
If form is already created I must make it blink and add some text to memo in the form.
If form don't exist I must create it and add some text to memo in the form.
You can see in code provided below I can create form and add some text to it .
But I want to modify the code to be able to search if form exist just blink it if no create it.
Here is parameters that I have when i receive message
procedure main_form.Messenger1Message(Sender: TObject;

  const Buddy: String; const Message: WideString;
  const ReceivedDateTime: TDateTime);

I have buddy like string it's seams that form name can't be buddy name because buddy can contains dot or some special characters but it can be some MD5 sum to be unique  caption of the form can be buddy.
Based on this data i must add text to forms.

Any help will be very appreciated .

Thanks in advance.

unit Unit1;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, Contnrs, Unit2;
 

type

  TForm1 = class(TForm)

    btnAdd: TButton;

    ebMsg: TEdit;

    btnSend: TButton;

    lbForms: TListBox;

    procedure btnAddClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure btnSendClick(Sender: TObject);

  private

    FForms: TObjectList;

  public

  end;
 

var

  Form1: TForm1;
 

implementation
 

{$R *.dfm}
 

procedure TForm1.btnAddClick(Sender: TObject);

var oForm: TForm2;

begin

  oForm:=TForm2.Create(nil);

  FForms.Add(oForm);

  lbForms.Items.Add( IntToHex(DWord(oForm), 8) );

end;
 

procedure TForm1.FormCreate(Sender: TObject);

begin

  FForms:=TObjectList.Create;

end;
 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  FForms.Free;

end;
 

procedure TForm1.btnSendClick(Sender: TObject);

var

  oForm: TForm2;

  pfwi : FLASHWINFO;
 

begin

  if( lbForms.ItemIndex=-1 ) then begin

    MessageDlg('Select Window!', mtError, [mbOK], 0);

  end else begin

    oForm:=TForm2(Pointer(StrToInt('$'+lbForms.Items[lbForms.ItemIndex])));
 

    if( IsIconic(oForm.Handle) ) then begin

      ZeroMemory( @pfwi, SizeOf(FLASHWINFO) );

      pfwi.cbSize :=SizeOf(FLASHWINFO);

      pfwi.hwnd   :=oForm.Handle;

      pfwi.uCount :=3;

      pfwi.dwFlags:=FLASHW_ALL;

      FlashWindowEx( pfwi );

    end else begin

      oForm.Show;

    end;
 

    oForm.Memo1.Lines.Add( ebMsg.Text );

  end;

end;
 

end.
 
 

unit Unit2;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;
 

type

  TForm2 = class(TForm)

    Memo1: TMemo;

    Button1: TButton;

    Button2: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  protected

    procedure CreateParams(var Params: TCreateParams); override;

  private

    procedure WMSysCmd( var Message: TMessage ); message WM_SYSCOMMAND;

  public

  end;
 

var

  Form2: TForm2;
 

implementation
 

{$R *.dfm}
 

{ TForm2 }
 

procedure TForm2.CreateParams(var Params: TCreateParams);

begin

  inherited;
 

  Params.WndParent:=0;

  Params.ExStyle:=Params.ExStyle or WS_EX_APPWINDOW;

end;
 

procedure TForm2.WMSysCmd(var Message: TMessage);

begin

  if( Message.WParam=SC_CLOSE ) then begin

    Hide;

    Message.Result:=0;

  end else inherited;

end;
 

procedure TForm2.Button1Click(Sender: TObject);

begin

  MessageDlg('button1 pressed', mtInformation, [mbOK], 0);

end;
 

procedure TForm2.Button2Click(Sender: TObject);

begin

  MessageDlg('button2 pressed', mtInformation, [mbOK], 0);

end;
 

end.

Open in new window

0
Comment
Question by:snedelchev
  • 7
  • 3
10 Comments
 
LVL 17

Accepted Solution

by:
TheRealLoki earned 500 total points
ID: 20355340
here's what I think you are trying to do
hope it helps...
unit Unit1;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, Contnrs, BuddyForm;
 

type

  TForm1 = class(TForm)

    btnAdd: TButton;

    ebMsg: TEdit;

    btnSend: TButton;

    lbForms: TListBox;

    eBuddyName: TEdit;

    procedure btnAddClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure btnSendClick(Sender: TObject);

  private

    FForms: TObjectList;

  public

    function FindBuddyFormForName(BuddyName_: string): TfBuddyForm;

    procedure SendMessageToBuddy(oForm: TfBuddyForm; Text_: string);

  end;
 

var

  Form1: TForm1;
 

implementation
 

{$R *.dfm}
 

procedure TForm1.btnAddClick(Sender: TObject);

var oForm: TfBuddyForm;

begin

  oForm := FindBuddyFormForName(eBuddyName.Text);

  if assigned(oForm) then

  begin

// this buddy already exists and we are trying to add it, just send the message to it I guess :-)

    SendMessageToBuddy(oForm, ebMsg.Text);

  end

  else

  begin // buddy does not yet exist, create it

    oForm := TfBuddyForm.Create(nil, eBuddyName.Text);

    FForms.Add(oForm);

    lbForms.Items.AddObject(eBuddyName.Text, oForm); // store the pointer to the actual buddy form in teh listbox also ;-)

  end;

end;
 

procedure TForm1.FormCreate(Sender: TObject);

begin

  FForms:=TObjectList.Create;

end;
 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  FForms.Free;

end;
 

procedure TForm1.btnSendClick(Sender: TObject);

var

  oForm: TfBuddyForm;

begin

  if( lbForms.ItemIndex=-1 ) then

  begin

    MessageDlg('Select Buddy!', mtError, [mbOK], 0);

  end

  else

  begin

    oForm := TfBuddyForm(lbForms.Items.Objects[lbForms.ItemIndex]);

    SendMessageToBuddy(oForm, ebMsg.Text);

  end;

end;
 

procedure TForm1.SendMessageToBuddy(oForm: TfBuddyForm; Text_: string);

var

  pfwi : FLASHWINFO;

begin

  if( IsIconic(oForm.Handle) ) then

  begin

    ZeroMemory( @pfwi, SizeOf(FLASHWINFO) );

    pfwi.cbSize :=SizeOf(FLASHWINFO);

    pfwi.hwnd   :=oForm.Handle;

    pfwi.uCount :=3;

    pfwi.dwFlags:=FLASHW_ALL;

    FlashWindowEx( pfwi );

  end else

  begin

    oForm.Show;

  end;

  oForm.Memo1.Lines.Add( text_ );

end;
 

function TForm1.FindBuddyFormForName(BuddyName_: string): TfBuddyForm;

var

  i: integer;

begin

  result := nil;

  i := 0;

  BuddyName_ := lowercase(BuddyName_); //guarantee case insensitive search

  while (result = nil) and (i < FForms.Count) do

  begin

    if lowercase(TfBuddyForm(FForms[i]).BuddyName) = BuddyName_ then

      result := TfBuddyForm(FForms[i])

    else

      inc(i);

  end;

end;

  

end.
 
 

***** FORM FOLLOWS
 

object Form1: TForm1

  Left = 249

  Top = 107

  Width = 517

  Height = 344

  Caption = 'Form1'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  OnClose = FormClose

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object btnAdd: TButton

    Left = 8

    Top = 264

    Width = 75

    Height = 25

    Caption = 'btnAdd'

    TabOrder = 0

    OnClick = btnAddClick

  end

  object ebMsg: TEdit

    Left = 224

    Top = 236

    Width = 241

    Height = 21

    TabOrder = 1

    Text = 'This is a message'

  end

  object btnSend: TButton

    Left = 224

    Top = 264

    Width = 75

    Height = 25

    Caption = 'btnSend'

    TabOrder = 2

    OnClick = btnSendClick

  end

  object lbForms: TListBox

    Left = 8

    Top = 8

    Width = 265

    Height = 221

    ItemHeight = 13

    TabOrder = 3

  end

  object eBuddyName: TEdit

    Left = 8

    Top = 236

    Width = 145

    Height = 21

    TabOrder = 4

    Text = 'Homer Simpson'#39's donut'

  end

end
 
 

**** Buddy Form UNIT follows
 

unit BuddyForm;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;
 

type

  TfBuddyForm = class(TForm)

    Memo1: TMemo;

    Button1: TButton;

    Button2: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  private

    fBuddyName: string;

    procedure WMSysCmd( var Message: TMessage ); message WM_SYSCOMMAND;

  protected

    procedure CreateParams(var Params: TCreateParams); override;

  public

    constructor Create(AOwner: TComponent; BuddyName_: string);

    property BuddyName: string read fBuddyName write fBuddyName;

  end;
 

var

  fBuddyForm: TfBuddyForm;
 

implementation
 

{$R *.dfm}
 

{ TForm2 }
 

procedure TfBuddyForm.Button1Click(Sender: TObject);

begin

  MessageDlg('button1 pressed', mtInformation, [mbOK], 0);

end;
 

procedure TfBuddyForm.Button2Click(Sender: TObject);

begin

  MessageDlg('button2 pressed', mtInformation, [mbOK], 0);

end;
 

constructor TfBuddyForm.Create(AOwner: TComponent; BuddyName_: string);

begin

  inherited Create(AOwner);

  Buddyname := BuddyName_;

end;
 

procedure TfBuddyForm.CreateParams(var Params: TCreateParams);

begin

  inherited;

 

  Params.WndParent:=0;

  Params.ExStyle:=Params.ExStyle or WS_EX_APPWINDOW;

end;
 

procedure TfBuddyForm.WMSysCmd(var Message: TMessage);

begin

  if( Message.WParam=SC_CLOSE ) then

  begin

    Hide;

    Message.Result:=0;

  end else inherited;

end;
 

end.
 
 
 

*** Buddy Form FORM follows
 

object fBuddyForm: TfBuddyForm

  Left = 249

  Top = 107

  Width = 502

  Height = 370

  Caption = 'fBuddyForm'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  PixelsPerInch = 96

  TextHeight = 13

  object Memo1: TMemo

    Left = 44

    Top = 0

    Width = 357

    Height = 253

    Lines.Strings = (

      'Memo1')

    TabOrder = 0

  end

  object Button1: TButton

    Left = 40

    Top = 264

    Width = 75

    Height = 25

    Caption = 'Button1'

    TabOrder = 1

    OnClick = Button1Click

  end

  object Button2: TButton

    Left = 144

    Top = 264

    Width = 75

    Height = 25

    Caption = 'Button2'

    TabOrder = 2

    OnClick = Button2Click

  end

end

Open in new window

0
 
LVL 17

Expert Comment

by:TheRealLoki
ID: 20355356
you can also make teh buddy form a little more obvious by changing the code here

constructor TfBuddyForm.Create(AOwner: TComponent; BuddyName_: string);
begin
  inherited Create(AOwner);
  Buddyname := BuddyName_;
  Caption := BuddyName_; // <-- Added this...
end;

0
 
LVL 3

Author Comment

by:snedelchev
ID: 20356082
Thanks very much for quick response. I will check your code today when I come back to home and I will give you feedback .

Regards.
0
 
LVL 3

Author Comment

by:snedelchev
ID: 20356130
This list box was for testing purpose. I'm planing to use in main form something like Tlistvew with thee columns
Buddy , Group, Status .
On Double click to open buddy form.
0
 
LVL 17

Expert Comment

by:TheRealLoki
ID: 20356199
that's fine.. as long as you store the "Buddy Name" somewhere you can find the window by using my "FindBuddyFormForName" function. This way you'll know if the buddy window has been created or not
e.g
FindBuddyFormForName(ListView1.Selected.Caption)
or
FindBuddyFormForName(ListView1.Selected.SubItems[0]);
depending on which column you have the buddy name in the listview
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 3

Author Comment

by:snedelchev
ID: 20359376
Now I'm on the same place like before I have the same problem like with my old code that I didn't find how to solve.
What is my problem if I'm typing in some form in memo to send a message to some buddy and I recieve  message form someone else a new form is taking a focus and I'm losing form that I'm taping in.
it's the same with allready created forms message from some one immidiatelly brings form for this new message except this forms that are minimized they only blink. I there some way to get focus back.
Don't loose focus if you are typing something or our are in some buddy form.

Thanks in Advanec.

unit Unit1;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls,Contnrs, BuddyForm, BSYAHOOMessenger, ComCtrls;
 

type

  TForm1 = class(TForm)

    btnAdd: TButton;

    ebMsg: TEdit;

    btnSend: TButton;

    lbForms: TListBox;

    eBuddyName: TEdit;

    Messenger: TBSYAHOOMessenger;

    ebUserName: TEdit;

    ebPassword: TEdit;

    btnLoin: TButton;

    StatusBar1: TStatusBar;

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure btnAddClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure btnSendClick(Sender: TObject);

    procedure btnLoinClick(Sender: TObject);

    procedure MessengerMessage(Sender: TObject; const Buddy: String;

      const Message: WideString; const ReceivedDateTime: TDateTime);

  private

  FForms: TObjectList;

    { Private declarations }

  public

  function FindBuddyFormForName(BuddyName_: string): TfBuddyForm;

  procedure SendMessageToBuddy(oForm: TfBuddyForm; Text_: string);

    { Public declarations }

  end;
 

var

  Form1: TForm1;

  CurentForm: string;

implementation
 

{$R *.dfm}
 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 FForms.Free;

end;
 

procedure TForm1.btnAddClick(Sender: TObject);

var oForm: TfBuddyForm;

begin

  oForm := FindBuddyFormForName(eBuddyName.Text);

  if assigned(oForm) then

  begin

// this buddy already exists and we are trying to add it, just send the message to it I guess :-)

    SendMessageToBuddy(oForm, ebMsg.Text);

  end

  else

  begin // buddy does not yet exist, create it

    oForm := TfBuddyForm.Create(nil, eBuddyName.Text);

    FForms.Add(oForm);

    lbForms.Items.AddObject(eBuddyName.Text, oForm); // store the pointer to the actual buddy form in teh listbox also ;-)

  end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

FForms:=TObjectList.Create;

end;
 

procedure TForm1.btnSendClick(Sender: TObject);

var

  oForm: TfBuddyForm;

begin

  if( lbForms.ItemIndex=-1 ) then

  begin

    MessageDlg('Select Buddy!', mtError, [mbOK], 0);

  end

  else

  begin

    //ShowMessage(lbForms.Items.Objects[lbForms.ItemIndex]);

    oForm := TfBuddyForm(lbForms.Items.Objects[lbForms.ItemIndex]);

    SendMessageToBuddy(oForm, ebMsg.Text);

  end;

end;
 

procedure TForm1.SendMessageToBuddy(oForm: TfBuddyForm; Text_: string);

var

  pfwi : FLASHWINFO;

begin

  if( IsIconic(oForm.Handle) ) then

  begin

    ZeroMemory( @pfwi, SizeOf(FLASHWINFO) );

    pfwi.cbSize :=SizeOf(FLASHWINFO);

    pfwi.hwnd   :=oForm.Handle;

    pfwi.uCount :=1;

    pfwi.dwFlags:=FLASHW_ALL;

    FlashWindowEx( pfwi );

  end else

  begin

    ZeroMemory( @pfwi, SizeOf(FLASHWINFO) );

    pfwi.cbSize :=SizeOf(FLASHWINFO);

    pfwi.hwnd   :=oForm.Handle;

    pfwi.uCount :=1;

    pfwi.dwFlags:=FLASHW_ALL;

    FlashWindowEx( pfwi );

    oForm.Show;

  end;

  oForm.HistoryMemo.Lines.Add( text_ );

end;

 

function TForm1.FindBuddyFormForName(BuddyName_: string): TfBuddyForm;

var

  i: integer;

begin

  result := nil;

  i := 0;

  BuddyName_ := lowercase(BuddyName_); //guarantee case insensitive search

  while (result = nil) and (i < FForms.Count) do

  begin

    if lowercase(TfBuddyForm(FForms[i]).BuddyName) = BuddyName_ then

      result := TfBuddyForm(FForms[i])

    else

      inc(i);

  end;

end;
 

procedure TForm1.btnLoinClick(Sender: TObject);

begin

Messenger.YAHOOID := ebUserName.Text;

Messenger.YAHOOPassword := ebPassword.Text;

Messenger.Login;

if Messenger.Logined  = true then

StatusBar1.Panels[1].Text := 'yes';

end;
 

procedure TForm1.MessengerMessage(Sender: TObject; const Buddy: String;

  const Message: WideString; const ReceivedDateTime: TDateTime);

var oForm: TfBuddyForm;

begin

  oForm := FindBuddyFormForName(Buddy);

  if assigned(oForm) then

  begin

// this buddy already exists and we are trying to add it, just send the message to it I guess :-)

    SendMessageToBuddy(oForm, Message);

  end

  else

  begin // buddy does not yet exist, create it

    oForm := TfBuddyForm.Create(nil, Buddy);

    FForms.Add(oForm);

    lbForms.Items.AddObject(Buddy, oForm); // store the pointer to the actual buddy form in teh listbox also ;-)

    SendMessageToBuddy(oForm, Message);

  end;

end;
 

end.
 

unit BuddyForm;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;
 

type

  TfBuddyForm = class(TForm)

    Button1: TButton;

    Button2: TButton;

    HistoryMemo: TMemo;

    AnswerMemo: TMemo;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure AnswerMemoKeyPress(Sender: TObject; var Key: Char);

  private

   fBuddyName: string;

   procedure WMSysCmd( var Message: TMessage ); message WM_SYSCOMMAND;

    { Private declarations }

  protected

  procedure CreateParams(var Params: TCreateParams); override;
 

  public

  constructor Create(AOwner: TComponent; BuddyName_: string);

  property BuddyName: string read fBuddyName write fBuddyName;

    { Public declarations }

  end;
 

var

  fBuddyForm: TfBuddyForm;
 

implementation
 

uses Unit1;
 

{$R *.dfm}
 

constructor TfBuddyForm.Create(AOwner: TComponent; BuddyName_: string);

begin

  inherited Create(AOwner);

  Buddyname := BuddyName_;

  Caption := BuddyName_;

end;

 

procedure TfBuddyForm.CreateParams(var Params: TCreateParams);

begin

  inherited;

 

  Params.WndParent:=0;

  Params.ExStyle:=Params.ExStyle or WS_EX_APPWINDOW;

end;

 

procedure TfBuddyForm.WMSysCmd(var Message: TMessage);

begin

  if( Message.WParam=SC_CLOSE ) then

  begin

    Hide;

    Message.Result:=0;

  end else inherited;

end;
 
 
 
 

procedure TfBuddyForm.Button1Click(Sender: TObject);

begin

  MessageDlg('button1 pressed', mtInformation, [mbOK], 0);

end;
 

procedure TfBuddyForm.Button2Click(Sender: TObject);

begin

  MessageDlg('button2 pressed', mtInformation, [mbOK], 0);

end;
 

procedure TfBuddyForm.AnswerMemoKeyPress(Sender: TObject; var Key: Char);

begin

if key = #13 then

  begin

    HistoryMemo.Lines.Add(DateToStr(date()) + ':' + TimeToStr(time()) + ' - ' + Form1.Messenger.YAHOOID + ' says: ' + AnswerMemo.Lines.Text);

    //Form2.AddTextFile(Form2.BSYAHOOMessenger1.YAHOOID,memo_answer.Lines.Text,Self.Caption);

    Form1.Messenger.SendMessage(Self.Caption,AnswerMemo.Lines.Text);

    AnswerMemo.Clear;
 

    Key := #0;

    

  end;

end;
 

end.

Open in new window

0
 
LVL 3

Author Comment

by:snedelchev
ID: 20359610
I clean up the code a little bit.
Here is .
unit Unit1;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls,Contnrs, BuddyForm, BSYAHOOMessenger, ComCtrls;
 

type

  TForm1 = class(TForm)

    lbForms: TListBox;

    Messenger: TBSYAHOOMessenger;

    ebUserName: TEdit;

    ebPassword: TEdit;

    btnLoin: TButton;

    StatusBar1: TStatusBar;

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    

    procedure FormCreate(Sender: TObject);
 

    procedure btnLoinClick(Sender: TObject);

    procedure MessengerMessage(Sender: TObject; const Buddy: String;

      const Message: WideString; const ReceivedDateTime: TDateTime);

  private

  FForms: TObjectList;

    { Private declarations }

  public

  function FindBuddyFormForName(BuddyName_: string): TfBuddyForm;

  procedure SendMessageToBuddy(oForm: TfBuddyForm; Text_: string);

    { Public declarations }

  end;
 

var

  Form1: TForm1;

  CurentForm: string;

implementation
 

{$R *.dfm}
 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 FForms.Free;

end;
 
 

procedure TForm1.FormCreate(Sender: TObject);

begin

FForms:=TObjectList.Create;

end;
 
 
 

procedure TForm1.SendMessageToBuddy(oForm: TfBuddyForm; Text_: string);

var

  pfwi : FLASHWINFO;

begin

    ZeroMemory( @pfwi, SizeOf(FLASHWINFO) );

    pfwi.cbSize :=SizeOf(FLASHWINFO);

    pfwi.hwnd   :=oForm.Handle;

    pfwi.uCount :=1;

    pfwi.dwFlags:=FLASHW_ALL;

    FlashWindowEx( pfwi );

    oForm.Show;

    oForm.HistoryMemo.Lines.Add( text_ );

end;

 

function TForm1.FindBuddyFormForName(BuddyName_: string): TfBuddyForm;

var

  i: integer;

begin

  result := nil;

  i := 0;

  BuddyName_ := lowercase(BuddyName_); //guarantee case insensitive search

  while (result = nil) and (i < FForms.Count) do

  begin

    if lowercase(TfBuddyForm(FForms[i]).BuddyName) = BuddyName_ then

      result := TfBuddyForm(FForms[i])

    else

      inc(i);

  end;

end;
 

procedure TForm1.btnLoinClick(Sender: TObject);

begin

Messenger.YAHOOID := ebUserName.Text;

Messenger.YAHOOPassword := ebPassword.Text;

Messenger.Login;

if Messenger.Logined  = true then

StatusBar1.Panels[1].Text := 'yes';

end;
 

procedure TForm1.MessengerMessage(Sender: TObject; const Buddy: String;

  const Message: WideString; const ReceivedDateTime: TDateTime);

var oForm: TfBuddyForm;

begin

  oForm := FindBuddyFormForName(Buddy);
 

  if assigned(oForm) then

  begin

  // Има го ще пратим само съобщение
 

    SendMessageToBuddy(oForm, Message);

  end

  else

  begin // няма го ще го създадем

    oForm := TfBuddyForm.Create(nil, Buddy);

    FForms.Add(oForm);

    oForm.WindowState := wsMinimized;

    lbForms.Items.AddObject(Buddy, oForm); // Да си го запишем в листбокса май ще го сменя с Treeview

    SendMessageToBuddy(oForm, Message);

  end;

end;
 

end.
 

unit BuddyForm;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;
 

type

  TfBuddyForm = class(TForm)

    Button1: TButton;

    Button2: TButton;

    HistoryMemo: TMemo;

    AnswerMemo: TMemo;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure AnswerMemoKeyPress(Sender: TObject; var Key: Char);

  private

   fBuddyName: string;

   procedure WMSysCmd( var Message: TMessage ); message WM_SYSCOMMAND;

    { Private declarations }

  protected

  procedure CreateParams(var Params: TCreateParams); override;
 

  public

  constructor Create(AOwner: TComponent; BuddyName_: string);

  property BuddyName: string read fBuddyName write fBuddyName;

    { Public declarations }

  end;
 

var

  fBuddyForm: TfBuddyForm;
 

implementation
 

uses Unit1;
 

{$R *.dfm}
 

constructor TfBuddyForm.Create(AOwner: TComponent; BuddyName_: string);

begin

  inherited Create(AOwner);

  Buddyname := BuddyName_;

  Caption := BuddyName_;

end;

 

procedure TfBuddyForm.CreateParams(var Params: TCreateParams);

begin

  inherited;

 

  Params.WndParent:=0;

  Params.ExStyle:=Params.ExStyle or WS_EX_APPWINDOW;

end;

 

procedure TfBuddyForm.WMSysCmd(var Message: TMessage);

begin

  if( Message.WParam=SC_CLOSE ) then

  begin

    Hide;

    Message.Result:=0;

  end else inherited;

end;
 
 
 
 

procedure TfBuddyForm.Button1Click(Sender: TObject);

begin

  MessageDlg('button1 pressed', mtInformation, [mbOK], 0);

end;
 

procedure TfBuddyForm.Button2Click(Sender: TObject);

begin

  MessageDlg('button2 pressed', mtInformation, [mbOK], 0);

end;
 

procedure TfBuddyForm.AnswerMemoKeyPress(Sender: TObject; var Key: Char);

begin

if key = #13 then

  begin

    HistoryMemo.Lines.Add(DateToStr(date()) + ':' + TimeToStr(time()) + ' - ' + Form1.Messenger.YAHOOID + ' says: ' + AnswerMemo.Lines.Text);
 

    Form1.Messenger.SendMessage(Self.Caption,AnswerMemo.Lines.Text);

    AnswerMemo.Clear;
 

    Key := #0;

    

  end;

end;
 

end.

Open in new window

0
 
LVL 3

Author Comment

by:snedelchev
ID: 20359752
I solve it partially I think that code that I produce can be cleaned a lot but .
Now i have problem only if i close some form but it's still exists in TobjectList and taking focus again.
Here is what i produce so far .


unit Unit1;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls,Contnrs, BuddyForm, BSYAHOOMessenger, ComCtrls;
 

type

  TForm1 = class(TForm)

    lbForms: TListBox;

    Messenger: TBSYAHOOMessenger;

    ebUserName: TEdit;

    ebPassword: TEdit;

    btnLoin: TButton;

    StatusBar1: TStatusBar;

    procedure FormClose(Sender: TObject; var Action: TCloseAction);
 

    procedure FormCreate(Sender: TObject);
 

    procedure btnLoinClick(Sender: TObject);

    procedure MessengerMessage(Sender: TObject; const Buddy: String;

      const Message: WideString; const ReceivedDateTime: TDateTime);

  private

  FForms: TObjectList;

    { Private declarations }

  public

  function FindBuddyFormForName(BuddyName_: string): TfBuddyForm;

  procedure SendMessageToBuddy(oForm: TfBuddyForm; Text_: string);

    { Public declarations }

  end;
 

var

  Form1: TForm1;

  CurentForm: string;

implementation
 

{$R *.dfm}
 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 FForms.Free;

end;
 
 

procedure TForm1.FormCreate(Sender: TObject);

begin

FForms:=TObjectList.Create;

end;
 
 
 

procedure TForm1.SendMessageToBuddy(oForm: TfBuddyForm; Text_: string);

var

  pfwi : FLASHWINFO;

begin

    if oForm.Visible = true then

    begin

    ZeroMemory( @pfwi, SizeOf(FLASHWINFO) );

    pfwi.cbSize :=SizeOf(FLASHWINFO);

    pfwi.hwnd   :=oForm.Handle;

    pfwi.uCount :=3;

    pfwi.dwFlags:=FLASHW_ALL;

    FlashWindowEx( pfwi );

    oForm.HistoryMemo.Lines.Add( text_ );

    end

    else

    begin

    ZeroMemory( @pfwi, SizeOf(FLASHWINFO) );

    pfwi.cbSize :=SizeOf(FLASHWINFO);

    pfwi.hwnd   :=oForm.Handle;

    pfwi.uCount :=3;

    pfwi.dwFlags:=FLASHW_ALL;

    FlashWindowEx( pfwi );

    oForm.HistoryMemo.Lines.Add( text_ );

    oForm.Show();
 

    end;

end;

 

function TForm1.FindBuddyFormForName(BuddyName_: string): TfBuddyForm;

var

  i: integer;

begin

  result := nil;

  i := 0;

  BuddyName_ := lowercase(BuddyName_); //guarantee case insensitive search

  while (result = nil) and (i < FForms.Count) do

  begin

    if lowercase(TfBuddyForm(FForms[i]).BuddyName) = BuddyName_ then

      result := TfBuddyForm(FForms[i])

    else

      inc(i);

  end;

end;
 

procedure TForm1.btnLoinClick(Sender: TObject);

begin

Messenger.YAHOOID := ebUserName.Text;

Messenger.YAHOOPassword := ebPassword.Text;

Messenger.Login;

if Messenger.Logined  = true then

StatusBar1.Panels[1].Text := 'yes';

end;
 

procedure TForm1.MessengerMessage(Sender: TObject; const Buddy: String;

  const Message: WideString; const ReceivedDateTime: TDateTime);

var oForm: TfBuddyForm;

pfwi : FLASHWINFO;

begin

  oForm := FindBuddyFormForName(Buddy);
 

  if assigned(oForm) then

  begin

  // Èìà ãî ùå ïðàòèì ñàìî ñúîáùåíèå
 

  SendMessageToBuddy(oForm, Message);

  end

  else

  begin // íÿìà ãî ùå ãî ñúçäàäåì

    oForm := TfBuddyForm.Create(nil, Buddy);

    FForms.Add(oForm);

    oForm.WindowState := wsMinimized;

    ZeroMemory( @pfwi, SizeOf(FLASHWINFO) );

    pfwi.cbSize :=SizeOf(FLASHWINFO);

    pfwi.hwnd   :=oForm.Handle;

    pfwi.uCount :=3;

    pfwi.dwFlags:=FLASHW_ALL;

    FlashWindowEx( pfwi );

    lbForms.Items.AddObject(Buddy, oForm); // Äà ñè ãî çàïèøåì â ëèñòáîêñà ìàé ùå ãî ñìåíÿ ñ Treeview

    SendMessageToBuddy(oForm, Message);

  end;

end;
 

end.
 
 
 

unit BuddyForm;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;
 

type

  TfBuddyForm = class(TForm)

    Button1: TButton;

    Button2: TButton;

    HistoryMemo: TMemo;

    AnswerMemo: TMemo;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure AnswerMemoKeyPress(Sender: TObject; var Key: Char);

  private

   fBuddyName: string;

   procedure WMSysCmd( var Message: TMessage ); message WM_SYSCOMMAND;

    { Private declarations }

  protected

  procedure CreateParams(var Params: TCreateParams); override;
 

  public

  constructor Create(AOwner: TComponent; BuddyName_: string);

  property BuddyName: string read fBuddyName write fBuddyName;

    { Public declarations }

  end;
 

var

  fBuddyForm: TfBuddyForm;
 

implementation
 

uses Unit1;
 

{$R *.dfm}
 

constructor TfBuddyForm.Create(AOwner: TComponent; BuddyName_: string);

begin

  inherited Create(AOwner);

  Buddyname := BuddyName_;

  Caption := BuddyName_;

end;

 

procedure TfBuddyForm.CreateParams(var Params: TCreateParams);

begin

  inherited;

 

  Params.WndParent:=0;

  Params.ExStyle:=Params.ExStyle or WS_EX_APPWINDOW;

end;

 

procedure TfBuddyForm.WMSysCmd(var Message: TMessage);

begin

  if( Message.WParam=SC_CLOSE ) then

  begin

    Hide;

    Message.Result:=0;

  end else inherited;

end;
 
 
 
 

procedure TfBuddyForm.Button1Click(Sender: TObject);

begin

  MessageDlg('button1 pressed', mtInformation, [mbOK], 0);

end;
 

procedure TfBuddyForm.Button2Click(Sender: TObject);

begin

  MessageDlg('button2 pressed', mtInformation, [mbOK], 0);

end;
 

procedure TfBuddyForm.AnswerMemoKeyPress(Sender: TObject; var Key: Char);

begin

if key = #13 then

  begin

    HistoryMemo.Lines.Add(DateToStr(date()) + ':' + TimeToStr(time()) + ' - ' + Form1.Messenger.YAHOOID + ' says: ' + AnswerMemo.Lines.Text);
 

    Form1.Messenger.SendMessage(Self.Caption,AnswerMemo.Lines.Text);

    AnswerMemo.Clear;
 

    Key := #0;

    

  end;

end;
 

end.

Open in new window

0
 
LVL 3

Author Comment

by:snedelchev
ID: 20363910
I can't find why onform close event is not working on template form.
0
 
LVL 3

Author Comment

by:snedelchev
ID: 20364168
This is hiding the form instead of closing it

procedure TfBuddyForm.WMSysCmd(var Message: TMessage);
begin

  if( Message.WParam=SC_CLOSE ) then
  begin
    Hide;
    Message.Result:=0;
  end else inherited;

end;
}
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This is used to tweak the memory usage for your computer, it is used for servers more so than workstations but just be careful editing registry settings as it may cause irreversible results. I hold no responsibility for anything you do to the regist…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now