-
объясните пожалуйста, что не так:
procedure TForm1.FormClick(Sender: TObject); var x, y: integer;
begin for x:=0 to Form.Width-1 do for y:=0 to Form.Height-1 do
NewBitmap(200,200).canvas.pixels[ X, Y ]:=clRed; end;
-
NewBitmap should be OUTSIDE of the loop.....
-
thanks but not working, how? please help !
-
program Project1;
uses
windows,messages,
kol;
var
form,button:PControl;
BM:pbitmap;
procedure clickbutton1(dummy:pointer;Sender:PControl; var mouse:TMouseEventData);
var x, y: integer;
begin
if BM = nil then Bm:=NewBitmap(200,200);
with bm.canvas^ do
for x:=0 to Form.Width-1 do
for y:=0 to Form.Height-1 do
pixels[ X, Y ]:=clRed;
Bm.Draw(form.Canvas.Handle,0,0);
end;
Begin
form:=NewForm(Applet,'шаблон').SetSize(300,240).setposition(330,300);
Button:=NewButton(form,'Выполнить').SetSize(90,30).SetPosition(25,75);
Button.OnClick:=TonEvent(MakeMethod(nil,@clickbutton1));
Run(form);
end.
-
большое спасибо)
буду разбираться
-
снова созрел вопрос - а как задать формат, к примеру:pf1bit
-
Bmp.PixelFormat := pf1bit;
-
-
Спасибки огромное
-
procedure TForm1.btnButton1Click(Sender: PObj);
var
x,y: Integer;
begin
Bm:=NewBitmap(Form.Width,Form.Height);
NewBrush;
Bm.Draw(form.Canvas.Handle,0,0);
end; как выставить цвет бруша? - подскажите пожалуйста
-
-
var bmp:PBitmap; //should be in form object or something; you should also free it somewhere.
procedure TForm1.FormClick(Sender: TObject); var x, y: integer; begin if nor assigned(bmp) then Bmp:=NewBitmap(200,200); for x:=0 to Form.Width-1 do for y:=0 to Form.Height-1 do bmp.canvas.pixels[ X, Y ]:=clRed; end;
-
var Bm:pbitmap; x,y: Integer; begin Bm:=NewBitmap(form.Width-1,form.Height-1);
with bm.canvas^ do Ellipse(10, 10, 100, 100);
//SetBkColor(form.canvas.Handle,$ffffff); Bm.Draw(form.Canvas.Handle,20,-1); bm.free; end; пока что получилось только это - не могу понять как избавиться от чёрного фона
-
BM.Canvas.Brush.BrushStyle:=bsSolid;
BM.Canvas.Brush.Color:=clBtnFace;
BM.Canvas.FloodFill(0,0,clBtnFace,fsBorder);
-
program Project1;
uses
windows,
kol;
var
form:PControl;
fRgn:HRGN;
fon:pBitmap;
fon_:HBrush;
procedure formPaint( Dummy: Pointer; Sender: PControl; DC: HDC );
begin
fon:= NewBitmap( 0, 0 );
try
fon.LoadFromFile('Голубые кружева 16.bmp');
fon_:=createPatternBrush(fon.Handle);
FrameRgn (form.Canvas.Handle, fRgn,fon_,71,71); finally
fon.Free;
DeleteObject (fRgn);
end;
end;
Begin
form:=NewForm(Applet,'Brush paint').SetSize(250,250).setposition(330,300);
fRgn := CreateEllipticRgn (0, 0, 200, 200);
form.OnPaint:=tonpaint(MakeMethod(nil,@formpaint));
Run(form);
end.
-
Спасибо Огромное Человеку под ником RusSun © , который всегда даёт внятные и чёткие ответы - побольше бы таких людей
-
Ещё один вопрос: как сделать чтобы нарисованное изображение не затиралось?
-
type co_ordinate = record
x,y : integer;
end;
type scanline = array[0..319] of byte;
var
pForm : TForm1;
Threshold : integer;
blobs : array[0..5] of co_ordinate;
Frame : Cardinal;
drawing : boolean;
implementation
var bmp : PBitmap;
procedure TForm1.KOLFormFormCreate(Sender: PObj);
var Temp : integer;
pal : PLogPalette;
hpal : HPALETTE;
x,y:Integer;
begin
frame := 0;
bmp := NewBitmap(form.Width,form.Height);
bmp.PixelFormat:=pf8bit;
bmp.width := form.Width;
bmp.height := form.Height;
timer1.Enabled := true;
end;
procedure TForm1.Timer1Timer(Sender: PObj);
var X_Loop, Y_Loop, I : integer;
Value, t : integer;
Scan : ^scanline;
begin
Frame := frame +1;
if drawing = false then
begin
blobs[0].x := 160 + round(150 * SIN((2 * frame) * 0.01745329252222));
blobs[0].y := 100 + round(90 * SIN((4 * frame) * 0.01745329252222));
blobs[1].x := 160 + round(150 * SIN((6 * frame) * 0.01745329252222));
blobs[1].y := 100 + round(90 * SIN((3 * frame) * 0.01745329252222));
blobs[2].x := 160 + round(150 * SIN((7 * frame) * 0.01745329252222));
blobs[2].y := 100 + round(90 * SIN((5 * frame) * 0.01745329252222));
blobs[3].x := 160 + round(150 * SIN((3 * frame) * 0.01745329252222));
blobs[3].y := 100 + round(90 * SIN((2 * frame) * 0.01745329252222));
blobs[4].x := 160 + round(150 * SIN((4 * frame) * 0.01745329252222));
blobs[4].y := 100 + round(90 * SIN((2 * frame) * 0.01745329252222));
blobs[5].x := 160 + round(150 * SIN((2 * frame) * 0.01745329252222));
blobs[5].y := 100 + round(90 * SIN((3 * frame) * 0.01745329252222));
drawing := true;
For Y_Loop := 0 to 239 do
begin
scan := Bmp.ScanLine[y_loop];
for X_Loop := 0 to 319 do
begin
t := 0;
For I := 0 to 5 do
begin
value := (Blobs[i].X-X_loop)*(Blobs[i].X-X_Loop);
value := value + (Blobs[i].Y-Y_loop)*(Blobs[i].Y-Y_Loop);
if value < 1 then value := 1;
t := t+ (100000 div value);
end;
t := 255-t;
if t < 0 then t := 0;
Scan[x_loop] := t;
end;
end;
drawing := false;
Bmp.Draw(form.Canvas.Handle,0,0);
end;
end;
end.
подскажите знающие люди: должен быть синий фон и красные блобы - цвет почемуто искажён, что не так?
-
Палитра не заполнена. for i := 0 to Bmp.DIBPalEntryCount - 1 do
Bmp.DIBPalEntries[i] := RGB2BGR(RGB(255 - i, 0, 128 - i));
-
Спасибо тебе и ркепкого здоровья добрый человек - заработало )
-
Подскажите пожалуйста - а как менять палитру формата pf4bpp битмапа?
-
Зачем вообще использовать палитровые битмапы? Мы ж не в каменном веке. Цель?
-
Спасибо за помощь - уже разобрался
-
как задать прозрачность лейбам или панелькам?
-
-
http://delphimaster.net/view/11-1211396216для формы _______________________________________________ Дмитрий К © (2008-05-22 00:08) [1]
Как вариант:
program testMouseWheel;
uses
Windows, KOL;
var Form, PB: PControl;
procedure FormMouseWheel(Dummy, Sender: PControl; var Mouse: TMouseEventData);
var zDelta: SmallInt; r:TRect; p: TPoint;
begin
GetWindowRect(PB.Handle, r);
GetCursorPos(p);
if PointInRect(p, r) then
begin
zDelta := HiWord(Mouse.Shift);
if zDelta < 0 then
begin
PB.Width := PB.Width - 10;
PB.Height := PB.Height - 10;
end
else begin
PB.Width := PB.Width + 10;
PB.Height := PB.Height + 10;
end;
end;
end;
procedure PBPaint(Dummy, Sender: PControl; DC: HDC);
begin
Sender.Canvas.FillRect(Sender.ClientRect);
end;
var wp: TWindowPlacement; FullScreened: Boolean;
procedure FullScreen(Undo: Boolean);
begin
if Undo then
begin
Form.Style := Form.Style or (WS_CAPTION or WS_THICKFRAME);
SetWindowPlacement(Form.Handle, @wp);
FullScreened := False;
end
else begin
wp.length := SizeOf(wp);
GetWindowPlacement(Form.Handle, @wp);
Form.Style := Form.Style and not (WS_CAPTION or WS_THICKFRAME);
Form.BoundsRect := MakeRect(0, 0, ScreenWidth, ScreenHeight);
FullScreened := True;
end;
end;
procedure FormKeyUp(Dummy, Sender: PControl; var Key: Longint; Shift: DWORD);
begin
if (Key = VK_F11) and (Shift and (MK_ALT or MK_CONTROL or MK_SHIFT) = 0) then
begin
FullScreen(FullScreened);
end;
end;
begin
Form := NewForm(nil, "test");
PB := NewPaintBox(Form);
PB.Style := PB.Style or WS_BORDER;
PB.Canvas.Brush.Color := clRed;
PB.OnPaint := TOnPaint(MakeMethod(nil, @PBPaint));
Form.OnMouseWheel := TOnMouse(MakeMethod(nil, @FormMouseWheel));
Form.ExStyle := Form.ExStyle or WS_EX_LAYERED;
Form.OnKeyUp := TOnKey(MakeMethod(nil, @FormKeyUp));
SetLayeredWindowAttributes(Form.GetWindowHandle, clRed, 200, LWA_COLORKEY or LWA_ALPHA);
Run(Form);
end.
-
спасибо большое за ответ - я имею ввиду прозрачность на фоне динамической картинки, к проимеру на форме идёт анимация а лежащая на ней лайба отображает только шрифт без фона
-
Созрел ещё вопрос - как сделать так чтобы при рисовании процессор не нагружался(как в mspaint)
-
Удалено модератором
-
Удалено модератором
-
Удалено модератором
-
Как извлечь палитру из PNG?
-
Грузануть в коловский PNGImage, в нем есть PBitmap, а в нем - палитра (если изображение 8-битное).
-
Как создать StayOnTop-Вторичную Форму только для главной формы, т.е. чтобы вызванная форма перекрывалась формами других приложений а своей главной формой не перекрывалось?
-
Да, и при этом главная форма должна быть полностью доступной как и второстепенная
-
"избил"(что называется) весь интернет - так и не нашёл решения дорисовки пиксела функции LineTo - люди добрые помогите, подскажите верный ответ
-
Что значит "дорисовки пиксела функции LineTo"?
-
DKOL, если вы не в курсе то не засоряйте тему, а ежели знаете толк то будте добры помогите
-
Существует ли готовое решение BmpSave2png ? Заранее спасибо!
-
-
tinyLoadJPGGIFBMPFile(Image.jpg); bmp.SaveToStream(ImageStream); png.LoadFromStream(ImageStream); png.SaveToFile(Image.png);
Подскажите пожалуйста как правильно
-
procedure TestBmpToPng;
var
bmp: PBitmap;
png: PPngObject;
begin
bmp := NewBitmap(0,0);
png := NewPngObject;
bmp.LoadFromFile('Test.bmp');
png.AssignHandle(bmp.Handle, False, 0);
png.SaveToFile('Test.png');
bmp.Free;
png.Free;
end;
-
Netspirit -спасибо!
|