FAQ - Вопросы - ответы - советы - Базы данных

Вопрос:

[VCL] Хочу шапку в TDBGRID. Как сделать?

Ответ:

UNIT BDBGRID;

INTERFACE

USES
  WINDOWS, MESSAGES, SYSUTILS, CLASSES, GRAPHICS, CONTROLS, FORMS,
DIALOGS,
  GRIDS, DBGRIDS, MATH;

TYPE
  TONDRAWTITLEEVENT = PROCEDURE(ACOL : INTEGER; ARECT : TRECT; VAR
TITLETEXT : STRING)
    OF OBJECT;

  TBITDBGRID = CLASS(TDBGRID)
  PRIVATE
   FBITMAPBROWSE : TBITMAP;
   FBITMAPEDIT : TBITMAP;
   FBITMAPINSERT : TBITMAP;
   FBITMAPFILL : TBITMAP;
   FREALTITLEFONT : TFONT;
   FONDRAWTITLE : TONDRAWTITLEEVENT;
   FRESIZEFLAG : BOOLEAN;
    { PRIVATE DECLARATIONS }
   PROCEDURE SETREALTITLEFONT(VALUE : TFONT);
   PROCEDURE UPDATETITLESHEIGHT;
  PROTECTED
   PROCEDURE DRAWCELL(ACOL, AROW: LONGINT; ARECT: TRECT; ASTATE:
TGRIDDRAWSTATE);
        OVERRIDE;
   PROCEDURE MOUSEDOWN(BUTTON: TMOUSEBUTTON; SHIFT: TSHIFTSTATE;
      X, Y: INTEGER); OVERRIDE;
   PROCEDURE MOUSEUP(BUTTON: TMOUSEBUTTON; SHIFT: TSHIFTSTATE;
      X, Y: INTEGER); OVERRIDE;
    { PROTECTED DECLARATIONS }
  PUBLIC
    CONSTRUCTOR CREATE(AOWNER : TCOMPONENT);OVERRIDE;
    DESTRUCTOR DESTROY; OVERRIDE;
    { PUBLIC DECLARATIONS }
  PUBLISHED
    PROPERTY ONDRAWTITLE : TONDRAWTITLEEVENT READ FONDRAWTITLE WRITE
FONDRAWTITLE;
    PROPERTY REALTITLEFONT : TFONT READ FREALTITLEFONT WRITE
SETREALTITLEFONT;
    { PUBLISHED DECLARATIONS }
  END;

PROCEDURE REGISTER;

IMPLEMENTATION

VAR DRAWBITMAP : TBITMAP;

FUNCTION MAX(X, Y: INTEGER): INTEGER;
BEGIN
  RESULT := Y;
  IF X > Y THEN RESULT := X;
END;

PROCEDURE WRITETEXT(ACANVAS: TCANVAS; ARECT: TRECT; DX, DY: INTEGER;
  CONST TEXT: STRING; ALIGNMENT: TALIGNMENT);
//(C) BORLAND FUNCTION :)
CONST
  ALIGNFLAGS : ARRAY [TALIGNMENT] OF INTEGER =
    ( DT_LEFT OR DT_WORDBREAK OR DT_EXPANDTABS OR DT_NOhrefIX,
      DT_RIGHT OR DT_WORDBREAK OR DT_EXPANDTABS OR DT_NOhrefIX,
      DT_CENTER OR DT_WORDBREAK OR DT_EXPANDTABS OR DT_NOhrefIX );
VAR
  B, R: TRECT;
  I, LEFT: INTEGER;
BEGIN
 WITH DRAWBITMAP, ARECT DO { USE OFFSCREEN BITMAP TO ELIMINATE FLICKER
AND }
   BEGIN                     { BRUSH ORIGIN TICS IN PAINTING /
SCROLLING.    }
     WIDTH := MAX(WIDTH, RIGHT - LEFT);
     HEIGHT := MAX(HEIGHT, BOTTOM - TOP);
     R := RECT(DX, DY, RIGHT - LEFT - 1, BOTTOM - TOP - 1);
     B := RECT(0, 0, RIGHT - LEFT, BOTTOM - TOP);
    END;
 WITH DRAWBITMAP.CANVAS DO
   BEGIN
     DRAWBITMAP.CANVAS.COPYRECT(B, ACANVAS, ARECT);
     FONT := ACANVAS.FONT;
     FONT.COLOR := ACANVAS.FONT.COLOR;
     BRUSH := ACANVAS.BRUSH;
     SETBKMODE(HANDLE, TRANSPARENT);
     DRAWTEXT(HANDLE, PCHAR(TEXT), LENGTH(TEXT), R,
ALIGNFLAGS[ALIGNMENT]);
    END;
 ACANVAS.COPYRECT(ARECT, DRAWBITMAP.CANVAS, B);
END;


CONSTRUCTOR TBITDBGRID.CREATE(AOWNER : TCOMPONENT);
BEGIN
 INHERITED CREATE(AOWNER);
 FREALTITLEFONT := TFONT.CREATE;
 FRESIZEFLAG := FALSE;
END;

DESTRUCTOR TBITDBGRID.DESTROY;
BEGIN
 FREALTITLEFONT.FREE;
 INHERITED DESTROY;
END;

PROCEDURE TBITDBGRID.UPDATETITLESHEIGHT;
VAR LOOP : INTEGER;
    MAXTEXTHEIGHT : INTEGER;
    RRECT : TRECT;
BEGIN
 MAXTEXTHEIGHT := 0;
 FOR LOOP := 0 TO COLUMNS.COUNT - 1 DO BEGIN
   RRECT := CELLRECT(0, 0);
   RRECT.RIGHT := COLUMNS[LOOP].WIDTH;
   RRECT.LEFT := 0;
   CANVAS.FONT := REALTITLEFONT;
   MAXTEXTHEIGHT := MAX(MAXTEXTHEIGHT, DRAWTEXT(CANVAS.HANDLE,
                         PCHAR(COLUMNS[LOOP].TITLE.CAPTION),
                         LENGTH(COLUMNS[LOOP].TITLE.CAPTION), RRECT,
                         DT_CALCRECT + DT_WORDBREAK));
  END;
 IF TITLEFONT.HEIGHT  - MAXTEXTHEIGHT THEN
   TITLEFONT.HEIGHT := - MAXTEXTHEIGHT;
END;

PROCEDURE TBITDBGRID.MOUSEDOWN(BUTTON: TMOUSEBUTTON; SHIFT: TSHIFTSTATE;
X, Y: INTEGER);
BEGIN
 IF MOUSECOORD(X, Y).Y = 0 THEN
   FRESIZEFLAG := TRUE;
 INHERITED MOUSEDOWN(BUTTON, SHIFT, X, Y);
END;

PROCEDURE TBITDBGRID.MOUSEUP(BUTTON: TMOUSEBUTTON; SHIFT: TSHIFTSTATE;
X, Y: INTEGER);
BEGIN
 INHERITED MOUSEUP(BUTTON, SHIFT, X, Y);
 IF FRESIZEFLAG THEN BEGIN
   FRESIZEFLAG := FALSE;
   UPDATETITLESHEIGHT;
  END;
END;

PROCEDURE TBITDBGRID.DRAWCELL(ACOL, AROW: LONGINT; ARECT: TRECT; ASTATE:
TGRIDDRAWSTATE);
VAR INDICATOR : TBITMAP;
    TITLETEXT : STRING;
    AL : TALIGNMENT;
BEGIN
 IF NOT ((GDFIXED IN ASTATE) AND ((AROW = 0) AND (DGTITLES IN OPTIONS)
AND (ACOL  0)))
  THEN INHERITED DRAWCELL(ACOL, AROW, ARECT, ASTATE)
  ELSE BEGIN
    IF DEFAULTDRAWING THEN BEGIN
      DRAWEDGE(CANVAS.HANDLE, ARECT, BDR_RAISEDINNER, BF_BOTTOMLEFT);
      DRAWEDGE(CANVAS.HANDLE, ARECT, BDR_RAISEDINNER, BF_TOPRIGHT);
      INFLATERECT(ARECT, -1, -1);
      CANVAS.BRUSH.COLOR := FIXEDCOLOR;
      CANVAS.FILLRECT(ARECT);
     END;
    TITLETEXT := COLUMNS[ACOL - 1].TITLE.CAPTION;
    IF ASSIGNED(ONDRAWTITLE) THEN ONDRAWTITLE(ACOL, ARECT, TITLETEXT);
    IF DEFAULTDRAWING  AND (TITLETEXT  '') THEN
      BEGIN
        CANVAS.BRUSH.STYLE := BSCLEAR;
        CANVAS.FONT := REALTITLEFONT;
        IF ACOL > 0 THEN AL := COLUMNS[ACOL - 1].TITLE.ALIGNMENT
          ELSE AL := COLUMNS[0].TITLE.DEFAULTALIGNMENT;
        WRITETEXT(CANVAS, ARECT, 2, 2, TITLETEXT, AL);
       END;
   END;
END;

PROCEDURE TBITDBGRID.SETREALTITLEFONT(VALUE : TFONT);
BEGIN
 FREALTITLEFONT.ASSIGN(VALUE);
 REPAINT;
END;

PROCEDURE REGISTER;
BEGIN
  REGISTERCOMPONENTS('ANDRE VCL', [TBITDBGRID]);
END;

INITIALIZATION
 DRAWBITMAP := TBITMAP.CREATE;

FINALIZATION
 DRAWBITMAP.FREE;

END.

1.

Аноним

6 декабря 2005, 17:29:02

При вызове процедуры drawcell из других порцедур в модуле,какое значение указывать для state:Tgriddrawstate если gdselected не подходит?