- 博客(6)
- 资源 (46)
- 收藏
- 关注
RSS订阅转载 Delphi中ChartFx构件使用详解
Delphi是一种新型可视化程序开发工具。它在功能上远远胜过VB，甚至被冠以VB杀手(VB Killer)的美誉。理由之一就是Delphi可以轻松地安装和使用VB的VBX控件并转换VB程序为Delphi程序。本文将就Delphi组件VBX页里ChartFx(图表)构件的特性和使用方法作一较为完备的阐述。相信对读者建立美观的图表有所裨益，并会对Delphi的“属性管理”有更深一步的认识
2012-08-31 09:33:41
1320
转载 cxgrid 如何动态创建列?
cxgrid 如何动态创建列?var i: Integer; Column: TcxGridDBColumn; cxView: TcxGridDBTableView; begin cxView := Self.Levels[0].GridView as TcxGridDBTableView; if cxView.DataController.DataSource
2012-08-28 13:57:21
1099
1
转载 webbrowser delphi 事件详解
webbrowser delphi 事件详解基础说明：方法：GoBack 后退，使你在当前历史列表中后退一项，Alt + ←GoForward 前进，使你在当前历史列表中前进一项，Alt + →GoHome 主页，连接用户默认的主页GoSearch 搜索，连接用户默认的搜索页面Navigate 连接到指定的URLRefresh 刷新当前页面，F5Refresh2
2012-08-06 22:17:21
1246
转载 解决delphi关于dbgrid和webbrowser的焦点冲突的问题
procedure TOpenCad.dbgrd1CellClick(Column: TColumn);var str:string; oldcur:TCursor;begin oldcur:=Screen.Cursor;//屏幕焦点 Screen.Cursor:=crHourGlass; if wb1.Busy then
2012-08-06 22:16:39
1079
转载 RichEdit到RichEdit复制
uses RichEditredt1里面有一些文本. RichEdit MaxLenght 属性设置为 2147483645 可以存储2G大小的文件通过代码实现将redt1的内容原封不动的复制到redt2中.用CopyToClipboard和PasteFromClipboard只能粘贴一次.比如:for i:=0 to 10 dobeginredt1
2012-08-06 22:15:48
423
转载 RichEdit 复制方法
The TRichEdit Delphi control is an editor control that supports rich text formatting: text that includes variation in font attributes and paragraph formatting information - rich text formatting.RT
2012-08-06 22:14:49
795
多用户通讯实例-文件传输
unit MyClass;
interface
uses Classes,SysUtils;
type
{$METHODINFO ON}
TMyClass = class(TComponent)
function Sum(const A, B: Double): Double;
end;
{$METHODINFO OFF}
implementation
uses Unit1;
{ TMyClass }
function TMyClass.Sum(const A, B: Double): Double;
var p:string;
begin
Result := A + B;
p:=floattostr(Result);
TThread.Synchronize(nil,
procedure begin
form1.Memo1.Lines.Add(p);
end);
end;
end.
2012-08-06
delphi字符串压缩
unit main;
interface
{*********************************************************************
压缩测试单元
作者：崔东伟
Email:cuidongwei@yeah.net 或 s72002004@yahoo.com.cn
发布这一文件的目的是希望它有用，但没有任何担保。甚至没有适合特定目的
而隐含的担保。作者不承担由此带来的任何问题
*********************************************************************}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;
const
BufferSize=2048;
type
Tmainfm = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
GroupBox1: TGroupBox;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
GroupBox2: TGroupBox;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
GroupBox3: TGroupBox;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
GroupBox4: TGroupBox;
BitBtn10: TBitBtn;
BitBtn11: TBitBtn;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Memo1: TMemo;
Label3: TLabel;
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
mainfm: Tmainfm;
implementation
{$R *.DFM}
uses
lz77,arith,zlib,lh5unit;
procedure ZCompress(InStr, OutStr: TStream);
var
Zstream:TCustomZlibStream;
CompressionLevel:TCompressionLevel;
begin
CompressionLevel:=clMax;
ZStream := TCompressionStream.Create(CompressionLevel, OutStr);
try
ZStream.CopyFrom(InStr, 0);
finally
ZStream.Free;
end;
end;
procedure ZExpand(InStr, OutStr: TStream);
var
Zstream:TCustomZlibStream;
Buffer : Array[0 .. BufferSize - 1] of Byte;
count:integer;
begin
ZStream := TDecompressionStream.Create(InStr);
try
while True do
begin
Count := ZStream.Read(Buffer, BufferSize);
if Count <> 0 then OutStr.WriteBuffer(Buffer, Count) else Break;
end;
finally
ZStream.Free;
end;
end;
procedure Tmainfm.BitBtn3Click(Sender: TObject);
const
cstr:array[1..8] of string=
('lz77Compress',
'lz77Expand',
'ArithCompress',
'ArithExpand',
'LHACompress',
'LHAExpand',
'ZCompress',
'ZExpand');
var
infn,outfn:string;
infile,outfile:TStream;
begin
infn:=Edit1.text;
if not fileexists(infn) then
raise exception.Create('源文件不存在!');
outfn:=Edit2.text;
if fileexists(outfn) then
begin
if application.messagebox('输出文件已经存在，要覆盖该文件吗?',
'警告',MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2)=IDNO then exit;
deletefile(outfn);
end;
InFile := TFileStream.Create(infn, fmOpenRead);
try
OutFile := TFileStream.Create(outfn, fmCreate);
try
case TComponent(Sender).tag of
1:lz77Compress(Infile,OutFile);
2:lz77Expand(Infile,OutFile);
3:ArithCompress(Infile,OutFile);
4:ArithExpand(Infile,OutFile);
5:LHACompress(Infile,OutFile);
6:LHAExpand(Infile,OutFile);
7:zCompress(Infile,OutFile);
8:zExpand(Infile,OutFile);
end;
if TComponent(Sender).tag in [1,3,5,7] then
memo1.Lines.add(format('%s 输入%d :bytes 输出:%d bytes 压缩比:%5.2f',
[cstr[TComponent(Sender).tag],InFile.size,outfile.size,outfile.size*100/InFile.size])+'%')
else
memo1.Lines.add(format('%s 输入%d :bytes 输出:%d bytes 压缩比:%5.2f',
[cstr[TComponent(Sender).tag],InFile.size,outfile.size,InFile.size*100/outfile.size])+'%');
finally
outfile.free;
end;
finally
InFile.Free;
end;
end;
procedure Tmainfm.BitBtn1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
edit1.Text:=OpenDialog1.FileName;
end;
procedure Tmainfm.BitBtn2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
edit2.Text:=SaveDialog1.FileName;
end;
end.
2012-08-06
delphi http_post
unit Main_U;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, StdCtrls, Buttons, Mask, DBCtrlsEh;
type
TMain_F = class(TForm)
idhtp1: TIdHTTP;
lbl1: TLabel;
lbl2: TLabel;
lbl3: TLabel;
lbl4: TLabel;
edt1: TDBNumberEditEh;
edt2: TDBNumberEditEh;
btn1: TBitBtn;
btn2: TBitBtn;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Main_F: TMain_F;
implementation
{$R *.dfm}
procedure TMain_F.btn1Click(Sender: TObject);
var
I : Integer;
PostList : TStringList;
begin
btn1.Enabled := False;
btn2.Enabled := True;
PostList := TStringList.Create;
PostList.Values['names'] := 'Name';
PostList.Values['sex'] := '男';
PostList.Values['agey'] := '1983';
PostList.Values['agem'] := '1';
PostList.Values['telb'] := '0755';
PostList.Values['TEL'] := '28121215';
PostList.Values['mb'] := '13838385438';
PostList.Values['area'] := '上海';
PostList.Values['city'] := '上海';
PostList.Values['job'] := '销售';
PostList.Values['EMAIL'] := 'hhh@hhh.com';
PostList.Values['ptitle'] := 'lesson';
PostList.Values['idx'] := '';
PostList.Values['Submit.x'] := '75';
PostList.Values['Submit.y'] := '12';
PostList.Values['Submit'] := '提交即可学习五十音图';
for I := 1 to edt1.Value do
begin
try
idhtp1.Post('http://www.sakurajp.com.cn/free/lesson/login.asp',PostList);
except
end;
Caption := IntToStr(I);
Application.ProcessMessages;
if not btn2.Enabled then
begin
Break;
end;
Sleep(edt2.Value);
end;
PostList.Free;
end;
procedure TMain_F.btn2Click(Sender: TObject);
begin
btn2.Enabled := False;
btn1.Enabled := True;
end;
end.
2012-08-06
Googlemap代码
Googlemap代码
unit GEarthMap;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, EarthMap, ComCtrls, ToolWin, XPMan;
type
TFmEarthMap = class(TForm)
stat1: TStatusBar;
Xpmnfst1: TXPManifest;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure OnShowGPS(Sender: TObject; Longitude, Latitude: Double);
procedure OnMapzoomChange(Sender: TObject; AZoom: Integer);
private
FEmGoogle: TEarthMap;
public
end;
var
FmEarthMap: TFmEarthMap;
implementation
{$R *.dfm}
{ TFmEarthMap }
procedure TFmEarthMap.FormCreate(Sender: TObject);
begin
inherited;
FEmGoogle := TEarthMap.Create(Self);
FEmGoogle.Parent := Self;
FEmGoogle.Align := alClient;
FEmGoogle.OnMapGPS := OnShowGPS;
FEmGoogle.OnMapZoomChange := OnMapzoomChange;
end;
procedure TFmEarthMap.FormDestroy(Sender: TObject);
begin
FEmGoogle.Free;
inherited;
end;
procedure TFmEarthMap.OnMapzoomChange(Sender: TObject; AZoom: Integer);
begin
stat1.Panels[2].Text := '地图放大系数:' + IntToStr(FEmGoogle.MapZoom);
end;
procedure TFmEarthMap.OnShowGPS(Sender: TObject; Longitude, Latitude: Double);
begin
stat1.Panels[0].Text := '经度:' + FloatToStr(Longitude);
stat1.Panels[1].Text := '纬度:' + FloatToStr(Latitude);
end;
end.
2012-08-06
cxGrid主从表记录
cxGrid主从表记录导出，不错的代码
for i:=0 to cxGrid1DBTableView1.DataController.RowCount-1 do begin
DetailRecCount:=cxGrid1DBTableView1.ViewData.Rows[i].AsMasterDataRow.ActiveDetailGridView.DataController.RecordCount;
memo1.Lines.Append('');
s:='';
for k:=0 to 2 do begin
v:=cxGrid1DBTableView1.ViewData.Rows[i].Values[k];
if VarIsNull(v) then
s:=s+'; '
else
s:=s+string(v)+'; ';
end;
memo1.Lines.Append(s);
for j:=0 to DetailRecCount-1 do begin
s:=' ';
for k:=0 to 3 do begin
if k=1 then continue;
with TcxGridDBTableView(cxGrid1DBTableView1.ViewData.Rows[i].AsMasterDataRow.ActiveDetailGridView) do
v:=ViewData.Rows[j].Values[k];
if VarIsNull(v) then
s:=s+'; '
else
s:=s+string(v)+'; ';
end;
memo1.Lines.Append(s);
end;
memo1.Lines.Append(' 从表共 '+inttostr(DetailRecCount)+' 笔记录.');
end;
2012-08-06
空空如也
TA创建的收藏夹 TA关注的收藏夹
TA关注的人