⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 customdrawcardviewdemomain.pas

📁 DevExpress ExpressQuantumGrid Suite v5.9 Full Source
💻 PAS
字号:
unit CustomDrawCardViewDemoMain;

{$I ..\..\cxVer.inc}

interface

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, cxControls, cxLookupGrid, cxLookupDBGrid, cxGridCustomTableView,
  cxGridTableView, cxGridDBTableView, cxGridLevel, cxGridCustomView, cxGrid,
  cxGridCardView, cxGridDBCardView, cxMaskEdit, StdCtrls, ExtCtrls,
  cxContainer, cxEdit, cxTextEdit, cxDropDownEdit, cxDBEdit, cxStyles,
  Menus, ActnList, ImgList, ComCtrls, cxLookAndFeels, cxGraphics,
  ToolWin, cxCustomData, cxFilter, cxData, DB, cxDBData,
  cxClasses, cxDataStorage, cxDBLookupComboBox, cxBlobEdit, DemoUtils;

type
  TCustomDrawCardViewDemoMainForm = class(TForm)
    mmMain: TMainMenu;
    miAbout: TMenuItem;
    miFile: TMenuItem;
    miOptions: TMenuItem;
    miExit: TMenuItem;
    sbMain: TStatusBar;
    lbDescrip: TLabel;
    miSeparator1: TMenuItem;
    miLookFeel: TMenuItem;
    miKind: TMenuItem;
    miFlat: TMenuItem;
    miStandard: TMenuItem;
    miUltraFlat: TMenuItem;
    miNativeStyle: TMenuItem;
    miSeparator4: TMenuItem;
    ilPics: TImageList;
    miBlue: TMenuItem;
    miGold: TMenuItem;
    miGreen: TMenuItem;
    miGrey: TMenuItem;
    pnPersonLines: TPanel;
    pnPersonLinesCaption: TPanel;
    tvPersonLine: TcxGridDBTableView;
    lvPersonLine: TcxGridLevel;
    cxgPersonLine: TcxGrid;
    pnPersons: TPanel;
    cxgPersons: TcxGrid;
    cvPersons: TcxGridDBCardView;
    lvPersons: TcxGridLevel;
    Splitter: TSplitter;
    pnPersonsCaption: TPanel;
    tvPersonLineNAME: TcxGridDBColumn;
    cvPersonsFIRSTNAME: TcxGridDBCardViewRow;
    cvPersonsSECONDNAME: TcxGridDBCardViewRow;
    cvPersonsGENDER: TcxGridDBCardViewRow;
    cvPersonsBIRTHNAME: TcxGridDBCardViewRow;
    cvPersonsDATEOFBIRTH: TcxGridDBCardViewRow;
    cvPersonsBIRTHCOUNTRY: TcxGridDBCardViewRow;
    cvPersonsLOCATIONOFBIRTH: TcxGridDBCardViewRow;
    cvPersonsBIOGRAPHY: TcxGridDBCardViewRow;
    cvPersonsNICKNAME: TcxGridDBCardViewRow;
    miCustomDrawStyles: TMenuItem;
    miGradient: TMenuItem;
    miBackgroundImage: TMenuItem;
    miCar: TMenuItem;
    miSky: TMenuItem;
    miLoadImage: TMenuItem;
    OpenDialog: TOpenDialog;
    miDefaultDrawing: TMenuItem;
    FontDialog: TFontDialog;
    miFont: TMenuItem;
    miDependOnDataDrawing: TMenuItem;
    miEgypt: TMenuItem;
    miTile: TMenuItem;
    miMyFace: TMenuItem;
    LookAndFeelController: TcxLookAndFeelController;
    procedure miAboutClick(Sender: TObject);
    procedure miExitClick(Sender: TObject);
    procedure miNativeStyleClick(Sender: TObject);
    procedure miLookAndFeelKindClick(Sender: TObject);
    procedure cvPersonsCustomDrawCell(Sender: TcxCustomGridTableView;
      ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo;
      var ADone: Boolean);
    procedure miBlueClick(Sender: TObject);
    procedure miGreenClick(Sender: TObject);
    procedure miGoldClick(Sender: TObject);
    procedure miGreyClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure miCarClick(Sender: TObject);
    procedure miSkyClick(Sender: TObject);
    procedure miLoadClick(Sender: TObject);
    procedure miDefaultDrawingClick(Sender: TObject);
    procedure miFontClick(Sender: TObject);
    procedure miDependOnDataDrawingClick(Sender: TObject);
    procedure miMyFaceClick(Sender: TObject);
    procedure miEgyptClick(Sender: TObject);
    procedure miTileClick(Sender: TObject);
  private
    FColorScheme: TColorScheme;
    FCustomDrawingStyle: TCustomDrawingStyle;
    FCarBitmap, FSkyBitmap, FUserDefinedImage, FCurrentBitmap,
      FEgyptBitmap, FMyFaceBitmap, FTileBitmap: TBitMap;
    FFont: TFont;
    procedure GridsStyles;
    procedure AssignCustomDrawProc;
    procedure UncheckMenuItem(AMenuItem: TMenuItem);
    procedure SetBkImage(AMenuItem: TMenuItem; ABitMap: TBitMap);
    procedure SetGradientColor(AMenuItem: TMenuItem;
      AColorScheme: TColorScheme; ABackGroudStyleIndex: Integer);
  end;

var
  CustomDrawCardViewDemoMainForm: TCustomDrawCardViewDemoMainForm;

implementation

{$R *.dfm}

uses
  CustomDrawCardViewDemoData, AboutDemoForm;

procedure TCustomDrawCardViewDemoMainForm.FormCreate(Sender: TObject);
begin
  FColorScheme := csBlue;
  GridsStyles;

  FCustomDrawingStyle := cdsBkImage;

  FFont := TFont.Create;
  FFont.Assign(cxgPersons.Font);

  FCarBitmap := TBitMap.Create;
  LoadImageFromRes(FCarBitmap, 'CAR');

  FSkyBitmap := TBitMap.Create;
  LoadImageFromRes(FSkyBitmap, 'SKY');

  FEgyptBitmap := TBitmap.Create;
  LoadImageFromRes(FEgyptBitmap, 'EGYPT');

  FMyFaceBitmap := TBitmap.Create;
  LoadImageFromRes(FMyFaceBitmap, 'MYFACE');

  FTileBitmap := TBitmap.Create;
  LoadImageFromRes(FTileBitmap, 'TILE');

  FUserDefinedImage := TBitmap.Create;
  FCurrentBitmap := FTileBitmap;
end;

procedure TCustomDrawCardViewDemoMainForm.FormDestroy(Sender: TObject);
begin
  FCurrentBitmap := nil;
  FUserDefinedImage.Free;
  FEgyptBitmap.Free;
  FMyFaceBitmap.Free;
  FTileBitmap.Free;
  FCarBitmap.Free;
  FSkyBitmap.Free;
end;

procedure TCustomDrawCardViewDemoMainForm.miAboutClick(Sender: TObject);
begin
  ShowAboutDemoForm;
end;

procedure TCustomDrawCardViewDemoMainForm.cvPersonsCustomDrawCell(
  Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;
  AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
var
  ARec: TRect;
  ATextToDraw: String;
  ABool: Boolean;
  AIsVertical: Boolean;
  procedure SetTextToDraw;
  begin
    if (AViewInfo is TcxGridCardRowDataViewInfo) then
    begin
      if (AViewInfo.Item.Index = cvPersonsGENDER.Index) then
      begin
        if VarAsType(AViewInfo.GridRecord.Values[cvPersonsGENDER.Index], varBoolean) then
          ATextToDraw := 'Male'
        else
          ATextToDraw := 'Female';
      end
      else
        ATextToDraw := AViewInfo.GridRecord.DisplayTexts[AViewInfo.Item.Index];
    end
    else
      ATextToDraw := VarAsType(AViewInfo.Item.Caption, varString);
  end;

begin
  ARec := AViewInfo.Bounds;
  ACanvas.Canvas.Font.Assign(FFont);
  SetTextToDraw;
  case FCustomDrawingStyle of
    cdsBkImage:
      ACanvas.FillRect(ARec, FCurrentBitmap);
    cdsGradient:
    begin
      AIsVertical := (FColorScheme = csGrey) or (FColorScheme = csGold);
      if AViewInfo is TcxGridCardRowDataViewInfo then
        DrawGradient(ACanvas.Canvas, ARec, ColorScheme[Integer(FColorScheme), 1], ColorScheme[Integer(FColorScheme), 0], 40, AIsVertical)
      else
        DrawGradient(ACanvas.Canvas, ARec, ColorScheme[Integer(FColorScheme), 0], ColorScheme[Integer(FColorScheme), 1], 40, AIsVertical);
    end;
    cdsDependOnData:
    begin
      ACanvas.Canvas.Brush.Style := bsSolid;
      ACanvas.Canvas.Brush.Color := clBlueLight;
      ACanvas.Canvas.FillRect(ARec);
      if VarAsType(AViewInfo.GridRecord.Values[cvPersonsGENDER.Index], varBoolean) then
        ACanvas.Canvas.Font.Color := clBlue
      else
        ACanvas.Canvas.Font.Color := clFuchsia;
      if (AViewInfo is TcxGridCardRowDataViewInfo) and (AViewInfo.Item.Index = cvPersonsGENDER.Index) then
      begin
        ABool := VarAsType(AViewInfo.GridRecord.Values[cvPersonsGENDER.Index], varBoolean);
        ilPics.Draw(ACanvas.Canvas, ARec.Left + 2, ARec.Top, Integer(ABool));
        ATextToDraw := '';
      end;
    end;
  end;

  SetBkMode(ACanvas.Canvas.Handle, TRANSPARENT);
  ACanvas.DrawText(ATextToDraw, TcxCustomTextEditViewInfo(AViewInfo.EditViewInfo).TextRect, 0);

  ADone := FCustomDrawingStyle <> cdsDefaultDrawing;
end;

procedure TCustomDrawCardViewDemoMainForm.GridsStyles;
begin
  cvPersons.OptionsView.SeparatorColor := ColorScheme[2, 2];
  cvPersons.Styles.Background := CustomDrawCardViewDemoMainDM.StyleRepository.Items[6] as TcxStyle;
end;

procedure TCustomDrawCardViewDemoMainForm.AssignCustomDrawProc;
begin
  if not Assigned(cvPersons.OnCustomDrawCell) then
    cvPersons.OnCustomDrawCell := cvPersonsCustomDrawCell;
end;

procedure TCustomDrawCardViewDemoMainForm.SetGradientColor(AMenuItem: TMenuItem; AColorScheme: TColorScheme; ABackGroudStyleIndex: Integer);
begin
  if (FCustomDrawingStyle <> cdsGradient) or (FColorScheme <> AColorScheme) then
  begin
    FColorScheme := AColorScheme;
    AMenuItem.Checked := True;
    if FCustomDrawingStyle <> cdsGradient then
    begin
      UncheckMenuItem(AMenuItem);
      FCustomDrawingStyle := cdsGradient;
      miGradient.Checked := True;
    end;
    cvPersons.OptionsView.SeparatorColor := ColorScheme[Integer(AColorScheme), 2];
    cvPersons.Styles.Background := CustomDrawCardViewDemoMainDM.StyleRepository.Items[ABackGroudStyleIndex] as TcxStyle;
    AssignCustomDrawProc;
    cvPersons.Painter.Invalidate;
  end;
end;

procedure TCustomDrawCardViewDemoMainForm.miGreenClick(
  Sender: TObject);
begin
  SetGradientColor(Sender as TMenuItem, csGreen, 8);
end;

procedure TCustomDrawCardViewDemoMainForm.miGoldClick(
  Sender: TObject);
begin
  SetGradientColor(Sender as TMenuItem, csGold, 4);
end;

procedure TCustomDrawCardViewDemoMainForm.miGreyClick(
  Sender: TObject);
begin
  SetGradientColor(Sender as TMenuItem, csGrey, 5);
end;

procedure TCustomDrawCardViewDemoMainForm.miBlueClick(
  Sender: TObject);
begin
  SetGradientColor(Sender as TMenuItem, csBlue, 6);
end;

procedure TCustomDrawCardViewDemoMainForm.miLoadClick(
  Sender: TObject);
begin
  if OpenDialog.Execute then
  begin
    TMenuItem(Sender).Checked := True;
    if FCustomDrawingStyle <> cdsBkImage then
    begin
      UncheckMenuItem(Sender as TMenuItem);
      GridsStyles;
      FCustomDrawingStyle := cdsBkImage;
      miBackgroundImage.Checked := True;
    end;

    FUserDefinedImage.LoadFromFile(OpenDialog.FileName);
    FCurrentBitmap := FUserDefinedImage;
    AssignCustomDrawProc;
    cvPersons.Painter.Invalidate;
 end;
end;

procedure TCustomDrawCardViewDemoMainForm.UncheckMenuItem(AMenuItem: TMenuItem);

  function IsLookAndFeelMenuItem(AMenuItem: TMenuItem): Boolean;
  begin
    Result := (AMenuItem.Parent = miKind) or (AMenuItem = miNativeStyle);
  end;

var
  i: Integer;
begin
  for i:=0 to ComponentCount - 1 do
    if (Components[i] is TMenuItem) and (Components[i] <> AMenuItem) and
      (Components[i] as TMenuItem).Checked and
       not IsLookAndFeelMenuItem(Components[i] as TMenuItem) then
        (Components[i] as TMenuItem).Checked := False;
end;

procedure TCustomDrawCardViewDemoMainForm.miDefaultDrawingClick(
  Sender: TObject);
begin
  if not TMenuItem(Sender).Checked then
  begin
    TMenuItem(Sender).Checked := True;
    UncheckMenuItem(Sender as TMenuItem);
    FCustomDrawingStyle := cdsDefaultDrawing;
    cvPersons.OnCustomDrawCell := nil;
    cvPersons.Styles.Background := nil;
    cvPersons.OptionsView.SeparatorColor := clBtnFace;
    cvPersons.Painter.Invalidate;
  end;
end;

procedure TCustomDrawCardViewDemoMainForm.miFontClick(Sender: TObject);
begin
  FontDialog.Font.Assign(FFont);
  if FontDialog.Execute then
  begin
    FFont.Assign(FontDialog.Font);
    cvPersons.Styles.ContentEven.Font.Assign(FontDialog.Font);
    cvPersons.Styles.ContentOdd.Font.Assign(FontDialog.Font);
    cvPersons.LayoutChanged(False);
    cvPersons.Painter.Invalidate;
  end;
end;

procedure TCustomDrawCardViewDemoMainForm.miExitClick(Sender: TObject);
begin
  Close;
end;

procedure TCustomDrawCardViewDemoMainForm.miNativeStyleClick(Sender: TObject);
begin
  with LookAndFeelController do
  begin
    NativeStyle := not NativeStyle;
    (Sender as TMenuItem).Checked := NativeStyle;
  end;
end;

procedure TCustomDrawCardViewDemoMainForm.miLookAndFeelKindClick(Sender: TObject);
begin
  LookAndFeelController.Kind := TcxLookAndFeelKind(TMenuItem(Sender).MenuIndex);
  (Sender as TMenuItem).Checked := True;
end;

procedure TCustomDrawCardViewDemoMainForm.miDependOnDataDrawingClick(
  Sender: TObject);
begin
  if not TMenuItem(Sender).Checked then
  begin
    TMenuItem(Sender).Checked := True;
    UncheckMenuItem(Sender as TMenuItem);
    FCustomDrawingStyle := cdsDependOnData;
    GridsStyles;
    AssignCustomDrawProc;
    cvPersons.Painter.Invalidate;
  end;
end;

procedure TCustomDrawCardViewDemoMainForm.miEgyptClick(
  Sender: TObject);
begin
  SetBkImage(Sender as TMenuItem, FEgyptBitmap);
end;

procedure TCustomDrawCardViewDemoMainForm.miMyFaceClick(
  Sender: TObject);
begin
  SetBkImage(Sender as TMenuItem, FMyFaceBitMap);
end;

procedure TCustomDrawCardViewDemoMainForm.miTileClick(
  Sender: TObject);
begin
  SetBkImage(Sender as TMenuItem, FTileBitMap);
end;

procedure TCustomDrawCardViewDemoMainForm.miSkyClick(
  Sender: TObject);
begin
  SetBkImage(Sender as TMenuItem, FSkyBitmap);
end;

procedure TCustomDrawCardViewDemoMainForm.miCarClick(
  Sender: TObject);
begin
  SetBkImage(Sender as TMenuItem, FCarBitmap);
end;

procedure TCustomDrawCardViewDemoMainForm.SetBkImage(AMenuItem: TMenuItem; ABitMap: TBitMap);
begin
  if not TMenuItem(AMenuItem).Checked then
  begin
    TMenuItem(AMenuItem).Checked := True;
    if FCustomDrawingStyle <> cdsBkImage then
    begin
      UncheckMenuItem(AMenuItem);
      GridsStyles;
      FCustomDrawingStyle := cdsBkImage;
      miBackgroundImage.Checked := True;
    end;
    FCurrentBitmap := ABitMap;
    AssignCustomDrawProc;
    cvPersons.Painter.Invalidate;
  end;
end;

end.  

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -