Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > избавиться от ScrollBar


Автор: Teleport 26.9.2008, 15:18
Нашел код, как избавиться от ScrollBar в DBGrid. 
Но ScrollBar не исчезает, а постоянно мигает. Как вообще удалить ScrollBar? Вот код, который делает "почти" то что мне нужно...
Код

type
  TNoScrollBarDBGrid = class(TDBGrid)
  protected
    procedure Paint; override;
end;

procedure register;

implementation

procedure register;
begin
  RegisterComponents('Samples', [TNoScrollBarDBGrid]);
end;

{ TNoScrollBarDBGrid }

procedure TNoScrollBarDBGrid.Paint;
begin
  SetScrollRange(Handle, SB_VERT, 0, 0, false);
  inherited;
end;



Справка в 2007 делфи чет не помогла... кучу функций scrollbar 'a перепробовал - и ничего...

Автор: THandle 26.9.2008, 15:31
http://msdn.microsoft.com/en-us/library/bb787601(VS.85).aspx


Код

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowScrollBar(DBGrid1.Handle, SB_VERT, false);
end;



Это?

Автор: Teleport 26.9.2008, 15:52
2 THandle - это работает, тоже самое и в моем коде выше. Но вот в чем проблема! Когда DBGrid заполняется значениями, то ScrollBar снова появляется! Каждый раз на кнопку нажимать - не очень как-то smile Пробовал засунуть в ONPaint - мигает постоянно этот ScrollBar. Быстренька нарисуется и исчезнет... Как его вообще убрать? smile 
Подозреваю, что функция EnableScrollBar.... но только не берется она почему-то...

Добавлено через 6 минут и 39 секунд
не, не та функция...

Автор: THandle 26.9.2008, 17:19
Teleport, выложи тестовый проектик. Воспроизводить самому это не хочется smile А так посмотрим что можно придумать... Выходные на носу smile

Автор: Teleport 26.9.2008, 18:15
вот тестовый проектик  smile))

а вот, совет мне дали...
Цитата

Нужные нам свойства существуют, но вынесены в секцию Protected предка DBGrid: TCustomGrid. 
Наиболее правильным способом было бы создание класса наследника от TDBGrid с выводом ScrollBars в 
секцию Public...

Автор: THandle 26.9.2008, 21:37
Teleport, пока ничего лучше вышепредложенных вариантов не могу предоставить.

Вот так, если дважды скрывать:
Код


procedure TForm1.Button1Click(Sender: TObject);
begin
  adotable1.Append;
  adotable1nomer.Value:= Edit1.Text;
  adotable1Color.Value:= Edit2.Text;
  ShowScrollBar(DBGrid1.Handle, SB_VERT, false);
  adotable1.Edit;
  adotable1.Post;
  ShowScrollBar(DBGrid1.Handle, SB_VERT, false);
end;


Практически не заметно мельканий. Но они есть :(

Тоже самое и со штуками типа:

http://forum.vingrad.ru/faq/topic-156385/hl/dbgrid++scrollbars/index.html


Есть пока мысли ка то на время запрещать отрисовку грида или же нафик удалить оттуда ScrollBars.
На выходных подумаю если время будет. Сейчас только пару часиков смог проблеме уделить.

Порыл гугль - там ничего нет. Все решения с мерцанием. Но выход должен быть smile

Если кто то знает решение - просьба выложить - интересно smile))

Автор: Teleport 26.9.2008, 22:52
мне был предложен следующий вариант создание нового контрола:
Код

type
   TMyGrid = class(TDBGrid)
   protected
      procedure UpdateScrollBar; override;
   public
      constructor Create(Owner:TComponent); override;
   end;

constructor TMyGrid.Create(Owner:TComponent);
begin
   inherited Create(Owner);
   ScrollBars := ssNone;
end;

procedure TMyGrid.UpdateScrollBar;
begin
    // ничего не делаем и не вызываем метода предка
end;


но вот не могу проверить - так как ssNone не компилируется... :(
может какого uses не хватает?

Добавлено через 43 секунды
Цитата

нафик удалить оттуда ScrollBars.
 - самое оно будет )))))))))))))))))))

Добавлено через 3 минуты и 16 секунд
Цитата

http://forum.vingrad.ru/faq/topic-156385/h...bars/index.html
 - слово в слово мне писали это же самое..., но это, к сожалению, не решение. Так как мигание остается...

Автор: THandle 27.9.2008, 10:17
Цитата(Teleport @  26.9.2008,  23:52 Найти цитируемый пост)
но вот не могу проверить - так как ssNone не компилируется... :(
может какого uses не хватает?


UpdateScrollBar в TCustomDBGrid является приватным методом...

Цитата(Teleport @  26.9.2008,  23:52 Найти цитируемый пост)
- самое оно будет )))))))))))))))))))


Самое оно конечно, но пока не придумал как это сделать smile

Автор: volvo877 27.9.2008, 11:09
Цитата(Teleport @  26.9.2008,  22:52 Найти цитируемый пост)
но вот не могу проверить - так как ssNone не компилируется... :(
Хм... Какая у тебя Дельфи?

Код

type
  TDBGrid = class(DBGrids.TDBGrid)
   protected
      procedure UpdateScrollBar; override;
   public
      constructor Create(Owner:TComponent); override;
  end;

  TForm1 = class(TForm)
  ...

// 

constructor TDBGrid.Create(Owner:TComponent);
begin
   inherited Create(Owner);
   ScrollBars := ssNone;
end;
procedure TDBGrid.UpdateScrollBar;
begin
    //
end;

...

нормально компилируется и работает (Delphi 2007, ибо теперь UpdateScrollBar - защищенный метод TCustomDBGrid)...

Автор: THandle 27.9.2008, 11:11
Teleport, решение есть...) Благодаря библиотеке, любезно предоставленной  http://forum.vingrad.ru/index.php?showuser=777&nickname=Rrader'ом ScrollBar исчезает. 

Работать будет всегда, если не изменять размеров DbGrid'a, иначе ScrollBar снова появится smile

Решение в аттаче.

Автор: Teleport 27.9.2008, 21:42
2 volvo877 - у меня не хватало модуля StdCtrls. А делфи - 2007.
 Вот текст нового контрола. Присваивать авторство не имею права, мне его полностью написали. smile
Код

unit MyDBGrid1;

interface

uses
  SysUtils, Classes, Controls, Grids, DBGrids, StdCtrls;

type
  TMyDBGrid = class(TDBGrid)
  private
    { Private declarations }
  protected
   procedure UpdateScrollBar; override;
    { Protected declarations }
  public
  constructor Create(Owner:TComponent); override;
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

constructor TMyDBGrid.Create(Owner:TComponent);
begin
   inherited Create(Owner);

   ScrollBars:= ssNone;
end;

procedure TMyDBGrid.UpdateScrollBar;
begin
    // ничего не делаем и не вызываем метода предка
end;

procedure Register;
begin
  RegisterComponents('Samples', [TMyDBGrid]);
end;

end.


в D2007 все работатет так как надо.

2 THandle - нука нука, ты всегда интересные решения предоставляешь, сейчас гляну твое. smile
Большое Спасибо тебе за помощь. Вопрос не на раз-два плюнуть... smile

Автор: Teleport 27.9.2008, 21:57
2 THandle - да, решение хорошее. smile Спасибо! Только вот один вопрос - исходный код библиотеки - нну очень интересно посмотреть... smile Это мне нужно непосредственно к автору библиотеки обращаться или выложен исходник где-то? smile

Автор: THandle 27.9.2008, 22:35
Teleport, завтра с автором поговорю smile

Попробуй положить на форму кнопку и в ней прописать:

Код

procedure TForm1.Button4Click(Sender: TObject);
begin
  SetScrollRange(DBGrid1.Handle, SB_VERT, 0, 0, False);
end;


Это сработает. Все скроется и при добавлении/удалении данных из грида не появится. но при растягивании ячеек за пределы(можно отследить чтоб этого не было...) опять скроллбар появится.


Teleport, данное решение ко мне относится не очень большим образом, поэтому, раз уж мне плюс, то просьба и rrader'у его поставить. Проблема не моя все таки...

Автор: THandle 28.9.2008, 00:13
Не знаю что там rrader писал, но у меня вот что получилось:
Код


library dllsh;

uses
  Windows;

{$R *.res}
type
  TOldCode = packed record
    FOne: Cardinal;
    FTwo: Word;
  end;

  TJmp = packed record
    FPOp: Byte;
    FAddr: Pointer;
    FRetOp: Byte;
  end;

var
  SSRAddress: Pointer;
  OldCode: TOldCode;
  Jmp: TJmp;

function NewSetScrollRange(HWND: HWND; nScroll: Integer;
  nMinPos: Integer; nMaxPos: Integer; bRedraw: BOOL): BOOL; stdcall;
begin
  // А я нифига не делаю))
end;


procedure SetHook;
var
  hKernel32: Cardinal;
  Bytes: Cardinal;
begin
  hKernel32 := GetModuleHandle('user32.dll');
  SSRAddress  := GetProcAddress(hKernel32, 'SetScrollRange');
  ReadProcessMemory(INVALID_HANDLE_VALUE, SSRAddress,
    @OldCode, SizeOf(TOldCode), Bytes);
  Jmp.FPOp := $68;
  Jmp.FAddr := @NewSetScrollRange;
  Jmp.FRetOp := $C3;
  WriteProcessMemory(INVALID_HANDLE_VALUE, SSRAddress, @Jmp,
    SizeOf(TJmp), Bytes);
end;

procedure UnHook;
var
  Bytes: Cardinal;
begin
  WriteProcessMemory(INVALID_HANDLE_VALUE, SSRAddress, @OldCode,
    SizeOf(OldCode), Bytes);
end;

function MessageProc(Code: Integer; wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall;
begin
  CallNextHookEx(0, Code, wParam, lParam);
  Result := 0;
end;

procedure SetGlobalHookProc;
begin
  SetWindowsHookEx(WH_GETMESSAGE, @MessageProc, HInstance, 0);
  Sleep(INFINITE);
end;

procedure SetGlobalHook();
var
  hMutex: Cardinal;
begin
  hMutex := CreateMutex(nil, False, 'DBGridScrollBarHook');
  if GetLastError = 0 then
    CreateThread(nil, 0, @SetGlobalHookProc, nil, 0, PLongWord(nil)^)
  else
    CloseHandle(hMutex);
end;

procedure BlockScrollBar(Window: HWND);
begin
  SetScrollRange(Window, SB_VERT, 0, 0, false);
  SetGlobalHook;
  SetHook;
end;


exports
  BlockScrollBar;

begin
end.



Ну и вот код того примера собсно говоря(то есть меняем на мою библиотеку):
Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ADODB, DB, Grids, StdCtrls, DBCtrls, Mask, DBGrids;

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    ADOTable1nomer: TWideStringField;
    ADOTable1DSDesigner: TAutoIncField;
    ADOTable1color: TWideStringField;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

procedure BlockScrollBar(Window: HWND); external 'dllsh.dll';

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  AdoTable1.Append;
  AdoTable1Nomer.Value:= Edit1.Text;
  AdoTable1Color.Value:= Edit2.Text;
  AdoTable1.Edit;
  AdoTable1.Post;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  AdoTable1.DeleteRecords(arCurrent);
  AdoTable1.Edit;
  AdoTable1.Post;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  BlockScrollBar(DBGrid1.Handle);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  SetScrollRange(DBGrid1.Handle, SB_VERT, 0, 0, False);
end;

end.



Ну у меня так вот получилось smile

Автор: Rrader 28.9.2008, 05:58
THandle,  smile 

1) Зачем хуки? smile 
2) Процедура UnHook никогда не вызывается.
3) Результат NewSetScrollRange не определен.
Код

library ScrollHunter;

uses Windows, Messages;

{$R *.res}

type
  OldCode = packed record
    One: Cardinal;
    Two: Word;
   end;

  FarJmp = packed record
    PuhsOp: Byte;
    PushArg: Pointer;
    RetOp: Byte;
   end;

var
  { SetScrollRange }
  JmpSSR: FarJmp;
  OldSSR: OldCode;
  SSRAdr: Pointer = NIL; 
  Wnd: HWND;

function TrueSetScrollRange(hWnd: HWND; nBar,
  nMinPos, nMaxPos: Integer; bRedraw: BOOL): BOOL; stdcall;
begin
  WriteProcessMemory(INVALID_HANDLE_VALUE, SSRAdr,
    @OldSSR, SizeOf(OldCode), PCardinal(NIL)^);
  Result := SetScrollRange(hWnd, nBar, nMinPos, nMaxPos, bRedraw);
  WriteProcessMemory(INVALID_HANDLE_VALUE, SSRAdr,
    @JmpSSR, SizeOf(FarJmp), PCardinal(NIL)^);
end;

function NewSetScrollRange(hWnd: HWND; nBar,
  nMinPos, nMaxPos: Integer; bRedraw: BOOL): BOOL; stdcall;
begin
  if (hWnd = Wnd) then
  begin
    nMinPos := 0;
    nMaxPos := 0;
    bRedraw := False;
  end;
  Result := TrueSetScrollRange(hWnd, nBar, nMinPos, nMaxPos, bRedraw);
end;  

procedure DisableBars(AWnd: HWND);
var
  hUser32: Cardinal;
begin
  Wnd := AWnd;
  hUser32 := GetModuleHandle('user32.dll');
  SSRAdr  := GetProcAddress(hUser32, 'SetScrollRange');
  ReadProcessMemory(INVALID_HANDLE_VALUE, SSRAdr,
    @OldSSR, SizeOf(OldCode), PCardinal(NIL)^);
  JmpSSR.PuhsOp  := $68;
  JmpSSR.PushArg := @NewSetScrollRange;
  JmpSSR.RetOp   := $C3;
  WriteProcessMemory(INVALID_HANDLE_VALUE, SSRAdr, @JmpSSR,
    SizeOf(FarJmp), PCardinal(NIL)^);
  TrueSetScrollRange(Wnd, SB_VERT, 0, 0, False);  
end;

exports 
  DisableBars; 

begin
  Wnd := 0;
end.

Автор: THandle 28.9.2008, 09:32
Rrader, в час ночи просто потырил код из какой то темы smile Работает в принципе smile У тебя естественно правильней. Как всегда smile

Rrader, в очередной раз поражаюсь твоим знаниям... smile 

Автор: Teleport 28.9.2008, 12:14
Спасибо вам за замечательные решения. Знаний почерпнул в этой теме. smile
Конечно в предоставленных кодах еще много неясного... smile

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)