Drawgrids & Shapes, oder Canvas mit onClick-Ereignis??

[venomsoup]

Hallo zusammen,

ich habe folgendes Ziel:
Eine Tabelle mit farbigen "Balken"(&Text), die über mehrere Spalten gehen können, und die mindestends ein onClick oder ein onMouseover Ereignis besitzen.
Zur verdeutlichung, es soll nachher ungefähr so aussehen:
http://home.nexgo.de/venomsoup/tabelle.jpg
(mit MSPaint erstellt ;D)

mein Problem:

Meine erste Idee war es das Drawgrid zu benutzen, und aus den Koordinaten die ich für jede Zelle bekomme, mit Canvas diese Balken zu zeichnen und zu Beschriften.
Das Problem hierbei war das diese Balken dann über keine Ereignisse verfügten, da sie ja nur gemalt waren.. also konnte der Benutzer Sie auch nicht markieren oder mit ihnen arbeiten.

Ok, 2. Anlauf: Meine Idee war nun, statt mit Canvas zu Zeichnen, Shapes dynamisch auf die Tabelle zu legen, da diese ja über Ereignisse verfügen. Mein Problem hier: Die Shapes blieben immer hiner der Tabelle, man konnte sie somit nicht sehen, geschweige denn sie anklicken.

Für Tipps zur Realisierung (oder Komponenten mit denen sowas geht) wäre ich euch echt dankbar!!

MfG,
Philipp Eckert

[omata]

Moin,

das ist etwas aufwendiger. Besonders weil ich nicht weiss wie du die Aufträge speicherst. Wenn diese in einer Datenbank liegen, wird es noch etwas einfacher. Ich habe jetzt erstmal eine Klasse für die Speicherung der Aufträge angelegt. Aber schau selbst...

zuerst die Typen:

Delphi-Quellcode:

type
  TAuftrag = class
  private
    _Start:integer;
    _Laenge:integer;
    _Zeile:integer;
    _Farbe:TColor;
    _Selected:boolean;
    _Bezeichnung:string;
  public
    constructor create(Start, Laenge, Zeile:integer; Bezeichnung:string; Farbe:TColor); reintroduce;
    property Zeile:integer read _Zeile;
    property Start:integer read _Start;
    property Laenge:integer read _Laenge;
    property Farbe:TColor read _Farbe;
    property Selected:boolean read _Selected write _Selected;
    property Bezeichnung:string read _Bezeichnung;
  end;

  TAuftraegeArray = array of TAuftrag;

  TAuftraege = class
  private
    _Auftraege:TAuftraegeArray;
  public
    constructor create; reintroduce;
    destructor destroy; override;
    procedure addAuftrag(Auftrag:TAuftrag);
    function GetAuftrag(Col, Row:integer):TAuftraegeArray; overload;
    function SelectAuftrag(X, Y:integer; Rect:TRect; Col, Row:integer):TAuftrag;
  end;

Dann die einzelnen Rümpfe...

Delphi-Quellcode:

{ TAuftraege }

procedure TAuftraege.addAuftrag(Auftrag: TAuftrag);
begin
  setlength(_Auftraege, length(_Auftraege)+1);
  _Auftraege[length(_Auftraege)-1]:=Auftrag;
end;

constructor TAuftraege.create;
begin
  setlength(_Auftraege, 0);
end;

destructor TAuftraege.destroy;
var i:integer;
begin
  for i:=1 to length(_Auftraege) do
    _Auftraege[i-1].Free;
  setlength(_Auftraege, 0);
  inherited;
end;

function TAuftraege.GetAuftrag(Col, Row: integer): TAuftraegeArray;
var i:integer;
begin
  setlength(Result, 0);
  i:=0;
  while (i < length(_Auftraege)) do begin
    if     (Row = _Auftraege[i].Zeile)
       and (_Auftraege[i]._Start <= Col)
       and (Col <= _Auftraege[i]._Start + _Auftraege[i]._Laenge) then begin
      setlength(Result, length(Result)+1);
      Result[length(Result)-1]:=_Auftraege[i];
    end;
    inc(i);
  end;
end;

function TAuftraege.SelectAuftrag(X, Y:integer; Rect:TRect; Col, Row:integer):TAuftrag;
var i:integer;
    AuftraegeArray:TAuftraegeArray;
    abbruch:boolean;
begin
  Result:=nil;
  i:=0;
  setlength(AuftraegeArray, 0);
  while (i < length(_Auftraege)) do begin
    _Auftraege[i].Selected:=false;
    if     (Row = _Auftraege[i].Zeile)
       and (_Auftraege[i]._Start <= Col)
       and (Col <= _Auftraege[i]._Start + _Auftraege[i]._Laenge) then begin
      setlength(AuftraegeArray, length(AuftraegeArray)+1);
      AuftraegeArray[length(AuftraegeArray)-1]:=_Auftraege[i];
    end;
    inc(i);
  end;

  if length(AuftraegeArray) > 0 then begin
    i:=0;
    abbruch:=false;
    while (i < length(AuftraegeArray)) and not abbruch do begin
      abbruch:=     (    (Y > Rect.Top + 3)
                     and (Y < Rect.Bottom - 3))
                and (    (    (X >= Rect.Left + ((Rect.Right - Rect.Left) div 2))
                          and (AuftraegeArray[i].Start = Col))
                      or (    (X < Rect.Left + ((Rect.Right - Rect.Left) div 2))
                          and (AuftraegeArray[i].Start + AuftraegeArray[i].Laenge = Col)
                      or (    (AuftraegeArray[i].Start < Col)
                          and (AuftraegeArray[i].Start + AuftraegeArray[i].Laenge > Col))));
      if not abbruch then
        inc(i);
    end;
    if abbruch then begin
      AuftraegeArray[i].Selected:=true;
      Result:=AuftraegeArray[i];
    end;
  end;
end;

{ TAuftrag }

constructor TAuftrag.create(Start, Laenge, Zeile: integer; Bezeichnung:string; Farbe: TColor);
begin
  _Start:=Start;
  _Laenge:=Laenge;
  _Zeile:=Zeile;
  _Farbe:=Farbe;
  _Selected:=false;
  _Bezeichnung:=Bezeichnung;
end;

Auf dem Formular benötigst du nur ein DrawGrid.
Die Ereignis-Methoden sehen dann folgendermaßen aus...

Delphi-Quellcode:

procedure TFMain.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var AuftraegeArray:TAuftraegeArray;
    i:integer;
    MyRect:TRect;
begin
  with Sender as TDrawGrid do begin
    if gdFixed in State then begin
      canvas.Brush.Color:=clSilver;
      canvas.FillRect(Rect);
    end
    else begin
      canvas.Brush.Color:=clWhite;
      canvas.FillRect(Rect);
      AuftraegeArray:=FAuftraege.GetAuftrag(ACol, ARow);
      for i:=1 to length(AuftraegeArray) do begin
        MyRect.Left:=Rect.Left;
        MyRect.Right:=Rect.Right;
        MyRect.Top:=Rect.Top + 3;
        MyRect.Bottom:=Rect.Bottom - 3;
        if AuftraegeArray[i-1].Start = ACol then
          MyRect.Left:=MyRect.Left + ((Rect.Right - Rect.Left) div 2);
        if ACol = AuftraegeArray[i-1].Start + AuftraegeArray[i-1].Laenge then
          MyRect.Right:=MyRect.Right - ((Rect.Right - Rect.Left) div 2);
        canvas.Brush.Color:=AuftraegeArray[i-1].Farbe;
        canvas.FillRect(MyRect);
        if AuftraegeArray[i-1].Selected then begin
          canvas.Pen.Color:=clBlack;
          canvas.Pen.Width:=2;
          canvas.MoveTo(MyRect.Left, MyRect.Top);
          canvas.LineTo(MyRect.Right, MyRect.Top);
          canvas.MoveTo(MyRect.Left, MyRect.Bottom);
          canvas.LineTo(MyRect.Right, MyRect.Bottom);
          if AuftraegeArray[i-1].Start = ACol then begin
            canvas.MoveTo(MyRect.Left, MyRect.Top);
            canvas.LineTo(MyRect.Left, MyRect.Bottom);
          end;
          if ACol = AuftraegeArray[i-1].Start + AuftraegeArray[i-1].Laenge then begin
            canvas.MoveTo(MyRect.Right, MyRect.Top);
            canvas.LineTo(MyRect.Right, MyRect.Bottom);
          end;
        end;
      end;
      setlength(AuftraegeArray, 0);
    end;
  end;
end;

procedure TFMain.DrawGridMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Col, Row:integer;
    Rect:TRect;
    Auftrag:TAuftrag;
begin
  if Button = mbLeft then begin
    TDrawGrid(Sender).MouseToCell(X, Y, Col, Row);
    Rect:=TDrawGrid(Sender).CellRect(Col, Row);
    Auftrag:=FAuftraege.SelectAuftrag(X, Y, Rect, Col, Row);
    TDrawGrid(Sender).Repaint;
    if assigned(Auftrag) then
      OnAuftragClick(Auftrag);
  end;
end;

Dann wird noch folgendes in der Formularklasse benötigt...

Delphi-Quellcode:

  :
  private
    FAuftraege:TAuftraege;
    procedure OnAuftragClick(Auftrag:TAuftrag);
  :
  :
  :
procedure TFMain.FormCreate(Sender: TObject);
begin
  FAuftraege:=TAuftraege.create;
  FAuftraege.addAuftrag(TAuftrag.create(1, 2, 1, '1. Auftrag', clRed));
  FAuftraege.addAuftrag(TAuftrag.create(3, 1, 1, '2. Auftrag', clGreen));
  FAuftraege.addAuftrag(TAuftrag.create(0, 1, 3, '3. Auftrag', clBlue));
end;

procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FAuftraege.Free;
end;

und Der Rumpf sieht als Beispiel zu aus...

Delphi-Quellcode:

procedure TFMain.OnAuftragClick(Auftrag: TAuftrag);
begin
  showmessage(Auftrag.Bezeichnung);
end;

So, hoffe es hilft dir...

MfG
Thorsten

[venomsoup]

Hi Thorsten!!

Vielen vielen Dank für die viele Mühe die du dir gemacht hast, es wird mir sicherlich sehr bei meinem Projekt (Dispositions-Software) helfen!!

Und ja, die Aufträge lese ich aus ner Firebird-DB aus.

Mfg, Philipp

[venomsoup]

Gibt es eigentlich noch ne Möglichkeit Text (am besten zweispaltig) in dem Canvas anzuzeigen?
Ich hab im Moment irgenwie keinen Überblick..

Danke im Vorraus für eure Hilfe!!

Mfg, Philipp

[omata]

Moin,

ich hatte schon geahnt, dass du das auch haben möchtest.
Tja, das ist auch nicht gerade ohne...

ich habe das Projekt mal angehängt.

Habe aber nicht zweispaltig sondern mit Zeilen gearbeitet. Aber das umzuändern sollte nicht so schwierig sein.

MfG
Thorsten

[venomsoup]

Hi Thorsten!
Abermals vielen vielen Dank das du deine Zeit opferst mir zu helfen, ich glaub ich bekomm den Rest jetzt selbst hin..
wenn de willst kann ich dir ja mal n paar screenshots von dem Projekt schicken wenns fertig ist..
oder ne exe..

MfG, und nen schönen Tag noch,
Philipp