Vyzkoušel jsem všelico od +4, +64, +1024 (všechny dávaj 0. tečka.); až po
yCurrent := pFirstByte+stride+4096
a v tu chvíli to krachne. Soubor má ale velikost 912x940 tak by krachnout neměl.
Volání té moji funkce probíhá takto:
Shrnutí aktuálního problému:
Čte pouze jeden řádek. Není možné to, že scanline - jak napovídá název funkce, zpřístupní do paměti jen jeden řádek? Přitom je ale problém v tom, že já ten obrázek v GUI nevidím vykreslený. Mám poslat celý kód? Možná je chyba právě v tomto. Já to sem pošlu ať víš z čeho se skládá GUI.
unit Unit1;
{$WARN UNSAFE_CODE OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, GR32_Image;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
OpenDialog1: TOpenDialog;
PaintBox1: TPaintBox;
PaintBox2: TPaintBox;
Label1: TLabel;
StaticText1: TStaticText;
StaticText2: TStaticText;
SaveDialog1: TSaveDialog;
timetext: TStaticText;
clocktext: TStaticText;
Label2: TLabel;
Label3: TLabel;
Edit2: TEdit;
Label4: TLabel;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses timerunit,resizeunit_2;
procedure TForm1.Button1Click(Sender: TObject);
//load picture
begin
opendialog1.filter := 'bitmaps | *bmp' ;
if opendialog1.execute then
begin
bm1.loadfromfile(opendialog1.filename);
bm1.PixelFormat := pf32bit;
end;
with paintbox1 do
with canvas do
begin
brush.color := $ffffff;
fillrect(rect(0,0,width,height));
draw(0,0,bm1);
end;
statictext1.caption := inttostr(bm1.width);
statictext2.caption := inttostr(bm1.height);
end;
procedure TForm1.Button2Click(Sender: TObject);
//resize bm1 to bm2
var destwidth,destheight : word;
clock1,clock2 : Int64;
begin
destwidth := strtoint(edit1.text);
if checkbox1.Checked then //keep ratio
begin
destheight := trunc(destwidth/bm1.Width*bm1.Height);
edit2.Text := inttostr(destheight);
end
else destheight := strtoint(edit2.text);
with bm2 do
begin
width := destwidth;
height := destheight;
end;
//--
with paintbox2 do with canvas do
begin
brush.color := $ffffff;
fillrect(rect(0,0,width,height));
end;
//--
getCPUticks(clock1);
// 16x16 steps should analyze (16-1)*(16-1)=225 pixels
// 8x8 picks should analyze next (8-1)*(8-1)=49 pixels
BMSampleResize(16,16,8,8);
getCPUticks(clock2);
//
timetext.Caption := formatfloat('0.0',(clock2-clock1)/CPUclock);
paintbox2.canvas.draw(0,0,bm2);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
setCPUclock;
clocktext.Caption := formatfloat('0.0',CPUclock);
bm1 := Tbitmap.create;
with bm1 do
begin
pixelformat := pf32bit;
width := 200;
height := 200;
end;
bm2 := Tbitmap.create;
bm2.pixelformat := pf32bit;
// @ For testing purposes:
bm1.loadfromfile('U:\DELPHI\Bitmapy\TheResizeProject\resize\test.bmp');
bm1.PixelFormat := pf32bit;
with paintbox1 do
with canvas do
begin
brush.color := $ffffff;
fillrect(rect(0,0,width,height));
draw(0,0,bm1);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bm1.free;
bm2.free;
end;
end.
A unit1.dfm
object Form1: TForm1
Left = 188
Top = 264
Width = 812
Height = 612
HorzScrollBar.Position = 38
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
Scaled = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 378
Top = 16
Width = 25
Height = 13
Caption = 'width'
end
object Label2: TLabel
Left = 610
Top = 16
Width = 56
Height = 13
Caption = 'time (usecs)'
end
object Label3: TLabel
Left = 722
Top = 16
Width = 82
Height = 13
Caption = 'CPU clock (MHz)'
end
object Label4: TLabel
Left = 434
Top = 16
Width = 29
Height = 13
Caption = 'height'
end
object PaintBox1: TPaintBox
Left = 24
Top = 72
Width = 497
Height = 489
end
object PaintBox2: TPaintBox
Left = 528
Top = 72
Width = 265
Height = 489
end
object Button1: TButton
Left = -22
Top = 32
Width = 75
Height = 25
Caption = 'load'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 498
Top = 32
Width = 75
Height = 25
Caption = 'resize'
TabOrder = 1
OnClick = Button2Click
end
object Edit1: TEdit
Left = 378
Top = 32
Width = 50
Height = 21
TabOrder = 2
Text = '200'
end
object StaticText1: TStaticText
Left = 66
Top = 32
Width = 50
Height = 21
AutoSize = False
BorderStyle = sbsSunken
Caption = '200'
TabOrder = 3
end
object StaticText2: TStaticText
Left = 138
Top = 32
Width = 50
Height = 21
AutoSize = False
BorderStyle = sbsSunken
Caption = '200'
TabOrder = 4
end
object timetext: TStaticText
Left = 610
Top = 32
Width = 97
Height = 24
AutoSize = False
BorderStyle = sbsSunken
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -16
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5
end
object clocktext: TStaticText
Left = 722
Top = 32
Width = 81
Height = 24
AutoSize = False
BorderStyle = sbsSunken
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -16
Font.Name = 'Arial'
Font.Style = []
ParentFont = False
TabOrder = 6
end
object Edit2: TEdit
Left = 434
Top = 32
Width = 50
Height = 21
TabOrder = 7
Text = '200'
end
object CheckBox1: TCheckBox
Left = 290
Top = 32
Width = 73
Height = 17
Caption = 'keep ratio'
Checked = True
State = cbChecked
TabOrder = 8
end
object OpenDialog1: TOpenDialog
Left = 24
Top = 80
end
object SaveDialog1: TSaveDialog
Left = 64
Top = 80
end
end
TIP: Přetáhni ikonu na hlavní panel pro připnutí webu
Grafoman
Nahlásit jako SPAM
IP: 89.177.85.–
Zjistit počet nových příspěvků
