Solved

My saga continue with form template

Posted on 2007-11-26
10
466 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
Problems using Powershell and Active Directory?

Managing Active Directory does not always have to be complicated.  If you are spending more time trying instead of doing, then it's time to look at something else. For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why

 
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
 
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

3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Delphi cmd execution 6 61
Delphi Firemonkey Need Sample for Online Shopping Example. 2 145
Firemonkey DbLookupComboBox equivalent ? 2 49
Wincontrol not (correctly) drawn 15 38
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…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

821 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