Вопросы и ответы - Delphi - VCL, написание и доработка компонентов - Библиотека программиста
Пользователь

Добро пожаловать,

Регистрация или входРегистрация или вход
Потеряли пароль?Потеряли пароль?

Ник:
Пароль:

Меню сайта




Ваше мнение
Оцените скорость загрузки страниц сайта

Реактивная
Быстрая
Нормальная
Неважная
Медленная
Черепашья


Результаты
Другие опросы

Всего голосов: 925
Комментарии: 4


Наши партнеры



Статистика




Programming books  Download software  Documentation  Scripts  Content Managment Systems(CMS)  Templates  Icon Sets  Articles  Contacts  Voting  Site Search




Вопросы и ответы - Delphi - VCL, написание и доработка компонентов

                  
 
CheckBox в DBGrid
Код
procedure DrawGridCheckBox(Canvas: TCanvas; Rect: TRect; Checked: boolean);

var

DrawFlags: Integer;

begin

Canvas.TextRect(Rect, Rect.Left + 1, Rect.Top + 1, ' ');

DrawFrameControl(Canvas.Handle, Rect, DFC_BUTTON, DFCS_BUTTONPUSH or DFCS_ADJUSTRECT);

DrawFlags := DFCS_BUTTONCHECK or DFCS_ADJUSTRECT;// DFCS_BUTTONCHECK

if Checked then

DrawFlags := DrawFlags or DFCS_CHECKED;

DrawFrameControl(Canvas.Handle, Rect, DFC_BUTTON, DrawFlags);

end;


На событие OnDrawColumnCell повесьте вызов процедуры DrawGridCheckBox():

Код
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

if Column.FieldName = 'WEIGHT' then // Модифицируйте под себя

if Column.Field.AsInteger > 10 then

DrawGridCheckBox(DBGrid1.Canvas, Rect, true)

else

DrawGridCheckBox(DBGrid1.Canvas, Rect, false)

end;



Кроме этого, для скрытия текста в ячейках с CheckBox-ом от отображения значения при вводе с клавиатуры определите реакцию на событие OnColumnEnter:

Код
procedure TfrmMain.DBGrid1ColEnter(Sender: TObject);

begin

with TDBGrid(Sender) do

if SelectedField.FieldName = 'Weight' then // Модифицируйте под себя

Options := Options - [dgEditing]

else

Options := Options + [dgEditing]

end;

Drag and Drop - как использовать ItemAtPos для получения элемента DirListBox
Просто сохраните результат функции ItematPos в переменной формы, и затем используйте эту переменную в обработчике ListBoxDragDrop. Пример:

Код
FDragItem := ItematPos(X, Y, True);

if FDragItem >= 0 then

BeginDrag(false);

...



procedure TForm1.ListBoxDragDrop(Sender, Source: TObject; X, Y: Integer);

begin

if Source is TDirectoryListBox then

ListBox.Items.Add(TDirectoryListBox(Source).GetItemPath(FDragItem));

end;
Drag and Drop TImage
Вот рабочий пример. Расположите на форме панель побольше, скопируйте и измените приведенный код так, чтобы изображение загружалось из ВАШЕГО каталога Delphi.

Код
procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);

begin

with Source as TImage do

begin

Left := X;

Top := Y;

end;

end;



procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

Accept := Source is TImage;

end;



procedure TForm1.FormCreate(Sender: TObject);

begin

with TImage.Create(Self) do

begin

Parent := Panel1;

AutoSize := True;

Picture.LoadFromFile('D:DELPHIIMAGESCHIP.BMP');

DragMode := dmAutomatic;

OnDragOver := Panel1DragOver;

OnDragDrop := Panel1DragDrop;

end;

end;
Drag and Drop в TOutline
Проблема заключается в том, что прежде, чем windows сможет обработать сообщение WM_MouseUp, курсор мыши передвинется дальше. Вот решение этой головоломки:

Разрешите Windows как можно скорее обработатывать события мыши:
Код
OnMouseDown:

BeginDrag(False);

while ... do

begin

Application.ProccessMessages; { это позволяет Windows обработать }

{ все сообщения за один шаг }

end;



  • Обратите пристальное внимание при создании цикла, если вы используете цикл типа 'while', то вы должны предусмотреть возможность выхода из него, например, при закрытии приложения, или других действий пользователя, требующих экстренного выхода из тела цикла.

  • Drag and Drop для двух компонентов TOutline
    Код
    unit Unit1;



    interface



    uses



    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

    Forms, Dialogs, Grids, Outline;



    type



    TForm1 = class(TForm)

    Outline1: TOutline;

    Outline2: TOutline;

    procedure OutlineDragDrop(Sender, Source: TObject; X, Y: Integer);

    procedure OutlineMouseDown(Sender: TObject; Button: TMouseButton;

    Shift: TShiftState; X, Y: Integer);

    procedure OutlineDragOver(Sender, Source: TObject; X, Y: Integer;



    State: TDragState; var Accept: Boolean);

    private

    { Private declarations }

    public

    { Public declarations }

    end;



    var



    Form1: TForm1;



    implementation



    {$R *.DFM}



    procedure TForm1.OutlineDragDrop(Sender, Source: TObject; X, Y: Integer);

    begin



    with Sender as TOutline do

    begin

    AddChild(GetItem(x, y),

    TOutline(Source).Items[TOutline(Source).SelectedItem].Text);

    end;



    end;



    procedure TForm1.OutlineMouseDown(Sender: TObject; Button: TMouseButton;



    Shift: TShiftState; X, Y: Integer);

    begin



    if Button = mbLeft then

    with Sender as TOutline do

    begin

    if GetItem(x, y) >= 0 then

    BeginDrag(False);

    end;

    end;



    procedure TForm1.OutlineDragOver(Sender, Source: TObject; X, Y: Integer;



    State: TDragState; var Accept: Boolean);

    begin

    if (Source is TOutline) and (TOutline(Source).GetItem(x, y) <>

    TOutline(Source).SelectedItem) then

    Accept := True

    else

    Accept := False;

    end;

    end.
    Drag and Drop из RichEdit
    Код
    var

    Form1: TForm1;

    richcopy: string;

    transfering: boolean;

    implementation



    {$R *.DFM}



    procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;

    Shift: TShiftState; X, Y: Integer);

    begin

    if length(richedit1.seltext)>0 then begin

    richcopy:=richedit1.seltext;

    transfering:=true;

    end; //seltext

    end;



    procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

    Y: Integer);

    begin

    if transfering then begin

    transfering:=false;

    listbox1.items.add(richcopy);

    end; //transfering

    end;
    Drag and Drop из TScrollBox
    Вы можете написать общую функцию для отдельного TImage, и назначать этот метод для каждого динамически создаваемого TImage, примерно так:

    Код
    procedure TForm1.GenericMouseDown(Sender: TObject; Button: TMouseButton;

    Shift: TShiftState; X, Y: Integer);

    begin

    TImage(Sender).BeginDrag(False);

    {что-то другое, что вы хотели бы сделать}

    end;



    {....}



    UmpteenthDynImage := TImage.Create(dummyImage);

    UmpteenthDynImage.MouseDown := TForm1.GenericMouseDown;
    Drag and Drop несколько элементов в TListView
    Код
    { ListView1.DragMode := dmAutomatic }



    procedure TForm1.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);

    var

    DragItem, DropItem, CurrentItem, NextItem: TListItem;

    begin

    if Sender = Source then

    with TListView(Sender) do

    begin

    DropItem := GetItemAt(X, Y);

    CurrentItem := Selected;

    while CurrentItem <> nil do

    begin

    NextItem := GetNextItem(CurrentItem, SdAll, [IsSelected]);

    if DropItem = nil then DragItem := Items.Add

    else

    DragItem := Items.Insert(DropItem.Index);

    DragItem.Assign(CurrentItem);

    CurrentItem.Free;

    CurrentItem := NextItem;

    end;

    end;

    end;



    procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;

    State: TDragState;

    var Accept: Boolean);

    begin

    Accept := Sender = ListView1;

    end;
    Edit с возможностью автоматического выбора
    ...маленький компонент THintEdit, порожденный от TCustomEdit, который представляет собой с виду обычный TEdit элемент с возможностью автоматического выбора стринговых значений из скрытого списка (так, как это реализовано в Netscape Navigator'е). Описание особенно не нужно, так как выполнено все достаточно элементарно: значения для выбора заносятся в свойство HintList, тип свойства TStrings. При нажатии клавиш вверх/вниз выбираются значения, соответствующие набранным начальным символам.

    Код
    unit HintEdit;



    interface



    uses

    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

    StdCtrls;



    type

    THintEdit = class(TCustomEdit)

    private

    { Private declarations }

    FHintList: TStrings;

    Searching,

    CanSearch: boolean;

    CurSPos: integer;

    protected

    { Protected declarations }

    procedure Change; override;

    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

    public

    { Public declarations }

    constructor Create(AOwner: TComponent); override;

    property HintList: TStrings read FHintList write FHintList;

    destructor Destroy; override;

    published

    { Published declarations }

    property Anchors;

    property AutoSelect;

    property AutoSize;

    property BiDiMode;

    property BorderStyle;

    property CharCase;

    property Color;

    property Constraints;

    property Ctl3D;

    property DragCursor;

    property DragKind;

    property DragMode;

    property Enabled;

    property Font;

    property HideSelection;

    property ImeMode;

    property ImeName;

    property MaxLength;

    property OEMConvert;

    property ParentBiDiMode;

    property ParentColor;

    property ParentCtl3D;

    property ParentFont;

    property ParentShowHint;

    property PasswordChar;

    property PopupMenu;

    property ReadOnly;

    property ShowHint;

    property TabOrder;

    property TabStop;

    property Text;

    property Visible;

    property OnChange;

    property OnClick;

    property OnDblClick;

    property OnDragDrop;

    property OnDragOver;

    property OnEndDock;

    property OnEndDrag;

    property OnEnter;

    property OnExit;

    property OnKeyDown;

    property OnKeyPress;

    property OnKeyUp;

    property OnMouseDown;

    property OnMouseMove;

    property OnMouseUp;

    property OnStartDock;

    property OnStartDrag;

    end;



    procedure Register;



    implementation



    {$R *.DCR}



    procedure Register;

    begin

    RegisterComponents('Netscape', [THintEdit]);

    end;



    constructor THintEdit.Create;

    begin

    inherited;

    FHintList := TStringList.Create;

    Searching := false;

    CanSearch := true;

    CurSPos := -1;

    end;



    procedure THintEdit.Change;

    var

    i, l: integer;

    begin

    if Searching then

    Exit;

    if not CanSearch then

    Exit;

    if Text = '' then

    exit;

    l := Length(Text);

    for i := 0 to FHintList.Count - 1 do

    if Copy(FHintList[i], 1, l) = Text then

    begin

    Searching := true;

    CurSPos := i;

    Text := FHintList[i];

    Searching := false;

    SelStart := Length(Text);

    SelLength := -(Length(Text) - l);

    break;

    end;

    inherited;

    end;



    procedure THintEdit.KeyDown;

    var

    l: integer;

    begin

    if Chr(Key) in ['A'..'z', 'А'..'Я', 'а'..'я'] then

    CanSearch := true

    else

    CanSearch := false;

    case Key of

    VK_DOWN:

    begin

    if (CurSPos < HintList.Count - 1) and (SelLength > 0) then

    if Copy(FHintList[CurSPos + 1], 1, SelStart) = Copy(Text, 1, SelStart)

    then

    begin

    l := SelStart;

    Inc(CurSPos);

    Text := FHintList[CurSPos];

    SelStart := Length(Text);

    SelLength := -(Length(Text) - l);

    end;

    Key := VK_RETURN;

    end;

    VK_UP:

    begin

    if (CurSPos > 0) and (SelLength > 0) then

    if Copy(FHintList[CurSPos - 1], 1, SelStart) = Copy(Text, 1, SelStart)

    then

    begin

    l := SelStart;

    Dec(CurSPos);

    Text := FHintList[CurSPos];

    SelStart := Length(Text);

    SelLength := -(Length(Text) - l);

    end;

    Key := VK_RETURN;

    end;

    VK_RETURN:

    begin

    SelStart := 0;

    SelLength := Length(Text);

    end;

    end;

    inherited;

    end;



    destructor THintEdit.Destroy;

    begin

    FHintList.Free;

    inherited;

    end;








    ©Drkb::00968

    http://delphiworld.narod.ru/

    DelphiWorld 6.0



    Подстановка в TEdit





    Code:

    var

    words: TStringList;



    procedure TForm1.FormCreate(Sender: TObject);

    begin

    words := TStringList.Create;

    words.Sorted := true;

    words.Add('one');

    words.Add('two');

    words.Add('four');

    words.Add('five');

    words.Add('six');

    words.Add('seven');

    words.Add('eight');

    words.Add('nine');

    words.Add('ten');

    end;



    procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word;

    Shift: TShiftState);

    const

    chars: set of char = ['A'..'Z', 'a'..'z', 'А'..'Я', 'а'..'я'];

    var

    w: string;

    i: integer;

    s: string;

    full: string;

    SelSt: integer;

    begin

    case Key of

    VK_RETURN, VK_TAB:

    begin

    Edit1.SelStart := Edit1.SelStart + Edit1.SelLength;

    Edit1.SelLength := 0;

    Exit;

    end;

    VK_DELETE, VK_BACK:

    begin

    Edit1.ClearSelection;

    Exit;

    end;

    end;

    s := Edit1.Text;

    SelSt := Edit1.SelStart;

    i := SelSt;

    if (length(s) > i) and (s[i+1] in chars) then

    Exit;

    w := '';

    while (i >= 1) and (s[i] in chars) do

    begin

    w := s[i] + w;

    dec(i);

    end;

    if length(w) <= 0 then

    Exit;

    words.Find(w, i);

    if (i >= 0) and (UpperCase(copy(words[i], 1,

    length(w))) = UpperCase(w)) then

    begin

    full := words[i];

    insert(copy(full, length(w) + 1, length(full)), s, SelSt + 1);

    Edit1.Text := s;

    Edit1.SelStart := SelSt;

    Edit1.SelLength := length(full) - length(w);

    end;

    end;

    OwnerDraw в компоненте StatusBar
    Код
    procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;

    Panel: TStatusPanel; const Rect: TRect);

    begin

    with statusbar1.Canvas do

    begin

    Brush.Color := clRed;

    FillRect(Rect);

    TextOut(Rect.Left, Rect.Top, 'Панель '+IntToStr(Panel.Index));

    end;

    end;

    ProgressBar в колонке TListView
    Код
    procedure TForm1.Button1Click(Sender: TObject);

    var

    r: TRect;

    pb: TProgressBar;

    begin

    Listview1.Columns.Add.Width := 100;

    Listview1.Columns.Add.Width := 200;

    Listview1.ViewStyle := vsReport;

    Listview1.Items.Add.Caption := 'Text';



    r := Listview1.Items[0].DisplayRect(drBounds);

    r.Left := r.Left + Listview1.columns[0].Width;

    r.Right := r.Left + Listview1.columns[1].Width;



    pb := TProgressBar.Create(Self);

    pb.Parent := Listview1;

    pb.BoundsRect := r;

    pb.Position := 30;

    Listview1.Items[0].Data := pb;

    end;





    // Change the ProgressBar Position

    // ProgressBar Position andern



    procedure TForm1.Button2Click(Sender: TObject);

    var

    pb: TProgressBar;

    begin

    pb := TProgressBar(Listview1.Items[0].Data);

    pb.StepIt;

    end;
    ProgressBar с заставки Windows XP
    Код
    {

    Use this ProgressBar when you do not know the amount of progress toward

    completion but wish to indicate that progress is being made.



    This ProgressBar works only on Windows XP and the ComCtl32.dll version

    6.00 or later is needed. To use the new ComCtrl you have to provide the manifest.

    In Delphi 7 just drop TXPManifest on the form. For prior versions of Delphi

    you have to include the XP manifest resource.

    }





    unit MarqueeProgressBar;



    interface



    uses

    SysUtils, Windows, Classes, Controls, ComCtrls, Messages;



    type

    TMarqueeProgressBar = class(TProgressBar)

    private

    FActive: Boolean;

    FAnimationSpeed: Integer;

    procedure SetActive(const Value: Boolean);

    procedure SetAnimationSpeed(const Value: Integer);

    procedure UpdateProgressBar;

    protected

    procedure CreateParams(var Params: TCreateParams); override;

    public

    constructor Create(AOwner: TComponent); override;

    published

    property Active: Boolean read FActive write SetActive;

    property AnimationSpeed: Integer read FAnimationSpeed write SetAnimationSpeed;

    end;



    const

    PBS_MARQUEE = $08;

    PBM_SETMARQUEE = WM_USER + 10;



    procedure Register;



    implementation



    procedure Register;

    begin

    RegisterComponents('SwissDelphiCenter', [TMarqueeProgressBar]);

    end;



    constructor TMarqueeProgressBar.Create(AOwner: TComponent);

    begin

    inherited;

    FAnimationSpeed := 60;

    end;



    procedure TMarqueeProgressBar.CreateParams(var Params: TCreateParams);

    begin

    inherited;

    Params.Style := Params.Style or PBS_MARQUEE;

    end;



    procedure TMarqueeProgressBar.SetActive(const Value: Boolean);

    begin

    FActive := Value;

    UpdateProgressBar;

    end;



    procedure TMarqueeProgressBar.SetAnimationSpeed(const Value: Integer);

    begin

    FAnimationSpeed := Value;

    UpdateProgressBar;

    end;



    procedure TMarqueeProgressBar.UpdateProgressBar;

    begin

    if FActive then

    SendMessage(Self.Handle, PBM_SETMARQUEE, 1, FAnimationSpeed)

    else

    SendMessage(Self.Handle, PBM_SETMARQUEE, 0, 0);

    end;



    end.
    ProgressBar с невидимой рамкой
    Заказчик моего проекта обратился с просьбой - "Сделать прогресс индикатор как в приложениях Нортона. Чтоб был в статус строке и НИКАКИХ рамок". ProgressBar в StatusBar - нет проблем, но как быть с рамкой от ProgressBar? ProgressBar всегда вычерчивает рамку и не имеет методов ее управления. Однако появилась интересная идея, воплотившаяся в компонент с новым свойством ShowFrame. Решение оказалось на удивление простым. На рисунке сравнение стандартного ProgressBar и ProgressBar с невидимой рамкой.

    Код
    unit vsprgs;



    interface



    uses

    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

    ComCtrls;



    type

    TNProgressBar = class(TProgressBar)

    procedure WMNCPAINT(var Msg: TMessage); message WM_NCPAINT;

    private

    FShowFrame: boolean;

    procedure SetShowFrame(Value: boolean);

    protected

    public

    constructor Create(AOwner: TComponent); override;

    published

    property ShowFrame: boolean read FShowFrame write SetShowFrame;

    end;



    procedure Register;



    implementation

    { TNProgressBar }



    constructor TNProgressBar.Create(AOwner: TComponent);

    begin

    inherited;

    FShowFrame := True;

    end;



    procedure TNProgressBar.SetShowFrame(Value: boolean);

    begin

    if FShowFrame <> Value then

    begin

    FShowFrame := Value;

    RecreateWnd;

    end;

    end;



    procedure TNProgressBar.WMNCPAINT(var Msg: TMessage);

    var

    DC: HDC;

    RC: TRect;

    begin

    if ShowFrame then

    begin

    inherited;

    Invalidate;

    end

    else

    begin

    DC := GetWindowDC(Handle);

    try

    Windows.GetClientRect(Handle, RC);

    with RC do

    begin

    Inc(Right, 2);

    Inc(Bottom, 2);

    end;

    Windows.FillRect(DC, RC, Brush.Handle);

    finally

    ReleaseDC(Handle, DC);

    end;

    end;

    end;



    procedure Register;

    begin

    RegisterComponents('Controls', [TNProgressBar]);

    end;



    end.
    ProgressBar, который не отображают реального прогресса
    Начиная с WinХР появились в системе забавные ProgressBar'ы, которые не отображают реального "прогресса", а лишь отображают, что что-нибудь работает... такой же появляется при загрузки виндыХР (бегает пару чёрточек слева вправо, а потом обратно возвращаются в начало). Такой же прогресс отображается если в ХР выбрать изображение, в меню нажать на Print (Печать), и вэтом диалоге при выборе шаблона печати - тоже такого стиля есть прогресс. (надеюсь, что теперь ясно что я имел в виду ).

    И сам вопрос: как такой сделать на делфи?

    Код
    const

    PBS_MARQUEE = $08;

    PBM_SETMARQUEE = WM_USER+10;



    ...



    with ProgressBar1 do

    begin

    SetWindowLong (Handle, GWL_STYLE, (GetWindowLong (Handle, GWL_STYLE) or PBS_MARQUEE));

    Perform(PBM_SETMARQUEE, 1, 50);

    end;


    PS: чтобы это работало, нужно включить в прогу XP-манифест
    StatusBar с другими контролами
    Этот StatusBar позволит размещать на себе любые другие контролы.

    Создаем новый компонент от StatusBar и првим код как внизу. Потом инсталлируем и все.

    Код
    unit StatusBarExt;



    interface



    uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls;



    type

    TStatusBarExt = class(TStatusBar)

    public

    constructor Create(AOwner: TComponent); override; // добавить конструктор

    end;



    procedure Register;



    implementation



    uses Consts; // не забыть



    constructor TStatusBarExt.Create( AOwner : TComponent );

    begin

    inherited Create(AOwner);

    ControlStyle := ControlStyle + [csAcceptsControls]; // собственно все!

    end;



    procedure Register;

    begin

    RegisterComponents('Samples', [TStatusBarExt]);

    end;



    end.
    TDateTimePicker в StringGrid
    Код
    unit Unit1;



    interface



    uses

    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

    Dialogs, StdCtrls, Grids, ComCtrls;



    type

    TForm1 = class(TForm)

    StringGrid1: TStringGrid;

    DateTimePicker1: TDateTimePicker;

    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;

    var CanSelect: Boolean);

    procedure FormCreate(Sender: TObject);

    procedure StringGrid1Exit(Sender: TObject);

    procedure DateTimePicker1Exit(Sender: TObject);

    end;



    var

    Form1: TForm1;



    implementation



    {$R *.dfm}



    procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,

    ARow: Integer; var CanSelect: Boolean);

    var

    D: TDateTime;

    begin

    DateTimePicker1.Visible := True;

    DateTimePicker1.BoundsRect := StringGrid1.CellRect(ACol, ARow);

    D := DateTimePicker1.DateTime;

    TryStrToDateTime(StringGrid1.Cells[ACol, ARow], D);

    DateTimePicker1.DateTime := D;

    DateTimePicker1.SetFocus;

    end;



    procedure TForm1.FormCreate(Sender: TObject);

    begin

    DateTimePicker1.Parent := StringGrid1;

    DateTimePicker1.Visible := False;

    DateTimePicker1.OnExit := DateTimePicker1Exit;



    StringGrid1.OnSelectCell := StringGrid1SelectCell;

    end;



    procedure TForm1.StringGrid1Exit(Sender: TObject);

    begin

    DateTimePicker1.Visible := False;

    end;



    procedure TForm1.DateTimePicker1Exit(Sender: TObject);

    begin

    with StringGrid1 do

    Cells[Col, Row] := DateTimeToStr(DateTimePicker1.DateTime);

    end;



    end.
    TDBGrid с номером строки
    Код
    unit RowGrid;

    interface

    uses
    WinTypes, WinProcs, Classes, Grids, DBGrids;

    type
    TRowDBGrid = class(TDBGrid)
    public
    property Row;
    property RowCount;
    property VisibleRowCount;
    end;

    procedure Register;

    implementation

    procedure Register;
    begin
    RegisterComponents('Data Controls', [TRowDBGrid]);
    end;

    end.



    {вот небольшой испытательный демо-проект.. мы
    поместили на форму нашу сетку-наследницу, 3 компонента
    EditBox и поместили следующий код в обработчик события
    ondrawdatacell вашего TRowGrid}
    procedure TForm1.RowDBGrid1DrawDataCell(Sender: TObject; const Rect:
    TRect; Field: TField; State: TGridDrawState);
    begin
    eb_row.text := inttostr(rowdbgrid1.row);
    eb_rowcount.text := inttostr(rowdbgrid1.rowcount);
    eb_visiblerowcount.text := inttostr(rowdbgrid1.visiblerowcount);
    end;
    TDBNavigator без иконок
    Код
    var
    c: shortint;
    s: string;
    begin
    s := 'A';
    with DBNavigator1 do
    for c := 0 to ControlCount - 1 do
    if Controls[c] is TNavButton then
    with TNavButton(Controls[c]) do
    begin
    ListBox1.Items.Add(Name);
    Glyph := nil;
    Caption := s;
    Inc(s[1]);
    end;
    end;
    TStatusBar+TProgressBar
    Вставить ProgressBar в StatusBar:

    Вот эту функцию применять вместо стандартного Create

    Код
    Function CreateProgressBar(StatusBar:TStatusBar; index:integer):TProgressBar;

    var findleft:integer;

    i:integer;

    begin

    result:=TProgressBar.create(Statusbar);

    result.parent:=Statusbar;

    result.visible:=true;

    result.top:=2;

    findleft:=0;

    for i:=0 to index-1 do

    findleft:=findleft+Statusbar.Panels[i].width+1;

    result.left:=findleft;

    result.width:=Statusbar.Panels[index].width-4;

    result.height:=Statusbar.height-2;

    end;
    Автоматический формат даты в компоненте Edit
    Код
    procedure TForm1.Edit1Exit(Sender: TObject);

    begin

    if Edit1.Text <> '' then

    begin

    try

    StrToDate(Edit1.Text);

    except

    Edit1.SetFocus;

    MessageBeep(0);

    raise Exception.Create('"' + Edit1.Text

    + '" - некорректная дата');

    end {try};

    Edit1.Text := DateToStr(StrToDate(Edit1.Text));

    end {if};

    end;



    Печать страницы
    Печать страницы




    Внимание! Если у вас не получилось найти нужную информацию, используйте рубрикатор или воспользуйтесь поиском


    .



    книги по программированию исходники компоненты шаблоны сайтов C++ PHP Delphi скачать