Solved

Position a listbox inside a memo component

Posted on 2004-09-20
10
795 Views
Last Modified: 2012-08-13
Hi,

I need to simulate what delphi does when you press ctrl space. I need a listbox to be positioned at the current caretpos inside the memo comp. I then need to insert the listbox item at the current cursor pos in the listbox.

Thanks,
Dion.
0
Comment
Question by:Diono
  • 6
  • 3
10 Comments
 
LVL 22

Expert Comment

by:Ferruccio Accalai
ID: 12101121
Well, this is not perfect but could be a point of start (i actually don't know if  you need to make it work exactly like delphi do).

BTW...

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ListBox1: TListBox;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  i: Integer;
  pt: TPOint;
implementation

{$R *.dfm}

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if ssCTRL in Shift then
  if Key = VK_SPACE then
   begin
      GetCaretPos(pt);
      ListBox1.Top := Memo1.Top+ pt.y+15;
      ListBox1.left := memo1.Left+ pt.x;
      i := Memo1.SelStart;
      ListBox1.Visible := true;
      ListBox1.SetFocus;
   end;
end;

procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
S,SubStr: String;
begin
if Key = VK_RETURN then begin
   S := Memo1.Text;
   SubStr := ListBox1.Items[ListBox1.ItemIndex];
   Insert(Substr,s,i);
   Memo1.Text := s;
   memo1.SelStart := i;
   Memo1.SetFocus;
   ListBox1.Visible := False;
   end;
end;

end.

Unit1.dfm

object Form1: TForm1
  Left = 192
  Top = 107
  Width = 696
  Height = 480
  Caption = 'Form1'
  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 = 58
    Top = 10
    Width = 185
    Height = 181
    Lines.Strings = (
      'Hi,'
      'I need to simulate what delphi does '
      'when you press ctrl space. I need a '
      'listbox to be positioned at the current '
      'caretpos inside the memo comp. I '
      'then need to insert the listbox item at '
      'the current cursor pos in the listbox.'
      'Thanks,'
      'Dion.'
      '')
    TabOrder = 0
    OnKeyDown = Memo1KeyDown
  end
  object ListBox1: TListBox
    Left = 484
    Top = 50
    Width = 121
    Height = 97
    ItemHeight = 13
    Items.Strings = (
      'Experts Exchange'
      'Delphi Programming'
      'Certified Expert'
      'Page Editor'
      'Community Support')
    TabOrder = 1
    Visible = False
    OnKeyDown = ListBox1KeyDown
  end
end

Hope this help

F68 ;-)
0
 

Author Comment

by:Diono
ID: 12101547
Works well, except that I don't like the idea of copying the memo text, manipulating it and reassigning it. Is it not possible to insert the text using messages? The problem is if there is a lot of text. The whole process is slow.

Dion.
0
 
LVL 22

Accepted Solution

by:
Ferruccio Accalai earned 450 total points
ID: 12101772
Ohh yes of course...i've remembered a TMemo method that works great :))

Replace the LB.OnKeyDown with this:

procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if Key = VK_RETURN then begin
   memo1.SelStart := i;
   Memo1.SetSelTextBuf(PChar(ListBox1.Items[ListBox1.ItemIndex]));
   Memo1.SetFocus;
   ListBox1.Visible := False;
   end;
end;
0
 
LVL 14

Assisted Solution

by:Pierre Cornelius
Pierre Cornelius earned 50 total points
ID: 12102322
Here's what you need:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;

type
  TMemoListbox = class(TListBox)
    protected
      constructor Create(AOwner: TMemo); reintroduce;
      procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
      procedure KeyUp(var Key: Word; Shift: TShiftState); override;
      procedure DoExit; override;

  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMemoListbox }

constructor TMemoListbox.Create(AOwner: TMemo);
begin
  inherited Create(AOwner);
  parent:= AOwner;
  SetFocus;
end;

procedure TMemoListbox.DoExit;
begin
  inherited;
  Destroy;
end;

procedure TMemoListbox.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if Key = 13 then
  begin
    Key:= 0;
    if ItemIndex <> -1 then
    begin
      parent.Perform(EM_REPLACESEL, 0, LongInt(pchar(Items[ItemIndex])));
      Destroy;
    end;
  end;
end;

procedure TMemoListbox.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  PosStart, PosEnd: PInteger;
begin
  inherited;
  if Button = mbLeft then
  begin
    if ItemIndex <> -1 then
    begin
      parent.Perform(EM_REPLACESEL, 0, LongInt(pchar(Items[ItemIndex])));
      Destroy;
    end;
  end;
end;

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i: integer;
begin
  //free any previous instances
  for i:= 0 to Memo1.ComponentCount-1 do
    if (Memo1.Components[i] is TMemoListBox)
    then Memo1.Components[i].Destroy;

  if Button = mbRight then
  begin
    with TMemoListbox.Create(Memo1) do
      begin
        parent:= Memo1;
        Top:= y;
        Left:= x;
        Items.Add('100000');
        Items.Add('200000');
        Items.Add('300000');
        Items.Add('400000');
        Items.Add('500000');
      end;
  end;
end;


end.


DFM :
===

object Form1: TForm1
  Left = 192
  Top = 114
  Width = 696
  Height = 480
  Caption = 'Form1'
  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 = 24
    Top = 24
    Width = 393
    Height = 297
    Lines.Strings = (
      'Memo1')
    TabOrder = 0
    OnMouseDown = Memo1MouseDown
  end
end

Regards
Pierre
0
 

Author Comment

by:Diono
ID: 12109910
I have used  Ferruccio68's code, but still have the problem that when I press ctrl space, the highlighted text in the richedit control is deleted(by the space bar, I guess). I do set the key value to 0 in the onkeydown event, but this does not prevent the space value from being applied. So when the listbox appears, the highlighted text in the richedit component is deleted.

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

 if ssCTRL in Shift then
  if Key = VK_SPACE then
   begin
      GetCaretPos(pt);
      ListBox1.Top := Memo1.Top+ pt.y+15;
      ListBox1.left := memo1.Left+ pt.x;
      i := Memo1.SelStart;
      ListBox1.Visible := true;
      ListBox1.ItemIndex := 0;
      ListBox1.BringToFront;
      ListBox1.SetFocus;
      Key := 0;
   end;

 IF Key = vk_Return then
   EnterPressed := TRUE
 else IF (Key = vk_Space) and not(ssCTRL in Shift) then
   SpacePressed := TRUE;
0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
LVL 22

Expert Comment

by:Ferruccio Accalai
ID: 12109968
OK Diono, so use the KeyPress event instead of the keydown...

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
var
  State: TKeyboardState;
begin
GetKeyboardState(State);
If (key = char(VK_Space)) and (State[VK_CONTROL] and 128 <> 0) then
   begin
      GetCaretPos(pt);
      ListBox1.Top := Memo1.Top+ pt.y+15;
      ListBox1.left := memo1.Left+ pt.x;
      i := Memo1.SelStart;
      ListBox1.Visible := true;
      ListBox1.ItemIndex := 0;
      ListBox1.BringToFront;
      ListBox1.SetFocus;

      key := #0; //and this works...  
   end;
end;
0
 
LVL 22

Expert Comment

by:Ferruccio Accalai
ID: 12109984
ah, not tested, but the key := #0 should stay on top
...
If (key = char(VK_Space)) and (State[VK_CONTROL] and 128 <> 0) then
   begin
        key := #0
      GetCaretPos(pt);
      ListBox1.Top := Memo1....
and so on
0
 

Author Comment

by:Diono
ID: 12110187
Please explain this(I have always meant to look at this)...
  (State[VK_CONTROL] and 128 <> 0)

Ok. I got it working pretty well. I used 98% of  code and the rest from PierreC. Would you guys be happy with a proportionate split?

Dion.
0
 
LVL 22

Expert Comment

by:Ferruccio Accalai
ID: 12110227
well State is a TKeyBoardState: array[0..255] of byte

So using API GetKeyboardState you can know the state of a virtual key

From SDK:
The GetKeyboardState function copies the status of the 256 virtual keys to the specified buffer.

BOOL GetKeyboardState(

    PBYTE lpKeyState       // address of array to receive status data
   );      
 
Parameters

lpKeyState

Points to the 256-byte array that will receive the status data for each virtual key.

Return Values

If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.

You could use GetKeyState instead, but i always prefere GetKeyboardState to check for specified virtual keys...

BTW what it do here is to get the state of CTRL key...

About splitting: i agree with whatever you want to do, so also with splitting :))

F68 ;-)
0
 
LVL 22

Expert Comment

by:Ferruccio Accalai
ID: 12110486
could you explain the grade?
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
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…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

760 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

21 Experts available now in Live!

Get 1:1 Help Now