請問Stringgrid是否可在cell中加入圖檔 |
尚未結案
|
shyu_ting
一般會員 發表:13 回覆:25 積分:12 註冊:2002-11-04 發送簡訊給我 |
|
hagar
版主 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
|
shyu_ting
一般會員 發表:13 回覆:25 積分:12 註冊:2002-11-04 發送簡訊給我 |
|
william
版主 發表:66 回覆:2535 積分:3048 註冊:2002-07-11 發送簡訊給我 |
引言:我試了文章中的方法,但結果會將該圖檔填滿整個stringgrid,而我需要的是當我點了哪個cell,那個cell才載入圖檔...有其它的做法嗎......感恩Would you mind posing you OnDrawCell here? BTW, I remember TBitmap has some leakage in destroying (resource leak?). Don't know whether it is fixed in Delphi 7 or not. Perhaps you could try using a common bitmap for all the cells? |
hagar
版主 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
|
shyu_ting
一般會員 發表:13 回覆:25 積分:12 註冊:2002-11-04 發送簡訊給我 |
|
hagar
版主 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
以下是 Help 的解釋:
type TGridDrawState = set of (gdSelected, gdFocused, gdFixed);
gdSelected: The cell is currently selected.
gdFocused: The cell has input focus.
gdFixed The cell is in the fixed region of the grid. 發表人 - hagar 於 2003/01/13 16:48:41
|
cmf
尊榮會員 發表:84 回覆:918 積分:1032 註冊:2002-06-26 發送簡訊給我 |
引言: 我試了文章中的方法,但結果會將該圖檔填滿整個stringgrid,而我需要的 是當我點了哪個cell,那個cell才載入圖檔...有其它的做法嗎......感恩unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, Grids, ExtDlgs; type TForm1 = class(TForm) DrawGrid1: TDrawGrid; PopupMenu1: TPopupMenu; ADDIMAGE: TMenuItem; ADDTEXT: TMenuItem; OpenPictureDialog1: TOpenPictureDialog; procedure ADDIMAGEClick(Sender: TObject); procedure ADDTEXTClick(Sender: TObject); procedure DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure FormCreate(Sender: TObject); private { Private declarations } texts:TStringList; Images:Timagelist; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.ADDIMAGEClick(Sender: TObject); var i:integer; bmp:TBitmap; begin if OpenPictureDialog1.Execute then begin i:=DrawGrid1.Row*DrawGrid1.ColCount DrawGrid1.Col; Images.GetBitmap(i,bmp); bmp.LoadFromFile(OpenPictureDialog1.FileName); end; end; procedure TForm1.ADDTEXTClick(Sender: TObject); var InputString: string; i:integer; begin InputString:= InputBox('Input Box', 'Prompt', ''); i:=DrawGrid1.Row*DrawGrid1.ColCount DrawGrid1.Col; texts.Strings[i]:=InputString; end; procedure TForm1.DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); var pt:TPoint; r:TRECT; begin if (ACol>1) and (ARow>1) then begin CanSelect:=TRUE; r:=DrawGrid1.CellRect(ACol, ARow); pt.X:=r.Left; pt.Y:=r.Top; DrawGrid1.ClientToScreen(pt); PopupMenu1.Popup(p1.x.pt.y); end else begin CanSelect:=FALSE; end; end; procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var i:integer; s:string; bmp:string; begin i:=ARow*DrawGrid1.ColCount ACol; s:=texts.Strings[i]; bmp:=Images.GetBitmap(i,bmp); DrawGrid1.Canvas.Draw(RECT.x,RECT.Y,bmp); DrawGrid1.Canvas.TextOut(RECT.x,RECT.Y,s); if State then DrawGrid1.Canvas.FrameRect(RECT); end; procedure TForm1.FormCreate(Sender: TObject); var i,count:integer; bmp:TBitmap; begin count:=DrawGrid1.RowCount*DrawGrid1.ColCount; texts:=TStringList.Create; Images:=Timagelist.Create(self); for i:=0 to count-1 do begin texts.Add(' '); bmp:=TBitmap.Create; Images.Add(bmp,nil); end; end; end.
------
︿︿ |
banson1716
高階會員 發表:55 回覆:182 積分:167 註冊:2002-04-14 發送簡訊給我 |
在StringGrid中顯示ImageList小圖形 (1)使用TStringGrid的OnDrawCell事件
(2)代碼:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol,
ARow: Integer;Rect: TRect; State: TGridDrawState);
var
index: integer;
begin
//確定從ImageList中的小東東的索引號
index := ARow * (Sender as TStringGrid).ColCount ACol; with Sender as TStringGrid do
begin
//填充背景
Canvas.Brush.Color := clBackGround;
Canvas.FillRect(Rect); //把imageList的小東東顯示在StringGrid中
ImageList1.Draw(Canvas,Rect.Left,Rect.Top,index); if gdFocused in State then
Canvas.DrawFocusRect(Rect);
end;
end;
(3)顯示的結果,不知道這個小東東是否對你有幫助?
|
banson1716
高階會員 發表:55 回覆:182 積分:167 註冊:2002-04-14 發送簡訊給我 |
unit Unit1; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Grids,FileCtrl,JPEG, Buttons, ComCtrls; type
TForm1 = class(TForm)
Panel1: TPanel;
StringGrid1: TStringGrid;
Panel2: TPanel;
Image1: TImage;
Button1: TButton;
Edit1: TEdit;
SpeedButton1: TSpeedButton;
Button2: TButton;
Memo1: TRichEdit;
procedure Button1Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure SpeedButton1Click(Sender: TObject);
procedure StringGrid1DblClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
bStop:Boolean;
function ListAllFiles(Path: String): Integer; stdcall;
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1;
FileSize:LongWord;
FileCount:LongWord;
FolderCount:LongWord;
AllCount:LongWord; implementation uses Unit2; {$R *.DFM}
function TForm1.ListAllFiles(Path:String):Integer;stdcall;
var SearchRec:TSearchRec;
ReValue:Integer;
begin
if Copy(Path,length(Path),1)<>'\' then
Path:=Path '\';
ReValue:=FindFirst(Path '*.*',faAnyFile,SearchRec);
while ReValue=0 do
begin
if bStop then
Break;
if SearchRec.Size=0 then
begin
if (SearchRec.Attr and faDirectory)<>0 then //文件夾
begin
if (Trim(SearchRec.Name)<>'.') and (Trim(SearchRec.Name)<>'..') then
begin
Inc(FolderCount);
Inc(AllCount);
StringGrid1.RowCount:=AllCount 1;
StringGrid1.Cells[0,AllCount]:=IntToStr(AllCount);
StringGrid1.Cells[1,AllCount]:='文件夾';
StringGrid1.Cells[2,AllCount]:=Path SearchRec.Name;
ListAllFiles(Path SearchRec.Name);
end;
end
else //0長度文件夾
begin
Inc(FileCount);
Inc(AllCount);
StringGrid1.RowCount:=AllCount 1;
StringGrid1.Cells[0,AllCount]:=IntToStr(AllCount);
StringGrid1.Cells[1,AllCount]:='文件';
StringGrid1.Cells[2,AllCount]:=Path SearchRec.Name;
StringGrid1.Cells[3,AllCount]:=IntToStr(SearchRec.Size);
end;
end
else //普通文件夾
begin
Inc(FileCount);
Inc(AllCount);
StringGrid1.RowCount:=AllCount 1;
StringGrid1.Cells[0,AllCount]:=IntToStr(AllCount);
StringGrid1.Cells[1,AllCount]:='文件';
StringGrid1.Cells[2,AllCount]:=Path SearchRec.Name;
StringGrid1.Cells[3,AllCount]:=IntToStr(SearchRec.Size);
FileSize:=FileSize (SearchRec.FindData.nFileSizeLow);
end;
ReValue:=FindNext(SearchRec);
Application.ProcessMessages;
end;
Result:=1;
end; procedure TForm1.Button1Click(Sender: TObject);
begin
bStop:=False;
FileSize:=0;
FileCount:=0;
AllCount:=0;
FolderCount:=0;
StringGrid1.RowCount:=2;
StringGrid1.Cells[0,0]:='序號';
StringGrid1.Cells[1,0]:='類型';
StringGrid1.Cells[2,0]:='名稱';
StringGrid1.Cells[3,0]:='大小';
ListAllFiles(Edit1.Text);
StringGrid1.RowCount:=StringGrid1.RowCount 1;
StringGrid1.Cells[1,StringGrid1.RowCount-1]:='合計';
StringGrid1.Cells[2,StringGrid1.RowCount-1]:='文件夾數:' IntToStr(FolderCount) '個 ' '文件數:' IntToStr(FileCount) '個';
StringGrid1.Cells[3,StringGrid1.RowCount-1]:=IntToStr(FileSize);
end; procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
Var TmpStr:String;
Flags:Word;
begin
if gdFixed in State then
(Sender as TStringGrid).Canvas.Brush.Color:=(Sender as TStringGrid).FixedColor
else
begin
if gdSelected in State then
(Sender as TStringGrid).Canvas.Brush.Color:=clHighlight
else
(Sender as TStringGrid).Canvas.Brush.Color:=(Sender as TStringGrid).Color;
end;
(Sender as TStringGrid).Canvas.FillRect(Rect);
(Sender as TStringGrid).Canvas.Font.Assign((Sender as TStringGrid).Font);
if (Copy((Sender as TStringGrid).Cells[1,ARow],1,6)='文件夾') and (ACol<>0) then
begin
if gdSelected in State then
(Sender as TStringGrid).Canvas.Brush.Color:=clHighlight
else
(Sender as TStringGrid).Canvas.Brush.Color:=clBtnShadow;
(Sender as TStringGrid).Canvas.FillRect(Rect);
if gdSelected in State then
(Sender as TStringGrid).Canvas.Font.Color:=clHighlightText
else
(Sender as TStringGrid).Canvas.Font.Color:=clRed;
(Sender as TStringGrid).Canvas.Font.Style:=(Sender as TStringGrid).Canvas.Font.Style [fsBold];
TmpStr:=(Sender as TStringGrid).Cells[ACol,ARow];
Flags:=DT_VCENTER or DT_END_ELLIPSIS or DT_SINGLELINE;
if (ACol=0) or (ARow=0) then
Flags:=Flags or DT_CENTER;
DrawText((Sender as TStringGrid).Canvas.Handle,PChar(TmpStr),Length(TmpStr),Rect,Flags);
end else
begin
(Sender as TStringGrid).Canvas.FillRect(Rect);
if gdSelected in State then
(Sender as TStringGrid).Canvas.Font.Color:=clHighlightText
else
(Sender as TStringGrid).Canvas.Font.Color:=clDefault;
TmpStr:=(Sender as TStringGrid).Cells[ACol,ARow];
Flags:=DT_VCENTER or DT_END_ELLIPSIS or DT_SINGLELINE;
if (ACol=3) and (ARow<>0) and (Trim(TmpStr)<>'') then
begin
TmpStr:=TmpStr 'KB';
Flags:=Flags or DT_RIGHT;
end
else if (ACol=0) or (ARow=0) then
Flags:=Flags or DT_CENTER;
DrawText((Sender as TStringGrid).Canvas.Handle,PChar(TmpStr),Length(TmpStr),Rect,Flags);
end;
end; procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
var Mem:TMemoryStream;
Str:String;
i:Integer;
c:Char;
begin
if (ACol=2) and (ARow>0) then
begin
Memo1.Clear;
if (Copy((Sender as TStringGrid).Cells[1,ARow],1,6)='文件夾')
then
Memo1.Text:='<文件夾>'
else if (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.TXT')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.LOG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.BAT')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.PAS')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INI')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INF')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INC')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.PHP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.ASP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.CSS')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.HTM')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.HTML') then
begin
Memo1.Visible:=True;
Image1.Visible:=False;
try
Memo1.Lines.LoadFromFile(StringGrid1.Cells[ACol,ARow]);
except
On E:Exception do
begin
Mem:=TMemoryStream.Create;
try
Mem.LoadFromFile(StringGrid1.Cells[ACol,ARow]);
Str:='';
For i:=0 to Mem.Size-1 do
begin
Mem.Read(C,1);
Str:=Str c;
if i>=63*1000 then
Break;
end;
if Trim(Str)='' then
Memo1.Text:='<空文件>'
else
Memo1.Text:=Trim(Str);
finally
Mem.Free;
end;
end;
end;
end
else if (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.JPG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.JPEG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.BMP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.ICO') then
begin
try
Image1.Picture.LoadFromFile((Sender as TStringGrid).Cells[2,ARow]);
Image1.Visible:=True;
Memo1.Visible:=False;
Except
On E:Exception do
begin
Memo1.Text:='非標準格式' ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]) '文件'
#13#10#13#10 '信息:' E.Message;
Image1.Visible:=False;
Memo1.Visible:=True;
end;
end;
end
else
begin
Memo1.Text:=ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]) '文件';
Image1.Visible:=False;
Memo1.Visible:=True;
end;
end;
end; procedure TForm1.SpeedButton1Click(Sender: TObject);
Var Dir:String;
begin
Dir:=Edit1.Text;
if SelectDirectory(Dir,[],0) then
Edit1.Text:=Dir;
end; procedure TForm1.StringGrid1DblClick(Sender: TObject);
Var ARow,ACol:Integer;
Mem:TMemoryStream;
Str:String;
i:Integer;
c:Char;
begin
ARow:=(Sender as TStringGrid).Selection.Top;
ACol:=(Sender as TStringGrid).Selection.Left;
if ACol=2 then
begin
if (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[ACol,ARow]))='.JPG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[ACol,ARow]))='.JPEG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[ACol,ARow]))='.BMP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[ACol,ARow]))='.ICO') then
begin
if Form2=nil then
Form2:=TForm2.Create(Application);
try
Form2.Image1.Picture.LoadFromFile((Sender as TStringGrid).Cells[ACol,ARow]);
Form2.Image1.Visible:=True;
Form2.Memo1.Visible:=False;
Form2.Show;
Except
Form2.Close;
end;
end
else if (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.TXT')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.LOG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.BAT')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.PAS')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INI')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INF')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INC')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.PHP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.ASP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.CSS')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.HTM')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.HTML') then
begin
if Form2=nil then
Form2:=TForm2.Create(Application);
Form2.Memo1.Visible:=True;
Form2.Image1.Visible:=False;
try
Form2.Memo1.Lines.LoadFromFile(StringGrid1.Cells[ACol,ARow]);
Form2.Show;
except
On E:Exception do
begin
Mem:=TMemoryStream.Create;
try
Mem.LoadFromFile(StringGrid1.Cells[ACol,ARow]);
Str:='';
For i:=0 to Mem.Size-1 do
begin
Mem.Read(C,1);
Str:=Str c;
if i>=63*1000 then
Break;
end;
if Trim(Str)='' then
Form2.Memo1.Text:='<空文件>'
else
Form2.Memo1.Text:=Trim(Str);
Form2.Show;
finally
Mem.Free;
end;
end;
end;
end;
end;
end; procedure TForm1.Button2Click(Sender: TObject);
begin
bStop:=True;
end; end.
|
shyu_ting
一般會員 發表:13 回覆:25 積分:12 註冊:2002-11-04 發送簡訊給我 |
|
cmf
尊榮會員 發表:84 回覆:918 積分:1032 註冊:2002-06-26 發送簡訊給我 |
|
shyu_ting
一般會員 發表:13 回覆:25 積分:12 註冊:2002-11-04 發送簡訊給我 |
|
cmf
尊榮會員 發表:84 回覆:918 積分:1032 註冊:2002-06-26 發送簡訊給我 |
unit Unit1; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, ImgList; type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
ImageList1: TImageList;
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.dfm} procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
var
s:string;
begin
if CanSelect then
begin
s:=StringGrid1.Cells[1,ARow];
if s='FALSE' then
begin
s:='TRUE';
end
else if s='TRUE' then
begin
s:='FALSE';
end
else
begin
s:='TRUE';
end; StringGrid1.Cells[1,ARow]:=s;
end; end; procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin if ACol=1 then
begin
if StringGrid1.Cells[1,ARow] = 'TRUE' then
begin
ImageList1.Draw(StringGrid1.Canvas,RECT.LEFT,RECT.Top,1);
end
else
begin
ImageList1.Draw(StringGrid1.Canvas,RECT.LEFT,RECT.Top,0);
end; end
else
begin StringGrid1.Canvas.TextOut(RECT.Left,RECT.Top,StringGrid1.CellRect(ACol, ARow));
StringGrid1.Canvas.FrameRect(RECT);
end; end; end. 發表人 - cmf 於 2003/01/20 14:16:56
------
︿︿ |
shyu_ting
一般會員 發表:13 回覆:25 積分:12 註冊:2002-11-04 發送簡訊給我 |
|
cmf
尊榮會員 發表:84 回覆:918 積分:1032 註冊:2002-06-26 發送簡訊給我 |
引言: 感謝CMF的程式幫忙,我的問題大致已得到解答,另外你的程式會將圖和True 或False字樣重疊,是否有辦法避免...謝謝!!!!procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); var s:string; begin if CanSelect then begin s:=StringGrid1.Objects[1,ARow]; if s='FALSE' then begin s:='TRUE'; end else if s='TRUE' then begin s:='FALSE'; end else begin s:='TRUE'; end; StringGrid1.Objects[1,ARow]:=s; end; end; procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin if ACol=1 then begin if StringGrid1.Objects[1,ARow] = 'TRUE' then begin ImageList1.Draw(StringGrid1.Canvas,RECT.LEFT,RECT.Top,1); end else begin ImageList1.Draw(StringGrid1.Canvas,RECT.LEFT,RECT.Top,0); end; end else begin StringGrid1.Canvas.TextOut(RECT.Left,RECT.Top,StringGrid1.CellRect(ACol, ARow)); StringGrid1.Canvas.FrameRect(RECT); end; end; end.
------
︿︿ |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |