Solved

My saga continue with form template

Posted on 2007-11-26
10
456 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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

743 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

11 Experts available now in Live!

Get 1:1 Help Now