Форум: "Начинающим";
Текущий архив: 2014.03.23;
Скачать: [xml.tar.bz2];
Внизналожение bmp. Найти похожие ветки
← →
Martin (2013-06-12 02:22) [0]вот такая задача .... что нужно взять текстовий документ в формате картинки ...... и за буквами наристовать узор .... (фрактали точнее)
← →
turbouser © (2013-06-12 05:34) [1]Хорошая задача
← →
brother © (2013-06-12 06:50) [2]еще чуть - и на орех смело потянет!
автор, еще раз и более понятный текст ТЗ давай... ибо, например
> взять текстовий документ в формате картинки
мне рвет голову, это сканированный документ или что?
← →
brother © (2013-06-12 07:42) [3]> узор .... (фрактали точнее)
вообще шедевр!
← →
[ВладОшин] © (2013-06-12 08:50) [4]варианта 2
либо это все же текст (*.txt)
тогда идея простая - рисовать что надо, а сверху canvas.textout( считанное из файла) следить за переносом слов руками ( textwidth)
либо это сканированный документ,
тогда идея не менее простая - на картинке, равной по размеру исходной, рисовать что надо, а сверху наложить исходную как OR (на исходной принять все буквы черными)
← →
[ВладОшин] © (2013-06-12 09:17) [5]
> как OR
отставить, как AND
← →
Inovet © (2013-06-12 09:27) [6]> [4] [ВладОшин] © (12.06.13 08:50)
> тогда идея не менее простая
Да, но у текста в буковах должна появиться фрактали.
← →
[ВладОшин] © (2013-06-12 09:32) [7]
> Inovet © (12.06.13 09:27) [6]
главное не фекали :)
← →
брат Птибурдукова (2013-06-12 10:22) [8]Шаланды полные фрактали
По тексту Martin провозил,
И все узоры ристовали,
Когда на форум он входил…
← →
Inovet © (2013-06-12 11:55) [9]Мы теплоход зафрахтовали
и пели песни наизусть.
Потом напелись и упали.
Фрактали сняться, ну и пусть.
← →
[ВладОшин] © (2013-06-12 12:21) [10]шаапкаа -
на бокуууу...
а фрактали - синииии...
это сани нас несут из
пруссии в Россию!
это сани нас несут из пруссии в Россию! эх...!1
← →
robt5 (2013-06-12 19:03) [11]а как насчет читабельности текста на фоне фракталей? яб невдул
← →
Мартін (2013-06-12 23:54) [12]исходной файл сканированый документ в формате .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.
← →
Мартін (2013-06-12 23:55) [13]
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:56) [14]
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;
ето надо чтото тут менять ?
← →
Inovet © (2013-06-13 07:13) [15]> [12] Мартін (12.06.13 23:54)
> как от него избавиться ????
Надо сказать, что белый - это прозрачный. Только сделать его белым, а не каким-то другим, например, сканировать в чёрнобелом.
← →
Алканавт расправил плечи (2013-06-13 07:47) [16]
> а там белый фон и он закрывает собой все фракталы .. как
> от него избавиться ????
читай справку по BitBlt, конкретно по режиму SRC_AND
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2014.03.23;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.002 c