Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

Custom kontrola, gdje griješim?

[es] :: Pascal / Delphi / Kylix :: Custom kontrola, gdje griješim?

[ Pregleda: 2033 | Odgovora: 7 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

komplikator
Programer / sys. inženjering
CRO

Član broj: 29755
Poruke: 158
*.adsl.net.t-com.hr.

ICQ: 13387003


+8 Profil

icon Custom kontrola, gdje griješim?04.02.2011. u 11:09 - pre 160 meseci
Pozdrav svima!

Napravio sam custom kontrolu koja naslijeđuje TDBGrid. Ova moja bi trebala imati svojstva svijetlije, tamnije boje kolone i prikazivanja (boolean) za dbgrid obojan u "zebru".

No prema ovome jednostavno neće. Instaliram kontrolu, ona uredno radi kao običan dbgrid, vide se svojstva u inspectoru, ali ne farba grid. Jesam li negdje promašio u radu s eventima, vjerojatno jesam?

Code:

unit B8DBGrid;

interface

uses
  SysUtils, Classes, Controls, Grids, DBGrids, Types, Graphics;

type
  TZebra = Array [ boolean ] of TColor;

type
  TB8DBGrid = class( TDBGrid )
    private
      fZebra: TZebra;
      fZebraDark: TColor;
      fZebraLight: TColor;
      fShowZebra: boolean;
      fOnDrawColumnCell: TDrawColumnCellEvent;
      function getShowZebra: boolean;
      procedure setShowZebra( const Value: boolean );
      function getZebraDark: TColor;
      function getZebraLight: TColor;
      procedure setZebraDark( const Value: TColor );
      procedure setZebraLight( const Value: TColor );
    protected
      procedure DrawColumnCell( Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState );

    public

    published
      property ColorZebraLight: TColor read getZebraLight write setZebraLight;
      property ColorZebraDark: TColor read getZebraDark write setZebraDark;
      property ShowZebra: boolean read getShowZebra write setShowZebra Default True;
      property ondrawcolumncell  : TDrawColumnCellEvent read fOnDrawColumnCell write fOnDrawColumnCell;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents( '8Bita', [ TB8DBGrid ] );
end;

{ T8BDBGrid }

function TB8DBGrid.getShowZebra: boolean;
begin
  Result := fShowZebra;
end;

function TB8DBGrid.getZebraDark: TColor;
begin
  Result := fZebraDark;
end;

function TB8DBGrid.getZebraLight: TColor;
begin
  Result := fZebraLight;
end;

procedure TB8DBGrid.DrawColumnCell( Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState );

VAR
  ColOdd: boolean;

BEGIN

  TRY
    ColOdd := ( ( Sender AS TDBGrid ).DataSource.DataSet.RecNo MOD 2 <> 0 );
    fZebra[ False ] := fZebraLight;
    fZebra[ True ] := fZebraDark;

    IF ( gdSelected IN State ) THEN

      BEGIN 

        ( Sender AS TDBGrid ).Canvas.Brush.Color := clHighlight;
        ( Sender AS TDBGrid ).Canvas.Font.Color := clHighlightText;
      END

    ELSE

      IF fShowZebra then
       ( Sender AS TDBGrid ).Canvas.Brush.Color := fZebra[ ColOdd ];
       ( Sender AS TDBGrid ).DefaultDrawColumnCell( Rect, DataCol, Column, State );

  EXCEPT
  END;

end;

procedure TB8DBGrid.setShowZebra( const Value: boolean );
begin
  fShowZebra := Value;

end;

procedure TB8DBGrid.setZebraDark( const Value: TColor );
begin
  fZebraDark := Value;
end;

procedure TB8DBGrid.setZebraLight( const Value: TColor );
begin
  fZebraLight := Value;
end;

end.

God is real unless is declared as integer.
 
Odgovor na temu

Milos D
Beograd

Član broj: 5621
Poruke: 280
*.adsl-a-11.sezampro.rs.



+1 Profil

icon Re: Custom kontrola, gdje griješim?04.02.2011. u 12:04 - pre 160 meseci
Fali override:

Code:

procedure DrawColumnCell( Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState ); Override;
 
Odgovor na temu

komplikator
Programer / sys. inženjering
CRO

Član broj: 29755
Poruke: 158
*.adsl.net.t-com.hr.

ICQ: 13387003


+8 Profil

icon Re: Custom kontrola, gdje griješim?04.02.2011. u 12:17 - pre 160 meseci
Znam, no override direktiva mi uzrokuje pogrešku: [DCC Error] B8DBGrid.pas(26): E2037 Declaration of 'DrawColumnCell' differs from previous declaration. Ne shvaćam zašto, procedura tj. metoda je identična po tipovima originalnoj za TDbGrid.

Edit: nisam shvatio da zbilja pozivam pogrešne parametre, nema "Sendera" što je logično jer se klasa obraća sama sebi tj. Self, zar ne?

Prepravio sam kod u dolje prikazani kod. Sad se dešava jedna zanimnjiva pojava: u designtime-u. kontrola oboji redove (nakon run-a.) no runtime tj. u samom programu neće. Očigledno još negdje nešto krivo inicializiram, ili griješim s ovim Self-om ?

Code:

unit B8DBGrid;

interface

uses
  SysUtils, Classes, Controls, Grids, DBGrids, Types, Graphics;

type
  TZebra = Array [ boolean ] of TColor;

type
  TB8DBGrid = class( TDBGrid )
    private
      fZebra: TZebra;
      fZebraDark: TColor;
      fZebraLight: TColor;
      fShowZebra: boolean;
      fOnDrawColumnCell: TDrawColumnCellEvent;
      function getShowZebra: boolean;
      procedure setShowZebra( const Value: boolean );
      function getZebraDark: TColor;
      function getZebraLight: TColor;
      procedure setZebraDark( const Value: TColor );
      procedure setZebraLight( const Value: TColor );
    protected
      procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState);   override;

    public

    published
      property ColorZebraLight: TColor read getZebraLight write setZebraLight;
      property ColorZebraDark: TColor read getZebraDark write setZebraDark;
      property ShowZebra: boolean read getShowZebra write setShowZebra Default True;
      property ondrawcolumncell
        : TDrawColumnCellEvent read fOnDrawColumnCell write fOnDrawColumnCell;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents( '8Bita', [ TB8DBGrid ] );
end;

{ T8BDBGrid }

function TB8DBGrid.getShowZebra: boolean;
begin
  Result := fShowZebra;
end;

function TB8DBGrid.getZebraDark: TColor;
begin
  Result := fZebraDark;
end;

function TB8DBGrid.getZebraLight: TColor;
begin
  Result := fZebraLight;
end;

procedure TB8DBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState);
VAR
  ColOdd: boolean;

BEGIN

  TRY
    ColOdd := Self.DataSource.DataSet.RecNo MOD 2 <> 0 ;
    fZebra[ False ] := fZebraLight;
    fZebra[ True  ] := fZebraDark;

    IF ( gdSelected IN State ) THEN

      With self do BEGIN
        Canvas.Brush.Color := clHighlight;
        Canvas.Font.Color := clHighlightText;
      END

    ELSE
      if fShowZebra then
    with self do begin
     Canvas.Brush.Color := fZebra[ ColOdd ];
     DefaultDrawColumnCell( Rect, DataCol, Column, State );
    end;
  EXCEPT
  END;

end;

procedure TB8DBGrid.setShowZebra( const Value: boolean );
begin
  fShowZebra := Value;

end;

procedure TB8DBGrid.setZebraDark( const Value: TColor );
begin
  fZebraDark := Value;
end;

procedure TB8DBGrid.setZebraLight( const Value: TColor );
begin
  fZebraLight := Value;
end;

end.


[Ovu poruku je menjao komplikator dana 04.02.2011. u 13:37 GMT+1]
God is real unless is declared as integer.
 
Odgovor na temu

Milos D
Beograd

Član broj: 5621
Poruke: 280
*.adsl-a-11.sezampro.rs.



+1 Profil

icon Re: Custom kontrola, gdje griješim?04.02.2011. u 14:21 - pre 160 meseci
Self ti ne treba jer se podrazumeva. Na primer, kad kažeš DataSource.nešto podrazumeva se da misliš na self.DataSource.nešto. Jedini izuzetak bi bio ako bi u proceduri definisao lokalnu promenljivu sa imenom "DataSource", e tad bi ona imala prioritet i samo tada bi morao da uradiš self.DataSource da bi, umesto lokalnoj, pristupio promenljivi koja pripada objektu.

Procedure koje postavljaju vrednosti property-ja bi trebalo da urade i Invalidate da bi naterao grid da se ponovo iscrta.

 
Odgovor na temu

rambo
Dejan Petković
Beograd

Član broj: 6095
Poruke: 190
*.dynamic.sbb.rs.



+6 Profil

icon Re: Custom kontrola, gdje griješim?04.02.2011. u 17:33 - pre 160 meseci
Evo ti nešto jednostavnije rešenje
Code (delphi):

unit dpDBGrid;

interface

uses
  SysUtils, Classes, Controls, Graphics, Types, Grids, DBGrids;

type
  TdpDBGrid = class(TDBGrid)
  private
    fZebraColorLight: TColor;
    fZebraColorDark: TColor;
    fZebraEnabled: Boolean;
    procedure SetZebraColorLight(Value: TColor);
    procedure SetZebraColorDark(Value: TColor);
    procedure SetZebraEnabled(Value: Boolean);
    function GetZebraColorLight: TColor;
    function GetZebraColorDark: TColor;
  protected
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ZebraColorLight: TColor read GetZebraColorLight write SetZebraColorLight;
    property ZebraColorDark: TColor read GetZebraColorDark write SetZebraColorDark;
    property ZebraEnabled: Boolean read fZebraEnabled write SetZebraEnabled;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Moje komponente', [TdpDBGrid]);
end;

{ TdpDBGrid }

constructor TdpDBGrid.Create(AOwner: TComponent);
begin
  inherited;
  fZebraColorLight := $00F0F0F0;
  fZebraColorDark := $00E0E0E0;
  fZebraEnabled := False;
end;

procedure TdpDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  fOddItem: Boolean;
begin
  inherited;
  fOddItem := DataSource.DataSet.RecNo mod 2 <> 0;
  if gdSelected in State then
  begin
    Canvas.Brush.Color := clHighlight;
    Canvas.Font.Color := clHighlightText;
  end
  else
  begin
    if fZebraEnabled then
    begin
      if fOddItem then
        Canvas.Brush.Color := fZebraColorDark
      else
        Canvas.Brush.Color := fZebraColorLight;
      DefaultDrawColumnCell(Rect, DataCol, Column, State);
    end;
  end;
end;

function TdpDBGrid.GetZebraColorDark: TColor;
begin
  Result := fZebraColorDark;
end;

function TdpDBGrid.GetZebraColorLight: TColor;
begin
  Result := fZebraColorLight;
end;

procedure TdpDBGrid.SetZebraColorDark(Value: TColor);
begin
  if Value <> fZebraColorDark then
  begin
    fZebraColorDark := Value;
    Invalidate;
  end;
end;

procedure TdpDBGrid.SetZebraColorLight(Value: TColor);
begin
  if Value <> fZebraColorLight then
  begin
    fZebraColorLight := Value;
    Invalidate;
  end;
end;

procedure TdpDBGrid.SetZebraEnabled(Value: Boolean);
begin
  if Value <> fZebraEnabled then
  begin
    fZebraEnabled := Value;
    Invalidate;
  end;
end;

end.
 


"There is a theory which states that if ever anybody discovers exactly what the
Universe is for and why it is here, it will instantly disappear and be replaced by
something even more bizarre and inexplicable. There is another theory which states
that this has already happened."
-- Douglas Adams
 
Odgovor na temu

komplikator
Programer / sys. inženjering
CRO

Član broj: 29755
Poruke: 158
*.adsl.net.t-com.hr.

ICQ: 13387003


+8 Profil

icon Re: Custom kontrola, gdje griješim?04.02.2011. u 18:02 - pre 160 meseci
Hvala, uspio sam pročistiti i ispraviti kod. Naletio sam na bug koji me mučio i mučio (senilnost, skroz sam zaboravio na taj "feature"). Dešavalo mi se da u designtime mijenjam svojstvo showZebra i sve radi, no runtime ne radi, osim ako svojstvo runtime postavim kroz kod. Na kraju sam se sjetio da se property ne pamti u dfm-u. ako je po defaultu true, nego se za defaulte boolean property postavlja false, a kao true ga postavim kroz konstruktor. Evo, vidim da si to isto napravio i ti Rambo. Sad idem korak dalje pa ću napraviti klasu/komponentu sa color shemama za razne situacije i razne custom komponente poput ove (lookup polja jedne boje, read-only druge itd, itd) i povezati je s ovom komponentom. Naravno, moram joj dodati još funkcionalnosti. Nije ni čudo, prije samo 3 dana sam se vratio u Clipper ispraviti neke stvari u prastarim programima, u međuvremenu odradio nešto u php-u.
God is real unless is declared as integer.
 
Odgovor na temu

Milos D
Beograd

Član broj: 5621
Poruke: 280
*.adsl-a-11.sezampro.rs.



+1 Profil

icon Re: Custom kontrola, gdje griješim?04.02.2011. u 18:45 - pre 160 meseci
Možeš da još pojednostaviš, ne treba ti GetZebraColorLight (i druga dva get___) ako treba samo da vrati fZebraColorLight stavi

property ... read fZebraColorLight write ...
 
Odgovor na temu

Boris B.
Ljubljana

Član broj: 213615
Poruke: 286
*.evj-kabel.net.



+14 Profil

icon Re: Custom kontrola, gdje griješim?05.02.2011. u 00:06 - pre 160 meseci
I lepo bi bilo da se doda default za boje, tako ce property inspector znati da prikaze default boju, i boje ce se pravilno serijalizovati u DFM:
Code (pascal):

    property ZebraColorLight: TColor read GetZebraColorLight write SetZebraColorLight; default $00F0F0F0;
    property ZebraColorDark: TColor read GetZebraColorDark write SetZebraColorDark; default $00E0E0E0;
    property ZebraEnabled: Boolean read fZebraEnabled write SetZebraEnabled; default false;
 


if it walks like a duck and quacks like a duck, it could be a dragon doing a duck
impersonation.
 
Odgovor na temu

[es] :: Pascal / Delphi / Kylix :: Custom kontrola, gdje griješim?

[ Pregleda: 2033 | Odgovora: 7 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.