Einzelnen Beitrag anzeigen

omata

Registriert seit: 26. Aug 2004
Ort: Nebel auf Amrum
3.154 Beiträge
 
Delphi 7 Enterprise
 
#2

Re: Drawgrids & Shapes, oder Canvas mit onClick-Ereignis

  Alt 7. Okt 2004, 01:48
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
  Mit Zitat antworten Zitat