| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

наложение bmp. [D7, XP]

Martin ©   (2013-06-12 02:22:00) 

вот такая задача .... что нужно взять текстовий документ в формате картинки ...... и за буквами наристовать узор .... (фрактали точнее)

---

Алканавт расправил плечи   (2013-06-13 07:47:00) [1]

> а там белый фон и он закрывает собой все фракталы .. как
> от него избавиться ????
читай справку по BitBlt, конкретно по режиму SRC_AND

---

Inovet   (2013-06-13 07:13:00) [2]

> [12] Мартін   (12.06.13 23:54)
> как от него избавиться ????

Надо сказать, что белый - это прозрачный. Только сделать его белым, а не каким-то другим, например, сканировать в чёрнобелом.

---

Мартін   (2013-06-12 23:56:00) [3]

 BitMap1.Height:=y;
   BitMap1.Width:=x;
   Bitmap1.Canvas.FillRect(Rect(0,0,x,y));
   a(p,Bitmap1.Canvas);
   Bitmap2:=TBitmap.Create;
   Bitmap2.LoadFromFile(OpenDialog1.FileName);
   Bitmap2.Transparent:=true;
   Bitmap1.Transparent:=true;
   Bitmap2.TransparentColor := clwhite;
   //Bitmap1.Canvas.BrushCopy(Rect(0,0,x,y),Bitmap2,Rect(0,0,x,y),clwhite);
   //Bitmap1.Canvas.CopyRect(Rect(0,0,x,y),Bitmap2.Canvas,Rect(0,0,x,y));
   a(p,Bitmap1.Canvas);
   BitMap1.SaveToFile(SavePictureDialog1.FileName );
   BitMap1.Free;
   Bitmap1 := TBitmap.Create;
ето надо чтото тут менять ?

---

Мартін   (2013-06-12 23:55:00) [4]

 BitMap1.Height:=y;
   BitMap1.Width:=x;
   Bitmap1.Canvas.FillRect(Rect(0,0,x,y));
   a(p,Bitmap1.Canvas);
   Bitmap2:=TBitmap.Create;
   Bitmap2.LoadFromFile(OpenDialog1.FileName);
   Bitmap2.Transparent:=true;
   Bitmap1.Transparent:=true;
   Bitmap2.TransparentColor := clwhite;
   //Bitmap1.Canvas.BrushCopy(Rect(0,0,x,y),Bitmap2,Rect(0,0,x,y),clwhite);
   //Bitmap1.Canvas.CopyRect(Rect(0,0,x,y),Bitmap2.Canvas,Rect(0,0,x,y));
   a(p,Bitmap1.Canvas);
   BitMap1.SaveToFile(SavePictureDialog1.FileName );
   BitMap1.Free;
   Bitmap1 := TBitmap.Create;
ето надо чтото тут менять ?

---

Мартін   (2013-06-12 23:54:00) [5]

исходной файл сканированый документ в формате .bmp и надо как бы под текст подложить фракталы .... у меня проблема в том что я рисую фракталы ... сверху накладываю картинку (скан) ... а там белый фон и он закрывает собой все фракталы .. как от него избавиться ????

unit Prog;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtDlgs, Menus, Buttons, ExtCtrls, ComCtrls, StdCtrls, ComObj,
 WordXP, OleServer,QClipbrd;

type
 TForm1 = class(TForm)
  Button1: TButton;
   Edit1: TEdit;
   MainMenu1: TMainMenu;
   N11: TMenuItem;
   SavePictureDialog1: TSavePictureDialog;
   Button2: TButton;
   Edit2: TEdit;
   Button3: TButton;
   GroupBox1: TGroupBox;
   ComboBox1: TComboBox;
   TrackBar1: TTrackBar;
   Edit3: TEdit;
   Edit4: TEdit;
   Label1: TLabel;
   Label2: TLabel;
   GroupBox2: TGroupBox;
   ComboBox3: TComboBox;
   ComboBox4: TComboBox;
   ColorBox1: TColorBox;
   BitBtn1: TBitBtn;
   OpenDialog1: TOpenDialog;
   WordDocument1: TWordDocument;
   WordApplication1: TWordApplication;
   procedure Button1Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure Edit2Change(Sender: TObject);
   procedure Edit3Change(Sender: TObject);
   procedure Edit4Change(Sender: TObject);
   procedure ComboBox1Change(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure ColorBox1Change(Sender: TObject);
   procedure ComboBox3Change(Sender: TObject);
   procedure Button2Click(Sender: TObject);

 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 Bitmap1 : TBitmap;
 Bitmap2: TBitmap;

implementation

{$R *.dfm}
var
 p,u,i: integer;
 x: integer=2100;
 y: integer=2970;

procedure a(i:integer; canvas: TCanvas); forward;
procedure b(i:integer; canvas: TCanvas); forward;
procedure c(i:integer; canvas: TCanvas); forward;
procedure d(i:integer; canvas: TCanvas); forward;

procedure a(i: integer; canvas: TCanvas);
 begin
   if i > 0 then begin

     d(i-1, canvas); canvas.LineTo(canvas.PenPos.X+u,canvas.PenPos.Y);
     a(i-1, canvas); canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y+u);
     a(i-1, canvas); canvas.LineTo(canvas.PenPos.X-u,canvas.PenPos.Y);
     c(i-1, canvas);
   end;
 end;

procedure b(i: integer; canvas: TCanvas);
 begin
  if i > 0 then
  begin
     c(i-1, canvas); canvas.LineTo(canvas.PenPos.X-u,canvas.PenPos.Y);
     b(i-1, canvas); canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y-u);
     b(i-1, canvas); canvas.LineTo(canvas.PenPos.X+u,canvas.PenPos.Y);
     d(i-1, canvas);
  end;
 end;

procedure c(i: integer; canvas: TCanvas);
 begin
  if i > 0 then
  begin
     b(i-1, canvas); canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y-u);
     c(i-1, canvas); canvas.LineTo(canvas.PenPos.X-u,canvas.PenPos.Y);
     c(i-1, canvas); canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y+u);
     a(i-1, canvas);
  end;
 end;

procedure d(i: integer; canvas: TCanvas);
 begin
  if i > 0 then
  begin
     a(i-1, canvas); canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y+u);
     d(i-1, canvas); canvas.LineTo(canvas.PenPos.X+u,canvas.PenPos.Y);
     d(i-1, canvas); canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y-u);
     b(i-1, canvas);
  end;
 end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   p:=TrackBar1.Position ;
   u:=1;
   for i:=1 to p do
   u:=u*2;
   u:=trunc(y/u+1);
   BitMap1.Height:=y;
   BitMap1.Width:=x;
   Bitmap1.Canvas.FillRect(Rect(0,0,x,y));
   a(p,Bitmap1.Canvas);
   Bitmap2:=TBitmap.Create;
   Bitmap2.LoadFromFile(OpenDialog1.FileName);
   Bitmap2.Transparent:=true;
   Bitmap1.Transparent:=true;
   Bitmap2.TransparentColor := clwhite;
   //Bitmap1.Canvas.BrushCopy(Rect(0,0,x,y),Bitmap2,Rect(0,0,x,y),clwhite);
   //Bitmap1.Canvas.CopyRect(Rect(0,0,x,y),Bitmap2.Canvas,Rect(0,0,x,y));
   a(p,Bitmap1.Canvas);
   BitMap1.SaveToFile(SavePictureDialog1.FileName );
   BitMap1.Free;
   Bitmap1 := TBitmap.Create;

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
SavePictureDialog1.Execute;
Edit2.Text:=SavePictureDialog1.FileName;
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
SavePictureDialog1.FileName:=Edit2.Text;
end;

procedure TForm1.Edit3Change(Sender: TObject);
begin
y:=trunc(StrToInt(Edit3.Text));
end;

procedure TForm1.Edit4Change(Sender: TObject);
begin
x:=trunc(StrToInt(Edit4.Text));
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
case ComboBox1.ItemIndex of
 0:begin x:=2970; y:=4200 end;
 1:begin x:=2100; y:=2970 end;
 2:begin x:=1480; y:=2100 end;
 end;
 Edit3.Text:=IntToStr(y);
 Edit4.Text:=IntToStr(x);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap1 := TBitmap.Create;
end;

procedure TForm1.ColorBox1Change(Sender: TObject);
begin
Bitmap1.Canvas.Pen.Color := ColorBox1.Selected;;
end;

procedure TForm1.ComboBox3Change(Sender: TObject);
begin
case ComboBox3.ItemIndex of
 0: begin x:=x*1; y:=y*1 end;
 1: begin x:=x*2; y:=y*2 end;
 2: begin x:=x*3; y:=y*3 end;
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
OpenDialog1.Execute;
Edit1.Text:=OpenDialog1.FileName;
end;

end.



---

robt5   (2013-06-12 19:03:00) [6]

а как насчет читабельности текста на фоне фракталей? яб невдул

---

[ВладОшин]   (2013-06-12 12:21:00) [7]

шаапкаа -
        на бокуууу...
а фрактали - синииии...

это сани нас несут из
пруссии в Россию!
это сани нас несут из пруссии в Россию! эх...!1

---

Inovet   (2013-06-12 11:55:00) [8]

Мы теплоход зафрахтовали
и пели песни наизусть.
Потом напелись и упали.
Фрактали сняться, ну и пусть.

---

брат Птибурдукова   (2013-06-12 10:22:00) [9]

Шаланды полные фрактали
По тексту Martin провозил,
И все узоры ристовали,
Когда на форум он входил…

---

[ВладОшин]   (2013-06-12 09:32:00) [10]

> Inovet ©   (12.06.13 09:27) [6]

главное не фекали :)

---

Inovet   (2013-06-12 09:27:00) [11]

> [4] [ВладОшин] ©   (12.06.13 08:50)
> тогда идея не менее простая

Да, но у текста в буковах должна появиться фрактали.

---

[ВладОшин]   (2013-06-12 09:17:00) [12]

>  как OR

отставить, как AND

---

[ВладОшин]   (2013-06-12 08:50:00) [13]

варианта 2
либо это все же текст (*.txt)
тогда идея простая - рисовать что надо, а сверху canvas.textout( считанное из файла) следить за переносом слов руками ( textwidth)

либо это сканированный документ,
тогда идея не менее простая - на картинке, равной по размеру исходной, рисовать что надо, а сверху наложить исходную  как OR (на исходной принять все буквы черными)

---

brother   (2013-06-12 07:42:00) [14]

> узор .... (фрактали точнее)

вообще шедевр!

---

brother   (2013-06-12 06:50:00) [15]

еще чуть - и на орех смело потянет!
автор, еще раз и более понятный текст ТЗ давай... ибо, например

> взять текстовий документ в формате картинки

мне рвет голову, это сканированный документ или что?

---

turbouser   (2013-06-12 05:34:00) [16]

Хорошая задача

---

Наверх