一年前的这个时候第一次接触DELPHI,一年后的今天发布一个新软件,请大家帮助测试!谢谢~~~新年快乐!!!^_^

[ehom]

《亿合图像秀》1.0a 基础版

下载地址：
http://www.ehom.net/picshow.exe
http://www.ehomsoft.com/picshow.exe
http://www.you365.com/picshow.exe
http://www.2xsky.com/picshow.exe

此版本实为应急之作，不足之处好望多多指教！：）

注：图像预览的问题比较大，主要是因为选用的实现方式不当！以后会重写这部分代码！

两个月后将发布一包含：图像浏览，图像处理，图像获取，图像输出，图像管理等模块的完整版！并且会通过插件方式获得对更多格式的支持！（支持dwg,sld,dxf等格式的插件已基本完成，本版本只提供对20种常见格式的支持）

[tata1]

界面做的很好，只是觉得选择文件速度慢了点。

[xiaoqlj]

好，值得向你学习学习。

[ehom]

To getter:

部分源代码:

var
LV : TListItem;
LV_File : TListView;

procedure TMain.PicListShow;
var
PicFileSize,PFile,i:integer;
FSize,FDateTime:String;
begin
For i:=1 to FileListView.Items.Count do
begin
try
if FileListView.Directory<>SV.Directory then Break;
LV:=LV_File.Items.Item[i-1];
LV.ImageIndex:=GetFileIcoIndex(Main.FileListView.Items.Strings[i-1]);
Repeat
PFile:=FileOpen(Main.FileListView.Items.Strings[i-1], fmOpenRead);
until PFile<>-1;
FDateTime:=DateTimeToStr(FileDateToDateTime(FileGetDate(PFile)));
PicFileSize:=FileSeek(PFile,0,2);
FileClose(PFile);
if PicFileSize<1024 then
FSize:=inttostr(PicFileSize)+' 字节'
else if PicFileSize<1048576 then
FSize:=floattostr(Trunc(PicFileSize/102.4)/10)+' KB'
else
FSize:=floattostr(Trunc(PicFileSize/104857.6)/10)+' MB';
LV.SubItems.Add(FSize);
LV.SubItems.Add(FDateTime);
except
Continue;
end;
Application.ProcessMessages;
end;
end;

procedure TMain.PicNameListShow;
var
i:integer;
begin
LV_File.Clear;
For i:=1 to Main.FileListView.Items.Count do
begin
try
LV:=LV_File.Items.Add;
LV.Caption:=FileListView.Items.Strings[i-1];
LV.ImageIndex:=-1;
except
Continue;
end;
end;
end;

LV_File.Items.BeginUpdate;
PicNameListShow;
with LV_File do
begin
SmallImages.Free;
SmallImages:=TImageList.CreateSize(16,16);
SmallImages.ShareImages := True;
SmallImages.Handle:=ShGetFileInfo(PChar(SV.Directory),0,FileInfo,SizeOf(FileInfo),SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX);
end;
if LV_File.ViewStyle=vsIcon then
begin
ThrdSee.Create(False);
end
else
begin
PicListShow;
end;
end;
LV_File.Items.EndUpdate;

[happyfancy]

不错的东西

只要在细节上下点功夫

排序。。。。

[getter]

thank u~!
當有問題時,希望一起研究...

[buaalhy21st]

恭喜
向你学习

[goomoo]

很好。界面是如何做的？

[goomoo]

你的主页啥都没有？

[WJY2003]

太好了呀!
如果大家都说点东东出来都会长进的!
我是刚学的后来之人才一个多月吧.
我也很希望自已一年之后能学出点名堂来你的不错
不管别人如何说自已已做出来啦
比那些只说不做的强多了
我支持你!
BUG谁都会有如果没有BUG那不叫软件!!!

[ddvboy]

ok

[ehom]

图形界面的制作并不难

所有可视控件都是GDI画出来的,你当然也可以自己写代码画!DELPHI中可以利用TCanvas!

完成图形窗体的制作后,对于标题栏有两种方法!我用的是模拟标题栏替换的方法!

给出部分代码:

procedure HitTest (var Msg: TWmNcHitTest);message WM_NCHITTEST;
procedure WndProc(var Msg:TMessage);override;

procedure TMainForm.HitTest(var Msg: TWmNcHitTest);
var pt:TPoint;
begin
inherited;
if (WindowState<>wsNormal) then
begin
inherited;
exit;
end;
pt:=Point(Msg.xPos,Msg.yPos);
pt:=ScreenToClient(pt);
if (pt.x<5) and (pt.y<5) then Msg.Result:=htTopLeft
else if (pt.x>width-5) and (pt.y<5) then Msg.Result:=htTopRight
else if (pt.x>width-5) and (pt.y>height-5) then Msg.Result:=htBottomRight
else if (pt.x<5) and (pt.y>height-5) then Msg.Result:=htBottomLeft
else if (pt.x<5) then Msg.Result:=htLeft
else if (pt.y<5) then Msg.Result:=htTop
else if (pt.x>width-5) then Msg.Result:=htRight
else if (pt.y>height-5) then Msg.Result:=htBottom
else inherited;
if Htclient=Msg.result then Msg.result:=htcaption;
end;

procedure TMainForm.WndProc(var Msg:TMessage);
begin
inherited WndProc(Msg);
if Msg.Msg=WM_ACTIVATE then
begin
case Msg.WParamLo of
WA_ACTIVE,WA_CLICKACTIVE:
begin
Ltitle.Font.Color:=$000000;
Self.FormStyle:=fsStayOnTop;
end;
WA_INACTIVE:
begin
Ltitle.Font.Color:=$778899;
end;
end;
end;
end;

procedure TMainForm.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
if NewHeight<=200 then NewHeight:=200;
if NewWidth<=300 then NewWidth:=300;
end;

procedure TMainForm.SysBtn_2Click(Sender: TObject);
begin
if WindowState=wsMaximized then
begin
ImgListSys.GetBitmap(0,SysBtn_2.Picture.Bitmap);
WindowState:=wsNormal;
end
else
begin
ImgListSys.GetBitmap(1,SysBtn_2.Picture.Bitmap);
WindowState:=wsMaximized;
end;
end;

procedure TMainForm.SysBtn_1Click(Sender: TObject);
begin
if Application.MainForm=Self then
Application.Minimize
else
WindowState:=wsMinimized;
end;

[brainers]

蛮厉害的~~但愿等我学了有一年的时候也能做出这个样子!

[fanky2003]

up

[whyNotHere]

一年就长了两颗星,厉害!

[singlesword]

这样的界面我喜欢，呵呵，我一直想
用这样的界面做东西，只是一直没有时间呢。

有点像网页的风格。

[hou_jg]

看上去很舒服！用的也不错！

[getter]

我亦斷斷續續學了年半的delphi...但...唉...14科測驗搞死我了...

[del_c_sharp]

友情Bug一个 :)

图象预览和浏览 切换图象时,如果新图像格式是透明背景的Gif文件,那么透明部分会显示上一副图片的内容,估计是运算次序或者...... ^_^

希望继续改良~~~

[ehom]

谢谢摩托,新版本中应该不存在这个BUG吧?^_^

[Jackeystone]

朋友，写得不错了。我用了一下，有这么个问题如果看的图片多的时候，在预览的最下面一行的图片的名字没了。