Fatal编程技术网
  • delphi/
  • Delphi 更改包含已写入文本的区域的背景

Delphi 更改包含已写入文本的区域的背景

delphi canvas colors

Delphi 更改包含已写入文本的区域的背景,delphi,canvas,colors,background,Delphi,Canvas,Colors,Background,（德尔福DX 10.3） 我有一个大的空白（白色）画布（在Tpanel的后代上），在那里我绘制一些文本（使用Textout（），假设文本总是黑色）和图形（线条、矩形，没有那么复杂的东西）。 绘图后，我需要将某些特定区域的白色背景颜色从白色更改为另一种颜色。 我想要达到的效果是非常像带有彩色单元格的excel工作表。在所附示例中，所有列均为空白（白色），如“值”和“差”，然后黄色（价格）和红色（结果）列已上色。 如果我能在写文本之前填写区域，我会使用SetBkMode（透明）并获得最佳结果。不幸的

（德尔福DX 10.3）
我有一个大的空白（白色）画布（在Tpanel的后代上），在那里我绘制一些文本（使用Textout（），假设文本总是黑色）和图形（线条、矩形，没有那么复杂的东西）。
绘图后，我需要将某些特定区域的白色背景颜色从白色更改为另一种颜色。
我想要达到的效果是非常像带有彩色单元格的excel工作表。在所附示例中，所有列均为空白（白色），如“值”和“差”，然后黄色（价格）和红色（结果）列已上色。

如果我能在写文本之前填写区域，我会使用SetBkMode（透明）并获得最佳结果。不幸的是，我需要在编写文本和图形后填写区域。 我想到的第一个解决方案是逐像素替换（使用Pixels[]函数），但它的速度非常慢，图形效果也不令人满意

因此，我的问题是：如何为包含已写入文本的区域的背景上色？

这里有一个最小可重复性示例
按钮1执行像素替换，速度非常慢，图形结果不令人满意。
按钮2使用SetBkMode（透明）在写入文本后填充区域。完美的结果，但我做不到

program BK_mode;

uses
  Vcl.Forms,
  main in 'main.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
////////////////////////////////

unit main;

interface

uses Windows, Forms, SysUtils, Vcl.StdCtrls, UiTypes, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Graphics, Dialogs;

type
  TForm1 = class(TForm)
        btn_01: TButton;
        btn_02: TButton;
        procedure btn_02Click(Sender: TObject);
        procedure btn_01Click(Sender: TObject);
  private
        procedure write_text(canvas: TCanvas;x, y : integer;i_fontsize : smallint;const str_text: String;style : TFontStyles;bo_transparent : boolean);
        procedure switch_color(canvas : TCanvas;color_source, color_target : TColor);
        procedure prepare_example(bo_transparent : boolean);
  end;

var
    Form1: TForm1;

implementation

{$R *.dfm}

const
    BASE_COLOR = clWhite;
    ALTERNATIVE_COLOR = clRed;

procedure TForm1.write_text(canvas: TCanvas;x, y : integer;i_fontsize : smallint;const str_text: String;style : TFontStyles;bo_transparent : boolean);
begin
    var lo_old_BK_color : TColor := canvas.Brush.Color;
    var lo_old_BK_mode := GetBKMode(canvas.Handle);
    if bo_transparent then SetBKMode(canvas.Handle, TRANSPARENT)
    else begin
        SetBKMode(canvas.Handle, OPAQUE);
        canvas.Brush.Color := BASE_COLOR
    end;
    canvas.Font.Color := clBlack;canvas.Font.Size := i_fontsize;canvas.Font.Style := style;
    TextOut(canvas.Handle, x, y, PChar(str_text), Length(str_text));
    if NOT bo_transparent then canvas.Brush.Color := lo_old_BK_color;
    SetBKMode(canvas.Handle, lo_old_BK_mode)
end;

procedure TForm1.switch_color(canvas : TCanvas;color_source, color_target : TColor);
begin
    for var x := 0 to clientWidth-1 do
        for var y := 0 to clientHeight - 1 do
            if (canvas.Pixels[x, y] = color_source) then canvas.Pixels[x, y] := color_target
end;

procedure TForm1.prepare_example(bo_transparent : boolean);
begin
    if bo_transparent then Color := ALTERNATIVE_COLOR else Color := BASE_COLOR;
    invalidate;
    application.MessageBox('Click me', 'Test');
    canvas.Rectangle(10, 10, 200, 100);
    canvas.MoveTo(10, 110);canvas.LineTo(200, 140);
    canvas.MoveTo(10, 140);canvas.LineTo(200, 110);
    write_text(canvas, 30, 30, 14, 'This is a text!', [], bo_transparent);
    write_text(canvas, 30, 60, 11, 'This is another text!', [fsBold, fsItalic], bo_transparent)
end;

procedure TForm1.btn_01Click(Sender: TObject);
begin
    prepare_example(FALSE);
    switch_color(canvas, BASE_COLOR, ALTERNATIVE_COLOR)
end;

procedure TForm1.btn_02Click(Sender: TObject);
begin
    prepare_example(TRUE)
end;

end.

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 283
  ClientWidth = 208
  Color = clWhite
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  DesignSize = (
    208
    283)
  PixelsPerInch = 96
  TextHeight = 13
  object btn_01: TButton
    Left = 17
    Top = 161
    Width = 178
    Height = 51
    Anchors = [akLeft, akRight, akBottom]
    Caption = '1. write text and fill area'
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 0
    WordWrap = True
    OnClick = btn_01Click
  end
  object btn_02: TButton
    Left = 17
    Top = 220
    Width = 178
    Height = 51
    Anchors = [akLeft, akRight, akBottom]
    Caption = '2. fill area then write text'
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 1
    WordWrap = True
    OnClick = btn_02Click
  end
end
/////////////////////////////////////////////////////////

unit main;

interface

uses Windows, Forms, SysUtils, Vcl.StdCtrls, UiTypes, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Graphics, Dialogs;

type
  TForm1 = class(TForm)
        btn_01: TButton;
        btn_02: TButton;
        procedure btn_02Click(Sender: TObject);
        procedure btn_01Click(Sender: TObject);
  private
        procedure write_text(canvas: TCanvas;x, y : integer;i_fontsize : smallint;const str_text: String;style : TFontStyles;bo_transparent : boolean);
        procedure switch_color(canvas : TCanvas;color_source, color_target : TColor);
        procedure prepare_example(bo_transparent : boolean);
  end;

var
    Form1: TForm1;

implementation

{$R *.dfm}

const
    BASE_COLOR = clWhite;
    ALTERNATIVE_COLOR = clRed;

procedure TForm1.write_text(canvas: TCanvas;x, y : integer;i_fontsize : smallint;const str_text: String;style : TFontStyles;bo_transparent : boolean);
begin
    var lo_old_BK_color : TColor := canvas.Brush.Color;
    var lo_old_BK_mode := GetBKMode(canvas.Handle);
    if bo_transparent then SetBKMode(canvas.Handle, TRANSPARENT)
    else begin
        SetBKMode(canvas.Handle, OPAQUE);
        canvas.Brush.Color := BASE_COLOR
    end;
    canvas.Font.Color := clBlack;canvas.Font.Size := i_fontsize;canvas.Font.Style := style;
    TextOut(canvas.Handle, x, y, PChar(str_text), Length(str_text));
    if NOT bo_transparent then canvas.Brush.Color := lo_old_BK_color;
    SetBKMode(canvas.Handle, lo_old_BK_mode)
end;

procedure TForm1.switch_color(canvas : TCanvas;color_source, color_target : TColor);
begin
    for var x := 0 to clientWidth-1 do
        for var y := 0 to clientHeight - 1 do
            if (canvas.Pixels[x, y] = color_source) then canvas.Pixels[x, y] := color_target
end;

procedure TForm1.prepare_example(bo_transparent : boolean);
begin
    if bo_transparent then Color := ALTERNATIVE_COLOR else Color := BASE_COLOR;
    invalidate;
    application.MessageBox('Click me', 'Test');
    canvas.Rectangle(10, 10, 200, 100);
    canvas.MoveTo(10, 110);canvas.LineTo(200, 140);
    canvas.MoveTo(10, 140);canvas.LineTo(200, 110);
    write_text(canvas, 30, 30, 14, 'This is a text!', [], bo_transparent);
    write_text(canvas, 30, 60, 11, 'This is another text!', [fsBold, fsItalic], bo_transparent)
end;

procedure TForm1.btn_01Click(Sender: TObject);
begin
    prepare_example(FALSE);
    switch_color(canvas, BASE_COLOR, ALTERNATIVE_COLOR)
end;

procedure TForm1.btn_02Click(Sender: TObject);
begin
    prepare_example(TRUE)
end;

end.

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 283
  ClientWidth = 208
  Color = clWhite
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  DesignSize = (
    208
    283)
  PixelsPerInch = 96
  TextHeight = 13
  object btn_01: TButton
    Left = 17
    Top = 161
    Width = 178
    Height = 51
    Anchors = [akLeft, akRight, akBottom]
    Caption = '1. write text and fill area'
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 0
    WordWrap = True
    OnClick = btn_01Click
  end
  object btn_02: TButton
    Left = 17
    Top = 220
    Width = 178
    Height = 51
    Anchors = [akLeft, akRight, akBottom]
    Caption = '2. fill area then write text'
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 1
    WordWrap = True
    OnClick = btn_02Click
  end
end
你所要求的是根本无法通过这种方式实现的。您需要重新绘制整个画布，在顶部绘制线条+文本之前先绘制背景。一旦你画好了，你需要重新画一遍。请勿从绘制事件外部在画布上绘制

您的示例在
TForm.Canvas
上绘制，因此使用
TForm.OnPaint
事件。对于
TPanel
子体，替代虚拟
Paint（）
方法。无论哪种方式，都要保留一些具有所需设置的变量，在绘制时使用这些变量，并在更新变量并希望触发重新绘制后调用
Invalidate（）

例如：

unitmain；
接口
使用Windows、窗体、SysUtils、Vcl.StdCtrls、UiTypes、System.class、Vcl.Controls、Vcl.ExtCtrls、图形、对话框；
类型
TForm1=类（TForm）
btn_01:t按钮；
btn_02:t按钮；
程序btn_02Click（发送方：TObject）；
程序btn_01单击（发送方：TObject）；
过程表单创建（发送方：ToObject）；
程序FormPaint（发送方：TObject）；
私有的
FDrawTransparent：布尔值；
FDrawColor:TColor；
过程写入文本（ACanvas:TCanvas；x，y:integer；i_fontsize:smallint；const str_text:String；style:TFontStyles；bo_transparent:boolean）；
过程准备示例（bo_透明：布尔；颜色目标：TColor）；
结束；
变量
表1:TForm1；
实施
{$R*.dfm}
常数
基色=白色；
可选颜色=clRed；
过程TForm1.FormCreate（发送方：TObject）；
开始
FDrawTransparent:=假；
FDrawColor:=基础颜色；
结束；
程序TForm1.FormPaint（发送方：TObject）；
开始
Canvas.Brush.Color:=Self.Color；
画布。矩形（10，10，200，100）；
Canvas.MoveTo（10110）；
Canvas.LineTo（200140）；
Canvas.MoveTo（10140）；
Canvas.LineTo（200110）；
编写文本（Canvas，30，30，14，'这是一个文本！'，[]，FDrawTransparent）；
书写文本（Canvas，30，60，11，'这是另一个文本！'，[fsBold，fsItalic]，FDrawTransparent）；
结束；
过程TForm1.write_text（ACanvas:TCanvas；x，y:integer；i_fontsize:smallint；const str_text:String；style:TFontStyles；bo_transparent:boolean）；
开始
var lo_old_BK_color:=ACanvas.Brush.color；
var lo_old_BK_mode:=GetBKMode（ACanvas.Handle）；
如果bo_透明的话
SetBKMode（ACanvas.Handle，透明）
否则开始
SetBKMode（ACanvas.Handle，不透明）；
ACanvas.Brush.Color:=FDrawColor；
结束；
ACanvas.Font.Color:=clBlack；
ACanvas.Font.Size:=i_fontsize；
ACanvas.Font.Style:=样式；
TextOut（ACanvas.Handle、x、y、PChar（str_-text）、Length（str_-text））；
如果不是透明的，则ACanvas.Brush.Color:=lo_old_BK_Color；
SetBKMode（ACanvas.Handle，低旧模式）；
结束；
步骤TForm1.准备示例（透明：布尔；颜色目标：TColor）；
开始
FDrawTransparent:=bo_transparent；
FDrawColor:=目标颜色；
如果透明，则颜色：=可选颜色，否则颜色：=基础颜色；
使无效
Application.MessageBox（'单击我'，'测试'）；
结束；
程序TForm1.btn_01单击（发送方：TObject）；
开始
准备_示例（错误，可选_颜色）；
结束；
程序TForm1.btn_02Click（发送方：TObject）；
开始
准备示例（真实、基本颜色）；
结束；
结束。
谢谢@Remy，你当然是对的。我总是用颜料在画布上画画，但在这种情况下，直接画画会节省我很多工作。我会改变我的策略，我会更加努力，但我会做得更好。