Results 1 to 10 of 10

Thread: stringgrid wirdt niet leeggemaakt na eigen OnDrawCell methode

  1. #1

    stringgrid wirdt niet leeggemaakt na eigen OnDrawCell methode

    Hallo,

    Voor mijn project krijgt de gebruiker een popup dialog venster met daarop een stringgrid om waardes in te vullen.
    Het aantal waardes kan per keer verschillen

    Om de stringgrid een beetje "smoel" te geven maak ik steeds de oneven regels licht blauw middels een eigen OnDrawCell event.
    Daarnaast wordt de cell voor invoerwaarde oranje gekleurd zolang de invoer nog niet voldoet aan spec.

    Code:
    if (Acol >= Tstringgrid(Sender).FixedCols) and (Arow > 0) then
     begin
      mycolor := clwhite;
      if not (Odd(ARow)) then mycolor:= $00DCCFC7;
      if (Acol = 1) and not(Data[Arow-1].checkInput(Tstringgrid(Sender).Cells[1,Arow]))then  mycolor:=clWebPeachPuff;
      with Tstringgrid(Sender) do
      begin
       Canvas.brush.Style := bsSolid;
       Canvas.brush.color := mycolor;// style.Colors.ButtonSelectedColorFrom; //$00DCCFC7;
       rect:=cellrect(ACol,ARow);
       Canvas.FillRect(Rect);
       Canvas.font.Color := clblack;
       Canvas.brush.Style := bsClear;
       rect.Left:=rect.Left+6;
       rect.top:=rect.top+2;
       A:=cells[acol, arow];
       DrawText(Tstringgrid(Sender).Canvas.Handle,PChar(A),StrLen(PChar(A)),Rect,DT_WORDBREAK);
      end;
     end;
    Wanneer ik nu voor een tweede keer de stringgrid laat zien met minder regels dan blijven de oude invoergegevens zichtbaar op de regels die niet worden overschreven.
    Dit komt natuurlijk omdat de waarde van de cell nu via de Drawtext direct op het canvas wordt geschreven.

    Kortom zodra ik het invoerscherm verlaat moet ik het canvas schoonmaken.

    Wat zou hier de beste methode voor zijn.

  2. #2
    Mhhh het wordt nog vreemder ik heb de OndrawCell nu uit gezet maar het hierboven beschreven effect blijft.
    Op de een of andere manier wordt het Canvas niet goed schoongemaakt

    de enige code die ik nog heb is
    Code:
    procedure TdlgMesInput.FillForm;
    var
      i: Integer;
    begin
    
    
       stgInvoerData.RowCount:=1 + TestData.Count;
       stgInvoerData.Cells[0,0]:='Parameter';
       stgInvoerData.Cells[1,0]:='Waarde';
       stgInvoerData.Cells[2,0]:='Eenheid';
       stgInvoerData.Cells[3,0]:='Spec_L';
       stgInvoerData.Cells[4,0]:='Spec_H';
       for i := 0 to TestData.Count-1 do
       begin
        stgInvoerData.Cells[0,i+1]:=TestData[i].Naam;
        stgInvoerData.Cells[1,i+1]:='';
        stgInvoerData.Cells[2,i+1]:=TestData[i].Eenheid;
        stgInvoerData.Cells[3,i+1]:=TestData[i].L_Spec;
        stgInvoerData.Cells[4,i+1]:=TestData[i].H_Spec;
    
       end;
    
      showmodal;
    
    end;

  3. #3
    Quote Originally Posted by cpri View Post
    Mhhh het wordt nog vreemder ik heb de OndrawCell nu uit gezet maar het hierboven beschreven effect blijft.
    Op de een of andere manier wordt het Canvas niet goed schoongemaakt
    de enige code die ik nog heb is
    Heb je TStringGrid.DefaultDrawing dan ook weer op true gezet?

    Anders moet je het natuurlijk nog steeds zelf regelen in OnDrawCell

    Misschien anders even met een TStringGrid.Invalidate een complete repaint forceren.

  4. #4
    De optie DefaultDrawing kende ik niet maar geeft ook geen verbetering
    Ook het plaatsen van Invalidate levert niet het gewenst resultaat op.

    Wel is het zo dat wanneer ik de stringgrid voor 2e keer laat zien en dan in kolom klik om de waarde in te vullen, de eerdere waardes die dus foutief weergegeven worden, verdwijnen

    Heb al op meerdere plekken en repaint actie geprobeerd.

    Daarnaast denk ik dat het feit dat ik het form als showmodal weergeef het extra moeilijk maakt.

  5. #5
    Inmiddels een work around gevonden.
    Ik maak het stringgrid nu dynamisch aan en verwijder deze weer wanneer ik de dialog verlaat.

    Wellicht niet de meest efficiente / elegante oplossing maar eindelijk iets dat werkt

    Mocht iemand nog een betere oplossing hebben dan houd ik me graag aanbevolen

  6. #6
    Misschien even uit mijn hoofd... maar dit zal niet veel efficiënter zijn

    Delphi Code:
    1. Stringgrid1.DefaultDrawing := true;
    2. Stringgrid1.Invalidate;
    3. Application.ProcessMessages; // to allow painting
    4. Stringgrid1.DefaultDrawing := false;
    5. Stringgrid1.Invalidate;
    6. Application.ProcessMessages; // to allow your own paintprocedure

    Je zult volgens mij wel zelf ergens een FillRect moeten doen van de regels en area die je niet gebruikt.

    Quote Originally Posted by cpri View Post
    Mhhh het wordt nog vreemder ik heb de OndrawCell nu uit gezet maar het hierboven beschreven effect blijft.
    Als je de OnDrawCell uitzet en de DefaultDrawing op true zet dan heb je dit probleem toch niet???
    Want dan heb je compleet de default drawing en dat zou toch goed moeten gaan.

    Anders heb je een ander probleem, misschien waar je het tekent.

    (ShowModal zou niet uit mogen maken zolang dit allemaal maar in het ModalForm zelf staat)

  7. #7
    Silly member NGLN's Avatar
    Join Date
    Aug 2004
    Location
    Werkendam
    Posts
    5,133
    Waar maak je het geheugen leeg dan? De Cells property wordt niet leeggemaakt door het StringGrid, ook niet bij verminderen van RowCount.
    (Sender as TNLDUser).Signature := 'Groeten van Albert';

  8. #8
    Ik kan dat gedrag eerlijk gezegd niet reproduceren. Voor zover ik zie, zou een stringgrid altijd zelf het gebied buiten de cellen moeten tekenen. Ook roept ie altijd OnDrawCell aan. Het enige wat DefaultDrawing bepaalt, is of de stringgrid vóór het OnDrawCell zelf de cel al tekent (zodat zelf tekenen optioneel wordt, of je eventueel alleen een klein deel kan doen), en of de stringgrid er naderhand nog wat op tekent (m.n. een focus-rechthoek).

    Het zou echt super handig zijn als er dus een ander event was, waarmee je de kleur van de cel nog kon aanpassen voor het tekenen, en dus is dat er niet (het blijft de Vcl )

    Je zou eventueel wel een override kunnen maken. De handigste optie is dan om DrawCellBackground te overriden. Dat is de method die de achtergrondkleur invult. Deze method is virtual en word aangeroepen vlak voor DrawCell, die zorgt voor de tekst en het event.

    Die afgeleide TStringGrid zit in onderstaande unit.
    Gebruik: Voeg bij je form `uStringGridHack` aan de uses toe. Zorg dat ie verder in de lijst staat dan Vcl.StringGrid. Je form zal dan automatisch uStringGridHack.TStringGrid gebruiken i.p.v. Vcl.StringGrid.TStringGrid. De override zorgt voor de rest.

    Delphi Code:
    1. unit uStringGridHack;
    2.  
    3. interface
    4.  
    5. uses
    6.   Vcl.Grids, Vcl.Graphics, WinApi.Windows;
    7.  
    8. type
    9.   TStringGrid = class(Vcl.Grids.TStringGrid)
    10.     procedure DrawCellBackground(const ARect: TRect; AColor: TColor;
    11.       AState: TGridDrawState; ACol, ARow: Integer); override;
    12.   end;
    13.  
    14. implementation
    15.  
    16. procedure TStringGrid.DrawCellBackground(const ARect: TRect; AColor: TColor;
    17.   AState: TGridDrawState; ACol, ARow: Integer);
    18. begin
    19.   if (ARow >= FixedRows) {and (ACol >= FixedCols)} then
    20.   begin
    21.     Canvas.Brush.Style := bsSolid;
    22.     if Odd(ARow - FixedRows) then
    23.       Canvas.Brush.Color := clMoneyGreen
    24.     else
    25.       Canvas.Brush.Color := clWhite;
    26.     Canvas.FillRect(ARect)
    27.   end else
    28.     inherited;
    29. end;
    30.  
    31. end.
    1+1=b

  9. #9
    Bedankt voor deze optie.
    Ik ga er mee aan de slag.

    Om het e.e.a. te kunnen testen heb ik een voorbeeld programma gemaakt bestaande uit twee units (mainform en de dialog)
    Op het mainform staat dus alleen een knop die het dialog venster met de stringgrid laat zien.

    Hieronder de code

    mainform
    Code:
    procedure TForm1.Button1Click(Sender: TObject);
    var
    TempData:TData;
    DataList:Tlist<TData>;
    i:integer;
    
    begin
    DataList:=Tlist<TData>.Create;
    tempdata.Naam:='Test 1';
    
    tempdata.Eenheid:='V';
    tempData.L_Spec:='1';
    tempData.H_Spec:='2';
    Datalist.Add(tempData);
    tempdata.Naam:='Test 2';
    tempdata.Eenheid:='V';
    tempData.L_Spec:='5';
    tempData.H_Spec:='6';
    Datalist.Add(tempData);
    
    dlgMesInput.TestData:=DataList;
    dlgMesInput.FillForm;
    
    
    DataList.Clear;
    tempdata.Naam:='Test 3';
    tempdata.Eenheid:='V';
    tempData.L_Spec:='7';
    tempData.H_Spec:='8';
    Datalist.Add(tempData);
    
    dlgMesInput.TestData:=DataList;
    dlgMesInput.FillForm;
    
    DataList.Free;
    //
    end;
    code van het dialog venster
    Code:
    procedure TdlgMesInput.btnValContinueClick(Sender: TObject);
    var
      i: Integer;
      tempData:TData;
    begin
    
    for i := 0 to TestData.Count-1 do
    begin
     tempData:=TestData[i];
     tempData.Waarde :=stgInvoerData.Cells[1,i+1];
     TestData[i]:=TempData;
    end;
    
    ModalResult:=mrOk;
    end;
    
    procedure TdlgMesInput.FillForm;
    var
      i: Integer;
    begin
    
       stgInvoerData.RowCount:=1 + TestData.Count;
       stgInvoerData.Cells[0,0]:='Parameter';
       stgInvoerData.Cells[1,0]:='Waarde';
       stgInvoerData.Cells[2,0]:='Eenheid';
       stgInvoerData.Cells[3,0]:='Spec_L';
       stgInvoerData.Cells[4,0]:='Spec_H';
       for i := 0 to TestData.Count-1 do
       begin
        stgInvoerData.Cells[0,i+1]:=TestData[i].Naam;
        stgInvoerData.Cells[1,i+1]:='';
        stgInvoerData.Cells[2,i+1]:=TestData[i].Eenheid;
        stgInvoerData.Cells[3,i+1]:=TestData[i].L_Spec;
        stgInvoerData.Cells[4,i+1]:=TestData[i].H_Spec;
    
       end;
    
    
      stgInvoerData.OnDrawCell:=stgInvoerDataDrawCell;
    
      showmodal;
    
    end;
    
    procedure TdlgMesInput.stgInvoerDataDrawCell(Sender: TObject; ACol,
      ARow: Integer; Rect: TRect; State: TGridDrawState);
    var mycolor:Tcolor;
    A:string;
    begin
    if (Acol >= Tstringgrid(Sender).FixedCols) and (Arow > 0) then
     begin
      mycolor := clwhite;
      if not (Odd(ARow)) then mycolor:= $00DCCFC7;
    //  if (Acol = 1) and not(Opstelling.Items[Arow-1].checkInput(Tstringgrid(Sender).Cells[1,Arow]))then  mycolor:=clWebPeachPuff;
      with Tstringgrid(Sender) do
      begin
       Canvas.brush.Style := bsSolid;
       Canvas.brush.color := mycolor;// style.Colors.ButtonSelectedColorFrom; //$00DCCFC7;
       rect:=cellrect(ACol,ARow);
       Canvas.FillRect(Rect);
       Canvas.font.Color := clblack;
       Canvas.brush.Style := bsClear;
       rect.Left:=rect.Left+6;
       rect.top:=rect.top+2;
       A:=cells[acol, arow];
       DrawText(Tstringgrid(Sender).Canvas.Handle,PChar(A),StrLen(PChar(A)),Rect,DT_WORDBREAK);
      end;
     end;
    end;
    
    procedure TdlgMesInput.stgInvoerDataSelectCell(Sender: TObject; ACol,
      ARow: Integer; var CanSelect: Boolean);
    begin
    
    if Acol =1 then
     stgInvoerData.Options:=stgInvoerData.Options+[goEditing]
    else
     stgInvoerData.Options:=stgInvoerData.Options-[goEditing];
    end;

  10. #10
    Dat voorbeeld wat je nu geeft... werkt dat bij jou niet goed????
    Want bij mij werkt het prima.
    Met en zonder DefaultDrawing op true.

    Wel moet DefaultDrawing op true staan om de header en row titels te zien.
    Maar zelfs met DefaultDrawing op true heb ik wisselende kleuren.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •