Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

CheckListBox Paints Poorly With Horizontal Scrollbar

Posted on 2007-09-30
7
Medium Priority
?
855 Views
Last Modified: 2008-01-09
I've tried a couple different ways to add a horizontal scrollbar with a checklistbox, and while they sort of work, all the approaches have the effect of "erasing" the checks in each checkbox when the horizontal scrollbar is used.

To be more precise, the checks are still in the boxes, they're just poorly repainted when the scrollbar is moved back to the left. Scrolling up or down repaints the checks, as does using the arrow keys to move the list.

I'd like my program to look as professional as possible, any suggestions?

It might also help to know that I'm using Delphi 2005, Windows XP SP2 and XPManifest.

Thanks!
0
Comment
Question by:surfbored
  • 4
  • 3
7 Comments
 
LVL 19

Expert Comment

by:MerijnB
ID: 19989905
show some source of your effort (as small as possible please)
0
 
LVL 1

Author Comment

by:surfbored
ID: 19990708
Here's two examples of what I tried...

    //Add Horizontal scrollbar, if needed.
  MaxWidth := 0;
  for i := 0 to lstInputFiles.Items.Count - 1 do
  if MaxWidth < lstInputFiles.Canvas.TextWidth(lstInputFiles.Items.Strings[i]) then
    MaxWidth := lstInputFiles.Canvas.TextWidth(lstInputFiles.Items.Strings[i]);
  SendMessage(lstInputFiles.Handle, LB_SETHORIZONTALEXTENT, MaxWidth, 0);
 
  //Add Horizontal scrollbar, regardless of need.
  lstInputFiles.Perform(LB_SETHORIZONTALEXTENT,500,0)

(And to be clear, lstInputFiles is a TCheckListBox)

Thanks!
0
 
LVL 19

Expert Comment

by:MerijnB
ID: 19991053
nasty bug which seems to go quite deep.
As a 'workaround' I can offer you this; please let me know if it's clear enough for you.
It's not a neat solution, but it does do the trick.


Make your own TCheckListBox descendant, like this:

type
 TMyChecklistbox = class(TChecklistBox)
  private
   procedure WMHSCROLL(var WMHScroll: TWMHScroll); message WM_HSCROLL;
 end;

...

procedure tMyChecklistbox.WMHSCROLL(var WMHScroll: TWMHScroll);
begin
 inherited;

 if GetScrollPos(Handle, SB_HORZ) < 15 then
  Invalidate();
end;
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 1

Author Comment

by:surfbored
ID: 19991357
Uh...

I'm afraid this fix is a little over my head.

If you could provide some more information on the topic of creating descendants, that would be most helpful. Or, at the least, guide me as to where this coding would be placed so I can try it.

Thanks again!
0
 
LVL 19

Expert Comment

by:MerijnB
ID: 19996919
ok, try this.

Make a new unit, name it CheckListBoxFixer.pas.
Use it in the form where you have the checklistbox, and in the formcreate call:

  FixChecklistBox(CheckListBox1);


here is the contents of the file CheckListBoxFixer.pas:

unit CheckListBoxFixer;

interface

uses CheckLst, Messages;

procedure FixChecklistBox(CheckListBox: TCheckListBox);

implementation

uses Contnrs, Windows, Classes;

type TChecklistBoxFixer = class(TObject)
     private
      fCheckListBox: TCheckListBox;
      fPrevWndProc: Pointer;

      procedure NewWndProc(Var Message: TMessage);
     public
      constructor Create(CheckListBox: TCheckListBox); reintroduce;
      destructor Destroy; override;
     end;

var Fixes: TObjectList;

procedure FixChecklistBox(CheckListBox: TCheckListBox);
begin
 Fixes.Add(TChecklistBoxFixer.Create(CheckListBox));
end;

{ TChecklistBoxFixer }

constructor TChecklistBoxFixer.Create(CheckListBox: TCheckListBox);
begin
 inherited Create();

 fCheckListBox := CheckListBox;
 fPrevWndProc := Pointer(GetWindowLong(fCheckListBox.Handle, GWL_WNDPROC));
 SetWindowLong(fCheckListBox.Handle, GWL_WNDPROC, integer(MakeObjectInstance(NewWndProc)));
end;

destructor TChecklistBoxFixer.Destroy;
begin
 SetWindowLong(fCheckListBox.Handle, GWL_WNDPROC, integer(fPrevWndProc));

 inherited;
end;

procedure TChecklistBoxFixer.NewWndProc(var Message: TMessage);
begin
 Message.Result := CallWindowProc(fPrevWndProc, fCheckListBox.Handle, Message.Msg, Message.WParam, Message.LParam);

 if (Message.Msg = WM_HSCROLL) and (GetScrollPos(fCheckListBox.Handle, SB_HORZ) < 15) then
  fCheckListBox.Invalidate();
end;

initialization
 Fixes := TObjectList.Create();

finalization
 Fixes.Free();

end.
0
 
LVL 1

Author Comment

by:surfbored
ID: 20088208
This answer goes above and beyond, thank you very much.

I have only found one problem, when I use this code, I get an error when I close the program. It reads as follows:

First chance exception at $7C812A5B. Exception class EInvalidOperation with message 'Control '' has no parent window'.  Process test.exe (2828)

It's not clear to me where/why this error is happening. Any suggestions?

PS: Point value has been doubled, thanks for all the help!
0
 
LVL 19

Accepted Solution

by:
MerijnB earned 1000 total points
ID: 20091438
here is the fixed version:

unit CheckListBoxFixer;

interface

uses CheckLst, Messages;

procedure FixChecklistBox(CheckListBox: TCheckListBox);

implementation

uses Contnrs, Windows, Classes;

type TChecklistBoxFixer = class(TObject)
     private
      fCheckListBox: TCheckListBox;
      fPrevWndProc: Pointer;

      procedure NewWndProc(Var Message: TMessage);
     public
      constructor Create(CheckListBox: TCheckListBox); reintroduce;
      destructor Destroy; override;
     end;

var Fixes: TObjectList;

procedure FixChecklistBox(CheckListBox: TCheckListBox);
begin
 Fixes.Add(TChecklistBoxFixer.Create(CheckListBox));
end;

{ TChecklistBoxFixer }

constructor TChecklistBoxFixer.Create(CheckListBox: TCheckListBox);
begin
 inherited Create();

 fCheckListBox := CheckListBox;
 fPrevWndProc := Pointer(GetWindowLong(fCheckListBox.Handle, GWL_WNDPROC));
 SetWindowLong(fCheckListBox.Handle, GWL_WNDPROC, integer(MakeObjectInstance(NewWndProc)));
end;

destructor TChecklistBoxFixer.Destroy;
begin
 if assigned(fCheckListBox.Parent) then
  SetWindowLong(fCheckListBox.Handle, GWL_WNDPROC, integer(fPrevWndProc));

 inherited;
end;

procedure TChecklistBoxFixer.NewWndProc(var Message: TMessage);
begin
 Message.Result := CallWindowProc(fPrevWndProc, fCheckListBox.Handle, Message.Msg, Message.WParam, Message.LParam);

 if (Message.Msg = WM_HSCROLL) and (GetScrollPos(fCheckListBox.Handle, SB_HORZ) < 15) then
  fCheckListBox.Invalidate();
end;

initialization
 Fixes := TObjectList.Create();

finalization
 Fixes.Free();

end.
back to top
0

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

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…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Loops Section Overview
Enter Foreign and Special Characters Enter characters you can't find on a keyboard using its ASCII code ... and learn how to make a handy reference for yourself using Excel ~ Use these codes in any Windows application! ... whether it is a Micr…
Suggested Courses
Course of the Month11 days, 4 hours left to enroll

572 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