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

📄 simplegridmain.pas

📁 GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for
💻 PAS
字号:
(*          GREATIS PRINT SUITE                 *)
(*  Copyright (C) 2001-2007 Greatis Software    *)
(*      web: http://www.greatis.com             *)
(*  support: http://www.greatis.com/bteam.html  *)

unit SimpleGridMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PSJob, PSStatusBar, PSPreview, ExtCtrls, PSToolbar, PJSimpleGrid, PJGrid;

type
  TMainForm = class(TForm)
    PreviewToolbar: TPreviewToolbar;
    Preview: TPreview;
    PreviewStatusBar: TPreviewStatusBar;
    SimpleGridPrintJob: TSimpleGridPrintJob;
    procedure SimpleGridPrintJobColWidth(Sender: TObject;
      TheCanvas: TCanvas; ACol: Integer; var ColWidth: Integer);
    procedure SimpleGridPrintJobInitDraw(Sender: TObject;
      TheCanvas: TCanvas; Target: TDrawTarget);
    procedure SimpleGridPrintJobDrawCell(Sender: TObject;
      TheCanvas: TCanvas; Rect: TRect; PageIndex, ACol, ARow: Integer;
      Target: TDrawTarget);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

type
  TColorData = record
    C: TColor;
    N: string;
  end;

const
  Colors: array[0..15] of TColorData = (
    (C: clBlack; N: 'Black'),
    (C: clMaroon; N: 'Maroon'),
    (C: clGreen; N: 'Green'),
    (C: clOlive; N: 'Olive'),
    (C: clNavy; N: 'Navy'),
    (C: clPurple; N: 'Purple'),
    (C: clTeal; N: 'Teal'),
    (C: clGray; N: 'Gray'),
    (C: clSilver; N: 'Silver'),
    (C: clRed; N: 'Red'),
    (C: clLime; N: 'Lime'),
    (C: clYellow; N: 'Yellow'),
    (C: clBlue; N: 'Blue'),
    (C: clFuchsia; N: 'Fuchsia'),
    (C: clAqua; N: 'Aqua'),
    (C: clWhite; N: 'White'));

procedure TMainForm.SimpleGridPrintJobColWidth(Sender: TObject;
  TheCanvas: TCanvas; ACol: Integer; var ColWidth: Integer);
var
  PW: Integer;
begin
  with (Sender as TCustomPrintJob).GetPageRect do PW:=Right-Left;
  case ACol of
    colIndex,0: ColWidth:=PW div 10
  else ColWidth:=8*PW div 30;
  end;
end;

procedure TMainForm.SimpleGridPrintJobInitDraw(Sender: TObject;
  TheCanvas: TCanvas; Target: TDrawTarget);
begin
  with TheCanvas.Font do
  begin
    Name:='Arial';
    Size:=12;
  end;
end;

procedure TMainForm.SimpleGridPrintJobDrawCell(Sender: TObject;
  TheCanvas: TCanvas; Rect: TRect; PageIndex, ACol, ARow: Integer;
  Target: TDrawTarget);
var
  Text: string;
  RGB: Integer;
begin
  with Sender as TSimpleGridPrintJob,TheCanvas,Rect do
  begin
    case ARow of
      rowHeader:
      begin
        case ACol of
          colIndex: Text:='#';
          0: Text:='C';
          1: Text:='Name';
          2: Text:='RGB Hex';
          3: Text:='RGB Decimal';
        end;
        Font.Style:=[fsBold];
      end;
      rowFooter: ;
    else
    begin
      case ACol of
        colIndex: Text:=IntToStr(ARow+IndexStart);
        0:
        begin
          Brush.Color:=Colors[ARow].C;
          InflateRect(Rect,-(Right-Left) div 5,-(Bottom-Top) div 5);
          Rectangle(Left,Top,Right,Bottom);
          Exit;
        end;
        1: Text:=Colors[ARow].N;
        2,3:
        begin
          RGB:=ColorToRGB(Colors[ARow].C);
          if ACol=2 then Text:=Format('%2.2x%2.2x%2.2x',[GetRValue(RGB),GetGValue(RGB),GetBValue(RGB)])
          else Text:=Format('%d,%d,%d',[GetRValue(RGB),GetGValue(RGB),GetBValue(RGB)]);
        end;
      end;
      Font.Style:=[];
    end;
    end;
    Brush.Color:=clWhite;
    TextOut(
      (Left+Right-TextWidth(Text)) div 2,
      (Top+Bottom-TextHeight(Text)) div 2,
      Text);
  end;
end;

end.

⌨️ 快捷键说明

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