Заштриховка нестандартной области

[somebody_now]

Вопрос такой:
как средствами delphi изобразить заштрихованную область на рисунке?
Пытался воткнуть логическое выражение (при пересечении - закрасить). Конечно ничего хорошего не вышло.
либо же возможно как-то скопировать эту область в другую канву - опять же все копировальные инструмент canvas'а приспособлены только для прямоугольника.
либо аналитически по координатам границы окружности,но не понимаю как задать такое выражение без логики, а у логикой с рисованием в delphi проблемы.
как мне сделать такую штриховку?

п.с. эти круги нарисованы на форме при выполнении onPaint. Может проблема разрешима использованием Shape. Если да, то как?

[BBB]

А с использованием регионов не получится?

Используются ф-ии WinApi:

1) CreateEllipticRgn - дважды, для каждого из двух кругов.
2) CombineRgn (fnCombineMode = RGN_AND) - получаем регион пересечения двух кругов
3) FillRgn или PaintRgn - закрашиваем регион нужной кистью.

PS. Наверное, это "си"-шный, а не "дельфи"-йный подход. Может, в Дельфи есть какие-то свои штучки. Но, в любом случае, Дэльфи все это, в конце концов, через WinAPI делает.

[somebody_now]

можно о регионах поподробнее? вобщем-то, первый раз об этом слышу...
или может на справочный материал какой направите..

[BBB]

MSDN.

A region is a rectangle, polygon, or ellipse (or a combination of two or more of these shapes) that can be filled, painted, inverted, framed, and used to perform hit testing (testing for the cursor location).

Посмотрите описание тех четырех функций. Параметров там немного, вроде особых загвоздок в их понимании быть не должно. Попробуйте, подойдет вам или нет. Я сам то, что предложил, не пробовал.

http://msdn2.microsoft.com/en-us/library/ms536643.aspx

Знаю еще, что для создания окон "необычной" формы (например, круглых) как раз используются регионы.

[Хыиуду]

А еще можно bitblt использовать. Поиграться там с разными флагами заливки.

[somewhere]

У канваса вроде FloodFill есть, можно его заюзать.

[BBB]

Попробовал свой "WinAPI-шный" способ.
Возможно, "по-Дельфийному" надо как-то по-дургому, через какие-то свои классы.
Но результат есть.
Два вызова FrameRgn - исключительно чтобы были видны две окружности.
Для расцветки использую системные кисти (GetSysColorBrush), чтобы не геморроиться в этом примере с созданием своих кистей.

Прикладываю картинку с результатом.

[syntax="Delphi"]
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm2 = class(TForm)
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
m_rgn1, m_rgn2 : HRGN;
m_rgn_sum : HRGN;
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormPaint(Sender: TObject);
var blOk : boolean;
begin

FrameRgn (
Canvas.Handle,
m_rgn1, //HRGN hrgn, // handle to region to be framed
GetSysColorBrush (1), // HBRUSH hbr, // handle to brush used to draw border
1, // int nWidth, // width of region frame
1 //int nHeight // height of region frame
);
FrameRgn (
Canvas.Handle,
m_rgn2, //HRGN hrgn, // handle to region to be framed
GetSysColorBrush (1), // HBRUSH hbr, // handle to brush used to draw border
1, // int nWidth, // width of region frame
1 //int nHeight // height of region frame
);

blOk := FillRgn (
Canvas.Handle,
m_rgn_sum,
GetSysColorBrush (2)
);

end;

procedure TForm2.FormCreate(Sender: TObject);
var
iCombineRes : integer;
begin
//
m_rgn1 := CreateEllipticRgn (100, 100, 200, 200);
m_rgn2 := CreateEllipticRgn (150, 150, 300, 300);
m_rgn_sum := CreateEllipticRgn (0, 0, 1, 1); // anything
iCombineRes := CombineRgn (
m_rgn_sum, m_rgn1, m_rgn2, RGN_AND);
if (iCombineRes = ERROR) then
ShowMessage (IntToStr (GetLastError ()));

end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
//
DeleteObject (m_rgn1);
DeleteObject (m_rgn2);
DeleteObject (m_rgn_sum);
end;

end.[/syntax]

[somebody_now]

спасибо всем)))
поскольку две пересекающиеся окружности были как пример(а пересекаются-то 3 фигуры, каждая между двумя другими,что впрочем менее важно), то floodfill реально наиболее простой и удобный метод. я просто как не дочитал в справочнике, что от некой точки floodfill заливает во все стороны, но при этом этом имеет и другие параметры, махнул на него рукой).
с регионами попробую сейчас посидеть, разобраться,хотя думается врядли для вобщей сложности 7 областей,это будет удобнее floodfill'а)
ещё раз спасибо всем за советы, за помощь!

[somebody_now]

а теперь пара слов, для чего это было нужно: необходимо было для вводимой логической формулы построить таблицу истинности (1 анализатор - записываем действия, 2 - распознаём их,сравниваем с каждым предыдущим столбцом, при совпадении производим операцию), ну и рисуем прямоугольник и круги, да и закрашиваем области, совпавшие по таблице.
Без внедрения скобок код работал исправно, вставил обработку скобок - без них нормально не работает. но это не главное - дело в одном условии, хуже то, что после заполнения таблицы на участке работы со скобками,заполняет таблицу неверно.
в коде немного комментов, но меня интересует в основном выделенный фрагмент:

Код: Выделить всё

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls, jpeg;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Button1: TButton;
    Label8: TLabel;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Label9: TLabel;
    StringGrid2: TStringGrid;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const srow=9;
const x0=700;    //центр новой системы координат для рисунка
const y0=600;    

procedure to2(c:integer; var r:string);
var z,ss:integer;
begin
r:=''; ss:=2;
  while c>0 do begin
    z:=c mod ss;
    case z of
      0: r:='0'+r;
      1: r:='1'+r;
    end;
  c:=c div ss;
  end;
end;

procedure zapst(obj:TStringGrid);
var nc,i,j:integer; a:string;
begin
nc:=0;
  while nc<8 do begin
    for i:=1 to 3 do begin
    to2(nc,a);
      for j:=1 to 3-length(a) do a:='0'+a;
    obj.cells[i-1,nc+1]:=a[i];
    end;
  inc(nc);
  end;
end;

procedure kolvo(y:string; var kol_op:integer; var kol_otr:integer; var kol_mul:integer; var kol_slozh:integer; var kol_imp:integer; var kol_ekv:integer);
var i:integer;
begin
kol_op:=0; kol_otr:=0; kol_mul:=0; kol_slozh:=0;  kol_ekv:=0; kol_imp:=0;
for i:=1 to length(y) do begin
  if y[i] in ['*','+','>','^','~'] then kol_op:=kol_op+1;
    if y[i]='*' then inc(kol_mul);
    if y[i]='+' then inc(kol_slozh);
    if y[i]='^' then inc(kol_otr);
    if y[i]='~' then inc(kol_ekv);
    if y[i]='>' then inc(kol_imp);
end;
end;

procedure otricanie(y:string; obj:TStringgrid; kol:integer; var kolvo_otr:integer);
var inv:set of 'A'..'C';
i,u:integer;
begin
inv:=[]; u:=0; kolvo_otr:=0;
for i:=1 to length(y)-1 do    //смотрим отрицания
  if y[i]='^' then
    if (y[i+1]='A') or (y[i+1]='B') or (y[i+1]='C') then begin
//проверяем "лишние"
      if y[i+1] in inv then begin inc(u); continue end else inv:=inv+[y[i+1]];
    obj.cells[kol,0]:=y[i]+y[i+1];
     inc(kol); inc(kolvo_otr);
    end;
obj.ColCount:=obj.ColCount-u;
end;

[somebody_now]

Код: Выделить всё

procedure analysis1_mul(obj:TStringGrid; smul:integer; ymul:string; k:integer; kol:integer);
var pst,i,c,d,k1,k2:integer;
begin
  while smul>0 do begin
k1:=0; k2:=0;
  pst:=pos('*',ymul); c:=pst-1; d:=pst+1;
  for i:=d to k do begin
    if (copy(ymul,i,1)='*') or (copy(ymul,i,1)='+') or (copy(ymul,i,1)='~') or (copy(ymul,i,1)='>') then begin k2:=i-1; break end
    else k2:=k; end;
  if pst=1 then begin
  k1:=1;
  obj.cells[kol,0]:=obj.cells[kol-1,0]+copy(ymul,k1,k2-k1+1);
delete(ymul,k1,k2-k1+1);
if (pos('+',ymul)=1) or (pos('~',ymul)=1) or (copy(ymul,i,1)='>') then delete(ymul,1,1);
inc(kol); dec(smul); continue
  end else
    for i:=c downto 1 do
     if (copy(ymul,i,1)='*') or (copy(ymul,i,1)='+') or (copy(ymul,i,1)='~') or (copy(ymul,i,1)='>') then begin k1:=i+1; break; end
      else k1:=1;
obj.cells[kol,0]:=copy(ymul,k1,k2-k1+1);
delete(ymul,k1,k2-k1+1);
if (pos('+',ymul)=1) or (pos('~',ymul)=1) or (copy(ymul,i,1)='>') then delete(ymul,1,1);
inc(kol); dec(smul);
end;
end;

procedure analysis1_slozh(obj:TStringGrid; sslozh:integer; yplus:string; k:integer; kol:integer);
var k1,k2,c,d,pst,i:integer;
begin
while sslozh>0 do begin
k1:=0; k2:=0;
  pst:=pos('+',yplus); c:=pst-1; d:=pst+1;
  for i:=d to k do
    if (copy(yplus,i,1)='+') or (copy(yplus,i,1)='~') or (copy(yplus,i,1)='>') then begin k2:=i-1; break end
    else k2:=k;
  if pst=1 then begin
  k1:=1;
  obj.cells[kol,0]:=obj.cells[kol-1,0]+copy(yplus,k1,k2-k1+1);
delete(yplus,k1,k2-k1+1);
if (pos('~',yplus)=1) or (pos('>',yplus)=1) then delete(yplus,1,1);
inc(kol); dec(sslozh); continue
  end else
    for i:=c downto 1 do
     if (copy(yplus,i,1)='+') or (copy(yplus,i,1)='~') or (copy(yplus,i,1)='>') then begin k1:=i+1; break; end
      else k1:=1;
obj.cells[kol,0]:=copy(yplus,k1,k2-k1+1);
delete(yplus,k1,k2-k1+1);
if (pos('~',yplus)=1) or (pos('>',yplus)=1) then delete(yplus,1,1);
inc(kol); dec(sslozh);
end;
end;

procedure analysis1_imp(obj:TStringGrid; simp:integer; yimp:string; k:integer; kol:integer);
var k1,pst,k2,c,d,i:integer;
begin
while simp>0 do begin
k1:=0; k2:=0;
  pst:=pos('>',yimp); c:=pst-1; d:=pst+1;
  for i:=d to k do
    if (copy(yimp,i,1)='~') or (copy(yimp,i,1)='>') then begin k2:=i-1; break end
    else k2:=k;
form1.label3.caption:=inttostr(c)+'  '+inttostr(d);
  if pst=1 then begin
  k1:=1;
obj.cells[kol,0]:=obj.cells[kol-1,0]+copy(yimp,k1,k2-k1+1);
delete(yimp,k1,k2-k1+1);
if (pos('~',yimp)=1) then delete(yimp,1,1);
inc(kol); dec(simp); continue
  end else
    for i:=c downto 1 do
     if (copy(yimp,i,1)='~') or (copy(yimp,i,1)='>') then begin k1:=i+1; break; end
      else k1:=1;
obj.cells[kol,0]:=copy(yimp,k1,k2-k1+1);
delete(yimp,k1,k2-k1+1);
if (pos('~',yimp)=1) then delete(yimp,1,1);
inc(kol); dec(simp);
end;
end;

procedure analysis1_ekv(obj:TStringGrid; sekv:integer; yekv:string; k:integer; kol:integer);
var k1,k2,c,d,pst,i:integer;
begin
    while sekv>0 do begin
k1:=0; k2:=0;
  pst:=pos('~',yekv); c:=pst-1; d:=pst+1;
  for i:=d to k do
    if (copy(yekv,i,1)='~') then begin k2:=i-1; break end
    else k2:=k;
  if pst=1 then begin
  k1:=1;
  obj.cells[kol,0]:=obj.cells[kol-1,0]+copy(yekv,k1,k2-k1+1);
delete(yekv,k1,k2-k1+1);
inc(kol); dec(sekv); continue
  end else
    for i:=c downto 1 do
     if (copy(yekv,i,1)='~') then begin k1:=i+1; break; end
      else k1:=1;
obj.cells[kol,0]:=copy(yekv,k1,k2-k1+1);
delete(yekv,k1,k2-k1+1);
inc(kol); dec(sekv);
end;
end;