Renkli resmi sepia yapmak(siyah-beyaz)
function bmptosepia(const bmp: TBitmap; depth: Integer): Boolean;
var
color,color2:longint;
r,g,b,rr,gg:byte;
h,w:integer;
begin
for h := 0 to bmp.height do
begin
for w := 0 to bmp.width do
begin
//first convert the bitmap to greyscale
color:=colortorgb(bmp.Canvas.pixels[w,h]);
r:=getrvalue(color);
g:=getgvalue(color);
b:=getbvalue(color);
color2:=(r+g+b) div 3;
bmp.canvas.Pixels[w,h]:=RGB(color2,color2,color2);
//then convert it to sepia
color:=colortorgb(bmp.Canvas.pixels[w,h]);
r:=getrvalue(color);
g:=getgvalue(color);
b:=getbvalue(color);
rr:=r+(depth*2);
gg:=g+depth;
if rr <= ((depth*2)-1) then
rr:=255;
if gg <= (depth-1) then
gg:=255;
bmp.canvas.Pixels[w,h]:=RGB(rr,gg,b);
end;
end;
end;
//Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
bmptosepia(image1.picture.bitmap, 20);
end;
Delphi - .....................................
Reknli resmi sepia yapmak(siyah-beyaz)
function bmptosepia(const bmp: TBitmap; depth: Integer): Boolean;
var
color,color2:longint;
r,g,b,rr,gg:byte;
h,w:integer;
begin
for h := 0 to bmp.height do
begin
for w := 0 to bmp.width do
begin
//first convert the bitmap to greyscale
color:=colortorgb(bmp.Canvas.pixels[w,h]);
r:=getrvalue(color);
g:=getgvalue(color);
b:=getbvalue(color);
color2:=(r+g+b) div 3;
bmp.canvas.Pixels[w,h]:=RGB(color2,color2,color2);
//then convert it to sepia
color:=colortorgb(bmp.Canvas.pixels[w,h]);
r:=getrvalue(color);
g:=getgvalue(color);
b:=getbvalue(color);
rr:=r+(depth*2);
gg:=g+depth;
if rr <= ((depth*2)-1) then
rr:=255;
if gg <= (depth-1) then
gg:=255;
bmp.canvas.Pixels[w,h]:=RGB(rr,gg,b);
end;
end;
end;
//Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
bmptosepia(image1.picture.bitmap, 20);
end;
Delphi - .....................................
SecoSoft Kronometre Yardım 
Arkadaşım kronometreyi yapmak zor değil ama sayaç olarak timer kullandım.
o da gerçek saniye hızında çalışmıyo.En azından benim makinamda. ama kod olarak
doğru. Eğer daha iyi sonuç istersen diğer componentlerden HighRes timer bul.
Şimdilik sana bukadar yardımcı olabilirim...
//----------- FORM1 in text kodları---------------//
object Form1: TForm1
Left = 221
Top = 205
Width = 182
Height = 143
Caption = 'Kronometre'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Saat: TLabel
Left = 22
Top = 70
Width = 28
Height = 32
Caption = '00'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object S: TLabel
Left = 96
Top = 70
Width = 28
Height = 32
Caption = '00'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object ms: TLabel
Left = 134
Top = 70
Width = 28
Height = 32
Caption = '00'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object D: TLabel
Left = 58
Top = 70
Width = 28
Height = 32
Caption = '00'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label1: TLabel
Left = 50
Top = 74
Width = 7
Height = 24
Caption = ':'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label2: TLabel
Left = 88
Top = 74
Width = 7
Height = 24
Caption = ':'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label3: TLabel
Left = 126
Top = 74
Width = 7
Height = 24
Caption = ':'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Button1: TButton
Left = 20
Top = 22
Width = 59
Height = 25
Caption = 'Başlat'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 84
Top = 22
Width = 59
Height = 25
Caption = 'Durdur'
TabOrder = 1
OnClick = Button2Click
end
object Timer1: TTimer
Enabled = False
Interval = 10
OnTimer = Timer1Timer
Left = 102
Top = 4
end
end
//------------SON----------------//
//---------UNIT1-------------------//
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, JvComponent, JvThreadTimer;
type
TForm1 = class(TForm)
Saat: TLabel;
S: TLabel;
ms: TLabel;
D: TLabel;
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Sayac:integer;
implementation
{$R *.dfm}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
inc(Sayac);
ms.Caption:=FormatFloat('00',Sayac mod 100);
s.Caption:=FormatFloat('00',(Sayac div 100) mod 60);
d.Caption:=FormatFloat('00',(Sayac div 6000) mod 60);
saat.Caption:=FormatFloat('00',Sayac div 360000);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Sayac:=0;
timer1.Enabled:=true;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled:=false;
end;
end.
//-----------------SON-------------------//
Delphi - .....................................
SecoSoft Kronometre Yardım
Arkadaşım kronometreyi yapmak zor değil ama sayaç olarak timer kullandım.
o da gerçek saniye hızında çalışmıyo.En azından benim makinamda. ama kod olarak
doğru. Eğer daha iyi sonuç istersen diğer componentlerden HighRes timer bul.
Şimdilik sana bukadar yardımcı olabilirim...
//----------- FORM1 in text kodları---------------//
object Form1: TForm1
Left = 221
Top = 205
Width = 182
Height = 143
Caption = 'Kronometre'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Saat: TLabel
Left = 22
Top = 70
Width = 28
Height = 32
Caption = '00'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object S: TLabel
Left = 96
Top = 70
Width = 28
Height = 32
Caption = '00'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object ms: TLabel
Left = 134
Top = 70
Width = 28
Height = 32
Caption = '00'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object D: TLabel
Left = 58
Top = 70
Width = 28
Height = 32
Caption = '00'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label1: TLabel
Left = 50
Top = 74
Width = 7
Height = 24
Caption = ':'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label2: TLabel
Left = 88
Top = 74
Width = 7
Height = 24
Caption = ':'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label3: TLabel
Left = 126
Top = 74
Width = 7
Height = 24
Caption = ':'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Button1: TButton
Left = 20
Top = 22
Width = 59
Height = 25
Caption = 'Başlat'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 84
Top = 22
Width = 59
Height = 25
Caption = 'Durdur'
TabOrder = 1
OnClick = Button2Click
end
object Timer1: TTimer
Enabled = False
Interval = 10
OnTimer = Timer1Timer
Left = 102
Top = 4
end
end
//------------SON----------------//
//---------UNIT1-------------------//
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, JvComponent, JvThreadTimer;
type
TForm1 = class(TForm)
Saat: TLabel;
S: TLabel;
ms: TLabel;
D: TLabel;
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Sayac:integer;
implementation
{$R *.dfm}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
inc(Sayac);
ms.Caption:=FormatFloat('00',Sayac mod 100);
s.Caption:=FormatFloat('00',(Sayac div 100) mod 60);
d.Caption:=FormatFloat('00',(Sayac div 6000) mod 60);
saat.Caption:=FormatFloat('00',Sayac div 360000);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Sayac:=0;
timer1.Enabled:=true;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled:=false;
end;
end.
//-----------------SON-------------------//
Delphi - .....................................
Yardım
delphi 5 kullanıyorum. Programlarım bayağı bir
gelişti. Harika programlar ortaya çıkarıyorum.
Ama kronometre yapamıyorum. Bana yardım edin. Bana
yardım etmeniz için bir formun içine form1 var
hiç birşey yok halde iken neler ekleyip hangi
kodları yazmalıyım? Bu kodu lütfen bana gönderin.
İstediğiniz (çok zor olmamak koşuluyla) bir programı
teşekkür olarak e-mail adresinize yollarım. Bu konuda
yardım edin. Şu anki kodlar işlemiyor. Yapılmış bir
programdan kesilmiş. Onlarla yapması acayip zor
geliyor.Siz de öyle yapmadan gönderin.Program e-mailinize
gelmek üzeredir. Okuduğum anda uygulayacağım ve
çalışırsa istediğiniz programa başlayacağım.
Delphi - .....................................
Yardım
delphi 5 kullanıyorum. Programlarım bayağı bir
gelişti. Harika programlar ortaya çıkarıyorum.
Ama kronometre yapamıyorum. Bana yardım edin. Bana
yardım etmeniz için bir formun içine form1 var
hiç birşey yok halde iken neler ekleyip hangi
kodları yazmalıyım? Bu kodu lütfen bana gönderin.
İstediğiniz (çok zor olmamak koşuluyla) bir programı
teşekkür olarak e-mail adresinize yollarım. Bu konuda
yardım edin. Şu anki kodlar işlemiyor. Yapılmış bir
programdan kesilmiş. Onlarla yapması acayip zor
geliyor.Siz de öyle yapmadan gönderin.Program e-mailinize
gelmek üzeredir. Okuduğum anda uygulayacağım ve
çalışırsa istediğiniz programa başlayacağım.
Delphi - .....................................
Excel'den dbgrid'e import
procedure TForm1.Import1Click(Sender: TObject);
Var
ExcelApplication1 : TExcelApplication;
ExcelWorkBook1 : TExcelWorkBook;
ExcelWorkSheet1 : TExcelWorkSheet;
lcid : Integer;
aExcelFile : OleVariant;
aFile: String;
aCurrLine : integer;
aCurrColumn : integer;
begin
od.Title:= 'Shipmentinfo ';
if od.Execute then
begin
aFile:= od.FileName; //Dosya Ismı buraya
ExcelApplication1:=TExcelApplication.Create( self );
ExcelWorkBook1:=TExcelWorkBook.Create( self );
ExcelWorkSheet1:=TExcelWorkSheet.Create( self );
ExcelApplication1.Connect;
lcid := 1033;//Sisteminizde yuklu msoffice'in default LCID ülke kodu.
ExcelApplication1.Visible[ lcid ] := False;
aExcelFile:=aFile;
ExcelWorkBook1.ConnectTo(ExcelApplication1.Workbooks.Add(aExcelFile, lcid));
ExcelWorkSheet1.ConnectTo(ExcelWorkBook1.Worksheets[1] as _Worksheet);
if DataModule1.Shipmentinfo.Active then
DataModule1.Shipmentinfo.Close;
DataModule1.Shipmentinfo.Open;
aCurrLine:= 2;
while VarToStr(ExcelWorkSheet1.Cells.Item[ aCurrLine, 1 ].Value) <> '' do
begin
DataModule1.Shipmentinfo.insert;
DataModule1.shipmentinfo.FieldByName('Week').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 1 ].Value; //Excel sheet 'deki alanların dbgrid karşılığı
DataModule1.shipmentinfo.FieldByName('Trailer').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 2 ].Value;
DataModule1.shipmentinfo.FieldByName('Shipment').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 3 ].Value;
DataModule1.shipmentinfo.FieldByName('Customer').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 4 ].Value;
DataModule1.shipmentinfo.FieldByName('Name').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 5 ].Value;
DataModule1.shipmentinfo.FieldByName('Zipcode').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 6 ].Value;
DataModule1.shipmentinfo.FieldByName('City').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 7 ].Value;
DataModule1.shipmentinfo.FieldByName('Colli').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 9 ].Value;
DataModule1.shipmentinfo.FieldByName('Country').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 8 ].Value;
DataModule1.shipmentinfo.FieldByName('Weight').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 10 ].Value;
DataModule1.shipmentinfo.FieldByName('Unit').AsString:= ExcelWorkSheet1.Cells.Item[ aCurrLine, 11 ].Value;
DataModule1.Shipmentinfo.Post;
Self.Refresh;
inc( aCurrLine );
end;
ExcelWorkSheet1.Columns.Autofit;
ExcelApplication1.Visible[lcid]:=true;
ExcelWorksheet1.disconnect;
ExcelWorkbook1.disconnect;
ExcelApplication1.disconnect;
End;
End;
Delphi - .....................................
